Sorry your browser is not supported!

sync on : set display mode 1024,768,32,1 : autocam off : set ambient light 10 : set camera range 1,10000 `: hide light 0
`make light 1
`set light range 1,10000
`position light 1,2500,1000,2500
`generate a grass texture
create bitmap 1,64,64
set current bitmap 1
for x=0 to 64 : for y=0 to 64
   color=rnd(200)
   ink rgb(50+color,50+color,50+color),0
   dot x,y
next y : next x
get image 1,0,0,64,64
`generate water texture
for x=0 to 64 : for y=0 to 64
   ink rgb(50+rnd(50),150+rnd(50),200+rnd(50)),0
   dot x,y
next y : next x
get image 2,0,0,64,64
delete bitmap 1

`make the basic meshes
   `2*2
   k#=250
   for sx=0 to 1 : for sz=0 to 1
      sx#=sx : sz#=sz
      make object triangle 2,sx#*k#,0,sz#*k#,sx#*k#,0,(sz#+1)*k#,(sx#+1)*k#,0,(sz#+1)*k#
      make mesh from object 1,2
      delete object 2
      make object triangle 2,sx#*k#,0,sz#*k#,(sx#+1)*k#,0,(sz#+1)*k#,(sx#+1)*k#,0,sz#*k#
      make mesh from object 2,2
      delete object 2
      make object 2,1,0
      add limb 2,1,2
      make mesh from object (sx+1)*2+(sz+1),2
      delete object 2
   next sz : next sx
   make object triangle 2,0,0,0,0,0,0,0,0,0
   for s=1 to 4
       add limb 2,s,s+2
   next s
   make mesh from object 101,2
   delete object 2
   `8*8
   k#=62.5
   for sx=0 to 7 : for sz=0 to 7
      sx#=sx : sz#=sz
      make object triangle 2,sx#*k#,0,sz#*k#,sx#*k#,0,(sz#+1)*k#,(sx#+1)*k#,0,(sz#+1)*k#
      make mesh from object 1,2
      delete object 2
      make object triangle 2,sx#*k#,0,sz#*k#,(sx#+1)*k#,0,(sz#+1)*k#,(sx#+1)*k#,0,sz#*k#
      make mesh from object 2,2
      delete object 2
      make object 2,1,0
      add limb 2,1,2
      make mesh from object (sx+1)*8+(sz+1),2
      delete object 2
   next sz : next sx
   make object triangle 2,0,0,0,0,0,0,0,0,0
   for s=1 to 64
      add limb 2,s,s+8
   next s
   make mesh from object 102,2
   delete object 2
   `32*32
   k#=15.625
   limb=1
   make object triangle 3,0,0,0,0,0,0,0,0,0
   for sx=0 to 31 : for sz=0 to 31
      sx#=sx : sz#=sz
      make object triangle 2,sx#*k#,0,sz#*k#,sx#*k#,0,(sz#+1)*k#,(sx#+1)*k#,0,(sz#+1)*k#
      make mesh from object 1,2
      delete object 2
      make object triangle 2,sx#*k#,0,sz#*k#,(sx#+1)*k#,0,(sz#+1)*k#,(sx#+1)*k#,0,sz#*k#
      make mesh from object 2,2
      delete object 2
      make object 2,1,0
      add limb 2,1,2
      make mesh from object 100,2
      delete object 2
      add limb 3,limb,100
      limb=limb+1
   next sz : next sx
   make mesh from object 103,3
   delete object 3

dim tile#(8,8)
dim tertile#(17,17)
dim terraintile#(33,33)
dim tiles#(11,11,3)
`0=limb
`1=altitude
`2=lod state
   `0=1*1
   `1=2*2
   `2=4*4
   `3=8*8
`3=random value

for x=1 to 10 : for z=1 to 10
   tiles#(x,z,1)=rnd(200)
   tiles#(x,z,3)=0
next z : next x


make object triangle 1,0,0,0,0,0,0,0,0,0
limb=1
for x=0 to 10 : for z=0 to 10
   add limb 1,limb,101
   offset limb 1,limb,x*500,0,z*500
   convert object fvf 1,338
   h1#=tiles#(x,z,1)
   h2#=tiles#(x+1,z,1)
   h3#=tiles#(x,z+1,1)
   h4#=tiles#(x+1,z+1,1)
   lock vertexdata for limb 1,limb
   verts=get vertexdata vertex count()-1
   for v=0 to verts
      posx#=get vertexdata position x(v)
      posz#=get vertexdata position z(v)
      ppx#=(posx#/500) : ppx2#=1 :ppx2#=ppx2#-ppx#
      ppz#=(posz#/500) : ppz2#=1 :ppz2#=ppz2#-ppz#
      posy#=(h1#*ppx2#*ppz2#)+(h2#*ppx#*ppz2#)+(h3#*ppx2#*ppz#)+(h4#*ppx#*ppz#)
      rx#=posx#+x*500 : rz#=posz#+z*500
      set vertexdata UV v,rx#/250,rz#/250
      set vertexdata position v,posx#,posy#,posz#
      if posy#>110
         SET VERTEXDATA DIFFUSE v,RGB(0,200,0)
      else
         SET VERTEXDATA DIFFUSE v,RGB(200,150,50)
      endif
   next v
   unlock vertexdata
   tiles#(x,z,0)=limb
   limb=limb+1
next z : next x
texture object 1,1 : set object normals 1 : set object texture 1,1,1

make object plain 2,6000,6000
position object 2,3000,100,3000
xrotate object 2,90
set object 2,1,1,0,1,0,0,0
texture object 2,2
set object transparency 2,5
set alpha mapping on 2,75

zoom#=1000 : cax#=70
x#=3000 : z#=3000
ink rgb(0,0,0),0
make object box 3,1,1000,1
do
   text 10,10,"FPS rate: "+str$(screen fps())
   text 10,30,"Arrow keys to move, right mouseclick to rotate, space to zoom out, return to zoom in."
   if returnkey()=1 then zoom#=zoom#*0.9
   if spacekey()=1 then zoom#=zoom#*1.1
   position camera x#,0,z#
   position object 3,x#,0,z#
   rotate camera 0,cay#,0
   if upkey()=1 then move camera zoom#/100
   if downkey()=1 then move camera zoom#/-100
   yrotate camera wrapvalue(cay#+90)
   if rightkey()=1 then move camera zoom#/100
   if leftkey()=1 then move camera zoom#/-100
   rotate camera cax#,cay#,0
   x#=camera position x()
   z#=camera position z()
   move camera -1*zoom#
   mmx#=mousemovex()*0.1
   mmy#=mousemovey()*0.1
   if mouseclick()=2
      cax#=wrapvalue(cax#+mmy#)
      cay#=wrapvalue(cay#+mmx#)
   endif
   cx#=camera position x()
   cy#=camera position y()
   cz#=camera position z()
   `------------------------------------------------
   `--              MAGIC LOD CODE                --
   `------------------------------------------------
   change=0
   for x=0 to 10 : for z=0 to 10
      xpos#=x*500+250
      zpos#=z*500+250
      tera#=tiles#(x,z,0)+tiles#(x+1,z,0)+tiles#(x,z+1,0)+tiles#(x+1,z+1,0) : tera#=tera#/4
      dist#=sqrt((cx#-xpos#)^2+((cy#-tera#)/2)^2+(cz#-zpos#)^2)
      `2*2squares
      if dist#>1000 and tiles#(x,z,2)<>0
         terrainarray(x,z)
         change=1
         change mesh 1,tiles#(x,z,0),101
         convert object fvf 1,338
         tiles#(x,z,2)=0
         lock vertexdata for limb 1,tiles#(x,z,0)
         verts=get vertexdata vertex count()-1
         for v=0 to verts
            posx#=get vertexdata position x(v)
            posz#=get vertexdata position z(v)
            xx#=(posx#/500)*33 : zz#=(posz#/500)*33
            xx=ceil(xx#) : zz=ceil(zz#)
            rx#=posx#+x*500 : rz#=posz#+z*500
            set vertexdata UV v,rx#/250,rz#/250
            posy#=terraintile#(xx,zz)
            ppx#=posx#/500 : ppz#=posz#/500
            if posx#<10 then posy#=(1-ppz#)*tiles#(x,z,1)+ppz#*tiles#(x,z+1,1)
            if posz#<10 then posy#=(1-ppx#)*tiles#(x,z,1)+ppx#*tiles#(x+1,z,1)
            if posx#>490 then posy#=(1-ppz#)*tiles#(x+1,z,1)+ppz#*tiles#(x+1,z+1,1)
            if posz#>490 then posy#=(1-ppx#)*tiles#(x,z+1,1)+ppx#*tiles#(x+1,z+1,1)
            set vertexdata position v,posx#,posy#,posz#
            if posy#>110
               SET VERTEXDATA DIFFUSE v,RGB(0,200,0)
            else
               SET VERTEXDATA DIFFUSE v,RGB(200,150,50)
            endif
         next v
         unlock vertexdata
         set limb normals 1,tiles#(x,z,0)
      endif
      `8*8squares
      if dist#>500 and dist#<1000 and tiles#(x,z,2)<>1
         terrainarray(x,z)
         change=1
         change mesh 1,tiles#(x,z,0),102
         convert object fvf 1,338
         tiles#(x,z,2)=1
         lock vertexdata for limb 1,tiles#(x,z,0)
         verts=get vertexdata vertex count()-1
         for v=0 to verts
            posx#=get vertexdata position x(v)
            posz#=get vertexdata position z(v)
            xx#=(posx#/500)*33 : zz#=(posz#/500)*33
            xx=ceil(xx#) : zz=ceil(zz#)
            rx#=posx#+x*500 : rz#=posz#+z*500
            set vertexdata UV v,rx#/100,rz#/100
            posy#=terraintile#(xx,zz)
            ppx#=posx#/500 : ppz#=posz#/500
            if posx#<10 then posy#=(1-ppz#)*tiles#(x,z,1)+ppz#*tiles#(x,z+1,1)
            if posz#<10 then posy#=(1-ppx#)*tiles#(x,z,1)+ppx#*tiles#(x+1,z,1)
            if posx#>490 then posy#=(1-ppz#)*tiles#(x+1,z,1)+ppz#*tiles#(x+1,z+1,1)
            if posz#>490 then posy#=(1-ppx#)*tiles#(x,z+1,1)+ppx#*tiles#(x+1,z+1,1)
            set vertexdata position v,posx#,posy#,posz#
            if posy#>110
               SET VERTEXDATA DIFFUSE v,RGB(0,200,0)
            else
               SET VERTEXDATA DIFFUSE v,RGB(200,150,50)
            endif
         next v
         unlock vertexdata
         set limb normals 1,tiles#(x,z,0)
      endif
      `32*32squares
      if dist#<500 and tiles#(x,z,2)<>2
         terrainarray(x,z)
         change=1
         change mesh 1,tiles#(x,z,0),103
         convert object fvf 1,338
         tiles#(x,z,2)=2
         lock vertexdata for limb 1,tiles#(x,z,0)
         verts=get vertexdata vertex count()-1
         for v=0 to verts
            posx#=get vertexdata position x(v)
            posz#=get vertexdata position z(v)
            xx#=(posx#/500)*33 : zz#=(posz#/500)*33
            xx=ceil(xx#) : zz=ceil(zz#)
            rx#=posx#+x*500 : rz#=posz#+z*500
            set vertexdata UV v,rx#/50,rz#/50
            posy#=terraintile#(xx,zz)
            ppx#=posx#/500 : ppz#=posz#/500
            if posx#<10 then posy#=(1-ppz#)*tiles#(x,z,1)+ppz#*tiles#(x,z+1,1)
            if posz#<10 then posy#=(1-ppx#)*tiles#(x,z,1)+ppx#*tiles#(x+1,z,1)
            if posx#>490 then posy#=(1-ppz#)*tiles#(x+1,z,1)+ppz#*tiles#(x+1,z+1,1)
            if posz#>490 then posy#=(1-ppx#)*tiles#(x,z+1,1)+ppx#*tiles#(x+1,z+1,1)
            set vertexdata position v,posx#,posy#,posz#
            if posy#>110
               SET VERTEXDATA DIFFUSE v,RGB(0,200,0)
            else
               SET VERTEXDATA DIFFUSE v,RGB(200,150,50)
            endif
         next v
         unlock vertexdata
         set limb normals 1,tiles#(x,z,0)
      endif
   next z : next x
   if change=1 then texture object 1,1 : set object filter 1,2
   sync
loop

function terrainarray(xx,zz)
   r=0
   h1#=tiles#(xx,zz,1)
   h2#=tiles#(xx+1,zz,1)
   h3#=tiles#(xx,zz+1,1)
   h4#=tiles#(xx+1,zz+1,1)
   FOR x=0 to 8
      x#=x : x#=x#/8
      x2#=1 : x2#=x2#-x#
      tile#(x,0)=h1#*x2#+h2#*x#
      tile#(x,8)=h3#*x2#+h4#*x#
      tile#(0,x)=h1#*x2#+h3#*x#
      tile#(8,x)=h2#*x2#+h4#*x#
   next x
   tile#(4,4)=h1#*0.25+h2#*0.25+h3#*0.25+h4#*0.25+fracal(x,z,4,4,4)
   tile#(2,4)=tile#(0,4)*0.5+tile#(4,4)*0.5+fracal(xx,zz,2,4,4)
   tile#(4,2)=tile#(4,0)*0.5+tile#(4,4)*0.5+fracal(xx,zz,4,2,4)
   tile#(6,4)=tile#(8,4)*0.5+tile#(4,4)*0.5+fracal(xx,zz,6,4,4)
   tile#(4,6)=tile#(4,8)*0.5+tile#(4,4)*0.5+fracal(xx,zz,4,6,4)
   for t=1 to 4
      if t=1 then x=2 : z=2
      if t=2 then x=6 : z=2
      if t=3 then x=2 : z=6
      if t=4 then x=6 : z=6
      tile#(x,z)=tile#(x-2,z-2)*0.25+tile#(x-2,z+2)*0.25+tile#(x+2,z-2)*0.25+tile#(x+2,z+2)*0.25+fracal(xx,zz,x,z,4)
   next t
   tile#(2,1)=tile#(2,2)*0.5+tile#(2,0)*0.5+fracal(xx,zz,2,1,3)
   tile#(4,1)=tile#(4,2)*0.5+tile#(4,0)*0.5+fracal(xx,zz,4,1,3)
   tile#(6,1)=tile#(6,2)*0.5+tile#(6,0)*0.5+fracal(xx,zz,6,1,3)
   tile#(1,2)=tile#(2,2)*0.5+tile#(0,2)*0.5+fracal(xx,zz,1,2,3)
   tile#(3,2)=tile#(2,2)*0.5+tile#(4,2)*0.5+fracal(xx,zz,3,2,3)
   tile#(5,2)=tile#(4,2)*0.5+tile#(6,2)*0.5+fracal(xx,zz,5,2,3)
   tile#(7,2)=tile#(6,2)*0.5+tile#(8,2)*0.5+fracal(xx,zz,7,2,3)
   tile#(2,3)=tile#(2,4)*0.5+tile#(2,2)*0.5+fracal(xx,zz,2,3,3)
   tile#(4,3)=tile#(4,4)*0.5+tile#(4,2)*0.5+fracal(xx,zz,4,3,3)
   tile#(6,3)=tile#(6,4)*0.5+tile#(6,2)*0.5+fracal(xx,zz,6,3,3)
   tile#(1,4)=tile#(2,4)*0.5+tile#(0,4)*0.5+fracal(xx,zz,1,4,3)
   tile#(3,4)=tile#(2,4)*0.5+tile#(4,4)*0.5+fracal(xx,zz,3,4,3)
   tile#(5,4)=tile#(4,4)*0.5+tile#(6,4)*0.5+fracal(xx,zz,5,4,3)
   tile#(7,4)=tile#(6,4)*0.5+tile#(8,4)*0.5+fracal(xx,zz,7,4,3)
   tile#(2,5)=tile#(2,6)*0.5+tile#(2,4)*0.5+fracal(xx,zz,2,5,3)
   tile#(4,5)=tile#(4,6)*0.5+tile#(4,4)*0.5+fracal(xx,zz,4,5,3)
   tile#(6,5)=tile#(6,6)*0.5+tile#(6,4)*0.5+fracal(xx,zz,6,5,3)
   tile#(1,6)=tile#(2,6)*0.5+tile#(0,6)*0.5+fracal(xx,zz,1,6,3)
   tile#(3,6)=tile#(2,6)*0.5+tile#(4,6)*0.5+fracal(xx,zz,3,6,3)
   tile#(5,6)=tile#(4,6)*0.5+tile#(6,6)*0.5+fracal(xx,zz,5,6,3)
   tile#(7,6)=tile#(6,6)*0.5+tile#(8,6)*0.5+fracal(xx,zz,7,6,3)
   tile#(2,7)=tile#(2,8)*0.5+tile#(2,6)*0.5+fracal(xx,zz,2,7,3)
   tile#(4,7)=tile#(4,8)*0.5+tile#(4,6)*0.5+fracal(xx,zz,4,7,3)
   tile#(6,7)=tile#(6,8)*0.5+tile#(6,6)*0.5+fracal(xx,zz,6,7,3)
   for t=1 to 16
      if t=1 then x=1 : z=1
      if t=2 then x=3 : z=1
      if t=3 then x=5 : z=1
      if t=4 then x=7 : z=1
      if t=5 then x=1 : z=3
      if t=6 then x=3 : z=3
      if t=7 then x=5 : z=3
      if t=8 then x=7 : z=3
      if t=9 then x=1 : z=5
      if t=10 then x=3 : z=5
      if t=11 then x=5 : z=5
      if t=12 then x=7 : z=5
      if t=13 then x=1 : z=7
      if t=14 then x=3 : z=7
      if t=15 then x=5 : z=7
      if t=16 then x=7 : z=7
      tile#(x,z)=tile#(x-1,z-1)*0.25+tile#(x-1,z+1)*0.25+tile#(x+1,z-1)*0.25+tile#(x+1,z+1)*0.25+fracal(xx,zz,x,z,3)
   next t

   for x=0 to 8
      tertile#(x*2,0)=tile#(x,0)
      tertile#(x*2,17)=tile#(x,8)
      tertile#(0,x*2)=tile#(0,x)
      tertile#(17,x*2)=tile#(8,x)
      tertile#(x*2,1)=tile#(x,0)
      tertile#(x*2,16)=tile#(x,8)
      tertile#(1,x*2)=tile#(0,x)
      tertile#(16,x*2)=tile#(8,x)
      if x+1<9
         tertile#(x*2+1,0)=tile#(x,0)*0.5+tile#(x+1,0)*0.5
         tertile#(x*2+1,17)=tile#(x,8)*0.5+tile#(x+1,8)*0.5
         tertile#(0,x*2+1)=tile#(0,x)*0.5+tile#(0,x+1)*0.5
         tertile#(17,x*2+1)=tile#(8,x)*0.5+tile#(8,x+1)*0.5
         tertile#(x*2+1,1)=tile#(x,0)*0.5+tile#(x+1,0)*0.5
         tertile#(x*2+1,16)=tile#(x,8)*0.5+tile#(x+1,8)*0.5
         tertile#(1,x*2+1)=tile#(0,x)*0.5+tile#(0,x+1)*0.5
         tertile#(16,x*2+1)=tile#(8,x)*0.5+tile#(8,x+1)*0.5
      else
         tertile#(x*2+1,0)=tile#(x,0)
         tertile#(x*2+1,17)=tile#(x,8)
         tertile#(0,x*2+1)=tile#(0,x)
         tertile#(17,x*2+1)=tile#(8,x)
         tertile#(x*2+1,1)=tile#(x,0)
         tertile#(x*2+1,16)=tile#(x,8)
         tertile#(1,x*2+1)=tile#(0,x)
         tertile#(16,x*2+1)=tile#(8,x)
      endif
   next x
   for x=1 to 7 : for z=1 to 7
      tertile#(x*2,z*2)=tile#(x,z)+fracal(xx,zz,x*2,z*2,2)
      h#=tile#(x,z)*0.5+tile#(x+1,z)*0.5
      tertile#(x*2+1,z*2)=h#+fracal(xx,zz,x*2+1,z*2,2)
      h#=tile#(x,z)*0.5+tile#(x,z+1)*0.5
      tertile#(x*2,z*2+1)=h#+fracal(xx,zz,x*2,z*2+1,2)
      h#=tile#(x,z)*0.25+tile#(x+1,z)*0.25+tile#(x,z+1)*0.25+tile#(x+1,z+1)*0.25
      tertile#(x*2+1,z*2+1)=h#+fracal(xx,zz,x*2+1,z*2+1,2)
   next z : next x

   for x=0 to 16 : for z=0 to 16
      terraintile#(x*2,z*2)=tertile#(x,z)+fracal(xx,zz,x*2,z*2,1)
      h#=tertile#(x,z)*0.5+tertile#(x+1,z)*0.5
      terraintile#(x*2+1,z*2)=h#+fracal(xx,zz,x*2+1,z*2,1)
      h#=tertile#(x,z)*0.5+tertile#(x,z+1)*0.5
      terraintile#(x*2,z*2+1)=h#+fracal(xx,zz,x*2,z*2+1,1)
      h#=tertile#(x,z)*0.25+tertile#(x+1,z)*0.25+tertile#(x,z+1)*0.25+tertile#(x+1,z+1)*0.25
      terraintile#(x*2+1,z*2+1)=h#+fracal(xx,zz,x*2+1,z*2+1,1)
   next z : next x

endfunction
function fracal(xx,zz,x,z,v)
   r#=(sin(x*xx*z*zz*100))*v^2
endfunction r#

sync on : set display mode 1024,768,32,1 : autocam off : set ambient light 10 : set camera range 1,10000 `: hide light 0
`make light 1
`set light range 1,10000
`position light 1,2500,1000,2500
`generate a grass texture
create bitmap 1,64,64
set current bitmap 1
for x=0 to 64 : for y=0 to 64
   color=rnd(200)
   ink rgb(50+color,50+color,50+color),0
   dot x,y
next y : next x
get image 1,0,0,64,64
`generate water texture
for x=0 to 64 : for y=0 to 64
   ink rgb(50+rnd(50),150+rnd(50),200+rnd(50)),0
   dot x,y
next y : next x
get image 2,0,0,64,64
delete bitmap 1

`make the basic meshes
   `2*2
   k#=100
   for sx=0 to 1 : for sz=0 to 1
      sx#=sx : sz#=sz
      make object triangle 2,sx#*k#,0,sz#*k#,sx#*k#,0,(sz#+1)*k#,(sx#+1)*k#,0,(sz#+1)*k#
      make mesh from object 1,2
      delete object 2
      make object triangle 2,sx#*k#,0,sz#*k#,(sx#+1)*k#,0,(sz#+1)*k#,(sx#+1)*k#,0,sz#*k#
      make mesh from object 2,2
      delete object 2
      make object 2,1,0
      add limb 2,1,2
      make mesh from object (sx+1)*2+(sz+1),2
      delete object 2
   next sz : next sx
   make object triangle 2,0,0,0,0,0,0,0,0,0
   for s=1 to 4
       add limb 2,s,s+2
   next s
   make mesh from object 101,2
   delete object 2
   `8*8
   k#=25
   for sx=0 to 7 : for sz=0 to 7
      sx#=sx : sz#=sz
      make object triangle 2,sx#*k#,0,sz#*k#,sx#*k#,0,(sz#+1)*k#,(sx#+1)*k#,0,(sz#+1)*k#
      make mesh from object 1,2
      delete object 2
      make object triangle 2,sx#*k#,0,sz#*k#,(sx#+1)*k#,0,(sz#+1)*k#,(sx#+1)*k#,0,sz#*k#
      make mesh from object 2,2
      delete object 2
      make object 2,1,0
      add limb 2,1,2
      make mesh from object (sx+1)*8+(sz+1),2
      delete object 2
   next sz : next sx
   make object triangle 2,0,0,0,0,0,0,0,0,0
   for s=1 to 64
      add limb 2,s,s+8
   next s
   make mesh from object 102,2
   delete object 2
   `32*32
   k#=6.25
   limb=1
   make object triangle 3,0,0,0,0,0,0,0,0,0
   for sx=0 to 31 : for sz=0 to 31
      sx#=sx : sz#=sz
      make object triangle 2,sx#*k#,0,sz#*k#,sx#*k#,0,(sz#+1)*k#,(sx#+1)*k#,0,(sz#+1)*k#
      make mesh from object 1,2
      delete object 2
      make object triangle 2,sx#*k#,0,sz#*k#,(sx#+1)*k#,0,(sz#+1)*k#,(sx#+1)*k#,0,sz#*k#
      make mesh from object 2,2
      delete object 2
      make object 2,1,0
      add limb 2,1,2
      make mesh from object 100,2
      delete object 2
      add limb 3,limb,100
      limb=limb+1
   next sz : next sx
   make mesh from object 103,3
   delete object 3

dim tile#(9,9)
dim tertile#(17,17)
dim terraintile#(33,33)
dim tiles#(26,26,3)
`0=limb
`1=altitude
`2=lod state
   `0=1*1
   `1=2*2
   `2=4*4
   `3=8*8

for t=1 to 5
   x=rnd(7)+1
   z=rnd(7)+1
   for xx=1 to 3 : for zz=1 to 3
      terraintile#(x+xx,z+zz)=rnd(100)+75
   next zz : next xx
next t

for x=0 to 13 : for z=0 to 13
   h1#=terraintile#(x,z) : h2#=terraintile#(x+1,z) : h3#=terraintile#(x,z+1) : h4#=terraintile#(x+1,z+1)
   for xx=0 to 1 : for zz=0 to 1
      px#=xx : px#=px#/2 : px2#=1-px#
      pz#=zz : pz#=pz#/2 : pz2#=1-pz#
      tiles#(xx+x*2,zz+z*2,1)=h1#*px2#*pz2#+h2#*px#*pz2#+h3#*px2#*pz#+h4#*px#*pz#+rnd(50)-25
   next zz : next xx
next z : next x

make object triangle 1,0,0,0,0,0,0,0,0,0
ob=50001
for x=0 to 25 : for z=0 to 25
   make object ob,101,0
   position object ob,x*200,0,z*200
   h1#=tiles#(x,z,1)
   h2#=tiles#(x+1,z,1)
   h3#=tiles#(x,z+1,1)
   h4#=tiles#(x+1,z+1,1)
   lock vertexdata for limb ob,0
   convert object fvf ob,338
   verts=get vertexdata vertex count()-1
   for v=0 to verts
      posx#=get vertexdata position x(v)
      posz#=get vertexdata position z(v)
      ppx#=(posx#/200) : ppx2#=1 :ppx2#=ppx2#-ppx#
      ppz#=(posz#/200) : ppz2#=1 :ppz2#=ppz2#-ppz#
      posy#=(h1#*ppx2#*ppz2#)+(h2#*ppx#*ppz2#)+(h3#*ppx2#*ppz#)+(h4#*ppx#*ppz#)
      rx#=posx#+x*200 : rz#=posz#+z*200
      set vertexdata UV v,rx#/100,rz#/100
      set vertexdata position v,posx#,posy#,posz#
      if posy#>110
         SET VERTEXDATA DIFFUSE v,RGB(0,200,0)
      else
         SET VERTEXDATA DIFFUSE v,RGB(200,150,50)
      endif
   next v
   unlock vertexdata
   tiles#(x,z,0)=ob
   texture object ob,1 : set object normals ob : set object texture ob,1,1
   ob=ob+1
next z : next x

make object plain 2,5000,5000
position object 2,2600,100,2600
xrotate object 2,90
set object 2,1,1,0,1,0,0,0
texture object 2,2
set object transparency 2,5
set alpha mapping on 2,75

zoom#=1000 : cax#=70
x#=3000 : z#=3000
ink rgb(0,0,0),0
make object box 3,1,1000,1
do
   text 10,10,"FPS rate: "+str$(screen fps())
   text 10,30,"Arrow keys to move, right mouseclick to rotate, space to zoom out, return to zoom in."
   if returnkey()=1 then zoom#=zoom#*0.9
   if spacekey()=1 then zoom#=zoom#*1.1
   position camera x#,0,z#
   position object 3,x#,0,z#
   rotate camera 0,cay#,0
   if upkey()=1 then move camera zoom#/100
   if downkey()=1 then move camera zoom#/-100
   yrotate camera wrapvalue(cay#+90)
   if rightkey()=1 then move camera zoom#/100
   if leftkey()=1 then move camera zoom#/-100
   rotate camera cax#,cay#,0
   x#=camera position x()
   z#=camera position z()
   move camera -1*zoom#
   mmx#=mousemovex()*0.1
   mmy#=mousemovey()*0.1
   if mouseclick()=2
      cax#=wrapvalue(cax#+mmy#)
      cay#=wrapvalue(cay#+mmx#)
   endif
   cx#=camera position x()
   cy#=camera position y()
   cz#=camera position z()
   `------------------------------------------------
   `--              MAGIC LOD CODE                --
   `------------------------------------------------
   change=0
   for x=0 to 25 : for z=0 to 25
      xpos#=x*200+100
      zpos#=z*200+100
      tera#=tiles#(x,z,0)+tiles#(x+1,z,0)+tiles#(x,z+1,0)+tiles#(x+1,z+1,0) : tera#=tera#/4
      dist#=sqrt((cx#-xpos#)^2+(cz#-zpos#)^2)
      `2*2squares
      if dist#>400 and tiles#(x,z,2)<>0
         terrainarray(x,z)
         change=1
         change mesh tiles#(x,z,0),0,101
         convert object fvf tiles#(x,z,0),338
         tiles#(x,z,2)=0
         lock vertexdata for limb tiles#(x,z,0),0
         verts=get vertexdata vertex count()-1
         for v=0 to verts
            posx#=get vertexdata position x(v)
            posz#=get vertexdata position z(v)
            xx#=(posx#/200)*33 : zz#=(posz#/200)*33
            xx=ceil(xx#) : zz=ceil(zz#)
            rx#=posx#+x*200 : rz#=posz#+z*200
            set vertexdata UV v,rx#/100,rz#/100
            posy#=terraintile#(xx,zz)
            ppx#=posx#/200 : ppz#=posz#/200
            if posx#<1 then posy#=(1-ppz#)*tiles#(x,z,1)+ppz#*tiles#(x,z+1,1)
            if posz#<1 then posy#=(1-ppx#)*tiles#(x,z,1)+ppx#*tiles#(x+1,z,1)
            if posx#>199 then posy#=(1-ppz#)*tiles#(x+1,z,1)+ppz#*tiles#(x+1,z+1,1)
            if posz#>199 then posy#=(1-ppx#)*tiles#(x,z+1,1)+ppx#*tiles#(x+1,z+1,1)
            set vertexdata position v,posx#,posy#,posz#
            if posy#>110
               SET VERTEXDATA DIFFUSE v,RGB(0,200,0)
            else
               SET VERTEXDATA DIFFUSE v,RGB(200,150,50)
            endif
         next v
         unlock vertexdata
         set object normals tiles#(x,z,0) : texture object tiles#(x,z,0),1
      endif
      `8*8squares
      if dist#>200 and dist#<400 and tiles#(x,z,2)<>1
         terrainarray(x,z)
         change=1
         change mesh tiles#(x,z,0),0,102
         convert object fvf tiles#(x,z,0),338
         tiles#(x,z,2)=1
         lock vertexdata for limb tiles#(x,z,0),0
         verts=get vertexdata vertex count()-1
         for v=0 to verts
            posx#=get vertexdata position x(v)
            posz#=get vertexdata position z(v)
            xx#=(posx#/200)*33 : zz#=(posz#/200)*33
            xx=ceil(xx#) : zz=ceil(zz#)
            rx#=posx#+x*200 : rz#=posz#+z*200
            set vertexdata UV v,rx#/50,rz#/50
            posy#=terraintile#(xx,zz)
            ppx#=posx#/200 : ppz#=posz#/200
            if posx#<1 then posy#=(1-ppz#)*tiles#(x,z,1)+ppz#*tiles#(x,z+1,1)
            if posz#<1 then posy#=(1-ppx#)*tiles#(x,z,1)+ppx#*tiles#(x+1,z,1)
            if posx#>199 then posy#=(1-ppz#)*tiles#(x+1,z,1)+ppz#*tiles#(x+1,z+1,1)
            if posz#>199 then posy#=(1-ppx#)*tiles#(x,z+1,1)+ppx#*tiles#(x+1,z+1,1)
            set vertexdata position v,posx#,posy#,posz#
            if posy#>110
               SET VERTEXDATA DIFFUSE v,RGB(0,200,0)
            else
               SET VERTEXDATA DIFFUSE v,RGB(200,150,50)
            endif
         next v
         unlock vertexdata
         set object normals tiles#(x,z,0) : texture object tiles#(x,z,0),1
      endif
      `32*32squares
      if dist#<200 and tiles#(x,z,2)<>2
         terrainarray(x,z)
         change=1
         change mesh tiles#(x,z,0),0,103
         convert object fvf tiles#(x,z,0),338
         tiles#(x,z,2)=2
         lock vertexdata for limb tiles#(x,z,0),0
         verts=get vertexdata vertex count()-1
         for v=0 to verts
            posx#=get vertexdata position x(v)
            posz#=get vertexdata position z(v)
            xx#=(posx#/200)*33 : zz#=(posz#/200)*33
            xx=ceil(xx#) : zz=ceil(zz#)
            rx#=posx#+x*200 : rz#=posz#+z*200
            set vertexdata UV v,rx#/25,rz#/25
            posy#=terraintile#(xx,zz)
            ppx#=posx#/200 : ppz#=posz#/200
            if posx#<1 then posy#=(1-ppz#)*tiles#(x,z,1)+ppz#*tiles#(x,z+1,1)
            if posz#<1 then posy#=(1-ppx#)*tiles#(x,z,1)+ppx#*tiles#(x+1,z,1)
            if posx#>199 then posy#=(1-ppz#)*tiles#(x+1,z,1)+ppz#*tiles#(x+1,z+1,1)
            if posz#>199 then posy#=(1-ppx#)*tiles#(x,z+1,1)+ppx#*tiles#(x+1,z+1,1)
            set vertexdata position v,posx#,posy#,posz#
            if posy#>110
               SET VERTEXDATA DIFFUSE v,RGB(0,200,0)
            else
               SET VERTEXDATA DIFFUSE v,RGB(200,150,50)
            endif
         next v
         unlock vertexdata
         set object normals tiles#(x,z,0) : texture object tiles#(x,z,0),1
      endif
   next z : next x
   if change=1 then text 100,100,"UPDATED"
   sync
loop

function terrainarray(xx,zz)
   r=0
   h1#=tiles#(xx,zz,1)
   h2#=tiles#(xx+1,zz,1)
   h3#=tiles#(xx,zz+1,1)
   h4#=tiles#(xx+1,zz+1,1)
   FOR x=0 to 8
      x#=x : x#=x#/8
      x2#=1 : x2#=x2#-x#
      tile#(x,0)=h1#*x2#+h2#*x#
      tile#(x,8)=h3#*x2#+h4#*x#
      tile#(0,x)=h1#*x2#+h3#*x#
      tile#(8,x)=h2#*x2#+h4#*x#
   next x
   tile#(4,4)=h1#*0.25+h2#*0.25+h3#*0.25+h4#*0.25+fracal(x,z,4,4,4)
   tile#(2,4)=tile#(0,4)*0.5+tile#(4,4)*0.5+fracal(xx,zz,2,4,4)
   tile#(4,2)=tile#(4,0)*0.5+tile#(4,4)*0.5+fracal(xx,zz,4,2,4)
   tile#(6,4)=tile#(8,4)*0.5+tile#(4,4)*0.5+fracal(xx,zz,6,4,4)
   tile#(4,6)=tile#(4,8)*0.5+tile#(4,4)*0.5+fracal(xx,zz,4,6,4)
   for t=1 to 4
      if t=1 then x=2 : z=2
      if t=2 then x=6 : z=2
      if t=3 then x=2 : z=6
      if t=4 then x=6 : z=6
      tile#(x,z)=tile#(x-2,z-2)*0.25+tile#(x-2,z+2)*0.25+tile#(x+2,z-2)*0.25+tile#(x+2,z+2)*0.25+fracal(xx,zz,x,z,4)
   next t
   tile#(2,1)=tile#(2,2)*0.5+tile#(2,0)*0.5+fracal(xx,zz,2,1,3)
   tile#(4,1)=tile#(4,2)*0.5+tile#(4,0)*0.5+fracal(xx,zz,4,1,3)
   tile#(6,1)=tile#(6,2)*0.5+tile#(6,0)*0.5+fracal(xx,zz,6,1,3)
   tile#(1,2)=tile#(2,2)*0.5+tile#(0,2)*0.5+fracal(xx,zz,1,2,3)
   tile#(3,2)=tile#(2,2)*0.5+tile#(4,2)*0.5+fracal(xx,zz,3,2,3)
   tile#(5,2)=tile#(4,2)*0.5+tile#(6,2)*0.5+fracal(xx,zz,5,2,3)
   tile#(7,2)=tile#(6,2)*0.5+tile#(8,2)*0.5+fracal(xx,zz,7,2,3)
   tile#(2,3)=tile#(2,4)*0.5+tile#(2,2)*0.5+fracal(xx,zz,2,3,3)
   tile#(4,3)=tile#(4,4)*0.5+tile#(4,2)*0.5+fracal(xx,zz,4,3,3)
   tile#(6,3)=tile#(6,4)*0.5+tile#(6,2)*0.5+fracal(xx,zz,6,3,3)
   tile#(1,4)=tile#(2,4)*0.5+tile#(0,4)*0.5+fracal(xx,zz,1,4,3)
   tile#(3,4)=tile#(2,4)*0.5+tile#(4,4)*0.5+fracal(xx,zz,3,4,3)
   tile#(5,4)=tile#(4,4)*0.5+tile#(6,4)*0.5+fracal(xx,zz,5,4,3)
   tile#(7,4)=tile#(6,4)*0.5+tile#(8,4)*0.5+fracal(xx,zz,7,4,3)
   tile#(2,5)=tile#(2,6)*0.5+tile#(2,4)*0.5+fracal(xx,zz,2,5,3)
   tile#(4,5)=tile#(4,6)*0.5+tile#(4,4)*0.5+fracal(xx,zz,4,5,3)
   tile#(6,5)=tile#(6,6)*0.5+tile#(6,4)*0.5+fracal(xx,zz,6,5,3)
   tile#(1,6)=tile#(2,6)*0.5+tile#(0,6)*0.5+fracal(xx,zz,1,6,3)
   tile#(3,6)=tile#(2,6)*0.5+tile#(4,6)*0.5+fracal(xx,zz,3,6,3)
   tile#(5,6)=tile#(4,6)*0.5+tile#(6,6)*0.5+fracal(xx,zz,5,6,3)
   tile#(7,6)=tile#(6,6)*0.5+tile#(8,6)*0.5+fracal(xx,zz,7,6,3)
   tile#(2,7)=tile#(2,8)*0.5+tile#(2,6)*0.5+fracal(xx,zz,2,7,3)
   tile#(4,7)=tile#(4,8)*0.5+tile#(4,6)*0.5+fracal(xx,zz,4,7,3)
   tile#(6,7)=tile#(6,8)*0.5+tile#(6,6)*0.5+fracal(xx,zz,6,7,3)
   for t=1 to 16
      if t=1 then x=1 : z=1
      if t=2 then x=3 : z=1
      if t=3 then x=5 : z=1
      if t=4 then x=7 : z=1
      if t=5 then x=1 : z=3
      if t=6 then x=3 : z=3
      if t=7 then x=5 : z=3
      if t=8 then x=7 : z=3
      if t=9 then x=1 : z=5
      if t=10 then x=3 : z=5
      if t=11 then x=5 : z=5
      if t=12 then x=7 : z=5
      if t=13 then x=1 : z=7
      if t=14 then x=3 : z=7
      if t=15 then x=5 : z=7
      if t=16 then x=7 : z=7
      tile#(x,z)=tile#(x-1,z-1)*0.25+tile#(x-1,z+1)*0.25+tile#(x+1,z-1)*0.25+tile#(x+1,z+1)*0.25+fracal(xx,zz,x,z,3)
   next t

   for x=0 to 8
      tertile#(x*2,0)=tile#(x,0)
      tertile#(x*2,17)=tile#(x,8)
      tertile#(0,x*2)=tile#(0,x)
      tertile#(17,x*2)=tile#(8,x)
      tertile#(x*2,1)=tile#(x,0)
      tertile#(x*2,16)=tile#(x,8)
      tertile#(1,x*2)=tile#(0,x)
      tertile#(16,x*2)=tile#(8,x)
      if x+1<9
         tertile#(x*2+1,0)=tile#(x,0)*0.5+tile#(x+1,0)*0.5
         tertile#(x*2+1,17)=tile#(x,8)*0.5+tile#(x+1,8)*0.5
         tertile#(0,x*2+1)=tile#(0,x)*0.5+tile#(0,x+1)*0.5
         tertile#(17,x*2+1)=tile#(8,x)*0.5+tile#(8,x+1)*0.5
         tertile#(x*2+1,1)=tile#(x,0)*0.5+tile#(x+1,0)*0.5
         tertile#(x*2+1,16)=tile#(x,8)*0.5+tile#(x+1,8)*0.5
         tertile#(1,x*2+1)=tile#(0,x)*0.5+tile#(0,x+1)*0.5
         tertile#(16,x*2+1)=tile#(8,x)*0.5+tile#(8,x+1)*0.5
      else
         tertile#(x*2+1,0)=tile#(x,0)
         tertile#(x*2+1,17)=tile#(x,8)
         tertile#(0,x*2+1)=tile#(0,x)
         tertile#(17,x*2+1)=tile#(8,x)
         tertile#(x*2+1,1)=tile#(x,0)
         tertile#(x*2+1,16)=tile#(x,8)
         tertile#(1,x*2+1)=tile#(0,x)
         tertile#(16,x*2+1)=tile#(8,x)
      endif
   next x
   for x=0 to 8 : for z=0 to 8
      tertile#(x*2,z*2)=tile#(x,z)+fracal(xx,zz,x*2,z*2,2)
      h#=tile#(x,z)*0.5+tile#(x+1,z)*0.5
      tertile#(x*2+1,z*2)=h#+fracal(xx,zz,x*2+1,z*2,2)
      h#=tile#(x,z)*0.5+tile#(x,z+1)*0.5
      tertile#(x*2,z*2+1)=h#+fracal(xx,zz,x*2,z*2+1,2)
      h#=tile#(x,z)*0.25+tile#(x+1,z)*0.25+tile#(x,z+1)*0.25+tile#(x+1,z+1)*0.25
      tertile#(x*2+1,z*2+1)=h#+fracal(xx,zz,x*2+1,z*2+1,2)
   next z : next x

   for x=0 to 16 : for z=0 to 16
      terraintile#(x*2,z*2)=tertile#(x,z)+fracal(xx,zz,x*2,z*2,1)
      h#=tertile#(x,z)*0.5+tertile#(x+1,z)*0.5
      terraintile#(x*2+1,z*2)=h#+fracal(xx,zz,x*2+1,z*2,1)
      h#=tertile#(x,z)*0.5+tertile#(x,z+1)*0.5
      terraintile#(x*2,z*2+1)=h#+fracal(xx,zz,x*2,z*2+1,1)
      h#=tertile#(x,z)*0.25+tertile#(x+1,z)*0.25+tertile#(x,z+1)*0.25+tertile#(x+1,z+1)*0.25
      terraintile#(x*2+1,z*2+1)=h#+fracal(xx,zz,x*2+1,z*2+1,1)
   next z : next x

endfunction
function fracal(xx,zz,x,z,v#)
   randomize xx*zz*x*z
   r#=(rnd(20)-10)*(v#^2)/25
endfunction r#

Rem Project: Sphical Planets
Rem Created: 20/12/2008 20:47:45

Rem ***** Main Source File *****
sync on : set display mode 1024,768,32,1 : autocam off
make object plain 60001,0,0
make object cube 1,1
make mesh from object 1000,1
delete object 1

`make basic square mesh
make object triangle 3,0,0,0,0,0,0,0,0,0
k#=10 : limb=1
for sx=0 to 0 : for sz=0 to 0
   sx#=sx : sz#=sz
   make object triangle 2,sx#*k#,0,sz#*k#,sx#*k#,0,(sz#+1)*k#,(sx#+1)*k#,0,(sz#+1)*k#
   make mesh from object 1,2
   delete object 2
   make object triangle 2,sx#*k#,0,sz#*k#,(sx#+1)*k#,0,(sz#+1)*k#,(sx#+1)*k#,0,sz#*k#
   make mesh from object 2,2
   delete object 2
   make object 2,1,0
   add limb 2,1,2
   make mesh from object 100,2
   delete object 2
   add limb 3,limb,100
   limb=limb+1
next sz : next sx
make mesh from object 101,3
delete object 3
make object 3,101,0
offset limb 3,0,-5,0,-5
make mesh from object 101,3
delete object 3


ob=1
for t=1 to 6
   for x=-5 to 5 : for z=-5 to 5
      make object ob,101,0
      set object wireframe ob,1

      make object plain ob+10000,0,0
      `adjust position so it is mapped to the sphere
      lock vertexdata for limb ob,0
      verts=get vertexdata vertex count()-1
      for v=0 to verts
         posy#=0
         posx#=get vertexdata position x(v)
         posz#=get vertexdata position z(v)
         if t=1 then rx#=posx#+x*10 : ry#=55 : rz#=posz#+z*10
         if t=2 then rx#=-posx#+x*10 : ry#=posz#+z*10 : rz#=55
         if t=3 then rx#=55 : ry#=posz#+z*10 : rz#=posx#+x*10
         if t=4 then rx#=posx#+x*10 : ry#=posz#+z*10 : rz#=-55
         if t=5 then rx#=-55 : ry#=posz#+z*10 : rz#=-posx#+x*10
         if t=6 then rx#=-posx#+x*10 : ry#=-55 : rz#=posz#+z*10
         dist#=sqrt(rx#^2+ry#^2+rz#^2)
         dist#=dist#-55
         position object 60001,rx#,ry#,rz#
         point object 60001,0,0,0
         move object 60001,dist#
         rx#=object position x(60001) : ry#=object position y(60001) : rz#=object position z(60001)
         set vertexdata position v,rx#,ry#,rz#
      next v
      unlock vertexdata
      set object normals ob
      ob=ob+1
   next z : next x
next t

zoom#=1000
do
   position camera 0,0,0
   rotate camera cax#,cay#,0
   move camera zoom#*-1
   mmx#=mousemovex()*0.1 : mmy#=mousemovey()*0.1
   if mouseclick()=2
      cax#=wrapvalue(cax#+mmy#)
      cay#=wrapvalue(cay#+mmx#)
   endif
   if upkey()=1 then zoom#=zoom#*0.9
   if downkey()=1 then zoom#=zoom#*1.1
   sync
loop

Set display mode (####,####,32)
Sync on : Sync Rate 60
`Planet (You can use your model/mesh)
make object sphere 1,50,50,50 : position object 1,500,25,500
Make Object Sphere 2,300,30,30
Set object ambient 2,0
Dist#=270
Ang#=0
Ang2#=0
Dist2#=60

`orbital ref.
  px# = newxvalue(object position x(1),ang#,dist#)
  pz# = newzvalue(object position z(1),ang#,dist#)
`camera orbital ref
  px2# = newxvalue(object position x(1),ang2#,dist2#)
  pz2# = newzvalue(object position z(1),ang2#,dist2#)
`Polar Spin
Turn Object right 1,0.06
turn object right 2,0.5
`Cam
position camera px2#,25,Pz2# : point camera Object position x(1),Object position y(1),Object position z(1)

`Display for testing time
set cursor 10,10
print "Sun's Radial Angle: ",Int(ang#),"º"
Set cursor 10,20
Print "Distance between Sun and Planet: ",dist#
if upkey()=1 then dist2#=dist2#-2
If downkey()=1 then Dist2#=dist2#+2
if leftkey()=1 then ang2#=Ang2#-2
if rightkey()=1 then ang2#=Ang2#+2
IF scancode()=02 then ang# = wrapvalue(ang# + 0.240) : turn object right 1,0.12
If Scancode()=03 then Ang# = Wrapvalue(ang# + 0.960) : turn object right 1,0.24
If Scancode()=04 then Ang# = Wrapvalue(ang# + 1.92) : turn object right 1,0.48
`Months
Set Cursor 10,30
print "God Time - ",TimeFormat( A# )," : ", a#
  If A#=>0 then Month$="January"
  IF A#=>7200 then Month$="February"
  If A#=>14400 then Month$="March"
  If A#=>21600 then Month$="April"
  If A#=>28800 then Month$="May"
  If A#=>36000then Month$="June"
  If A#=>43200 then Month$="July"
  If A#=>50400 then Month$="August"
  If A#=>57600 then Month$="September"
  If A#=>64800 then Month$="October"
  If A#=>72000 then Month$="November"
  If A#=>79200 then Month$="December"

`Sun's Radiance + Location

position light 1,px#,15.0,pz#

  ` position planet

  position object 2,px#,15.0,pz#

`orbit and time update

  ang# = wrapvalue(ang# + 0.120)
 ang2# = wrapvalue(ang2# - 0.00)
  ang3# = wrapvalue(Ang3# +4.800)
    ang4# = wrapvalue(Ang4# +480.0)

A#=Ang#*(10*(24))

if a# < 86400.0
  Set cursor 10,60
endif
loop

function TimeFormat( Time# as float )
  SS# = SawTooth( Time#, 60.0 )
  MM# = SawTooth( Time#/60.0, 60.0 )
  HH# = 1+SawTooth( Time#/3600, 12.0 )



  TimeString$ = (str$(int(HH#))) + ":" + (str$(int(MM#))) + ":" + (str$(int(SS#)))
endfunction TimeString$

function SawTooth( x# as float, Amplitude# as float )
  t# = Amplitude# * ( x#/Amplitude# - floor( x#/Amplitude# ) )
endfunction t#

Rem Project: RandomHeightmap
Rem Created: 12/11/2008 12:05:35 PM

Rem ***** Main Source File *****

sync on : autocam off

` Make the terrain and a random texture for it.
MakeTerrainObject( 1, 100, 100, 100.0, 100.0 )
MakeGrassImage( 100, 1 )
texture object 1, 0, 1
set object cull 1, 0
set object light 1, 1

make object sphere 2, 1.0
position object 2, object position x(1), object position y(1), object position z(1)


do
  set cursor 20, 20
  print screen fps()


  ControlCamera(0.5)
  ` Pick object is slow...
  if pick object( mousex(), mousey(), 1, 1 )
    cpx# = camera position x()
    cpy# = camera position y()
    cpz# = camera position z()
    position object 2, cpx# + get pick vector x(), cpy# + get pick vector y(), cpz# + get pick vector z()
    show object 2
    text object screen x(2), object screen y(2), str$(obj)
   else
    hide object 2
  endif

  sync
loop



function ControlCamera( velocity# as float )
  camXSpd# = keystate(17) - keystate(31) : camXSpd# = camXSpd# * velocity#
  camZSpd# = keystate(30) - keystate(32) : camZSpd# = camZSpd# * velocity#
  camYSpd# = keystate(16) - keystate(18) : camYSpd# = camYSpd# * velocity#
  x# = camera position x() : y# = camera position y() : z# = camera position z()
  yrotate camera wrapvalue( camera angle y() + mousemovex() / 2.0 )
  xrotate camera wrapvalue( camera angle x() + mousemovey() / 2.0 )
  ny# = y# - camYSpd#
  nx# = x# + camXSpd# * sin( camera angle y() ) + camZSpd# * sin( camera angle Y() - 90.0 )
  nz# = z# + camXSpd# * cos( camera angle y() ) + camZSpd# * cos( camera angle Y() - 90.0 )
  position camera (nx#), (ny#), (nz#)
endfunction


function MakeTerrainObject( ObjNum as integer, xTiles as integer, zTiles as integer, xDim#, zDim# )
  ` You could easily modify this to load a bitmap for height. right now im just too lazy.
  global dim HeightArray( (xTiles+1),(zTiles+1) )
  for z = 0 to zTiles
    for x = 0 to xTiles
      HeightArray(x,z) = rndrng( -1, 0 )
    next x
  next z

  byteSize = 12 + xTiles * zTiles * 6 * 36
  mem = 1 : TileWidth# = xDim# / xTiles : TileDepth# = zDim# / zTiles
  make memblock mem, byteSize
    write memblock dword mem, 0, 338
    write memblock dword mem, 4, 36
    write memblock dword mem, 8, xTiles * zTiles * 6
    ` build terrain mesh
    `center text Screen width()/2.0, 200, "Building Mesh." : sync : sync
    for z = 0 to zTiles-1
      for x = 0 to xTiles-1
        ` For each tile x + z*xTiles
        tile = x + z*xTiles
        for t = 0 to 1
          ` For each triangle t in that tile
          for v = 0 to 2
            ` For each vertex v in that triangle
            select v
              case 0
                if t = 0
                  x# = x * TileWidth#
                  y# = HeightArray(x,z)
                  z# = z * TileDepth#
                 else
                  x# = (x+1) * TileWidth#
                  y# = HeightArray(x+1,z)
                  z# = z * TileDepth#
                endif
              endcase
              case 1
                if t = 0
                  x# = (x+1) * TileWidth#
                  y# = HeightArray(x+1,z)
                  z# = z * TileDepth#
                 else
                  x# = (x+1) * TileWidth#
                  y# = HeightArray(x+1,z+1)
                  z# = (z+1) * TileDepth#
                endif
              endcase
              case 2
                x# = x * TileWidth#
                y# = HeightArray(x,z+1)
                z# = (z+1) * TileDepth#
              endcase
            endselect
            ` I han't fixed the smooth normals yet... :`(
````````````````````````````````````````````````````````
            Ax# = x#+TileWidth# : Ay# = HeightArray(x+1,z)-y# : Az# = z#
            Bx# = x# : By# = HeightArray(x,z+1)-y# : Bz# = z#+TileDepth#

            nx# = Ay#*Bz# - Az#*By#
            ny# = Az#*Bx# - Ax#*Bz#
            nz# = Ax#*By# - Ay#*Bx#
````````````````````````````````````````````````````````
            vertex = tile*6 + t*3 + v
            mempos = 12 + vertex * 36

            xt# = xTiles * 1.0  :  xt# = x / xt#
            zt# = zTiles * 1.0  :  zt# = z / zt#
            `print "mempos: ", mempos, "/", bytesize, ": vertex=", vertex, " (", x#, ",", y#, ",", z#, ")" : sync
            write memblock float mem, mempos + 0, x#
            write memblock float mem, mempos + 4, y#
            write memblock float mem, mempos + 8, z#
            write memblock float mem, mempos + 12, nx#
            write memblock float mem, mempos + 16, ny#
            write memblock float mem, mempos + 20, nz#
            write memblock dword mem, mempos + 24, rgb(255,255,255)
            write memblock float mem, mempos + 28, xt#
            write memblock float mem, mempos + 32, zt#

          next v
        next t
      next x
    next z

    `center text Screen width()/2.0, 200, "Building Object." : sync
    make mesh from memblock ObjNum, mem
      if object exist(ObjNum) then delete object ObjNum
      make object ObjNum, ObjNum, 1
    `delete mesh mem
  delete memblock mem
endfunction


function MakeGrassImage( TileSize as integer, imgNum as integer )
  `Width(DWORD), Height(DWORD), Depth(DWORD), Data(BYTES).
  make memblock 255, (TileSize*TileSize*4) + 12
    write memblock dword 255, 0, TileSize
    write memblock dword 255, 4, TileSize
    write memblock dword 255, 8, 32

    `for each pixel
    for i=12 to (TileSize*TileSize*4+11) step 4
      write memblock byte 255, i+2, rndrng( 12 ,25 )
      write memblock byte 255, i+1, rndrng( 50 ,192 )
      write memblock byte 255, i,   rndrng( 12 ,25 )
      write memblock byte 255, i+3, 0
    next i
  make image from memblock imgNum, 255
  delete memblock 255
endfunction

function MakeWaterImage( TileSize as integer, imgNum as integer )
  `Width(DWORD), Height(DWORD), Depth(DWORD), Data(BYTES).
  make memblock 255, (TileSize*TileSize*4) + 12
    write memblock dword 255, 0, TileSize
    write memblock dword 255, 4, TileSize
    write memblock dword 255, 8, 32
    bt as byte
    `for each pixel
    for i=12 to (TileSize*TileSize*4+11) step 4
      write memblock byte 255, i+2, rndrng( 104 , 126 )
      write memblock byte 255, i+1, rndrng( 115 , 137 )
      write memblock byte 255, i,   rndrng( 243 , 247 )
      write memblock byte 255, i+3, 0
    next i
  make image from memblock imgNum, 255
  delete memblock 255
endfunction

function MakeDirtImage( TileSize as integer, imgNum as integer )
  `Width(DWORD), Height(DWORD), Depth(DWORD), Data(BYTES).
  make memblock 255, (TileSize*TileSize*4) + 12
    write memblock dword 255, 0, TileSize
    write memblock dword 255, 4, TileSize
    write memblock dword 255, 8, 32

    `for each pixel
    for i=12 to (TileSize*TileSize*4+11) step 4
      write memblock byte 255, i+2, rndrng( 40 , 94 ) : `R
      write memblock byte 255, i+1, rndrng( 30 , 45 ) : `G
      write memblock byte 255, i,   rndrng( 1 , 2 ) : `B
      write memblock byte 255, i+3, 0
    next i
  make image from memblock imgNum, 255
  delete memblock 255
endfunction

` Returns the unsigned distance of the point(x,y) from the line segment created by Pt1(Pt1X,Pt1Y) and Pt2(Pt2X,Pt2Y)
function PointDistanceFromLineSegment2D( x# as float, y# as float, Pt1X# as float, Pt1Y# as float, Pt2X# as float, Pt2Y# as float )
  dist# as float

  l1# = DotProd( x#-Pt1X#, y#-Pt1Y#, Pt2X#-Pt1X#, Pt2Y#-Pt1Y# )
  if l1# <= 0
    dist# = sqrt(DotProd(x#-Pt1X#, y#-Pt1Y#, x#-Pt1X#, y#-Pt1Y#))
    exitfunction dist#
  endif

  l2# = DotProd( Pt2X#-Pt1X#, Pt2Y#-Pt1Y#, Pt2X#-Pt1X#, Pt2Y#-Pt1Y# )
  if l2# <= l1#
     dist# = sqrt(DotProd(x#-Pt2X#,y#-Pt2Y#,x#-Pt2X#,y#-Pt2Y#))
    exitfunction dist#
  endif

  b# = l1# / l2#
  bx# = Pt1X# + b#*(Pt2X# - Pt1X#)
  by# = Pt1Y# + b#*(Pt2Y# - Pt1Y#)

  dist# = sqrt(DotProd(x#-bx#,y#-by#,x#-bx#,y#-by#))

endfunction dist#

function DotProd( x1#, y1#, x2#, y2# )
  d# = x1# * x2# + y1# * y2#
endfunction d#

function rndrng( minimum as integer, maximum as integer )
  value = rnd( maximum - minimum ) + minimum
endfunction value

sync on : set display mode 1024,768,32,1 : autocam off : set ambient light 10 : set camera range 1,10000 `: hide light 0
make object triangle 60001,0,0,0,0,0,0,0,0,0
`make light 1
`set light range 1,10000
`position light 1,2500,1000,2500
`generate a grass texture
create bitmap 1,64,64
set current bitmap 1
for x=0 to 64 : for y=0 to 64
   color=rnd(200)
   ink rgb(50+color,50+color,50+color),0
   dot x,y
next y : next x
get image 1,0,0,64,64
`generate water texture
for x=0 to 64 : for y=0 to 64
   ink rgb(50+rnd(50),150+rnd(50),200+rnd(50)),0
   dot x,y
next y : next x
get image 2,0,0,64,64
delete bitmap 1

`make the basic meshes
   `2*2
   k#=100
   for sx=0 to 1 : for sz=0 to 1
      sx#=sx : sz#=sz
      make object triangle 2,sx#*k#,0,sz#*k#,sx#*k#,0,(sz#+1)*k#,(sx#+1)*k#,0,(sz#+1)*k#
      make mesh from object 1,2
      delete object 2
      make object triangle 2,sx#*k#,0,sz#*k#,(sx#+1)*k#,0,(sz#+1)*k#,(sx#+1)*k#,0,sz#*k#
      make mesh from object 2,2
      delete object 2
      make object 2,1,0
      add limb 2,1,2
      make mesh from object (sx+1)*2+(sz+1),2
      delete object 2
   next sz : next sx
   make object triangle 2,0,0,0,0,0,0,0,0,0
   for s=1 to 4
       add limb 2,s,s+2
   next s
   make mesh from object 101,2
   delete object 2
   `8*8
   k#=25
   for sx=0 to 7 : for sz=0 to 7
      sx#=sx : sz#=sz
      make object triangle 2,sx#*k#,0,sz#*k#,sx#*k#,0,(sz#+1)*k#,(sx#+1)*k#,0,(sz#+1)*k#
      make mesh from object 1,2
      delete object 2
      make object triangle 2,sx#*k#,0,sz#*k#,(sx#+1)*k#,0,(sz#+1)*k#,(sx#+1)*k#,0,sz#*k#
      make mesh from object 2,2
      delete object 2
      make object 2,1,0
      add limb 2,1,2
      make mesh from object (sx+1)*8+(sz+1),2
      delete object 2
   next sz : next sx
   make object triangle 2,0,0,0,0,0,0,0,0,0
   for s=1 to 64
      add limb 2,s,s+8
   next s
   make mesh from object 102,2
   delete object 2
   `32*32
   k#=6.25
   limb=1
   make object triangle 3,0,0,0,0,0,0,0,0,0
   for sx=0 to 31 : for sz=0 to 31
      sx#=sx : sz#=sz
      make object triangle 2,sx#*k#,0,sz#*k#,sx#*k#,0,(sz#+1)*k#,(sx#+1)*k#,0,(sz#+1)*k#
      make mesh from object 1,2
      delete object 2
      make object triangle 2,sx#*k#,0,sz#*k#,(sx#+1)*k#,0,(sz#+1)*k#,(sx#+1)*k#,0,sz#*k#
      make mesh from object 2,2
      delete object 2
      make object 2,1,0
      add limb 2,1,2
      make mesh from object 100,2
      delete object 2
      add limb 3,limb,100
      limb=limb+1
   next sz : next sx
   make mesh from object 103,3
   delete object 3

dim tile#(9,9)
dim tertile#(17,17)
dim terraintile#(33,33)
dim tiles#(26,26,3)
`0=limb
`1=altitude
`2=lod state
   `0=1*1
   `1=2*2
   `2=4*4
   `3=8*8

for t=1 to 5
   x=rnd(7)+1
   z=rnd(7)+1
   for xx=1 to 3 : for zz=1 to 3
      terraintile#(x+xx,z+zz)=rnd(100)+75
   next zz : next xx
next t

for x=0 to 13 : for z=0 to 13
   h1#=terraintile#(x,z) : h2#=terraintile#(x+1,z) : h3#=terraintile#(x,z+1) : h4#=terraintile#(x+1,z+1)
   for xx=0 to 1 : for zz=0 to 1
      px#=xx : px#=px#/2 : px2#=1-px#
      pz#=zz : pz#=pz#/2 : pz2#=1-pz#
      tiles#(xx+x*2,zz+z*2,1)=h1#*px2#*pz2#+h2#*px#*pz2#+h3#*px2#*pz#+h4#*px#*pz#+rnd(50)-25
   next zz : next xx
next z : next x

ob=50001
for x=0 to 25 : for z=0 to 25
   make object ob,101,0
   position object ob,0,0,0
   h1#=tiles#(x,z,1)
   h2#=tiles#(x+1,z,1)
   h3#=tiles#(x,z+1,1)
   h4#=tiles#(x+1,z+1,1)
   lock vertexdata for limb ob,0
   convert object fvf ob,338
   verts=get vertexdata vertex count()-1
   for v=0 to verts
      posx#=get vertexdata position x(v)
      posz#=get vertexdata position z(v)
      ppx#=(posx#/200) : ppx2#=1 :ppx2#=ppx2#-ppx#
      ppz#=(posz#/200) : ppz2#=1 :ppz2#=ppz2#-ppz#
      posy#=(h1#*ppx2#*ppz2#)+(h2#*ppx#*ppz2#)+(h3#*ppx2#*ppz#)+(h4#*ppx#*ppz#)
      rx#=posx#+x*200-2500 : rz#=posz#+z*200-2500
      dist#=sqrt(rx#^2+(2500)^2+rz#^2)
      dist#=dist#-2500-posy#
      position object 60001,rx#,2500,rz#
      point object 60001,0,0,0
      move object 60001,dist#
      rx#=object position x(60001) : ry#=object position y(60001) : rz#=object position z(60001)
      set vertexdata UV v,rx#/100,rz#/100
      set vertexdata position v,rx#,ry#,rz#
      if posy#>110
         SET VERTEXDATA DIFFUSE v,RGB(0,200,0)
      else
         SET VERTEXDATA DIFFUSE v,RGB(200,150,50)
      endif
   next v
   unlock vertexdata
   tiles#(x,z,0)=ob
   texture object ob,1 : set object normals ob : set object texture ob,1,1 : set object radius ob,-1
   ob=ob+1
next z : next x

make object sphere 2,5200,32,64
position object 2,0,0,0
xrotate object 2,90
set object 2,1,1,0,1,0,0,0
texture object 2,2
set object transparency 2,5
set alpha mapping on 2,75

zoom#=100
ink rgb(0,0,0),0
make object cube 3,10
position object 3,0,3000,0
point object 3,0,0,0
do
   text 10,10,"FPS rate: "+str$(screen fps())
   text 10,30,"Arrow keys to move, mouse to look"
   if upkey()=1 then move object 3,5
   if downkey()=1 then move object 3,-5
   if rightkey()=1 then roll object right 3,3
   if leftkey()=1 then roll object left 3,3
   x#=object position x(3)
   y#=object position y(3)
   z#=object position z(3)
   position camera x#,y#,z#
   set camera to object orientation 3
   move camera -1*zoom#
   mmx#=mousemovex()*0.1
   mmy#=mousemovey()*0.1
   pitch object down 3,mmy#
   turn object right 3,mmx#
   cx#=camera position x()
   cy#=camera position y()
   cz#=camera position z()
   `------------------------------------------------
   `--              MAGIC LOD CODE                --
   `------------------------------------------------
   change=0

   for x=0 to 25 : for z=0 to 25
      xpos#=x*200+100-2500
      ypos#=2550
      zpos#=z*200+100-2500
      position object 60001,xpos#,ypos#,zpos#
      dst#=sqrt(xpos#^2+ypos#^2+zpos#^2)
      point object 60001,0,0,0
      move object 60001,dst#-2550
      xpos#=object position x(60001) : ypos#=object position y(60001) : zpos#=object position z(60001)
      dist#=sqrt((cx#-xpos#)^2+(cy#-ypos#)^2+(cz#-zpos#)^2)
      `2*2squares
      if dist#>500 and tiles#(x,z,2)<>0
         terrainarray(x,z)
         change=1
         change mesh tiles#(x,z,0),0,101
         convert object fvf tiles#(x,z,0),338
         tiles#(x,z,2)=0
         lock vertexdata for limb tiles#(x,z,0),0
         verts=get vertexdata vertex count()-1
         for v=0 to verts
            posx#=get vertexdata position x(v)
            posz#=get vertexdata position z(v)
            xx#=(posx#/200)*32 : zz#=(posz#/200)*32
            xx=ceil(xx#) : zz=ceil(zz#)
            posy#=terraintile#(xx,zz)
            ppx#=posx#/200 : ppz#=posz#/200
            if posx#<1 then posy#=(1-ppz#)*tiles#(x,z,1)+ppz#*tiles#(x,z+1,1)
            if posz#<1 then posy#=(1-ppx#)*tiles#(x,z,1)+ppx#*tiles#(x+1,z,1)
            if posx#>199 then posy#=(1-ppz#)*tiles#(x+1,z,1)+ppz#*tiles#(x+1,z+1,1)
            if posz#>199 then posy#=(1-ppx#)*tiles#(x,z+1,1)+ppx#*tiles#(x+1,z+1,1)
            rx#=posx#+x*200-2500 : rz#=posz#+z*200-2500
            dst#=sqrt(rx#^2+(2500)^2+rz#^2)
            dst#=dst#-2500-posy#
            position object 60001,rx#,2500,rz#
            point object 60001,0,0,0
            move object 60001,dst#
            rx#=object position x(60001) : ry#=object position y(60001) : rz#=object position z(60001)
            set vertexdata UV v,rx#/100,rz#/100
            set vertexdata position v,rx#,ry#,rz#
            if posy#>110
               SET VERTEXDATA DIFFUSE v,RGB(0,200,0)
            else
               SET VERTEXDATA DIFFUSE v,RGB(200,150,50)
            endif
         next v
         unlock vertexdata
         set object normals tiles#(x,z,0) : texture object tiles#(x,z,0),1
      endif
      `8*8squares
      if dist#>250 and dist#<500 and tiles#(x,z,2)<>1
         terrainarray(x,z)
         change=1
         change mesh tiles#(x,z,0),0,102
         convert object fvf tiles#(x,z,0),338
         tiles#(x,z,2)=1
         lock vertexdata for limb tiles#(x,z,0),0
         verts=get vertexdata vertex count()-1
         for v=0 to verts
            posx#=get vertexdata position x(v)
            posz#=get vertexdata position z(v)
            xx#=(posx#/200)*32 : zz#=(posz#/200)*32
            xx=ceil(xx#) : zz=ceil(zz#)
            posy#=terraintile#(xx,zz)
            ppx#=posx#/200 : ppz#=posz#/200
            if posx#<1 then posy#=(1-ppz#)*tiles#(x,z,1)+ppz#*tiles#(x,z+1,1)
            if posz#<1 then posy#=(1-ppx#)*tiles#(x,z,1)+ppx#*tiles#(x+1,z,1)
            if posx#>199 then posy#=(1-ppz#)*tiles#(x+1,z,1)+ppz#*tiles#(x+1,z+1,1)
            if posz#>199 then posy#=(1-ppx#)*tiles#(x,z+1,1)+ppx#*tiles#(x+1,z+1,1)
            rx#=posx#+x*200-2500 : rz#=posz#+z*200-2500
            dst#=sqrt(rx#^2+(2500)^2+rz#^2)
            dst#=dst#-2500-posy#
            position object 60001,rx#,2500,rz#
            point object 60001,0,0,0
            move object 60001,dst#
            rx#=object position x(60001) : ry#=object position y(60001) : rz#=object position z(60001)
            set vertexdata UV v,rx#/100,rz#/100
            set vertexdata position v,rx#,ry#,rz#
            if posy#>110
               SET VERTEXDATA DIFFUSE v,RGB(0,200,0)
            else
               SET VERTEXDATA DIFFUSE v,RGB(200,150,50)
            endif
         next v
         unlock vertexdata
         set object normals tiles#(x,z,0) : texture object tiles#(x,z,0),1
      endif
      `32*32squares
      if dist#<250 and tiles#(x,z,2)<>2
         terrainarray(x,z)
         change=1
         change mesh tiles#(x,z,0),0,103
         convert object fvf tiles#(x,z,0),338
         tiles#(x,z,2)=2
         lock vertexdata for limb tiles#(x,z,0),0
         verts=get vertexdata vertex count()-1
         for v=0 to verts
            posx#=get vertexdata position x(v)
            posz#=get vertexdata position z(v)
            xx#=(posx#/200)*32 : zz#=(posz#/200)*32
            xx=ceil(xx#) : zz=ceil(zz#)
            posy#=terraintile#(xx,zz)
            ppx#=posx#/200 : ppz#=posz#/200
            if posx#<1 then posy#=(1-ppz#)*tiles#(x,z,1)+ppz#*tiles#(x,z+1,1)
            if posz#<1 then posy#=(1-ppx#)*tiles#(x,z,1)+ppx#*tiles#(x+1,z,1)
            if posx#>199 then posy#=(1-ppz#)*tiles#(x+1,z,1)+ppz#*tiles#(x+1,z+1,1)
            if posz#>199 then posy#=(1-ppx#)*tiles#(x,z+1,1)+ppx#*tiles#(x+1,z+1,1)
            rx#=posx#+x*200-2500 : rz#=posz#+z*200-2500
            dst#=sqrt(rx#^2+(2500)^2+rz#^2)
            dst#=dst#-2500-posy#
            position object 60001,rx#,2500,rz#
            point object 60001,0,0,0
            move object 60001,dst#
            rx#=object position x(60001) : ry#=object position y(60001) : rz#=object position z(60001)
            set vertexdata UV v,rx#/100,rz#/100
            set vertexdata position v,rx#,ry#,rz#
            if posy#>110
               SET VERTEXDATA DIFFUSE v,RGB(0,200,0)
            else
               SET VERTEXDATA DIFFUSE v,RGB(200,150,50)
            endif
         next v
         unlock vertexdata
         set object normals tiles#(x,z,0) : texture object tiles#(x,z,0),1
      endif
   next z : next x
   if change=1 then text 100,100,"UPDATED"
   sync
loop

function terrainarray(xx,zz)
   r=0
   h1#=tiles#(xx,zz,1)
   h2#=tiles#(xx+1,zz,1)
   h3#=tiles#(xx,zz+1,1)
   h4#=tiles#(xx+1,zz+1,1)
   FOR x=0 to 8
      x#=x : x#=x#/8
      x2#=1 : x2#=x2#-x#
      tile#(x,0)=h1#*x2#+h2#*x#
      tile#(x,8)=h3#*x2#+h4#*x#
      tile#(0,x)=h1#*x2#+h3#*x#
      tile#(8,x)=h2#*x2#+h4#*x#
   next x
   tile#(4,4)=h1#*0.25+h2#*0.25+h3#*0.25+h4#*0.25+fracal(x,z,4,4,4)
   tile#(2,4)=tile#(0,4)*0.5+tile#(4,4)*0.5+fracal(xx,zz,2,4,4)
   tile#(4,2)=tile#(4,0)*0.5+tile#(4,4)*0.5+fracal(xx,zz,4,2,4)
   tile#(6,4)=tile#(8,4)*0.5+tile#(4,4)*0.5+fracal(xx,zz,6,4,4)
   tile#(4,6)=tile#(4,8)*0.5+tile#(4,4)*0.5+fracal(xx,zz,4,6,4)
   for t=1 to 4
      if t=1 then x=2 : z=2
      if t=2 then x=6 : z=2
      if t=3 then x=2 : z=6
      if t=4 then x=6 : z=6
      tile#(x,z)=tile#(x-2,z-2)*0.25+tile#(x-2,z+2)*0.25+tile#(x+2,z-2)*0.25+tile#(x+2,z+2)*0.25+fracal(xx,zz,x,z,4)
   next t
   tile#(2,1)=tile#(2,2)*0.5+tile#(2,0)*0.5+fracal(xx,zz,2,1,3)
   tile#(4,1)=tile#(4,2)*0.5+tile#(4,0)*0.5+fracal(xx,zz,4,1,3)
   tile#(6,1)=tile#(6,2)*0.5+tile#(6,0)*0.5+fracal(xx,zz,6,1,3)
   tile#(1,2)=tile#(2,2)*0.5+tile#(0,2)*0.5+fracal(xx,zz,1,2,3)
   tile#(3,2)=tile#(2,2)*0.5+tile#(4,2)*0.5+fracal(xx,zz,3,2,3)
   tile#(5,2)=tile#(4,2)*0.5+tile#(6,2)*0.5+fracal(xx,zz,5,2,3)
   tile#(7,2)=tile#(6,2)*0.5+tile#(8,2)*0.5+fracal(xx,zz,7,2,3)
   tile#(2,3)=tile#(2,4)*0.5+tile#(2,2)*0.5+fracal(xx,zz,2,3,3)
   tile#(4,3)=tile#(4,4)*0.5+tile#(4,2)*0.5+fracal(xx,zz,4,3,3)
   tile#(6,3)=tile#(6,4)*0.5+tile#(6,2)*0.5+fracal(xx,zz,6,3,3)
   tile#(1,4)=tile#(2,4)*0.5+tile#(0,4)*0.5+fracal(xx,zz,1,4,3)
   tile#(3,4)=tile#(2,4)*0.5+tile#(4,4)*0.5+fracal(xx,zz,3,4,3)
   tile#(5,4)=tile#(4,4)*0.5+tile#(6,4)*0.5+fracal(xx,zz,5,4,3)
   tile#(7,4)=tile#(6,4)*0.5+tile#(8,4)*0.5+fracal(xx,zz,7,4,3)
   tile#(2,5)=tile#(2,6)*0.5+tile#(2,4)*0.5+fracal(xx,zz,2,5,3)
   tile#(4,5)=tile#(4,6)*0.5+tile#(4,4)*0.5+fracal(xx,zz,4,5,3)
   tile#(6,5)=tile#(6,6)*0.5+tile#(6,4)*0.5+fracal(xx,zz,6,5,3)
   tile#(1,6)=tile#(2,6)*0.5+tile#(0,6)*0.5+fracal(xx,zz,1,6,3)
   tile#(3,6)=tile#(2,6)*0.5+tile#(4,6)*0.5+fracal(xx,zz,3,6,3)
   tile#(5,6)=tile#(4,6)*0.5+tile#(6,6)*0.5+fracal(xx,zz,5,6,3)
   tile#(7,6)=tile#(6,6)*0.5+tile#(8,6)*0.5+fracal(xx,zz,7,6,3)
   tile#(2,7)=tile#(2,8)*0.5+tile#(2,6)*0.5+fracal(xx,zz,2,7,3)
   tile#(4,7)=tile#(4,8)*0.5+tile#(4,6)*0.5+fracal(xx,zz,4,7,3)
   tile#(6,7)=tile#(6,8)*0.5+tile#(6,6)*0.5+fracal(xx,zz,6,7,3)
   for t=1 to 16
      if t=1 then x=1 : z=1
      if t=2 then x=3 : z=1
      if t=3 then x=5 : z=1
      if t=4 then x=7 : z=1
      if t=5 then x=1 : z=3
      if t=6 then x=3 : z=3
      if t=7 then x=5 : z=3
      if t=8 then x=7 : z=3
      if t=9 then x=1 : z=5
      if t=10 then x=3 : z=5
      if t=11 then x=5 : z=5
      if t=12 then x=7 : z=5
      if t=13 then x=1 : z=7
      if t=14 then x=3 : z=7
      if t=15 then x=5 : z=7
      if t=16 then x=7 : z=7
      tile#(x,z)=tile#(x-1,z-1)*0.25+tile#(x-1,z+1)*0.25+tile#(x+1,z-1)*0.25+tile#(x+1,z+1)*0.25+fracal(xx,zz,x,z,3)
   next t

   for x=0 to 8
      tertile#(x*2,0)=tile#(x,0)
      tertile#(x*2,17)=tile#(x,8)
      tertile#(0,x*2)=tile#(0,x)
      tertile#(17,x*2)=tile#(8,x)
      tertile#(x*2,1)=tile#(x,0)
      tertile#(x*2,16)=tile#(x,8)
      tertile#(1,x*2)=tile#(0,x)
      tertile#(16,x*2)=tile#(8,x)
      if x+1<9
         tertile#(x*2+1,0)=tile#(x,0)*0.5+tile#(x+1,0)*0.5
         tertile#(x*2+1,17)=tile#(x,8)*0.5+tile#(x+1,8)*0.5
         tertile#(0,x*2+1)=tile#(0,x)*0.5+tile#(0,x+1)*0.5
         tertile#(17,x*2+1)=tile#(8,x)*0.5+tile#(8,x+1)*0.5
         tertile#(x*2+1,1)=tile#(x,0)*0.5+tile#(x+1,0)*0.5
         tertile#(x*2+1,16)=tile#(x,8)*0.5+tile#(x+1,8)*0.5
         tertile#(1,x*2+1)=tile#(0,x)*0.5+tile#(0,x+1)*0.5
         tertile#(16,x*2+1)=tile#(8,x)*0.5+tile#(8,x+1)*0.5
      else
         tertile#(x*2+1,0)=tile#(x,0)
         tertile#(x*2+1,17)=tile#(x,8)
         tertile#(0,x*2+1)=tile#(0,x)
         tertile#(17,x*2+1)=tile#(8,x)
         tertile#(x*2+1,1)=tile#(x,0)
         tertile#(x*2+1,16)=tile#(x,8)
         tertile#(1,x*2+1)=tile#(0,x)
         tertile#(16,x*2+1)=tile#(8,x)
      endif
   next x
   for x=0 to 8 : for z=0 to 8
      tertile#(x*2,z*2)=tile#(x,z)+fracal(xx,zz,x*2,z*2,2)
      h#=tile#(x,z)*0.5+tile#(x+1,z)*0.5
      tertile#(x*2+1,z*2)=h#+fracal(xx,zz,x*2+1,z*2,2)
      h#=tile#(x,z)*0.5+tile#(x,z+1)*0.5
      tertile#(x*2,z*2+1)=h#+fracal(xx,zz,x*2,z*2+1,2)
      h#=tile#(x,z)*0.25+tile#(x+1,z)*0.25+tile#(x,z+1)*0.25+tile#(x+1,z+1)*0.25
      tertile#(x*2+1,z*2+1)=h#+fracal(xx,zz,x*2+1,z*2+1,2)
   next z : next x

   for x=0 to 16 : for z=0 to 16
      terraintile#(x*2,z*2)=tertile#(x,z)+fracal(xx,zz,x*2,z*2,1)
      h#=tertile#(x,z)*0.5+tertile#(x+1,z)*0.5
      terraintile#(x*2+1,z*2)=h#+fracal(xx,zz,x*2+1,z*2,1)
      h#=tertile#(x,z)*0.5+tertile#(x,z+1)*0.5
      terraintile#(x*2,z*2+1)=h#+fracal(xx,zz,x*2,z*2+1,1)
      h#=tertile#(x,z)*0.25+tertile#(x+1,z)*0.25+tertile#(x,z+1)*0.25+tertile#(x+1,z+1)*0.25
      terraintile#(x*2+1,z*2+1)=h#+fracal(xx,zz,x*2+1,z*2+1,1)
   next z : next x

endfunction
function fracal(xx,zz,x,z,v#)
   randomize xx*zz*x*z
   r#=(rnd(20)-10)*(v#^2)/25
endfunction r#

sync on : set display mode 1024,768,32,1 : autocam off : set ambient light 10 : set camera range 1,10000 : hide light 0
make object triangle 60001,0,0,0,0,0,0,0,0,0
make light 1
position light 1,75000,0,-100000
set light range 1,1000000
make light 2
position light 2,-75000,0,-100000
set light range 2,1000000

`generate a grass texture
create bitmap 1,64,64
set current bitmap 1
for x=0 to 64 : for y=0 to 64
   color=rnd(200)
   ink rgb(50+color,50+color,50+color),0
   dot x,y
next y : next x
get image 1,0,0,64,64
`generate water texture
for x=0 to 64 : for y=0 to 64
   ink rgb(50+rnd(50),150+rnd(50),200+rnd(50)),0
   dot x,y
next y : next x
get image 2,0,0,64,64
delete bitmap 1

`make the basic meshes
   `2*2
   k#=100
   for sx=0 to 1 : for sz=0 to 1
      sx#=sx : sz#=sz
      make object triangle 2,sx#*k#,0,sz#*k#,sx#*k#,0,(sz#+1)*k#,(sx#+1)*k#,0,(sz#+1)*k#
      make mesh from object 1,2
      delete object 2
      make object triangle 2,sx#*k#,0,sz#*k#,(sx#+1)*k#,0,(sz#+1)*k#,(sx#+1)*k#,0,sz#*k#
      make mesh from object 2,2
      delete object 2
      make object 2,1,0
      add limb 2,1,2
      make mesh from object (sx+1)*2+(sz+1),2
      delete object 2
   next sz : next sx
   make object triangle 2,0,0,0,0,0,0,0,0,0
   for s=1 to 4
       add limb 2,s,s+2
   next s
   make mesh from object 101,2
   delete object 2
   `8*8
   k#=25
   for sx=0 to 7 : for sz=0 to 7
      sx#=sx : sz#=sz
      make object triangle 2,sx#*k#,0,sz#*k#,sx#*k#,0,(sz#+1)*k#,(sx#+1)*k#,0,(sz#+1)*k#
      make mesh from object 1,2
      delete object 2
      make object triangle 2,sx#*k#,0,sz#*k#,(sx#+1)*k#,0,(sz#+1)*k#,(sx#+1)*k#,0,sz#*k#
      make mesh from object 2,2
      delete object 2
      make object 2,1,0
      add limb 2,1,2
      make mesh from object (sx+1)*8+(sz+1),2
      delete object 2
   next sz : next sx
   make object triangle 2,0,0,0,0,0,0,0,0,0
   for s=1 to 64
      add limb 2,s,s+8
   next s
   make mesh from object 102,2
   delete object 2
   `32*32
   k#=6.25
   limb=1
   make object triangle 3,0,0,0,0,0,0,0,0,0
   for sx=0 to 31 : for sz=0 to 31
      sx#=sx : sz#=sz
      make object triangle 2,sx#*k#,0,sz#*k#,sx#*k#,0,(sz#+1)*k#,(sx#+1)*k#,0,(sz#+1)*k#
      make mesh from object 1,2
      delete object 2
      make object triangle 2,sx#*k#,0,sz#*k#,(sx#+1)*k#,0,(sz#+1)*k#,(sx#+1)*k#,0,sz#*k#
      make mesh from object 2,2
      delete object 2
      make object 2,1,0
      add limb 2,1,2
      make mesh from object 100,2
      delete object 2
      add limb 3,limb,100
      limb=limb+1
   next sz : next sx
   make mesh from object 103,3
   delete object 3

dim tile#(9,9)
dim tertile#(17,17)
dim terraintile#(33,33)
dim tiles#(6,26,26,3)
`0=limb
`1=altitude
`2=lod state
   `0=hidden
   `1=2*2
   `2=4*4
   `3=8*8
for s=1 to 6
   for t=1 to 5
      x=rnd(7)+1
      z=rnd(7)+1
      for xx=1 to 3 : for zz=1 to 3
         terraintile#(x+xx,z+zz)=rnd(100)+75
      next zz : next xx
   next t
   for x=0 to 13 : for z=0 to 13
      h1#=terraintile#(x,z) : h2#=terraintile#(x+1,z) : h3#=terraintile#(x,z+1) : h4#=terraintile#(x+1,z+1)
      for xx=0 to 1 : for zz=0 to 1
         px#=xx : px#=px#/2 : px2#=1-px#
         pz#=zz : pz#=pz#/2 : pz2#=1-pz#
         tiles#(s,xx+x*2,zz+z*2,1)=h1#*px2#*pz2#+h2#*px#*pz2#+h3#*px2#*pz#+h4#*px#*pz#
         if x>0 and z>0 and x<13 and z<13 then tiles#(s,xx+x*2,zz+z*2,1)=tiles#(s,xx+x*2,zz+z*2,1)+rnd(50)-25
      next zz : next xx
   next z : next x
next s

for s=1 to 6
   ob=49001+1000*s
   for x=0 to 25 : for z=0 to 25
      make object ob,101,0
      position object ob,0,0,0
      if s=1 then rotate object ob,0,0,0
      if s=2 then rotate object ob,90,0,0
      if s=3 then rotate object ob,90,90,0
      if s=4 then rotate object ob,90,180,0
      if s=5 then rotate object ob,90,270,0
      if s=6 then rotate object ob,180,0,0
      h1#=tiles#(s,x,z,1)
      h2#=tiles#(s,x+1,z,1)
      h3#=tiles#(s,x,z+1,1)
      h4#=tiles#(s,x+1,z+1,1)
      lock vertexdata for limb ob,0
      convert object fvf ob,338
      verts=get vertexdata vertex count()-1
      for v=0 to verts
         posx#=get vertexdata position x(v)
         posz#=get vertexdata position z(v)
         ppx#=(posx#/200) : ppx2#=1 :ppx2#=ppx2#-ppx#
         ppz#=(posz#/200) : ppz2#=1 :ppz2#=ppz2#-ppz#
         posy#=(h1#*ppx2#*ppz2#)+(h2#*ppx#*ppz2#)+(h3#*ppx2#*ppz#)+(h4#*ppx#*ppz#)
         rx#=posx#+x*200-2500 : rz#=posz#+z*200-2500
         dist#=sqrt(rx#^2+(2500)^2+rz#^2)
         dist#=dist#-2500-posy#
         position object 60001,rx#,2500,rz#
         point object 60001,0,0,0
         move object 60001,dist#
         rx#=object position x(60001) : ry#=object position y(60001) : rz#=object position z(60001)
         set vertexdata UV v,posx#/100,posz#/100
         set vertexdata position v,rx#,ry#,rz#
         if posy#>110
            SET VERTEXDATA DIFFUSE v,RGB(0,200,0)
         else
            SET VERTEXDATA DIFFUSE v,RGB(200,150,50)
         endif
      next v
      unlock vertexdata
      tiles#(s,x,z,0)=ob
      tiles#(s,x,z,2)=1
      texture object ob,1 : set object normals ob : set object texture ob,1,1 : set object radius ob,-1
      ob=ob+1
   next z : next x
next s

make object sphere 2,5200,32,64
position object 2,0,0,0
xrotate object 2,90
set object 2,1,1,1,1,1,1,1
texture object 2,2
set object transparency 2,5
set alpha mapping on 2,75

zoom#=100
ink rgb(0,0,0),0
make object cube 3,10
position object 3,0,3000,0
point object 3,0,0,0
do
   text 10,10,"FPS rate: "+str$(screen fps())
   text 10,30,"Arrow keys to move, mouse to look"
   if upkey()=1 then move object 3,5
   if downkey()=1 then move object 3,-5
   if rightkey()=1 then roll object right 3,3
   if leftkey()=1 then roll object left 3,3
   x#=object position x(3)
   y#=object position y(3)
   z#=object position z(3)
   text 10,50,str$(x#)
   text 10,70,str$(y#)
   text 10,90,str$(z#)
   position camera x#,y#,z#
   set camera to object orientation 3
   move camera -1*zoom#
   mmx#=mousemovex()*0.1
   mmy#=mousemovey()*0.1
   pitch object down 3,mmy#
   turn object right 3,mmx#
   cx#=camera position x()
   cy#=camera position y()
   cz#=camera position z()
   dist#=sqrt(cx#^2+cy#^2+cz#^2)
   if dist#<2600
      set object cull 2,0
   else
      set object cull 2,1
   endif

   `------------------------------------------------
   `--              MAGIC LOD CODE                --
   `------------------------------------------------
   for s=1 to 6
      for x=0 to 25 : for z=0 to 25
         ob=tiles#(s,x,z,0)
         if s=1
            xpos#=x*200+100-2500
            ypos#=2550
            zpos#=z*200+100-2500
         endif
         if s=2
            xpos#=x*200+100-2500
            ypos#=-z*200-100+2500
            zpos#=2550
         endif
         if s=3
            xpos#=2550
            ypos#=-z*200-100+2500
            zpos#=-x*200-100+2500
         endif
         if s=4
            xpos#=-x*200-100+2500
            ypos#=-z*200-100+2500
            zpos#=-2550
         endif
         if s=5
            xpos#=-2550
            ypos#=-z*200-100+2500
            zpos#=x*200+100-2500
         endif
         if s=6
            xpos#=x*200+100-2500
            ypos#=-2550
            zpos#=-z*200-100+2500
         endif
         position object 60001,xpos#,ypos#,zpos#
         dst#=sqrt(xpos#^2+ypos#^2+zpos#^2)
         point object 60001,0,0,0
         move object 60001,dst#-2550
         xpos#=object position x(60001) : ypos#=object position y(60001) : zpos#=object position z(60001)
         dist#=sqrt((cx#-xpos#)^2+(cy#-ypos#)^2+(cz#-zpos#)^2)
         if dist#>2500
            if tiles#(s,x,z,2)=1 then hide object ob : tiles#(s,x,z,2)=0
         else
            if tiles#(s,x,z,2)=0 then show object ob : tiles#(s,x,z,2)=1
         endif
         change=0
         if dist#>400 and tiles#(s,x,z,2)>1
            change=1
            change mesh tiles#(s,x,z,0),0,101
            tiles#(s,x,z,2)=1
         endif
         if dist#>200 and dist#<400 and tiles#(s,x,z,2)<>2
            change=1
            change mesh tiles#(s,x,z,0),0,102
            tiles#(s,x,z,2)=2
         endif
         if dist#<200 and tiles#(s,x,z,2)<>3
            change=1
            change mesh tiles#(s,x,z,0),0,103
            tiles#(s,x,z,2)=3
         endif
         `update the mesh
         if change=1
            terrainarray(s,x,z)
            convert object fvf tiles#(s,x,z,0),338
            lock vertexdata for limb tiles#(s,x,z,0),0
            verts=get vertexdata vertex count()-1
            for v=0 to verts
               posx#=get vertexdata position x(v)
               posz#=get vertexdata position z(v)
               xx#=(posx#/200)*32 : zz#=(posz#/200)*32
               xx=ceil(xx#) : zz=ceil(zz#)
               posy#=terraintile#(xx,zz)
               ppx#=posx#/200 : ppz#=posz#/200
               if posx#<1 then posy#=(1-ppz#)*tiles#(s,x,z,1)+ppz#*tiles#(s,x,z+1,1)
               if posz#<1 then posy#=(1-ppx#)*tiles#(s,x,z,1)+ppx#*tiles#(s,x+1,z,1)
               if posx#>199 then posy#=(1-ppz#)*tiles#(s,x+1,z,1)+ppz#*tiles#(s,x+1,z+1,1)
               if posz#>199 then posy#=(1-ppx#)*tiles#(s,x,z+1,1)+ppx#*tiles#(s,x+1,z+1,1)
               rx#=posx#+x*200-2500 : rz#=posz#+z*200-2500
               dst#=sqrt(rx#^2+(2500)^2+rz#^2)
               dst#=dst#-2500-posy#
               position object 60001,rx#,2500,rz#
               point object 60001,0,0,0
               move object 60001,dst#
               rx#=object position x(60001) : ry#=object position y(60001) : rz#=object position z(60001)
               if tiles#(s,x,z,2)=1 then set vertexdata UV v,posx#/100,posz#/100
               if tiles#(s,x,z,2)=2 then set vertexdata UV v,posx#/50,posz#/50
               if tiles#(s,x,z,2)=3 then set vertexdata UV v,posx#/25,posz#/25
               set vertexdata position v,rx#,ry#,rz#
               if posy#>110
                  SET VERTEXDATA DIFFUSE v,RGB(0,200,0)
               else
                  SET VERTEXDATA DIFFUSE v,RGB(200,150,50)
               endif
            next v
            unlock vertexdata
            texture object tiles#(s,x,z,0),1
            set object normals tiles#(s,x,z,0)
            set object smoothing tiles#(s,x,z,0),25
            text 100,100,"UPDATED"
         endif
      next z : next x
   next s
   sync
loop

function terrainarray(s,xx,zz)
   r=0
   h1#=tiles#(s,xx,zz,1)
   h2#=tiles#(s,xx+1,zz,1)
   h3#=tiles#(s,xx,zz+1,1)
   h4#=tiles#(s,xx+1,zz+1,1)
   FOR x=0 to 8
      x#=x : x#=x#/8
      x2#=1 : x2#=x2#-x#
      tile#(x,0)=h1#*x2#+h2#*x#
      tile#(x,8)=h3#*x2#+h4#*x#
      tile#(0,x)=h1#*x2#+h3#*x#
      tile#(8,x)=h2#*x2#+h4#*x#
   next x
   tile#(4,4)=h1#*0.25+h2#*0.25+h3#*0.25+h4#*0.25+fracal(x,z,4,4,4)
   tile#(2,4)=tile#(0,4)*0.5+tile#(4,4)*0.5+fracal(xx,zz,2,4,4)
   tile#(4,2)=tile#(4,0)*0.5+tile#(4,4)*0.5+fracal(xx,zz,4,2,4)
   tile#(6,4)=tile#(8,4)*0.5+tile#(4,4)*0.5+fracal(xx,zz,6,4,4)
   tile#(4,6)=tile#(4,8)*0.5+tile#(4,4)*0.5+fracal(xx,zz,4,6,4)
   for t=1 to 4
      if t=1 then x=2 : z=2
      if t=2 then x=6 : z=2
      if t=3 then x=2 : z=6
      if t=4 then x=6 : z=6
      tile#(x,z)=tile#(x-2,z-2)*0.25+tile#(x-2,z+2)*0.25+tile#(x+2,z-2)*0.25+tile#(x+2,z+2)*0.25+fracal(xx,zz,x,z,4)
   next t
   tile#(2,1)=tile#(2,2)*0.5+tile#(2,0)*0.5+fracal(xx,zz,2,1,3)
   tile#(4,1)=tile#(4,2)*0.5+tile#(4,0)*0.5+fracal(xx,zz,4,1,3)
   tile#(6,1)=tile#(6,2)*0.5+tile#(6,0)*0.5+fracal(xx,zz,6,1,3)
   tile#(1,2)=tile#(2,2)*0.5+tile#(0,2)*0.5+fracal(xx,zz,1,2,3)
   tile#(3,2)=tile#(2,2)*0.5+tile#(4,2)*0.5+fracal(xx,zz,3,2,3)
   tile#(5,2)=tile#(4,2)*0.5+tile#(6,2)*0.5+fracal(xx,zz,5,2,3)
   tile#(7,2)=tile#(6,2)*0.5+tile#(8,2)*0.5+fracal(xx,zz,7,2,3)
   tile#(2,3)=tile#(2,4)*0.5+tile#(2,2)*0.5+fracal(xx,zz,2,3,3)
   tile#(4,3)=tile#(4,4)*0.5+tile#(4,2)*0.5+fracal(xx,zz,4,3,3)
   tile#(6,3)=tile#(6,4)*0.5+tile#(6,2)*0.5+fracal(xx,zz,6,3,3)
   tile#(1,4)=tile#(2,4)*0.5+tile#(0,4)*0.5+fracal(xx,zz,1,4,3)
   tile#(3,4)=tile#(2,4)*0.5+tile#(4,4)*0.5+fracal(xx,zz,3,4,3)
   tile#(5,4)=tile#(4,4)*0.5+tile#(6,4)*0.5+fracal(xx,zz,5,4,3)
   tile#(7,4)=tile#(6,4)*0.5+tile#(8,4)*0.5+fracal(xx,zz,7,4,3)
   tile#(2,5)=tile#(2,6)*0.5+tile#(2,4)*0.5+fracal(xx,zz,2,5,3)
   tile#(4,5)=tile#(4,6)*0.5+tile#(4,4)*0.5+fracal(xx,zz,4,5,3)
   tile#(6,5)=tile#(6,6)*0.5+tile#(6,4)*0.5+fracal(xx,zz,6,5,3)
   tile#(1,6)=tile#(2,6)*0.5+tile#(0,6)*0.5+fracal(xx,zz,1,6,3)
   tile#(3,6)=tile#(2,6)*0.5+tile#(4,6)*0.5+fracal(xx,zz,3,6,3)
   tile#(5,6)=tile#(4,6)*0.5+tile#(6,6)*0.5+fracal(xx,zz,5,6,3)
   tile#(7,6)=tile#(6,6)*0.5+tile#(8,6)*0.5+fracal(xx,zz,7,6,3)
   tile#(2,7)=tile#(2,8)*0.5+tile#(2,6)*0.5+fracal(xx,zz,2,7,3)
   tile#(4,7)=tile#(4,8)*0.5+tile#(4,6)*0.5+fracal(xx,zz,4,7,3)
   tile#(6,7)=tile#(6,8)*0.5+tile#(6,6)*0.5+fracal(xx,zz,6,7,3)
   for t=1 to 16
      if t=1 then x=1 : z=1
      if t=2 then x=3 : z=1
      if t=3 then x=5 : z=1
      if t=4 then x=7 : z=1
      if t=5 then x=1 : z=3
      if t=6 then x=3 : z=3
      if t=7 then x=5 : z=3
      if t=8 then x=7 : z=3
      if t=9 then x=1 : z=5
      if t=10 then x=3 : z=5
      if t=11 then x=5 : z=5
      if t=12 then x=7 : z=5
      if t=13 then x=1 : z=7
      if t=14 then x=3 : z=7
      if t=15 then x=5 : z=7
      if t=16 then x=7 : z=7
      tile#(x,z)=tile#(x-1,z-1)*0.25+tile#(x-1,z+1)*0.25+tile#(x+1,z-1)*0.25+tile#(x+1,z+1)*0.25+fracal(xx,zz,x,z,3)
   next t

   for x=0 to 8
      tertile#(x*2,0)=tile#(x,0)
      tertile#(x*2,17)=tile#(x,8)
      tertile#(0,x*2)=tile#(0,x)
      tertile#(17,x*2)=tile#(8,x)
      tertile#(x*2,1)=tile#(x,0)
      tertile#(x*2,16)=tile#(x,8)
      tertile#(1,x*2)=tile#(0,x)
      tertile#(16,x*2)=tile#(8,x)
      if x+1<9
         tertile#(x*2+1,0)=tile#(x,0)*0.5+tile#(x+1,0)*0.5
         tertile#(x*2+1,17)=tile#(x,8)*0.5+tile#(x+1,8)*0.5
         tertile#(0,x*2+1)=tile#(0,x)*0.5+tile#(0,x+1)*0.5
         tertile#(17,x*2+1)=tile#(8,x)*0.5+tile#(8,x+1)*0.5
         tertile#(x*2+1,1)=tile#(x,0)*0.5+tile#(x+1,0)*0.5
         tertile#(x*2+1,16)=tile#(x,8)*0.5+tile#(x+1,8)*0.5
         tertile#(1,x*2+1)=tile#(0,x)*0.5+tile#(0,x+1)*0.5
         tertile#(16,x*2+1)=tile#(8,x)*0.5+tile#(8,x+1)*0.5
      else
         tertile#(x*2+1,0)=tile#(x,0)
         tertile#(x*2+1,17)=tile#(x,8)
         tertile#(0,x*2+1)=tile#(0,x)
         tertile#(17,x*2+1)=tile#(8,x)
         tertile#(x*2+1,1)=tile#(x,0)
         tertile#(x*2+1,16)=tile#(x,8)
         tertile#(1,x*2+1)=tile#(0,x)
         tertile#(16,x*2+1)=tile#(8,x)
      endif
   next x
   for x=0 to 8 : for z=0 to 8
      tertile#(x*2,z*2)=tile#(x,z)+fracal(xx,zz,x*2,z*2,2)
      h#=tile#(x,z)*0.5+tile#(x+1,z)*0.5
      tertile#(x*2+1,z*2)=h#+fracal(xx,zz,x*2+1,z*2,2)
      h#=tile#(x,z)*0.5+tile#(x,z+1)*0.5
      tertile#(x*2,z*2+1)=h#+fracal(xx,zz,x*2,z*2+1,2)
      h#=tile#(x,z)*0.25+tile#(x+1,z)*0.25+tile#(x,z+1)*0.25+tile#(x+1,z+1)*0.25
      tertile#(x*2+1,z*2+1)=h#+fracal(xx,zz,x*2+1,z*2+1,2)
   next z : next x

   for x=0 to 16 : for z=0 to 16
      terraintile#(x*2,z*2)=tertile#(x,z)+fracal(xx,zz,x*2,z*2,1)
      h#=tertile#(x,z)*0.5+tertile#(x+1,z)*0.5
      terraintile#(x*2+1,z*2)=h#+fracal(xx,zz,x*2+1,z*2,1)
      h#=tertile#(x,z)*0.5+tertile#(x,z+1)*0.5
      terraintile#(x*2,z*2+1)=h#+fracal(xx,zz,x*2,z*2+1,1)
      h#=tertile#(x,z)*0.25+tertile#(x+1,z)*0.25+tertile#(x,z+1)*0.25+tertile#(x+1,z+1)*0.25
      terraintile#(x*2+1,z*2+1)=h#+fracal(xx,zz,x*2+1,z*2+1,1)
   next z : next x

endfunction
function fracal(xx,zz,x,z,v#)
   randomize xx*zz*x*z
   r#=(rnd(20)-10)*(v#^2)/25
endfunction r#

sync on
set display mode 1024,768,32,1
autocam off
make object triangle 60001,0,0,0,0,0,0,0,0,0
color backdrop rgb(0,0,0)
make object sphere 1,2000
dim species$(24)
dim species(24,5)
remstart
   0=number
   1=nest x angle
   2=nest y angle
   3=strength
remend

`set up the ecosystem
for t=0 to 24
   species$(t)=str$(t*10+rnd(10))
   species(t,0)=10
   species(t,1)=rnd(140)-70
   species(t,2)=rnd(360)
   species(t,3)=10
next t


do
   position camera 0,0,0
   mmy#=mousemovey()*0.1
   mmx#=mousemovex()*0.1
   if mouseclick()>1
      cax#=wrapvalue(cax#+mmy#)
      cay#=wrapvalue(cay#+mmx#)
   endif
   rotate camera cax#,cay#,0
   move camera -3000
   ecosystem()
   sync
loop

function ecosystem()
   for t=0 to 24
      ink rgb(250,250,250),0
      text 10,10+15*t,species$(t)+": "+str$(species(t,0))
      position object 60001,0,0,0
      rotate object 60001,species(t,1),species(t,2),0
      move object 60001,1000
      nx#=object position x(60001)
      ny#=object position y(60001)
      nz#=object position z(60001)
      sx#=object screen x(60001)
      sy#=object screen y(60001)
      ink rgb(200,0,0),0
      if object in screen(60001)=1 then box sx#-2,sy#-2,sx#+2,sy#+2 : text sx#,sy#,species$(t)
      for s=0 to 24
         if s<>t
            position object 60001,0,0,0
            rotate object 60001,species(s,1),species(s,2),0
            move object 60001,1000
            n2x#=object position x(60001)
            n2y#=object position y(60001)
            n2z#=object position z(60001)
            dist=sqrt((nx#-n2x#)^2+(ny#-n2y#)^2+(nz#-n2z#)^2)
            if rnd(dist)=1
               tsrength=rnd(species(t,3))
               ssrength=rnd(species(s,3))
               if tsrength>ssrength
                  species(s,0)=species(s,0)-1
                  species(t,0)=species(t,0)+1
               else
                  species(t,0)=species(t,0)-1
                  species(s,0)=species(s,0)+1
               endif
            endif
         endif
      next s
      if species(t,0)<1
         mutate=rnd(24)
         species$(t)=species$(mutate)+"*"
         species(t,0)=species(mutate,0)/3
         species(t,1)=rnd(140)-70
         species(t,2)=rnd(360)
         species(t,3)=species(mutate,3)+rnd(2)-1
      endif
   next t
endfunction