NewsForumsCodeLogsGallerySpecsSearch

Code archives/Algorithms/Generate Nice Terrain+Lightmap

This code has been declared by its author to be Public Domain code.

Download source code

Generate Nice Terrain+Lightmap by Bobysait2008
This Code makes paradisiac islands, generates the colormap and the lightmap.

We can update the lightmap in realtime, it may use about 50 ms to render a 256*256 Terrain, so it 's very fast.
For bigger Terrain, we could use multiple pass to render the lightmap in realtime.

This code is here for free, you may use it for your own project (commercial or not), but eventually, credit are always welcome.

Comments are also welcome.
ps : Yes, Of course, I love when people say I'm clever ^^


Features :
the ColorMap process use a simple "height to ColorLevel" system.
the Lightmap use an algorythm of ray to check the height of the terrain along the Sun vector.
The generated terrain is a little bit rocky, so you might want to blur the heightmap before any other process. 
Graphics3D 800,600,0,2
SetBuffer BackBuffer()

Local World%=	CreatePivot		();

Local piv	=	CreatePivot		(World);
Local cam	=	CreateCamera	(piv);
Local CamY#	=	10.0
				PositionEntity	(cam, 0,CamY,0,0);
				CameraRange		(cam, 1,10000);
				CameraClsColor	(cam, 100,150,255);

Local Sun%	=	CreateSphere	(10,World)
				PositionEntity	(Sun,1000,500,1000)
				ScaleEntity		(Sun,15,15,15)
				EntityColor		(Sun,250,230,220)
				EntityFX		(Sun,1)
				PointEntity		(Sun,World)
Local TSize%=	512
Local Terr	=	CreateTerrain	(TSize,World)
				Generation_Terrain(Terr,4,250,4,150,.01,.15,20,TSize/3)
				TerrainColore	(Terr)
;				ExtractLightMap	(Terr,4,250,Sun)
				EntityFX		(Terr,1)

Local Plane%=	CreatePlane		(1,World)
				EntityColor		(Plane,80,50,10)
				EntityFX		(Plane,1)

Local Sea%	=	CreatePlane		(1,World)
				EntityColor		(Sea,10,50,100)
				EntityFX		(Sea,1)
				EntityAlpha		(Sea,.5)
				MoveEntity		(Sea,0,250*.08,0)

Local MainTime%=MilliSecs()
Local OldTime%=0
Repeat
	msx=MouseXSpeed()
	msy=MouseYSpeed()
	msz=MouseZSpeed()
	TurnEntity piv,0,-msx,0
	TurnEntity cam,+msy,0,0
	Local vz# = Float ( ( ( KeyDown(200)+KeyDown(17) ) > 0 ) - ( ( KeyDown(208)+KeyDown(31) ) > 0 ) )
	Local vx# = Float ( ( ( KeyDown(205)+KeyDown(32) ) > 0 ) - ( ( KeyDown(203)+KeyDown(30) ) > 0 ) )
	MoveEntity piv,.1*vx*CamY,0,.1*vz*CamY
	Px#=EntityX(piv,1)
	Pz#=EntityZ(piv,1)
	Py#=TerrainY(Terr,Px,0,Pz)
	PositionEntity piv,pX,Py,Pz
	If msz CamY=CamY+CamY*.1*Float(msz):PositionEntity cam,0,CamY,0,0

	Time=MilliSecs()-MainTime
	; 4*360° / Min
		AT%=Float(time)*.001
		Tour%=4
		Dec#=.360
		Ang#=Dec*Float(AT*Tour)
		Rayon#=1500.0
		SunPosX#=Rayon*Cos(Ang):SunPosZ#=Rayon*Sin(Ang)
		PositionEntity Sun,SunPosX,500,SunPosZ,1:PointEntity Sun,World

		If Time>OldTime	ExtractLightMap(Terr,4,250,Sun):OldTime=Time+5000

	MoveMouse 400,300
	RenderWorld
		Text 10,10,"Ang="+Ang
	Flip
Until KeyHit(1)
FreeEntity World
End

Function Generation_Terrain(Terrain%,sclX#,sclY#,sclZ#,nbc#,COEF_HAUT1#=.005,COEF_HAUT2#=.02,Zone1#=15,Zone2#=50, smoothterrain%=2)
	Local Taille#=TerrainSize(Terrain)
	SeedRnd (MilliSecs())
	Local a
	For a = 0 To nbc
		; varie la hauteur de coef1 à coef2 => plus la surface est grande, plus on adoucie !
		; inversement, plus la surface est petite, plus on generera de "pics"
		Local COEF_HAUT#	=	Rnd(COEF_HAUT1,COEF_HAUT2)
		Local ZONE#			=	Rnd(Zone1/2,Zone2/2);*COEF_HAUT*10
		
		Local Force# = 1.0 / (ZONE*COEF_HAUT);
		If Force<1 Then Force=1;
		If Force>10 Then Force=10;
		
		;ZONE=ZONE/2
		Local COEF#=90.0/ZONE
		Local pX#=Rand(ZONE+Taille/10,Taille#-ZONE-Taille/10)
		Local pZ#=Rand(ZONE+Taille/10,Taille#-ZONE-Taille/10)
		TFormPoint pX,0,pZ,0,Terrain : pX=TFormedX():pZ=TFormedZ()
		
		Local frc%
		For frc=1 To Force
			pX=pX+Rand(-ZONE/Force,ZONE/Force)
			pZ=pZ+Rand(-ZONE/Force,ZONE/Force)
			Local X#, Z#
			Local AH_X#, AH_Y#, AH_Z#, AH_T#
			For X = -ZONE To ZONE
				AH_X	=	Cos(X*COEF)*COEF_HAUT
				For Z# = -ZONE To ZONE
					AH_Z	=	Cos(Z*COEF)
					AH_T	=	AH_X * AH_Z + TerrainHeight(Terrain,pX+X,pZ+Z)
					If AH_T>1	Then AH_T=1;
					ModifyTerrain Terrain, pX+X,pZ+Z,AH_T
				Next
			Next
		Next
	Next
	
	For i = smoothterrain To TerrainSize(Terrain)-1-smoothterrain
		For j = smoothterrain To TerrainSize(Terrain)-1-smoothterrain
			Local sum# = 0.0, nb=0
			For tx = -smoothterrain To smoothterrain
				For ty = -smoothterrain To smoothterrain
					sum=sum+TerrainHeight(Terrain, i+tx,j+ty)
					nb=nb+1
				Next
			Next
			ModifyTerrain(Terrain, i,j, sum/nb, True);
		Next
	Next
	ScaleEntity (Terrain,sclX#,sclY#,sclZ#)
	MoveEntity	(Terrain,-sclX*Taille*.5,0,-sclZ*Taille*.5)

End Function


Function TerrainColore(Terrain%)
	Tsz	=	TerrainSize		(Terrain)
	Tex	=	CreateTexture	(Tsz,Tsz):ScaleTexture(Tex,Tsz,Tsz)
	CBuf%=	GraphicsBuffer	()
	TBuf%=	TextureBuffer	(Tex):SetBuffer(TBuf):LockBuffer(TBuf)
	For i = 0 To Tsz-1
		For j = 0 To Tsz-1
			AH_T#=TerrainHeight(Terrain,i,j)
			If AH_T<.08		; Sol->Mer => Sol->Sable
				Dh#=AH_T*1.0/.08	:R=080+030*Dh:G=050+030*Dh:B=010+040*Dh	; fin = 110 / 080 / 050
			ElseIf AH_T<.1	; Sable
				Dh#=(AH_T-.08)*1/.02:R=110+080*Dh:G=080+080*Dh:B=050+070*Dh	; fin = 190 / 160 / 120
			ElseIf AH_T<.15	; Herbe
				Dh#=(AH_T-.1)*1/.05	:R=190-170*Dh:G=160-120*Dh:B=120-110*Dh	; fin = 020 / 040 / 010
			ElseIf AH_T<.7	; Roche
				Dh#=(AH_T-.17)*1/.55:R=020+080*Dh:G=040+060*Dh:B=010+040*Dh	; fin = 120 / 100 / 050
			Else			; neige
				Dh#=(AH_T-.72)*1/.3	:R=120+020*Dh:G=100+050*Dh:B=050+160*Dh	; fin = 180 / 150/ 210
			EndIf
			If R<0 R=0
			If G<0 G=0
			If B<0 B=0
			WritePixelFast i,Tsz-j-1,R Shl(16) + G Shl(8) + B
		Next
	Next
	UnlockBuffer(TBuf):SetBuffer(CBuf)
	EntityTexture	(Terrain,Tex,0,0):FreeTexture(Tex)
End Function

Dim Terr_Shd#(0,0)
Function ExtractLightMap%(Terrain%,Scx#,Scy#,Sun%=0)
	Local Sz#	=	TerrainSize(Terrain)
	Dim Terr_Shd(Sz,Sz)
	Local LMap	=	CreateTexture(Sz,Sz):ScaleTexture(LMap,Sz,Sz):EntityTexture(Terrain,LMap,0,2)
	Local CBuff%=	GraphicsBuffer(),TBuff%=TextureBuffer(LMap)
	If Sun<>0	:TFormNormal(0,0,1,Sun,0)
	Else		:TFormNormal(-1,-.5,-.8,0,0)
	EndIf
	Local SunVx#=TFormedX(),SunVy#=TFormedY(),SunVz#=TFormedZ()
	Scy#=Scy/Scx
	For i = 0 To Sz-1
		For j = 0 To Sz-1
			dx#=0.0:dy#=0.0:dz#=0.0:dh#=TerrainHeight(Terrain,i,j)*Scy
			Repeat
				dx=dx+SunVx*.95:dy=dy+SunVy*.95:dz=dz+SunVz*.95
				If i+dx>=0 And i+dx<Sz And j+dz>=0 And j+dz<Sz
					TrY#=TerrainHeight(Terrain,i+dx,j+dz)*Scy
					If TrY>dh+dy Exit
					Terr_Shd(i+dx,j+dz)=.9-.4*(dh-Try)/Scy
				Else	:Exit
				EndIf
			Forever
		Next
	Next
	SetBuffer(TBuff):LockBuffer(TBuff)
	For i= 0 To Sz-1:For j= 0 To Sz-1
		If Terr_Shd(i,j)<>0	:rgb=255*Terr_Shd(i,j)
		Else				:rgb=255
		EndIf
		WritePixelFast i,Sz-j-1,RGB Shl(16) + RGB Shl(8) + RGB + 255 Shl(24)
	Next:Next
	UnlockBuffer(TBuff):SetBuffer CBuff
	FreeTexture			(LMap)
	Dim Terr_Shd(0,0)
End Function

Comments

Bobysait2008
and here is the multi pass for shadowing the terrain in realtime


Dim Terr_Shd#(0,0)
Global LightmapExtracted%=False
Function ExtractLightMap%(Terrain%,Scx#,Scy#,Sun%=0,FreeLightmap%=True)
	Local Sz#	=	TerrainSize(Terrain)
	Dim Terr_Shd(Sz,Sz)
	Local LMap	=	CreateTexture(Sz,Sz,1+16+32):ScaleTexture(LMap,Sz,Sz):EntityTexture(Terrain,LMap,0,2)
	Local CBuff%=	GraphicsBuffer(),TBuff%=TextureBuffer(LMap)
	If Sun<>0 :TFormNormal(0,0,1,Sun,0) :Else :TFormNormal(-1,-.5,-.8,0,0) :EndIf
	Local SunVx#=TFormedX(),SunVy#=TFormedY(),SunVz#=TFormedZ()
	scy#=Scy/Scx
	For i = 0 To Sz-1:For j = 0 To Sz-1 :dx#=0.0:dy#=0.0:dz#=0.0:dh#=TerrainHeight(Terrain,i,j)*scy :Repeat
		dx=dx+SunVx*.95:dy=dy+SunVy*.95:dz=dz+SunVz*.95
		If i+dx>=0 And i+dx<Sz And j+dz>=0 And j+dz<Sz
			TrY#=TerrainHeight(Terrain,i+dx,j+dz)*scy:If TrY>dh+dy:Exit:EndIf:Terr_Shd(i+dx,j+dz)=.9-.4*(dh-Try)/Scy
		Else :Exit :EndIf
	Forever :Next:Next
	SetBuffer(TBuff):LockBuffer(TBuff)
	For i= 0 To Sz-1:For j= 0 To Sz-1
		If terr_Shd(i,j)<>0 :rgb=255*terr_Shd(i,j) :Else :rgb=255 :EndIf
		WritePixelFast i,Sz-j-1,RGB Shl(16) + RGB Shl(8) + RGB + 255 Shl(24)
	Next:Next
	UnlockBuffer(TBuff):SetBuffer CBuff:TextureBlend(LMap,5)
	If FreeLightmap	:FreeTexture(LMap):Dim Terr_Shd(0,0):LightmapExtracted=False
	Else			:LightmapExtracted=True:Return LMap
	EndIf
End Function

Global CurseurI%,CurseurJ%
Global CurseurFromI%,CurseurToI
Global CurseurFromJ%,CurseurToJ
Function TerrainRealtimeShadowMap(Terrain%,LMap%,Scx#,scy#,Sun%=0)
	Local Sz#	=	TerrainSize(Terrain)
	If LightmapExtracted=False	LMap=ExtractLightMap(Terrain,Scx,Scy,Sun,False) :CurseurToI=Sz-1 :CurseurToJ=Sz-1 :CurseurFromI=0: CurseurFromJ=0
	Local CBuff%=	GraphicsBuffer(),TBuff%=TextureBuffer(LMap)
	If Sun<>0 :TFormNormal(0,0,1,Sun,0) :Else :TFormNormal(-1,-.5,-.8,0,0) :EndIf
	Local SunVx#=TFormedX(),SunVy#=TFormedY(),SunVz#=TFormedZ():scy#=Scy/Scx
	CurseurFromI=0 :CurseurToI=Sz-1
	If CurseurFromJ=Sz-1 :CurseurFromJ=0 :Else :CurseurFromJ=CurseurFromJ+1 :EndIf
	If CurseurFromJ>Sz-1 CurseurFromJ=Sz-1
	CurseurToJ=CurseurFromJ
	Local dx#,dy#,dz#,dh#
	For i = CurseurFromI To CurseurToI :For j = CurseurFromJ To CurseurToJ:dx=0:dy=0:dz=0:dh=TerrainHeight(Terrain,i,j)*scy :Repeat
		dx=dx+SunVx*.95:dy=dy+SunVy*.95:dz=dz+SunVz*.95
		If i+dx>=0 And i+dx<Sz And j+dz>=0 And j+dz<Sz
			TrY#=TerrainHeight(Terrain,i+dx,j+dz)*scy :If TrY>dh+dy:Exit:EndIf:Terr_Shd(i+dx,j+dz)=.9-.4*(dh-Try)/Scy
		Else :Exit :EndIf
	Forever:Next:Next
	SetBuffer(TBuff):LockBuffer(TBuff)
	For i = CurseurFromI To CurseurToI:For j = CurseurFromJ To CurseurToJ
		If terr_Shd(i,j)<>0	:rgb=255*terr_Shd(i,j) :Else :rgb=255 :EndIf
		WritePixelFast i,Sz-j-1,RGB Shl(16) + RGB Shl(8) + RGB; + 255 Shl(24)
	Next:Next
	UnlockBuffer(TBuff):SetBuffer CBuff:Return LMap
End Function



=> TerrainRealtimeShadowMap(Terrain%,LMap%,Scx#,scy#,Sun%=0)
Specify the LightMap Texture applyied to the terrain
So, you 'll have 2 choices :
choise 1 : -> Make a first complete rendering using "ExtractLightMap" function
For convinience, I had an extra "LightmapExtracted" global, if the Lightmap has not yet been extracted, then the lightmap will be automatically generated...

choise 2 : -> Make a cleared texture, apply it to the terrain, and specify the texture to LMap parameter for TerrainRealtimeShadowMap(Terrain%,LMap%,Scx#,scy#,Sun%=0)

the function TerrainRealtimeShadowMap() is made to be used inside the main loop
it performs line after line shadow render
the larger the terrain, most time it needs.

It ran it at 500 FPS on a 1024*1024 TerrainSize (Config in Sig)


DareDevil2008
Good !!!

if you store in array the value TerrainHeight(Terrain,i+dx,j+dz) obtainend over speed

bye


DareDevil2008
Hi have changed your code for litle speed up

Bye

Graphics3D 800,600,0,2
SetBuffer BackBuffer()

Local World%=	CreatePivot		()

Local piv	=	CreatePivot		()
Local cam	=	CreateCamera	()
Local CamY#	=	1000.0
PositionEntity	(cam,0,CamY,0,0)
CameraRange		(cam,1,5000)

Local Sun%	=	CreateSphere	(10,World)
PositionEntity	(Sun,1000,500,1000)
ScaleEntity		(Sun,15,15,15)
EntityColor		(Sun,250,230,220)
EntityFX		(Sun,1)
PointEntity		(Sun,World)
Local TSize%=	256
Local Terr	=	CreateTerrain	(TSize,World)
Generation_Terrain(Terr,4,250,4,150,.01,.15,20,TSize/3)
TerrainColore	(Terr)
;				ExtractLightMap	(Terr,4,250,Sun)
EntityFX		(Terr,1)

Local Plane%=	CreatePlane		(1,World)
EntityColor	(Plane,80,50,10)
EntityFX		(Plane,1)

Local Sea%	=	CreatePlane		(1,World)
EntityColor	(Sea,10,50,100)
EntityFX		(Sea,1)
EntityAlpha	(Sea,.5)
MoveEntity	(Sea,0,250*.08,0)


Global OldTime%=MilliSecs()
;Stop
Global TLightMap = ExtractLightMap(Terr,4,250,Sun,False)
Repeat
	spd#=5
	
	;TurnEntity piv,0,-msx,0
	;TurnEntity cam,+msy,0,0
	;MoveEntity piv,0,0,.1*(KeyDown(200)-KeyDown(208))*CamY
	
	MoveEntity cam,(KeyDown(205)-KeyDown(203))*spd,0,((MouseDown(1)Or KeyDown(201))-(MouseDown(2)Or KeyDown(207)))*spd
	TurnEntity cam,-MouseYSpeed()*0.1,-MouseXSpeed()*0.1,0
	RotateEntity cam,EntityPitch(cam,True),EntityYaw(cam,True),0
	MoveMouse GraphicsWidth()*.5,GraphicsHeight()*.5
	
	;PositionEntity cam,0,CamY,0,0
		
;	Time=MilliSecs()-MainTime
; 4*360° / Min
	
	
	Dec#=Dec#+1.0
	Local Rayon#=1000.0
	Local SunPosX#=Rayon*Cos(Dec)
	Local SunPosZ#=Rayon*Sin(Dec)
	PositionEntity Sun,SunPosX,500,SunPosZ,1:PointEntity Sun,World
	
	;If Time>OldTime	TerrainRealtimeShadowMap(Terr,TLightMap,4,250,Sun):OldTime=Time+1
		
	ExtractLightMap(Terr,4,250,Sun,False)
	;TerrainRealtimeShadowMap(Terr,TLightMap,4,250,Sun)
	
	MoveMouse 400,300
	RenderWorld
	Text 10,10,"Ang : "+Dec
	Text 10,20,"Fps : "+(MilliSecs()-OldTime) : OldTime%=MilliSecs()
	Flip(True)
Until KeyHit(1)
FreeEntity World
End
		
Function Generation_Terrain(Terrain%,sclX#,sclY#,sclZ#,nbc#,COEF_HAUT1#=.005,COEF_HAUT2#=.02,Zone1#=15,Zone2#=50)
	Local Taille#=TerrainSize(Terrain)
	SeedRnd (MilliSecs())
	For a=0 To nbc#
		; varie la hauteur de coef1 à coef2 => plus la surface est grande, plus on adoucie !
		; inversement, plus la surface est petite, plus on generera de "pics"
		Local COEF_HAUT#=Rnd(COEF_HAUT1,COEF_HAUT2)
		Local ZONE#=Rand(Zone1/2,Zone2/2);*COEF_HAUT*10
		Force=1/(ZONE*COEF_HAUT)
		If Force<1 Force=1
			If Force>10 Force=10
		;ZONE=ZONE/2
				Local COEF#=90.0/ZONE
				pX#=Rand(ZONE+Taille/10,Taille#-ZONE-Taille/10)
				pZ#=Rand(ZONE+Taille/10,Taille#-ZONE-Taille/10)
				TFormPoint Px,0,Pz,0,Terrain
				PX=TFormedX():PZ=TFormedZ()
				For frc=1 To Force
					Px=Px+Rand(-ZONE/Force,ZONE/Force)
					Pz=Pz+Rand(-ZONE/Force,ZONE/Force)
					For X# = -ZONE To ZONE
						AH_X#	=	Cos(X*COEF)*COEF_HAUT
						For Z# = -ZONE To ZONE
							AH_Z#	=	Cos(Z*COEF)
							AH_T#	=	AH_X*AH_Z+TerrainHeight(Terrain,Px+X,Pz+Z)
							If AH_T>1 AH_T=1
								ModifyTerrain Terrain, Px+X,Pz+Z,AH_T
							Next
						Next
					Next
				Next
				ScaleEntity (Terrain,sclX#,sclY#,sclZ#)
				MoveEntity	(Terrain,-sclX*Taille*.5,0,-sclZ*Taille*.5)
				
End Function


Function TerrainColore(Terrain%)
	Local px%,py%
	Tsz	=	TerrainSize		(Terrain)
	Tex	=	CreateTexture	(Tsz,Tsz):ScaleTexture(Tex,Tsz,Tsz)
	CBuf%=	GraphicsBuffer	()
	TBuf%=	TextureBuffer	(Tex):SetBuffer(TBuf):LockBuffer(TBuf)
	For px = 0 To Tsz-1
		For py = 0 To Tsz-1
			AH_T#=TerrainHeight(Terrain,px,py)
			If AH_T<.08		; Sol->Mer => Sol->Sable
				Dh#=AH_T*1.0/.08	
				R=080+030*Dh
				G=050+030*Dh
				B=010+040*Dh	; fin = 110 / 080 / 050
			ElseIf AH_T<.1	; Sable
				Dh#=(AH_T-.08)*1/.02
				R=110+080*Dh
				G=080+080*Dh
				B=050+070*Dh	; fin = 190 / 160 / 120
			ElseIf AH_T<.15	; Herbe
				Dh#=(AH_T-.1)*1/.05	
				R=190-170*Dh
				G=160-120*Dh
				B=120-110*Dh	; fin = 020 / 040 / 010
			ElseIf AH_T<.7	; Roche
				Dh#=(AH_T-.17)*1/.55
				R=020+080*Dh
				G=040+060*Dh
				B=010+040*Dh	; fin = 120 / 100 / 050
			Else			; neige
				Dh#=(AH_T-.72)*1/.3	
				R=120+020*Dh
				G=100+050*Dh
				B=050+160*Dh	; fin = 180 / 150/ 210
			EndIf
			If R<0 R=0
				If G<0 G=0
					If B<0 B=0
						WritePixelFast px,Tsz-py-1,R Shl(16) + G Shl(8) + B
					Next
				Next
				UnlockBuffer(TBuf):SetBuffer(CBuf)
				EntityTexture	(Terrain,Tex,0,0):FreeTexture(Tex)
End Function




Dim Terr_Shd#(0,0)
Global CurseurI%,CurseurJ%
Global CurseurFromI%,CurseurToI
Global CurseurFromJ%,CurseurToJ
Global LightmapExtracted%=False

Function ExtractLightMap%(Terrain%,Scx#,Scy#,Sun%=0,FreeLightmap%=True)
	;===>
	Local Sz#	=	TerrainSize(Terrain)
	Local LMap	=	CreateTexture(Sz,Sz,1+16+32) : TextureBlend(LMap,2)
	Local CBuff%=	GraphicsBuffer()
	Local TBuff%=TextureBuffer(LMap)
	Local SunVx#, SunVy#, SunVz#;
	Local px%,py%
	Local dx#,dy#,dz#,dh#
	Local fa#,fb#
	Local RGB%
	Local TrY#=0
	;===>
	Dim Terr_Shd(Sz,Sz)
	;===>
	ScaleTexture(LMap,Sz,Sz)
	EntityTexture(Terrain,LMap,0,2)
	If Sun<>0 Then 
		TFormNormal(0,0,1,Sun,0) 
	Else 
		TFormNormal(-1,-.5,-.8,0,0) 
	EndIf
	SunVx#=TFormedX();
	SunVy#=TFormedY();
	SunVz#=TFormedZ();
	Scy#=Scy/Scx;
	
	For px = 0 To Sz-1
		For py = 0 To Sz-1 
			dx#=0.0
			dy#=0.0
			dz#=0.0
			dh#=TerrainHeight(Terrain,px,py)*Scy 
			Repeat
				;===>
				dx = dx+SunVx
				dy = dy+SunVy
				dz = dz+SunVz
				fa = px+dx
				fb = py+dz
				;===>
				If fa>=0 And fa<Sz And fb>=0 And fb<Sz Then 
					TrY#=TerrainHeight(Terrain,fa,fb)*Scy
					If TrY>dh+dy Then 
						Exit
					EndIf
					Terr_Shd(fa,fb)=.9-.4*(dh-TrY)/Scy
				Else 
					Exit 
				EndIf
			Forever
		Next
	Next
	
	PI_Smooth(Terrain)
	
	SetBuffer(TBuff)
	LockBuffer(TBuff)
	For px= 0 To Sz-1
		For py= 0 To Sz-1
			If Terr_Shd(px,py)>0 Then 
				RGB=255-(255*Terr_Shd(px,py)) 
			Else 
				RGB=0 
			EndIf
			WritePixelFast px,Sz-py-1, RGB Shl(16) + RGB Shl(8) + RGB + 255 Shl(24)
		Next
	Next
	;===>
	UnlockBuffer(TBuff)
	SetBuffer CBuff
	;===>
	If FreeLightmap Then 
		;===>
		FreeTexture(LMap)
		;Dim Terr_Shd(0,0)
		LightmapExtracted=False
		;===>
	Else 
		;===>
		LightmapExtracted=True
		Return LMap
	;===>
	EndIf
	
End Function

Function PI_Smooth(Terrain%)
	;===>
	Local Sz#	=	TerrainSize(Terrain)
	Local pix#, pix1#, x, y, offsetY, b
	;===>
	;smoot
	;===>
	For y=0 To Sz-3
		
		For x=0 To Sz-3
			;===>
			Terr_Shd(x+1,y) = (Terr_Shd(x,y)+Terr_Shd(x+1,y)+Terr_Shd(x+2,y))/3
			Terr_Shd(x,y+1) = (Terr_Shd(x,y)+Terr_Shd(x,y+1)+Terr_Shd(x,y+2))/3
			;===>
		Next
		;===>
	Next
	
	;===>
End Function



Code Archives Forum