Code archives/3D Graphics - Mesh/Retro style patchwork landscape generator - ala Zarch
This code has not been declared by its author to be Public Domain code, and therefore should not be assumed to be so.
Download source code
| The landscape is made from a single surface using vertex colors. I posted this code in the forums a few days ago but figured that it'd be handy for anyone attempting a virus / zarch / conqueror or zeewolf clone. |
Graphics3D 320,240,16,1 Const size#=256 Const divs#=7 Const divg#=divs*4+1 Const scale#=16 Const speed#=.25 Global divd#=Sqr( 2*(divs*divs) ) Global camera=CreateCamera() Global light=CreateLight() Global target=CreatePivot() Global map,map_tex Global grid=create_grid() Global surf=GetSurface(grid,1) Global x_pos#= size *.5 Global z_pos#= size *.5 Global last_x# = x_pos Global last_z# = z_pos Global frames Type point Field height# Field index Field r,g,b End Type Dim terrain.point(size-1,size-1) random_terrain(0) ;10031972 While Not KeyDown(1) x_pos=qwrap( x_pos + (KeyDown(205)-KeyDown(203)) * speed,size) z_pos=qwrap( z_pos + (KeyDown(208)-KeyDown(200)) * speed,size) update_terrain() update_camera() frames=qwrap(frames+1,10) If frames = 0 update_map() UpdateWorld() RenderWorld() Flip Wend ;===================================================================================================== ;UPDATE TERRAIN ===================================================================================================== ;===================================================================================================== Function update_terrain() ax#=Floor(x_pos):az#=Floor(z_pos) fx#=(x_pos) - ax:fz#=(z_pos) - az For z=-divs To divs+1 For x=-divs To divs+1 nx#=qwrap(ax+x,size) nz#=qwrap(az+z,size) vy#=terrain(nx,nz)\height vx#=qlimit( x-fx,-divs,divs) vz#=qlimit( z-fz,-divs,divs) ;brightness c#=.25 + ( divd - Sqr(vx*vx+vz*vz) ) / (divd ) r=terrain(nx,nz)\r * c g=terrain(nx,nz)\g * c b=terrain(nx,nz)\b * c If Abs(vx)=divs Or Abs(vz)=divs vy#=get_height( x_pos+vx , z_pos+vz) EndIf ;vertex positions For iz = 0 To ( z > -divs And z < divs+1 ) For ix = 0 To ( x > -divs And x < divs+1 ) x1 = ( x + divs ) * 2 - ( x > -divs ) + ix z1 = ( z + divs ) * 2 - ( z > -divs ) + iz v=x1+z1*(divg+1) VertexCoords surf,v, vx * scale , vy , -vz * scale Next Next ;colours For iz = 0 To (z < divs+1) For ix = 0 To (x < divs+1) x1 = ( x + divs ) * 2 + ix z1 = ( z + divs ) * 2 + iz v=x1+z1*(divg+1) VertexColor surf,v,r,g,b Next Next Next Next End Function ;===================================================================================================== ;GET HEIGHT OF POINT ON WORLD CO-ORDS ===================================================================================================== ;===================================================================================================== Function get_height(bx#,bz#) bx=qwrap(bx,size):bz=qwrap(bz,size) tx#=Floor(bx):tz#=Floor(bz) jx#=bx - tx:jz#=bz - tz cx#=qwrap(tx+1.0,size) cz#=qwrap(tz+1.0,size) v1#=terrain(tx,tz)\height+(terrain(cx,tz)\height-terrain(tx,tz)\height)*jx v2#=terrain(tx,cz)\height+(terrain(cx,cz)\height-terrain(tx,cz)\height)*jx Return v1+(v2-v1)*jz End Function ;===================================================================================================== ;UPDATE CAMERA ===================================================================================================== ;===================================================================================================== Function update_camera() PositionEntity target,0,divs*10+get_height(x_pos,z_pos)* 1.0,-divs*25 dx#=(EntityX(target,1)-EntityX(camera,1))*.1 dy#=(EntityY(target,1)-EntityY(camera,1))*.1 dz#=(EntityZ(target,1)-EntityZ(camera,1))*.1 TranslateEntity camera,dx,dy,dz End Function ;===================================================================================================== ;UPDATE MAP ===================================================================================================== ;===================================================================================================== Function update_map() SetBuffer TextureBuffer(map_tex) For z=-2 To 2 For x=-2 To 2 xp=qwrap(last_x+x,size) zp=qwrap(last_z+z,size) Color terrain(xp,zp)\r,terrain(xp,zp)\g,terrain(xp,zp)\b Plot xp,zp Next Next For z=-2 To 2 For x=-2 To 2 xp=qwrap(Floor(x_pos)+x,size) zp=qwrap(Floor(z_pos)+z,size) Color 255,255,255 Plot xp,zp Next Next SetBuffer BackBuffer() last_x=Floor(x_pos) last_z=Floor(z_pos) End Function ;===================================================================================================== ;GENERATE RANDOM TERRAIN FOR TESTING ===================================================================================================== ;===================================================================================================== Function random_terrain(seed) SeedRnd seed ;initialise For z=0 To size-1 For x=0 To size-1 terrain(x,z) = New point Next Next passes=50+Rand(150) ;do heights For parts=0 To passes start_x=Rand(0,size) start_z=Rand(0,size) rad#=Rand(1,32) start_y#=Rand(8,32) For z=-rad To rad For x=-rad To rad d#=Sqr(x*x+z*z) If d < rad py#=Cos(d/rad * 90) * start_y px=qwrap(start_x+x,size) pz=qwrap(start_z+z,size) terrain(px,pz)\height = ( terrain(px,pz)\height + py ) EndIf Next Next Next ;do colours - based on code from BIG& For z=size-1 To 0 Step -1 For x=0 To size-1 th#=get_height(x+.5,z+.5) terrain(x,z)\r = th+Rnd(80) terrain(x,z)\g = th+120 terrain(x,z)\b = th+Rnd(80) If th=0 ;*BODGE*Sea terrain(x,z)\r=60+Rnd(40) terrain(x,z)\g=60+Rnd(40) terrain(x,z)\b=200+Rnd(40) Else If th < 12;*BODGE*Beach terrain(x,z)\r=th *10+90 terrain(x,z)\g=th *10+90 terrain(x,z)\b=240-th *20 End If End If Next Next ;*BODGE* Color Landing Pad For z=-4 To 4 For x=-4 To 4 col=Rnd(32)+168 xp=qwrap(size*.5+x,size):zp=qwrap(size*.5+z,size) If x >-4 And z >-4 terrain(xp,zp)\height=30 terrain(xp,zp)\r=col terrain(xp,zp)\g=col terrain(xp,zp)\b=col Next Next ;create map map_tex=CreateTexture(256,256) SetBuffer TextureBuffer(map_tex) For z=0 To size-1 For x=0 To size-1 Color terrain(x,z)\r,terrain(x,z)\g,terrain(x,z)\b Plot x,z Next Next SetBuffer BackBuffer() map=create_quad(camera) PositionEntity map,-5,3,6 EntityTexture map,map_tex,0 End Function ;===================================================================================================== ;CREATE DISPLAY GRID ===================================================================================================== ;===================================================================================================== Function create_grid() mesh=CreateMesh():s=CreateSurface(mesh) For z=0 To divg For x=0 To divg v=AddVertex(s,0,0,0) Next Next For z=0 To divg-1 For x=0 To divg-1 v0=x+z*(divg+1):v1=v0+1 v2=v1+divg+1:v3=v0+divg+1 AddTriangle s,v0,v1,v2 AddTriangle s,v2,v3,v0 Next Next EntityFX mesh,6 Return mesh End Function ;===================================================================================================== ;===================================================================================================== ;===================================================================================================== Function qlimit#(q#,a#,b#) If q < a q=a If q > b q=b Return q End Function ;===================================================================================================== ;===================================================================================================== ;===================================================================================================== Function qwrap#(q#,a#) If q >=a q=q-a If q < 0 q=a+q Return q End Function ;===================================================================================================== ;===================================================================================================== ;===================================================================================================== Function create_quad(parent=0) mesh=CreateMesh(parent) surface=CreateSurface(mesh) AddVertex surface,-1,1,0,0,0 AddVertex surface,1,1,0,1,0 AddVertex surface,1,-1,0,1,1 AddVertex surface,-1,-1,0,0,1 AddTriangle surface,0,1,2 AddTriangle surface,2,3,0 Return mesh End Function |