Code archives/Algorithms/Height Map Generator
This code has been declared by its author to be Public Domain code.
Download source code
| When you run this it assumes you have a grass.bmp in the same folder, this is needed to show the landscape after it is created. Also it creates a file "heightmap.bmp" in the folder once it's done, if you want to create more heightmaps you'll have to rename the file otherwise it will be overwritten. Cheers, Av |
; Height Map Generator ; Rob Farley 2001 ; rob@mentalhangover.co.uk ; http://www.mentalhangover.co.uk ; *** This assumes you have a grass.bmp file in the same folder, please put a grass texture here. *** Graphics 640,480 SetBuffer BackBuffer() ; set up varibles size=256 ; Play with these varibles to change the look of the landscape scale=5 hill_size=50 hill_number=30 dip_size=100 dip_number=10 menu=1 While Not KeyHit(28) Cls Color 255,255,255 Text 320,0,"Height Map Generator",True,False Text 320,250,"Use Arrow keys to adjust settings, enter to confirm selections",True,False Color 255,255,0 Text 320,20,"Rob Farley 2001",True,False Color 0,128,128 If KeyDown(208)=True Then menu=menu+1 If KeyDown(200)=True Then menu=menu-1 If menu>6 Then menu=1 If menu<1 Then menu=6 Color 0,128,128 If menu=1 Color 0,255,255 If KeyDown(205)=True Then size=size+256 If KeyDown(203)=True Then size=size-256 If size<256 Then size=256 If size>1024 Then size=1024 EndIf Text 320,100,"Size:"+size,True,False Color 0,128,128 If menu=2 Color 0,255,255 If KeyDown(205)=True Then scale=scale+1 If KeyDown(203)=True Then scale=scale-1 If scale<0 Then scale=0 If scale>50 Then scale=50 EndIf Text 320,120,"Scale:"+scale,True,False Color 0,128,128 If menu=3 Color 0,255,255 If KeyDown(205)=True Then hill_size=hill_size+1 If KeyDown(203)=True Then hill_size=hill_size-1 If hill_size<0 Then hill_size=0 EndIf Text 320,140,"Hill Size:"+hill_size,True,False Color 0,128,128 If menu=4 Color 0,255,255 If KeyDown(205)=True Then hill_number=hill_number+1 If KeyDown(203)=True Then hill_number=hill_number-1 If hill_number<0 Then hill_number=0 EndIf Text 320,160,"Hill Quantity:"+hill_number,True,False Color 0,128,128 If menu=5 Color 0,255,255 If KeyDown(205)=True Then dip_size=dip_size+1 If KeyDown(203)=True Then dip_size=dip_size-1 If dip_size<0 Then dip_size=0 EndIf Text 320,180,"Dip Size:"+dip_size,True,False Color 0,128,128 If menu=6 Color 0,255,255 If KeyDown(205)=True Then dip_number=dip_number+1 If KeyDown(203)=True Then dip_number=dip_number-1 If dip_number<0 Then dip_number=0 EndIf Text 320,200,"Dip Quantity:"+dip_number,True,False Flip Delay 100 Wend Dim land#(size,size) Dim land2#(size,size) Dim hill#(45,45) Dim blur#(9,9) Data 0,0,0,1,1,1,0,0,0 Data 0,0,1,2,3,2,1,0,0 Data 0,1,2,3,5,3,2,1,0 Data 1,2,3,5,7,5,3,1,1 Data 1,3,5,7,9,7,5,3,1 Data 1,2,3,5,7,5,3,1,1 Data 0,1,2,3,5,3,2,1,0 Data 0,0,1,2,3,2,1,0,0 Data 0,0,0,1,1,1,0,0,0 For x=1 To 9 For y=1 To 9 Read blur#(x,y) blur#(x,y)=blur#(x,y)/10 Next Next For x=0 To 20 For r=0 To 359 sx=(Sin(r)*x)+23 sy=(Cos(r)*x)+23 hill#(sx,sy)=Cos(x*4)*10 Next Next SeedRnd MilliSecs() ; Make Landscape - Drawing edges... printstuff(1) Text 320,100,"Drawing Edges...",True,False Flip h=120 For x=0 To size-1 land#(x+1,1)=h h=h+Rnd(0,scale)-(scale/2) Next h=120 For x=0 To size-1 land#(1,x+1)=h h=h+Rnd(0,scale)-(scale/2) Next ; make landscape - fill in middle printstuff(2) Text 320,120,"Filling Middle...",True,False Flip For x=2 To size For z=2 To size h=land#(x-1,z) i=land#(x,z-1) j=(h+i)/2 h=j+Rnd(0,scale)-(scale/2) land#(x,z)=h Next Next ; make landscape - Create hills For n=1 To hill_number printstuff(3) Text 320,140,"Creating Hills..."+n+"/"+hill_number,True,False Flip hx=Rnd(0,size) hy=Rnd(0,size) For x=1 To hill_size For xx=1 To 45 For yy=1 To 45 hxx=hx+xx-1 hyy=hy+yy-1 If hxx>size Then hxx=hxx-size If hxx<1 Then hxx=hxx+size If hyy>size Then hyy=hyy-size If hyy<1 Then hyy=hyy+size land#(hxx,hyy)=land#(hxx,hyy)+hill#(xx,yy) Next Next hx=hx+Rnd(0,10)-5 hy=hy+Rnd(0,10)-5 If hx<20 Then hx=size-20 If hx>size-20 Then hx=20 If hy<20 Then hy=size-20 If hy>size-20 Then hy=20 Next Next ; make landscape - Create Dips For n=1 To dip_number printstuff(4) Text 320,160,"Creating Dips..."+n+"/"+dip_number,True,False Flip hx=Rnd(0,size) hy=Rnd(0,size) For x=1 To dip_size For xx=1 To 45 For yy=1 To 45 hxx=hx+xx-1 hyy=hy+yy-1 If hxx>size Then hxx=hxx-size If hxx<1 Then hxx=hxx+size If hyy>size Then hyy=hyy-size If hyy<1 Then hyy=hyy+size land#(hxx,hyy)=land#(hxx,hyy)-hill#(xx,yy) If land#(hxx,hyy)<-20 Then land#(hxx,hyy)=-20 Next Next hx=hx+Rnd(0,10)-5 hy=hy+Rnd(0,10)-5 If hx<20 Then hx=size-20 If hx>size-20 Then hx=20 If hy<20 Then hy=size-20 If hy>size-20 Then hy=20 Next Next ; Blur Landscape printstuff(5) Text 320,180,"Blurring Landscape pass 1",True,False Flip For x=1 To size For y=1 To size p=land#(x,y) For bx=-4 To 4 For by=-4 To 4 xx=x+bx yy=y+by If xx>=1 And xx<=size And yy>=1 And yy<=size Then land2#(xx,yy)=land2#(xx,yy)+(p*blur#(bx+5,by+5)) Next Next Next Next For x=1 To size For y=1 To size land#(x,y)=land2#(x,y) land2#(x,y)=0 Next Next ; Normalise Landscape printstuff(6) Text 320,200,"Normalising Landscape pass 1",True,False Flip high#=-10000 low#=10000 For x=0 To size-1 For y=0 To size-1 If land#(x+1,y+1)>high# Then high#=land#(x+1,y+1) If land#(x+1,y+1)<low# Then low#=land#(x+1,y+1) Next Next normal#=high#-low# For x=0 To size-1 For y=0 To size-1 l#=land#(x+1,y+1) l#=l#-low# l#=(l#/normal#)*255 land#(x+1,y+1)=Int(l#) Next Next ; Blur Landscape printstuff(7) Text 320,220,"Blurring Landscape pass 2",True,False Flip For x=1 To size For y=1 To size p=land#(x,y) For bx=-4 To 4 For by=-4 To 4 xx=x+bx yy=y+by If xx>=1 And xx<=size And yy>=1 And yy<=size Then land2#(xx,yy)=land2#(xx,yy)+(p*blur#(bx+5,by+5)) Next Next Next Next For x=1 To size For y=1 To size land#(x,y)=land2#(x,y) land2#(x,y)=0 Next Next ; Normalise Landscape printstuff(8) Text 320,240,"Normalising Landscape pass 2",True,False Flip high#=-10000 low#=10000 For x=0 To size-1 For y=0 To size-1 If land#(x+1,y+1)>high# Then high#=land#(x+1,y+1) If land#(x+1,y+1)<low# Then low#=land#(x+1,y+1) Next Next normal#=high#-low# For x=0 To size-1 For y=0 To size-1 l#=land#(x+1,y+1) l#=l#-low# l#=(l#/normal#)*255 land#(x+1,y+1)=Int(l#) Next Next ; Render Heightmap and capture image printstuff(9) Text 320,260,"Rendering Height Map",True,False Flip height=CreateImage (size,size) SetBuffer ImageBuffer(height) For x=0 To size-1 For y=0 To size-1 dot(x,y,land#(x+1,y+1)) Next Next SetBuffer BackBuffer() SaveImage height,"heightmap.bmp" ; Show 3D view of Landscape Cls Graphics3D 640,480,16 ;Set graphics mode SetBuffer BackBuffer() terrain = LoadTerrain ("heightmap.bmp") ScaleEntity terrain, 5, 100, 5 TerrainShading terrain, True TerrainDetail terrain, 2500 grass=LoadTexture( "grass.bmp" ) ScaleTexture grass,20,20 EntityTexture terrain,grass camera = CreateCamera() CameraFogRange camera,700,1000 CameraFogMode camera,1 AmbientLight 255,255,255 middle= CreatePivot() PositionEntity middle,640,0,640 rot#=0.0 While Not KeyHit(1) cx#=640+(Sin(rot#)*400) cz#=640+(Cos(rot#)*400) cy#=TerrainY#(terrain,cx#,0.0,cz#)+5 PositionEntity camera,cx#,cy#,cz# lx#=640+(Sin(rot#)*400)+(Cos(rot#+90)*20) lz#=640+(Cos(rot#)*400)+(Sin(rot#+90)*20) ly#=TerrainY#(terrain,lx#,0.0,lz#)+5 PositionEntity middle,lx#,ly#,lz# PointEntity camera,middle rot#=rot#+.1 If rot#=360 Then rot#=0 UpdateWorld RenderWorld Flip Wend End Function dot(x,y,c) If c>255 Then c=255 If c<0 Then c=0 Color c,c,c Plot x,y End Function Function printstuff(prtstf) Cls Color 255,255,255 Text 320,0,"Height Map Generator",True,False Color 255,255,0 Text 320,20,"Rob Farley 2001",True,False Color 0,128,128 If prtstf<>1 Then Text 320,100,"Drawing Edges...",True,False If prtstf<>2 Then Text 320,120,"Filling Middle...",True,False If prtstf<>3 Then Text 320,140,"Creating Hills...",True,False If prtstf<>4 Then Text 320,160,"Creating Dips...",True,False If prtstf<>5 Then Text 320,180,"Blurring Landscape pass 1",True,False If prtstf<>6 Then Text 320,200,"Normalising Landscape pass 1",True,False If prtstf<>7 Then Text 320,220,"Blurring Landscape pass 2",True,False If prtstf<>8 Then Text 320,240,"Normalising Landscape pass 2",True,False If prtstf<>9 Then Text 320,260,"Rendering Height Map",True,False Color 0,255,255 End Function |