Code archives/3D Graphics - Misc/CreateShadowmap()
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
function to make terrain shadow map | |||||
;Please use however you like. ;If you improve functionality or speed please poste improvements! ;Make sure all meshes you like to cast shadows are set to ;EntityPickMode(), obscure true ;Use a paint program to blur the resulting shadow map ;For finer shadow details render shadow map in high resolution, ;up to 1024x1024 (beware, quite long render time!) then scale it ;down in a paint program ;points for improvement: ;better speed ;added edge blur functionality ;Idea and implementation by nadia lunanova ;nadia_lunanova@yahoo.com ;++ How to use ++++++++++++++++++++++++++++++ ; mapName$ File name of new shadow map. ; map_Width Width of new shadow map in pixels. ; map_Height Height of new shadow map in pixels. (Width and height are usually the same.) ; light Handel to the light element. ; terrain Handel to the terrain. ; terrain_Left# Left position of terrain. ; terrain_Width# Width of terrain after scaling. ; terrain_Top# Top position of terrain. ; terrain_Depth# Depth or Length of terrain after scaling. ; light_Color Color on shadow map where there is no shadow. Optional, defaults to white ; shadow_Color Color useed to paint shadow. Optional, defaults to grey 50,50,50 ; ; Default trigger key is 'M' Function CreateShadowMap(mapName$,map_Width, map_Height,light, terrain,terrain_Left#,terrain_Width#,terrain_Top#,terrain_Depth#,light_Color=255,shadow_Color=90) If (Not KeyHit(Key_B)) Then Return ;<<---------------- Only run if key 'M' is hit FlushKeys() time#=MilliSecs() ;to measure render time sMsg$="Creating Shadow Map, please wait...!" font=LoadFont("Arial",35,True) SetFont font Color 250,250,150 Text GraphicsWidth()/2,(GraphicsHeight()/2)-(60*scr_Scale),sMsg$,True,True ;set up progress bar progW=400 progX=(GraphicsWidth()/2)-(progW/2) progY=(GraphicsHeight()/2)+50 progH=20 Color 0,0,200 Rect progX-4,progY-4,progW+8,progH+8 Flip ;get light coordinates lX# = EntityX(light) lY# = EntityY(light) lZ# = EntityZ(light) ;this asumes that the light is set ;relative To the centre of the terrain lnX#=lX+(terrain_Width/2) lnZ#=lZ-(terrain_Depth/2) lposX#=lnX lposZ#=lnZ PositionEntity light,lposX,ly,lposZ ;calculate step increments stepX#=terrain_Width#/map_Width stepZ#=terrain_Depth#/map_Height ;create shadow map img=CreateImage(map_Width,map_Height) ;create ant ant= CreatePivot() posX#=terrain_Left posY#=terrain_Top ;place ant on first grid spot PositionEntity ant,posX,TerrainY(terrain,posX,0,posY)+0.2,posY ;set shadow color colGrey= GetRGB(shadow_Color,shadow_Color,shadow_Color) ;set shadow color colLight= GetRGB(light_Color,light_Color,light_Color) ;walk the walk... For x= 0 To map_Width-1 For y= 0 To map_Height-1 LockBuffer ImageBuffer(img) If Not EntityVisible (ant, light) Then pCol=colGrey Else pCol=colLight End If ;paint he spot WritePixelFast x,y,pCol,ImageBuffer(img) ;calculate next position posY=posY-stepZ PositionEntity ant,posX,TerrainY(terrain,posX,0,posY),posY ;for light lposY=lposY-stepZ PositionEntity light,lposX,lY,lposX If KeyHit(1) Then End Next posY=terrain_Left posX=posX+stepX ;show progress UnlockBuffer ImageBuffer(img) SetBuffer BackBuffer() Color 0,0,200 Rect progX-4,progY-4,progW+8,progH+8 Color 255,0,0 Rect progX,progY,progW/Float(map_Width)*Float(x+1),progH Color 250,250,150 Text GraphicsWidth()/2,(GraphicsHeight()/2)-(60*scr_Scale),sMsg$,True,True Flip ;back to shadow paint mode SetBuffer ImageBuffer(img) Color shadow_color,shadow_color,shadow_color Next ;save shadow map, clean up SaveImage img,mapName$ SetBuffer BackBuffer() FreeImage img FreeEntity ant ;move light back to original position PositionEntity light,lx,ly,lz RenderWorld() ;display elapsed time time= (MilliSecs() - time)/600 sTime$=" Min" If time > 60 Then min=time/60 sec=time Mod 60 Else sec=Int(time) End If Text GraphicsWidth()/2,(GraphicsHeight()/2)-60,"Shadow Map done!",True,True FreeFont font font = LoadFont("Arial",30,True) SetFont font Color 200,0,0 Text GraphicsWidth()/2,(GraphicsHeight()/2)-30,"Time elapsed: " + min + ":" + sec + sTime$,True,True Text GraphicsWidth()/2,(GraphicsHeight()/2),"Hit any key to continue...",True,True Flip FreeFont font WaitKey() End Function Function GetRGB(R,G,B) Return (B Or (G Shl 8) Or (R Shl 16) Or (255 Shl 24)) End Function |
Comments
None.
Code Archives Forum