[bb] Retro style patchwork landscape generator - ala Zarch by Stevie G [ 1+ years ago ]

Started by BlitzBot, June 29, 2017, 00:28:38

Previous topic - Next topic
Print
Go Down Pages1
User actions

BlitzBot

June 29, 2017, 00:28:38
Title : Retro style patchwork landscape generator - ala Zarch
Author : Stevie G
Posted : 1+ years ago

Description : 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.

Code :
Code (blitzbasic) Select
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) * c
g=terrain(nx,nz)g * c
b=terrain(nx,nz) * 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),terrain(xp,zp)g,terrain(xp,zp)
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) = th+Rnd(80)
terrain(x,z)g = th+120
terrain(x,z) = th+Rnd(80)
If th=0 ;*BODGE*Sea
terrain(x,z)=60+Rnd(40)
terrain(x,z)g=60+Rnd(40)
terrain(x,z)=200+Rnd(40)
Else
If th < 12;*BODGE*Beach
terrain(x,z)=th *10+90
terrain(x,z)g=th *10+90
terrain(x,z)=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)=col
terrain(xp,zp)g=col
terrain(xp,zp)=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),terrain(x,z)g,terrain(x,z)
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

Comments :


Jeroen(Posted 1+ years ago)

 old school :-) nice


grindalf(Posted 1+ years ago)

 so very awesome :D


Jason W.(Posted 1+ years ago)

 Make a bmax port ;) Jason
Print
Go Up Pages1
User actions