This is my new memblock-terrain engine :
-Fast loading (40 ms for a 32*32 terrain)
-Vertex color-transparency based on height and color-map
-smoothing on/off
-Allow you to make some holes in the terrain (if you don't want useless polygons under your buildings)
-It's an object, so it reacts well to the light, it can be ghosted etc...
sync on
sync rate 60
set display mode 1024,768,32
rem ////IMPORTANT\\
type terrain
sizex as word
sizez as word
tilesx as word
tilesy as word
scaley as byte
objet as word
endtype
dim terrain(0) as terrain
rem texture
load image "dirt.bmp",1
rem terrain
start=timer()
terrain=make_terrain(1,"map 2.png","gradient.png","map_c.png",50,50,5,1)
texture object terrain,1
set object transparency terrain,1
finish=timer()
rem camera
position camera 0,50,-50
set camera range 1,5000
rem lights
set point light 0,100,100,250
set light range 0,2500
make light 1
set directional light 1,0,0,0
position light 1,1000,1000,1000 : point light 1,0,0,0
do
rem text
set cursor 0,0
print "polygons : ",statistic(1)
print "fps : ",screen fps()
print "loading time of 1 terrain : ",finish-start," ms"
rem camera
move camera (upkey()-downkey())*(10+shiftkey()*10)
ax#=wrapvalue(ax#+mousemovey()*0.2)
ay#=wrapvalue(ay#+mousemovex()*0.2)
rotate camera ax#,ay#,0
rem light
position light 0,camera position x(),camera position y(),camera position z()
sync
loop
remstart
terrain = Terrain ID
map$ = heightmap
gradient$ = vertex color based on the height
diffus$ = optional texture (change the vertex color, based on the alpha channel)
sizex/z = tile size x/z
scaley = height coeff
smoothing = smoothing on/off
remend
function make_terrain(terrain,map$,gradient$,diffus$,sizex,sizez,scaley,smoothing)
while terrain>array count(terrain(0))
array insert at bottom terrain(0)
endwhile
terrain(terrain).sizex=sizex
terrain(terrain).sizez=sizez
terrain(terrain).scaley=scaley
rem 1st pass : reading the heightmap, the colors and the useless polygons
img=free_image()
load image map$,img
memimg=free_memblock() : make memblock from image memimg,img : delete image img
tilesx=memblock dword(memimg,0)
tilesy=memblock dword(memimg,0)
terrain(terrain).tilesx=tilesx
terrain(terrain).tilesy=tilesy
dim temp_terrain(tilesx-1,tilesy-1)
dim temp_exist(tilesx-1,tilesy-1) as boolean
dim temp_colour(tilesx-1,tilesy-1)
grad=free_image():load image gradient$,grad
memgrad=free_memblock():make memblock from image memgrad,grad:delete image grad
gradx=memblock dword(memgrad,0):grady=memblock dword(memgrad,4)
if diffus$>""
diffus=free_image():load image diffus$,diffus
memdiff=free_memblock():make memblock from image memdiff,diffus:delete image diffus
diffx=memblock dword(memdiff,0):diffy=memblock dword(memdiff,4)
endif
for x=0 to tilesx-1
for y=0 to tilesy-1
pos=12+((y*tilesx)+x)*4
red=memblock byte(memimg,pos+2)
green=memblock byte(memimg,pos+1)
rem gradient color
posgrady=(255-red)*grady/256.0
pos=(posgrady*gradx+rnd(gradx-1))*4+12
degradeb=memblock byte(memgrad,pos)
degradeg=memblock byte(memgrad,pos+1)
degrader=memblock byte(memgrad,pos+2)
degradea=memblock byte(memgrad,pos+3)
if memdiff>0
rem texture color
posx=x*diffx*1.0/tilesx:posy=y*diffy*1.0/tilesy
posdiff=(posy*diffx+posx)*4+12
dblue=memblock byte(memdiff,posdiff)
dgreen=memblock byte(memdiff,posdiff+1)
dred=memblock byte(memdiff,posdiff+2)
melange= memblock byte(memdiff,posdiff+3)
rem final color
finalred=(dred*melange)/255 + (degrader*(255-melange))/255
finalgreen=(dgreen*melange)/255 + (degradeg*(255-melange))/255
finalblue=(dblue*melange)/255 + (degradeb*(255-melange))/255
temp_colour(x,y)=rgb(finalred,finalgreen,finalblue)+degradea*65536*256
else
rem final color
temp_colour(x,y)=rgb(degrader,degradeg,degradeb)+degradea*65536*256
endif
rem height
temp_terrain(x,y)=(red-128)*scaley
rem useless polygons
if abs(red-green)<5
inc sommets
temp_exist(x,y)=1
else
temp_exist(x,y)=0
endif
next y
next x
delete memblock memgrad
if memdiff>0 then delete memblock memdiff
rem normals smoothing (a bit bad)
if smoothing
dim temp_normal(tilesx-1,tilesy-1,2) as float
for x=0 to tilesx-2
for y=0 to tilesy-2
nx#=cos(atanfull(sizex,temp_terrain(x,y)-temp_terrain(x+1,y)))
ny#=sin(atanfull(sizex,temp_terrain(x,y)-temp_terrain(x+1,y)))
nz#=cos(atanfull(sizez,temp_terrain(x,y)-temp_terrain(x,y+1)))
temp_normal(x,y,0)=nx#:temp_normal(x,y,1)=ny#:temp_normal(x,y,2)=nz#
next y
next x
rem edges
for x=0 to tilesx-2
temp_normal(x,tilesy-1,0)=temp_normal(x,tilesy-2,0)
temp_normal(x,tilesy-1,1)=temp_normal(x,tilesy-2,1)
temp_normal(x,tilesy-1,2)=temp_normal(x,tilesy-2,2)
next x
for y=0 to tilesy-2
temp_normal(tilesx-1,y,0)=temp_normal(tilesx-2,y,0)
temp_normal(tilesx-1,y,1)=temp_normal(tilesx-2,y,1)
temp_normal(tilesx-1,y,2)=temp_normal(tilesx-2,y,2)
next y
temp_normal(tilesx-1,tilesy-1,0)=temp_normal(tilesx-2,tilesy-2,0)
temp_normal(tilesx-1,tilesy-1,1)=temp_normal(tilesx-2,tilesy-2,1)
temp_normal(tilesx-1,tilesy-1,2)=temp_normal(tilesx-2,tilesy-2,2)
endif
rem 2nd pass : making the object
memsize=12+sommets*6*36
delete memblock memimg : memobj=memimg
make memblock memobj,memsize
write memblock dword memobj,0,338
write memblock dword memobj,4,36
write memblock dword memobj,8,sommets*6
mempos=12
for x=0 to tilesx-2
for y=0 to tilesy-2
if temp_exist(x,y)=1
y1=temp_terrain(x,y)
y2=temp_terrain(x+1,y)
y3=temp_terrain(x+1,y+1)
y4=temp_terrain(x,y+1)
make_quad(terrain,memobj,mempos,x*sizex,y*sizez,y1,y2,y3,y4,smoothing)
inc mempos,216
endif
next y
next x
make mesh from memblock 1,memobj
object=free_obj(1)
make object object,1,0
delete memblock memobj
terrain(terrain).objet=object
undim temp_colour()
undim temp_terrain()
undim temp_exist()
undim temp_normal()
undim check()
undim vertex()
endfunction object
function make_quad(terrain,memblock,mempos,x,z,y1,y2,y3,y4,lisse)
sizex=terrain(terrain).sizex
sizez=terrain(terrain).sizez
tilex=x/sizex : tilez=z/sizez
couleur1=temp_colour(tilex,tilez)
couleur2=temp_colour(tilex+1,tilez)
couleur3=temp_colour(tilex+1,tilez+1)
couleur4=temp_colour(tilex,tilez+1)
if lisse=1
if tilex<terrain(terrain).tilesx and tilez<terrain(terrain).tilesy
null=make vector3(1) : set vector3 1,temp_normal(tilex,tilez,0),temp_normal(tilex,tilez,1),temp_normal(tilex,tilez,2)
null=make vector3(2) : set vector3 2,temp_normal(tilex+1,tilez,0),temp_normal(tilex+1,tilez,1),temp_normal(tilex+1,tilez,2)
null=make vector3(3) : set vector3 3,temp_normal(tilex+1,tilez+1,0),temp_normal(tilex+1,tilez+1,1),temp_normal(tilex+1,tilez+1,2)
null=make vector3(4) : set vector3 4,temp_normal(tilex,tilez+1,0),temp_normal(tilex,tilez+1,1),temp_normal(tilex,tilez+1,2)
endif
make_vertex(memblock,mempos,x+sizex,y2,z,1,0,couleur2,2)
make_vertex(memblock,mempos+36,x,y1,z,0,0,couleur1,1)
make_vertex(memblock,mempos+72,x+sizex,y3,z+sizez,1,1,couleur3,3)
make_vertex(memblock,mempos+108,x,y1,z,0,0,couleur1,1)
make_vertex(memblock,mempos+144,x,y4,z+sizez,0,1,couleur4,4)
make_vertex(memblock,mempos+180,x+sizex,y3,z+sizez,1,1,couleur3,3)
else
normale( sizex,y2,0 , 0,y1,0 , sizex,y3,sizez , 1)
normale( 0,y1,0 , 0,y4,sizez , sizex,y3,sizez , 2)
make_vertex(memblock,mempos,x+sizex,y2,z,1,0,couleur2,1)
make_vertex(memblock,mempos+36,x,y1,z,0,0,couleur1,1)
make_vertex(memblock,mempos+72,x+sizex,y3,z+sizez,1,1,couleur3,1)
make_vertex(memblock,mempos+108,x,y1,z,0,0,couleur1,2)
make_vertex(memblock,mempos+144,x,y4,z+sizez,0,1,couleur4,2)
make_vertex(memblock,mempos+180,x+sizex,y3,z+sizez,1,1,couleur3,2)
endif
endfunction
rem finding the normal of a triangle
function normale(x1,y1,z1,x2,y2,z2,x3,y3,z3,vecteur)
vx#=x2-x1
vy#=y2-y1
vz#=z2-z1
vvx#=x3-x1
vvy#=y3-y1
vvz#=z3-z1
Normalex# = ((Vy# * Vvz#) - (Vz# * Vvy#))
Normaley# = ((Vz# * Vvx#) - (Vx# * Vvz#))
Normalez# = ((Vx# * Vvy#) - (Vy# * Vvx#))
Magnitude# = Sqrt(Normalex#*Normalex# + Normaley#*Normaley# + Normalez#*Normalez#)
nx#=Normalex# / Magnitude#
ny#=Normaley# / Magnitude#
nz#=Normalez# / Magnitude#
null=make vector3(vecteur) : set vector3 vecteur,nx#,ny#,nz#
endfunction
rem making a vertex
function make_vertex(memblock,mempos,x,y,z,u#,v#,colour,v)
write memblock float memblock,mempos,x
write memblock float memblock,mempos+4,y
write memblock float memblock,mempos+8,z
write memblock float memblock,mempos+12,x vector3(v)
write memblock float memblock,mempos+16,y vector3(v)
write memblock float memblock,mempos+20,z vector3(v)
write memblock dword memblock,mempos+24,colour
write memblock float memblock,mempos+28,u#
write memblock float memblock,mempos+32,v#
endfunction
rem misc functions
function free_memblock()
for m=1 to 254
if memblock exist(m)=0 then exit
next m
endfunction m
function free_obj(i)
for o=i to 65535
if object exist(o)=0 then exitfunction o
next o
endfunction 0
function free_image()
for i=1 to 1024
if image exist(i)=0 then exit
next i
endfunction i
rem smoothing (not used in the program, but may be usefull)
function smooth_object(object,smooth)
make mesh from object 1,object
memobj=free_memblock() : make memblock from mesh memobj,1 : delete mesh 1
size=memblock dword(memobj,4)
sommets=memblock dword(memobj,8)
if smooth=1
dim check(sommets) : `si on s'en est deja occupé
dim vertex(0) : `numero des sommets
rem on regarde tous les sommets
for v=0 to sommets-1
rem si on l'a pas deja vu
if check(v)=0
check(v)=1
verts=0
mempos=v*size+12
rem on garde ses positions et ses normales
x#=memblock float(memobj,mempos)
y#=memblock float(memobj,mempos+4)
z#=memblock float(memobj,mempos+8)
nx#=memblock float(memobj,mempos+12)
ny#=memblock float(memobj,mempos+16)
nz#=memblock float(memobj,mempos+20)
vertex(0)=v
rem recherche des sommets confondus
for vv=0 to sommets-1
if v<>vv and check(vv)=0
newpos=vv*size+12
newx#=memblock float(memobj,newpos)
newy#=memblock float(memobj,newpos+4)
newz#=memblock float(memobj,newpos+8)
if x#=newx# and y#=newy# and z#=newz#
rem on en trouve un
inc verts
while array count(vertex(0))<verts
array insert at bottom vertex(0)
endwhile
check(vv)=1
vertex(verts)=vv
nx#=nx#+memblock float(memobj,newpos+12)
ny#=ny#+memblock float(memobj,newpos+16)
nz#=nz#+memblock float(memobj,newpos+20)
endif
endif
next vv
if verts>2
rem on calcule la nouvelle normale des sommets confondus (on se fait pas chier, lissage a donf)
newnx#=nx#/(verts+1)
newny#=ny#/(verts+1)
newnz#=nz#/(verts+1)
rem on applique les changements
for s=0 to verts
pos=vertex(s)*size+12
write memblock float memobj,pos+12,newnx#
write memblock float memobj,pos+16,newny#
write memblock float memobj,pos+20,newnz#
next s
endif
endif
next v
else
dim pos(2,2) as float
rem on supprime le lissage
for v=0 to sommets-1 step 3
for vv=0 to 2
pos=(v+vv)*size+12
pos(vv,0)=memblock float(memobj,pos)
pos(vv,1)=memblock float(memobj,pos+4)
pos(vv,2)=memblock float(memobj,pos+8)
next vv
normale( pos(0,0),pos(0,1),pos(0,2) , pos(1,0),pos(1,1),pos(1,2) , pos(2,0),pos(2,1),pos(2,2) , 1)
for vv=0 to 2
pos=(v+vv)*size+12
write memblock float memobj,pos+12,x vector3(1)
write memblock float memobj,pos+16,y vector3(1)
write memblock float memobj,pos+20,z vector3(1)
next v
next v
endif
make mesh from memblock 1,memobj
delete object object : make object object,1,0 : delete mesh 1
delete memblock memobj
endfunction