Sorry your browser is not supported!

`random world matrix generation
dim MatHeight#(26,26) as float
`standard setup
sync on : sync rate 0 : autocam off : hide mouse : randomize timer() : set image colorkey 0,0,0
`make world texture
width=256
height=256
depth=32
make memblock 1,width*height*depth*4+12
write memblock dword 1,0,width
write memblock dword 1,4,height
write memblock dword 1,8,depth
for x=1 to width
   for y=1 to height
      position=((y-1)*width+x-1)*4+12
      g=rnd(150)
      r=rnd(int(g*5/6.0))
      b=rnd(10)
      color=rgb(r,g,b)
      write memblock dword 1,position,color
   next y
next x
make image from memblock 1,1
`blur image
create bitmap 1,256,256
paste image 1,0,0
blur bitmap 1,6
get image 1,0,0,256,256
cls
set current bitmap 0
delete bitmap 1
`create water texture
make memblock 2,width*height*depth*4+12
write memblock dword 2,0,width
write memblock dword 2,4,height
write memblock dword 2,8,depth
for x=1 to width
   for y=1 to height
      position=((y-1)*width+x-1)*4+12
      b=rnd(255)
      g=rnd(int(b*2/3.0))
      r=rnd(int(b*1/3.0))
      color=rgb(r,g,b)
      write memblock dword 2,position,color
   next y
next x
make image from memblock 2,2
`blur image
create bitmap 1,256,256
paste image 2,0,0
blur bitmap 1,6
get image 2,0,0,256,256
cls
set current bitmap 0
delete bitmap 1
`create sky texture
make memblock 3,width*height*depth*4+12
write memblock dword 3,0,width
write memblock dword 3,4,height
write memblock dword 3,8,depth
for x=1 to width
   for y=1 to height
      position=((y-1)*width+x-1)*4+12
      b=rnd(128)+127
      g=(int(b*200/255.0))
      r=(int(b*100/255.0))
      color=rgb(r,g,b)
      write memblock dword 3,position,color
   next y
next x
make image from memblock 3,3
`blur image
create bitmap 1,256,256
paste image 3,0,0
blur bitmap 1,6
get image 3,0,0,256,256
cls
set current bitmap 0
delete bitmap 1
`create plant
make memblock 4,width*height*depth*4+12
write memblock dword 4,0,width
write memblock dword 4,4,height
write memblock dword 4,8,depth
for leaf=1 to 30
   x=rnd(10)+123
   eh=rnd(50)+204
   g=rnd(100)+155
   b=rnd(int(g*80/255.0))
   r=rnd(int(g*150/255.0))
   color=rgb(r,g,b)
   for y=255 to 255-eh step -1
      position=((y-1)*width+x-1)*4+12
      x=rnd(6)-3+x
      if x>width-1 then x=width-1
      if x<1 then x=1
      write memblock dword 4,position,color
   next y
next leaf
make image from memblock 4,4
`blur image
create bitmap 1,256,256
paste image 4,0,0
blur bitmap 1,6
get image 4,0,0,256,256
cls
set current bitmap 0
delete bitmap 1
`make world matrix
make matrix 1,100,100,25,25
prepare matrix texture 1,1,1,1
`add different flat levels
for cliff=1 to 10
   repeat
   xb=rnd(23)+1
   zb=rnd(23)+1
   xe=rnd(23)+1
   ze=rnd(23)+1
   until xb<>xe and zb<>ze
   elevation=rnd(9)+1
   xs=(xe-xb)/abs(xe-xb)
   zs=(ze-zb)/abs(ze-zb)
   for x=xb to xe step xs
      for z=zb to ze step zs
         set matrix height 1,x,z,get matrix height(1,x,z)+elevation
      next z
   next x
next cliff
`smooth by averaging
for x=1 to 23
   for z=1 to 23
      average#=(get matrix height(1,x-1,z)+get matrix height(1,x+1,z)+get matrix height(1,x,z-1)+get matrix height(1,x,z+1))/4.0
      set matrix height 1,x,z,average#
   next z
next x
update matrix 1
`store heights in array
for x=0 to 25
   for z=0 to 25
      MatHeight#(x,z)=get matrix height(1,x,z)
   next z
next x
`add shadows to matrix
`All hail Yarbles for this code
`http://forum.thegamecreators.com/?m=forum_view&t=24971&b=1 is where I found it
rem generate_normals
for x=1 to 24
   for z=1 to 24
      rem create regular normals for Terrain array

      rem  Vertices on the matrix
      rem    x-1,z-1    x,z-1
      rem    x-1,z      x,z

      rem Get stored heights
      h8#=MatHeight#(x,z-1)
      h4#=MatHeight#(x-1,z)
      h1#=MatHeight#(x,z)

      rem Calculate projected angle X using heights
      y1#=h1#
      y2#=h4#
      rem X distance is a function of stepX#
      dx#=stepX#/10
      rem Y distance is the difference in height
      dy#=y2#-y1#
      ax#=atanfull(dx#,dy#)
      ax#=wrapvalue(90-ax#)

      rem Calculate projected angle Z using heights
      y1#=h1#
      y2#=h8#
      rem Z distance is a function of stepZ#
      dz#=stepZ#/10
      rem Y distance is the difference in height
      dy#=y2#-y1#
      az#=atanfull(dz#,dy#)
      az#=wrapvalue(90-az#)

      rem Make normal from projected angle
      nx# = Sin(ax#)
      ny# = Cos(ax#)
      nz# = Sin(az#)

      rem Setting matrix normal for smoothness
      Set Matrix Normal 1,x,z,nx#,ny#,nz#

    Next X
  Next Z


update matrix 1

`create water
make matrix 2,400,400,50,50
prepare matrix texture 2,2,1,1
position matrix 2,-200,2,-200
update matrix 2
`create sky
make object sphere 1,390
set object 1,1,0,0,0,0,0
texture object 1,3
position camera 50,20,50
make object plain 2,3,3
texture object 2,4
set object transparency 2,4
for patch=1 to 10
   px=rnd(90)+5
   pz=rnd(90)+5
   for i=patch*10 to patch*10+9
      instance object i,2
      xo=rnd(10)-5
      zo=rnd(10)-5
      position object i,px+xo,get ground height(1,px+xo,pz+zo),pz+zo
      yrotate object i,rnd(359)
   next i
next patch
x=rnd(100)
z=rnd(100)
position object 2,x,get ground height(1,x,z),z
yrotate object 2,rnd(359)
do
`camera control
sync
move camera (upkey()-downkey())/10.0
x#=camera angle x()
xrotate camera 0
yrotate camera camera angle y()+90
move camera (rightkey()-leftkey())/10.0
yrotate camera camera angle y()-90+mousemovex()/2.0
xrotate camera x#+mousemovey()/2.0
`wavy water
for x=0 to 50
   for z=0 to 50
      h1#=sin((x*100.0+time))*2.0
      h2#=sin((z*76.0+time))*2.0
      if h1#>h2#
         height#=h1#
      else
         height#=h2#
      endif
      set matrix height 2,x,z,height#
   next z
next x
update matrix 2
inc time
loop

set display mode 1280, 1024, 32
sync on
sync rate 0
backdrop on
color backdrop 0
autocam off

`Required Vectors..
null = make vector3(1)
null = make vector3(2)
null = make vector3(3)
null = make vector3(4)
null = make vector3(5)
null = make vector3(6)
null = make vector3(7)
null = make vector3(8)
null = make vector3(9)



gosub MakeWaveMesh







Dim Heights(WAVE_PLAIN_WIDTH, WAVE_PLAIN_DEPTH) as float

position camera -100, 50, -100
point camera 0,0,0

frameTime# = 1.0
startTime = timer()
do
   frameTime# = (frameTime# * 0.8) + ((timer() - startTime) * 0.2)
   startTime = timer()
   text 0, 0, "FPS: " + str$(screen fps())


   `This is the height calculation
   for x = 0 to WAVE_PLAIN_WIDTH-1
      for z = 0 to WAVE_PLAIN_DEPTH-1
         Heights(x, z) = sin((timer()*0.2 + (x * z)) * 1.440)
      next z
   next x



   lock vertexdata for limb 1, 0
   for x = 1 to WAVE_PLAIN_WIDTH-1
      for z = 1 to WAVE_PLAIN_DEPTH-1
         `Do Normal
         `function createNormal(hUp#, hRight#, hDown#, hLeft#)
         createNormal(Heights(x, z-1),    Heights(x+1, z),    Heights(x, z+1),    Heights(x-1, z))

         for i = 0 to 5
            v = WaveVerts(x + ArrayOffsets(i, 0), z + ArrayOffsets(i, 1), i)
            set vertexdata position v, get vertexdata position x(v), Heights(x, z), get vertexdata position z(v)

            set vertexdata normals v, x vector3(9), y vector3(9), z vector3(9)
         next i
      next z

`      text 100, x*10, str$(x vector3(9)) + ", " + str$(y vector3(9)) + ", " + str$(z vector3(9)) + ",   H: " + str$(Heights(x, 10))
   next x
   unlock vertexdata

   sync
   while spacekey() : endwhile
loop





MakeWaveMesh:
   #constant WAVE_PLAIN_WIDTH 32
   #constant WAVE_PLAIN_DEPTH 32
   #constant WAVE_PLAIN_SCALE 4.0
   global Ustep#
   global Vstep#
   Ustep# = 1.0/WAVE_PLAIN_WIDTH
   Vstep# = 1.0/WAVE_PLAIN_DEPTH

   `First we need an array to store the verts position/ID
   Dim WaveVerts(WAVE_PLAIN_WIDTH, WAVE_PLAIN_DEPTH, 6)
   `3rd dimensions...
   `  0 = TL
   `  1 = BL
   `  2 = TR
   `  3 = BL
   `  4 = BR
   `  5 = TR
   Dim ArrayOffsets(5, 2)
   `     X                          Z
   ArrayOffsets(0, 0) =  0 : ArrayOffsets(0, 1) =  0
   ArrayOffsets(1, 0) =  0 : ArrayOffsets(1, 1) = -1
   ArrayOffsets(2, 0) = -1 : ArrayOffsets(2, 1) =  0
   ArrayOffsets(3, 0) =  0 : ArrayOffsets(3, 1) = -1
   ArrayOffsets(4, 0) = -1 : ArrayOffsets(4, 1) = -1
   ArrayOffsets(5, 0) = -1 : ArrayOffsets(5, 1) =  0




   `Now make the memblock to create a mesh
   make memblock 1, 12 + (32 * 3 * 2 * WAVE_PLAIN_WIDTH * WAVE_PLAIN_DEPTH)
   write memblock dword 1,0,274 : `FVF FORMAT
   write memblock dword 1,4,32  : `SIZE PER VERT
   write memblock dword 1,8,WAVE_PLAIN_WIDTH * WAVE_PLAIN_DEPTH * 2 * 3   : `VERT NO

   for i = 0 to WAVE_PLAIN_WIDTH-1
      for j = 0 to WAVE_PLAIN_DEPTH-1
         x = (i - (WAVE_PLAIN_WIDTH * 0.5)) * WAVE_PLAIN_SCALE
         z = (j - (WAVE_PLAIN_DEPTH * 0.5)) * WAVE_PLAIN_SCALE

         p = ((i * WAVE_PLAIN_DEPTH) + j)

         `Write the two triangles for this poly
         `POLY 1
         MakeMeshEntry(1, 12 + (p * 192)       ,    x                   , 0, z                   ,    0, 1, 0,          i * Ustep#,       j * Vstep#)   :`TL
         MakeMeshEntry(1, 12 + (p * 192) + 32  ,    x                   , 0, z + WAVE_PLAIN_SCALE,    0, 1, 0,          i * Ustep#, (j + 1) * Vstep#)   :`BLa
         MakeMeshEntry(1, 12 + (p * 192) + 64  ,    x + WAVE_PLAIN_SCALE, 0, z                   ,    0, 1, 0,    (i + 1) * Ustep#,       j * Vstep#)   :`TRa
         `POLY 2
         MakeMeshEntry(1, 12 + (p * 192) + 96  ,    x                   , 0, z + WAVE_PLAIN_SCALE,    0, 1, 0,          i * Ustep#, (j + 1) * Vstep#)   :`BLa
         MakeMeshEntry(1, 12 + (p * 192) + 128 ,    x + WAVE_PLAIN_SCALE, 0, z + WAVE_PLAIN_SCALE,    0, 1, 0,    (i + 1) * Ustep#, (j + 1) * Vstep#)   :`BR
         MakeMeshEntry(1, 12 + (p * 192) + 160 ,    x + WAVE_PLAIN_SCALE, 0, z                   ,    0, 1, 0,    (i + 1) * Ustep#,       j * Vstep#)   :`TRb


         WaveVerts(i, j, 0) = (p * 6) + 0 :`Top Left
         WaveVerts(i, j, 1) = (p * 6) + 1 :`Top Right a
         WaveVerts(i, j, 2) = (p * 6) + 2 :`Top Right b
         WaveVerts(i, j, 3) = (p * 6) + 3 :`Bottom Right
         WaveVerts(i, j, 4) = (p * 6) + 4 :`Bottom Left a
         WaveVerts(i, j, 5) = (p * 6) + 5 :`Bottom Left b
      next j
   next i
   make mesh from memblock 1, 1
   make object 1, 1, 0
   load image "SeaWeed v2.png",1

   texture object 1,1
return




`Vector 9 holds the result
function createNormal(hUp#, hRight#, hDown#, hLeft#)
   ` GG comment - you might like to adjust the ny value a bit /WAVE_PLAIN_SCALE
   set vector3 9, hLeft#-hRight#,2.0*WAVE_PLAIN_SCALE,hDown#-hUp#
   divide vector3 9, length vector3(9)
endfunction











function MakeMeshEntry(mbNum, n,    x#, y#, z#,   nx#, ny#, nz#,    u#, v#)
   write memblock float mbNum, n +  0, x#  :`X
   write memblock float mbNum, n +  4, y#  :`Y
   write memblock float mbNum, n +  8, z#  :`Z

   write memblock float mbNum, n + 12, nx#  :`NX
   write memblock float mbNum, n + 16, ny#  :`NY
   write memblock float mbNum, n + 20, nz#  :`NZ

   write memblock float mbNum, n + 24, u#  :`X
   write memblock float mbNum, n + 28, v#  :`Y
endfunction

`random world matrix generation
dim MatHeight#(26,26) as float
`standard setup
sync on : sync rate 0 : autocam off : hide mouse : randomize timer() : set camera range 0.1,400
`make world texture
width=256
height=256
depth=32
make memblock 1,width*height*depth*4+12
write memblock dword 1,0,width
write memblock dword 1,4,height
write memblock dword 1,8,depth
for x=1 to width
   for y=1 to height
      position=((y-1)*width+x-1)*4+12
      g=rnd(150)+50
      r=rnd(int((g-50)*5/6.0))+50
      b=rnd(10)
      color=rgb(r,g,b)
      write memblock dword 1,position,color
   next y
next x
make image from memblock 1,1
`blur image
create bitmap 1,256,256
paste image 1,0,0
blur bitmap 1,6
get image 1,0,0,256,256
cls
set current bitmap 0
delete bitmap 1
`create water texture
make memblock 2,width*height*depth*4+12
write memblock dword 2,0,width
write memblock dword 2,4,height
write memblock dword 2,8,depth
for x=1 to width
   for y=1 to height
      position=((y-1)*width+x-1)*4+12
      b=rnd(155)+100
      g=rnd(int((b-100)*2/3.0))+40
      r=rnd(int((b-100)*1/3.0))
      color=rgb(r,g,b)
      write memblock dword 2,position,color
   next y
next x
make image from memblock 2,2
`blur image
create bitmap 1,256,256
paste image 2,0,0
blur bitmap 1,6
get image 2,0,0,256,256
cls
set current bitmap 0
delete bitmap 1
`create sky texture
make memblock 3,width*height*depth*4+12
write memblock dword 3,0,width
write memblock dword 3,4,height
write memblock dword 3,8,depth
for x=1 to width
   for y=1 to height
      position=((y-1)*width+x-1)*4+12
      b=rnd(128)+127
      g=(int(b*200/255.0))
      r=(int(b*100/255.0))
      color=rgb(r,g,b)
      write memblock dword 3,position,color
   next y
next x
make image from memblock 3,3
`blur image
`and add clouds
create bitmap 1,256,256
paste image 3,0,0
for cloud=1 to 1000
   bx=rnd(245)
   by=rnd(100)
   ex=bx+rnd(10)
   ey=by+rnd(10)
   n=rnd(255)
   ink rgb(n,n,n),0
   box bx,by,ex,ey
next i
for cloud=1 to 1000
   bx=rnd(245)
   by=rnd(50)
   ex=bx+rnd(10)
   ey=by+rnd(10)
   n=rnd(255)
   ink rgb(n,n,n),0
   box bx,by,ex,ey
next i
for cloud=1 to 1000
   bx=rnd(245)
   by=rnd(30)
   ex=bx+rnd(10)
   ey=by+rnd(10)
   n=rnd(255)
   ink rgb(n,n,n),0
   box bx,by,ex,ey
next i
blur bitmap 1,6
get image 3,0,0,256,256
cls
set current bitmap 0
delete bitmap 1
`create plant
set image colorkey 50,135,0
make memblock 4,width*height*depth*4+12
write memblock dword 4,0,width
write memblock dword 4,4,height
write memblock dword 4,8,depth
plantcolor=rgb(50,135,0)
for x=1 to width
   for y=1 to height
      position=((y-1)*width+x-1)*4+12
      write memblock dword 4,position,plantcolor
   next z
next x
for leaf=1 to 30
   x=rnd(10)+123
   eh=rnd(50)+204
   g=rnd(100)+155
   b=rnd(int(g*80.0/255.0))
   r=rnd(int(g*150.0/255.0))
   color=rgb(r,g,b)
   for y=255 to 255-eh step -1
      position=((y-1)*width+x-1)*4+12
      x=rnd(6)-3+x
      if x>width-1 then x=width-1
      if x<1 then x=1
      write memblock dword 4,position,color
   next y
next leaf
make image from memblock 4,4
`blur image
create bitmap 1,256,256
paste image 4,0,0
blur bitmap 1,6
get image 4,0,0,256,256
cls
set current bitmap 0
delete bitmap 1
`make world matrix
make matrix 1,100,100,25,25
prepare matrix texture 1,1,1,1
`add different flat levels
for cliff=1 to 10
   repeat
   xb=rnd(23)+1
   zb=rnd(23)+1
   xe=rnd(23)+1
   ze=rnd(23)+1
   until xb<>xe and zb<>ze
   elevation=rnd(9)+1
   xs=(xe-xb)/abs(xe-xb)
   zs=(ze-zb)/abs(ze-zb)
   for x=xb to xe step xs
      for z=zb to ze step zs
         set matrix height 1,x,z,get matrix height(1,x,z)+elevation
      next z
   next x
next cliff
`smooth by averaging
for x=1 to 24
   for z=1 to 24
      average#=(get matrix height(1,x-1,z)+get matrix height(1,x+1,z)+get matrix height(1,x,z-1)+get matrix height(1,x,z+1))/4.0
      set matrix height 1,x,z,average#
   next z
next x
update matrix 1
`store heights in array
for x=0 to 25
   for z=0 to 25
      MatHeight#(x,z)=get matrix height(1,x,z)
   next z
next x
`add shadows to matrix
`All hail Yarbles for this code
`http://forum.thegamecreators.com/?m=forum_view&t=24971&b=1 is where I found it
rem generate_normals
for x=1 to 24
   for z=1 to 24
      rem create regular normals for Terrain array

      rem  Vertices on the matrix
      rem    x-1,z-1    x,z-1
      rem    x-1,z      x,z

      rem Get stored heights
      h8#=MatHeight#(x,z-1)
      h4#=MatHeight#(x-1,z)
      h1#=MatHeight#(x,z)

      rem Calculate projected angle X using heights
      y1#=h1#
      y2#=h4#
      rem X distance is a function of stepX#
      dx#=stepX#/10
      rem Y distance is the difference in height
      dy#=y2#-y1#
      ax#=atanfull(dx#,dy#)
      ax#=wrapvalue(90-ax#)

      rem Calculate projected angle Z using heights
      y1#=h1#
      y2#=h8#
      rem Z distance is a function of stepZ#
      dz#=stepZ#/10
      rem Y distance is the difference in height
      dy#=y2#-y1#
      az#=atanfull(dz#,dy#)
      az#=wrapvalue(90-az#)

      rem Make normal from projected angle
      nx# = Sin(ax#)
      ny# = Cos(ax#)
      nz# = Sin(az#)

      rem Setting matrix normal for smoothness
      Set Matrix Normal 1,x,z,nx#,ny#,nz#

    Next X
  Next Z


update matrix 1

`create water
make matrix 2,400,400,50,50
prepare matrix texture 2,2,1,1
position matrix 2,-200,2,-200
update matrix 2
`create sky
make object sphere 1,390
set object 1,1,0,0,0,0,0
texture object 1,3

position camera 50,20,50
`make plant objects
make object plain 2,3,3
texture object 2,4
set object transparency 2,4
for patch=1 to 10
   px=rnd(90)+5
   pz=rnd(90)+5
   for i=patch*10 to patch*10+9
      instance object i,2
      xo=rnd(10)-5
      zo=rnd(10)-5
      position object i,px+xo,get ground height(1,px+xo,pz+zo)+1.5,pz+zo
      yrotate object i,rnd(359)
   next i
next patch
x=rnd(100)
z=rnd(100)
position object 2,x,get ground height(1,x,z)+1.5,z
yrotate object 2,rnd(359)
`view variables
view=1
wt=0
do
sync
`camera control
if view=1
   move camera (upkey()-downkey())/10.0
   x#=camera angle x()
   xrotate camera 0
   yrotate camera camera angle y()+90
   move camera (rightkey()-leftkey())/10.0
   yrotate camera camera angle y()-90+mousemovex()/2.0
   xrotate camera x#+mousemovey()/2.0
   view$="Free Flight"
else
   x#=camera angle x()
   xrotate camera 0
   move camera (upkey()-downkey())/50.0
   yrotate camera camera angle y()+90
   move camera (rightkey()-leftkey())/50.0
   yrotate camera camera angle y()-90+mousemovex()/2.0
   xrotate camera x#+mousemovey()/2.0
   cx#=camera position x()
   cz#=camera position z()
   position camera cx#,get ground height(1,cx#,cz#)+1,cz#
   view$="Walking"
endif
if wt=0
   if spacekey()=1
      view=view*-1
      position camera 50,get ground height(1,50,50),50
      wt=30
   endif
else
   dec wt
endif
`wavy water
for x=0 to 50
   for z=0 to 50
      h1#=sin((x*100.0+time))*2.0
      h2#=sin((z*76.0+time))*2.0
      if h1#>h2#
         height#=h1#
      else
         height#=h2#
      endif
      set matrix height 2,x,z,height#
   next z
next x
update matrix 2
set cursor 1,1
print "Camera Mode: "+view$+"  (spacekey)"
inc time
loop

`random world matrix generation
dim MatHeight#(26,26) as float
`standard setup
sync on : sync rate 0 : autocam off : hide mouse : randomize timer() : set camera range 0.1,400
`make world texture
width=256
height=256
depth=32
make memblock 1,width*height*depth*4+12
write memblock dword 1,0,width
write memblock dword 1,4,height
write memblock dword 1,8,depth
for x=1 to width
   for y=1 to height
      position=((y-1)*width+x-1)*4+12
      g=rnd(150)+50
      r=rnd(int((g-50)*5/6.0))+50
      b=rnd(10)
      color=rgb(r,g,b)
      write memblock dword 1,position,color
   next y
next x
make image from memblock 1,1
`blur image
create bitmap 1,256,256
paste image 1,0,0
blur bitmap 1,6
get image 1,0,0,256,256
cls
set current bitmap 0
delete bitmap 1
`create water texture
make memblock 2,width*height*depth*4+12
write memblock dword 2,0,width
write memblock dword 2,4,height
write memblock dword 2,8,depth
for x=1 to width
   for y=1 to height
      position=((y-1)*width+x-1)*4+12
      b=rnd(155)+100
      g=rnd(int((b-100)*2/3.0))+40
      r=rnd(int((b-100)*1/3.0))
      color=rgb(r,g,b)
      write memblock dword 2,position,color
   next y
next x
make image from memblock 2,2
`blur image
create bitmap 1,256,256
paste image 2,0,0
blur bitmap 1,6
get image 2,0,0,256,256
cls
set current bitmap 0
delete bitmap 1
`create sky texture
width=1000
height=1000
make memblock 3,width*height*depth*4+12
write memblock dword 3,0,width
write memblock dword 3,4,height
write memblock dword 3,8,depth
for x=1 to width
   for y=1 to height
      position=((y-1)*width+x-1)*4+12
      b=rnd(128)+127
      g=(int(b*200/255.0))
      r=(int(b*100/255.0))
      color=rgb(r,g,b)
      write memblock dword 3,position,color
   next y
next x
make image from memblock 3,3
`blur image
create bitmap 1,1000,1000
paste image 3,0,0
blur bitmap 1,6
get image 3,0,0,1000,1000
cls
set current bitmap 0
delete bitmap 1
`create plant
width=256
height=256
set image colorkey 50,135,0
make memblock 4,width*height*depth*4+12
write memblock dword 4,0,width
write memblock dword 4,4,height
write memblock dword 4,8,depth
plantcolor=rgb(50,135,0)
for x=1 to width
   for y=1 to height
      position=((y-1)*width+x-1)*4+12
      write memblock dword 4,position,plantcolor
   next z
next x
for leaf=1 to 30
   x=rnd(10)+123
   eh=rnd(50)+204
   g=rnd(100)+155
   b=rnd(int(g*80.0/255.0))
   r=rnd(int(g*150.0/255.0))
   color=rgb(r,g,b)
   for y=255 to 255-eh step -1
      position=((y-1)*width+x-1)*4+12
      x=rnd(6)-3+x
      if x>width-1 then x=width-1
      if x<1 then x=1
      write memblock dword 4,position,color
   next y
next leaf
make image from memblock 4,4
`blur image
create bitmap 1,256,256
paste image 4,0,0
blur bitmap 1,6
get image 4,0,0,256,256
cls
set current bitmap 0
delete bitmap 1
`create cloud (crosses fingers)
width=300
height=300
set image colorkey 255,255,255
make memblock 5,width*height*depth*4+12
write memblock dword 5,0,width
write memblock dword 5,4,height
write memblock dword 5,8,depth
white=rgb(255,255,255)
for x=1 to width
   for y=1 to height
      position=((y-1)*width+x-1)*4+12
      write memblock dword 5,position,white
   next z
next x
for circles=1 to 25
   cx=rnd(200)+50
   cy=rnd(200)+50
   radius=rnd(40)+10
   tr=abs(radius^2)
   c=rnd(60)+194
   cloudc=rgb(c,c,c)
   for x=cx-radius to cy+radius
      for y=cy-radius to cy+radius
         `sqrt takes too long
         dist#=abs((x-cx)^2+(y-cy)^2)
         if dist#<tr
            position=((y-1)*width+x-1)*4+12
            write memblock dword 5,position,cloudc
         endif
      next y
   next x
next circles
make image from memblock 5,5
`blur image
create bitmap 1,300,300
paste image 5,0,0
blur bitmap 1,6
get image 5,0,0,300,300
cls
set current bitmap 0
delete bitmap 1
`make world matrix
make matrix 1,100,100,25,25
prepare matrix texture 1,1,1,1
`add different flat levels
for cliff=1 to 10
   repeat
   xb=rnd(23)+1
   zb=rnd(23)+1
   xe=rnd(23)+1
   ze=rnd(23)+1
   until xb<>xe and zb<>ze
   elevation=rnd(9)+1
   xs=(xe-xb)/abs(xe-xb)
   zs=(ze-zb)/abs(ze-zb)
   for x=xb to xe step xs
      for z=zb to ze step zs
         set matrix height 1,x,z,get matrix height(1,x,z)+elevation
      next z
   next x
next cliff
`smooth by averaging
for x=1 to 24
   for z=1 to 24
      average#=(get matrix height(1,x-1,z)+get matrix height(1,x+1,z)+get matrix height(1,x,z-1)+get matrix height(1,x,z+1))/4.0
      set matrix height 1,x,z,average#
   next z
next x
update matrix 1
`store heights in array
for x=0 to 25
   for z=0 to 25
      MatHeight#(x,z)=get matrix height(1,x,z)
   next z
next x
`add shadows to matrix
`All hail Yarbles for this code
`http://forum.thegamecreators.com/?m=forum_view&t=24971&b=1 is where I found it
rem generate_normals
for x=1 to 24
   for z=1 to 24
      rem create regular normals for Terrain array

      rem  Vertices on the matrix
      rem    x-1,z-1    x,z-1
      rem    x-1,z      x,z

      rem Get stored heights
      h8#=MatHeight#(x,z-1)
      h4#=MatHeight#(x-1,z)
      h1#=MatHeight#(x,z)

      rem Calculate projected angle X using heights
      y1#=h1#
      y2#=h4#
      rem X distance is a function of stepX#
      dx#=stepX#/10
      rem Y distance is the difference in height
      dy#=y2#-y1#
      ax#=atanfull(dx#,dy#)
      ax#=wrapvalue(90-ax#)

      rem Calculate projected angle Z using heights
      y1#=h1#
      y2#=h8#
      rem Z distance is a function of stepZ#
      dz#=stepZ#/10
      rem Y distance is the difference in height
      dy#=y2#-y1#
      az#=atanfull(dz#,dy#)
      az#=wrapvalue(90-az#)

      rem Make normal from projected angle
      nx# = Sin(ax#)
      ny# = Cos(ax#)
      nz# = Sin(az#)

      rem Setting matrix normal for smoothness
      Set Matrix Normal 1,x,z,nx#,ny#,nz#

    Next X
  Next Z


update matrix 1

`create water
make matrix 2,400,400,50,50
prepare matrix texture 2,2,1,1
position matrix 2,-200,2,-200
update matrix 2
`create sky
make object sphere 1,390
set object 1,1,0,0,0,0,0
texture object 1,3

position camera 50,20,50
`make plant objects
make object plain 2,3,3
texture object 2,4
set object transparency 2,4
for patch=1 to 10
   px=rnd(90)+5
   pz=rnd(90)+5
   for i=patch*10 to patch*10+9
      instance object i,2
      xo=rnd(10)-5
      zo=rnd(10)-5
      position object i,px+xo,get ground height(1,px+xo,pz+zo)+1.5,pz+zo
      yrotate object i,rnd(359)
   next i
next patch
x=rnd(100)
z=rnd(100)
position object 2,x,get ground height(1,x,z)+1.5,z
yrotate object 2,rnd(359)
`make cloud plain
make object plain 110,100,100
set object light 110,0
texture object 110,5
set object transparency 110,4
for i=111 to 150
   instance object i,110
   scale object i,rnd(100)+10,rnd(10)+5,100
   rotate object i,-(rnd(60)+20),rnd(359),0
   move object i,rnd(10)+100
   point object i,50,20,50
next i
rotate object 110,-(rnd(60)+20),rnd(359),0
move object 110,1000
point object 110,50,20,50
`view variables
view=1
wt=0
do
sync
`camera control
if view=1
   move camera (upkey()-downkey())/10.0
   x#=camera angle x()
   xrotate camera 0
   yrotate camera camera angle y()+90
   move camera (rightkey()-leftkey())/10.0
   yrotate camera camera angle y()-90+mousemovex()/2.0
   xrotate camera x#+mousemovey()/2.0
   view$="Free Flight"
else
   x#=camera angle x()
   xrotate camera 0
   move camera (upkey()-downkey())/50.0
   yrotate camera camera angle y()+90
   move camera (rightkey()-leftkey())/50.0
   yrotate camera camera angle y()-90+mousemovex()/2.0
   xrotate camera x#+mousemovey()/2.0
   cx#=camera position x()
   cz#=camera position z()
   position camera cx#,get ground height(1,cx#,cz#)+1,cz#
   view$="Walking"
endif
if wt=0
   if spacekey()=1
      view=view*-1
      position camera 50,get ground height(1,50,50),50
      wt=30
   endif
else
   dec wt
endif
`wavy water
for x=0 to 50
   for z=0 to 50
      h1#=sin((x*100.0+time))*2.0
      h2#=sin((z*76.0+time))*2.0
      if h1#>h2#
         height#=h1#
      else
         height#=h2#
      endif
      set matrix height 2,x,z,height#
   next z
next x
update matrix 2
`move clouds
for i=110 to 150
   move object right i,rnd(5)/200.0
   move object up i,(rnd(2)-1)/400.0
   point object i,50,20,50
next i
set cursor 1,1
print "Camera Mode: "+view$+"  (spacekey)"
inc time
loop

`random world matrix generation
global dim MatHeight#(101,101) as double float
`standard setup
sync on : sync rate 0 : autocam off : hide mouse : randomize timer() : set camera range 0.1,400
`make world texture
width=256
height=256
depth=32
make memblock 1,width*height*depth*4+12
write memblock dword 1,0,width
write memblock dword 1,4,height
write memblock dword 1,8,depth
for x=1 to width
   for y=1 to height
      position=((y-1)*width+x-1)*4+12
      g=rnd(150)+50
      r=rnd(int((g-50)*5/6.0))+50
      b=rnd(10)
      color=rgb(r,g,b)
      write memblock dword 1,position,color
   next y
next x
make image from memblock 1,1
`blur image
create bitmap 1,256,256
paste image 1,0,0
blur bitmap 1,6
get image 1,0,0,256,256
cls
set current bitmap 0
delete bitmap 1
`create water texture
make memblock 2,width*height*depth*4+12
write memblock dword 2,0,width
write memblock dword 2,4,height
write memblock dword 2,8,depth
for x=1 to width
   for y=1 to height
      position=((y-1)*width+x-1)*4+12
      b=rnd(155)+100
      g=rnd(int((b-100)*2/3.0))+40
      r=rnd(int((b-100)*1/3.0))
      color=rgb(r,g,b)
      write memblock dword 2,position,color
   next y
next x
make image from memblock 2,2
`blur image
create bitmap 1,256,256
paste image 2,0,0
blur bitmap 1,6
get image 2,0,0,256,256
cls
set current bitmap 0
delete bitmap 1
`create sky texture
width=1000
height=1000
make memblock 3,width*height*depth*4+12
write memblock dword 3,0,width
write memblock dword 3,4,height
write memblock dword 3,8,depth
for x=1 to width
   for y=1 to height
      position=((y-1)*width+x-1)*4+12
      b=rnd(128)+127
      g=(int(b*200/255.0))
      r=(int(b*100/255.0))
      color=rgb(r,g,b)
      write memblock dword 3,position,color
   next y
next x
make image from memblock 3,3
`blur image
create bitmap 1,1000,1000
paste image 3,0,0
blur bitmap 1,6
get image 3,0,0,1000,1000
cls
set current bitmap 0
delete bitmap 1
`create plant
width=256
height=256
set image colorkey 50,135,0
make memblock 4,width*height*depth*4+12
write memblock dword 4,0,width
write memblock dword 4,4,height
write memblock dword 4,8,depth
plantcolor=rgb(50,135,0)
for x=1 to width
   for y=1 to height
      position=((y-1)*width+x-1)*4+12
      write memblock dword 4,position,plantcolor
   next z
next x
for leaf=1 to 30
   x=rnd(10)+123
   eh=rnd(50)+204
   g=rnd(100)+155
   b=rnd(int(g*80.0/255.0))
   r=rnd(int(g*150.0/255.0))
   color=rgb(r,g,b)
   for y=255 to 255-eh step -1
      position=((y-1)*width+x-1)*4+12
      x=rnd(6)-3+x
      if x>width-1 then x=width-1
      if x<1 then x=1
      write memblock dword 4,position,color
   next y
next leaf
make image from memblock 4,4
`blur image
create bitmap 1,256,256
paste image 4,0,0
blur bitmap 1,6
get image 4,0,0,256,256
cls
set current bitmap 0
delete bitmap 1
`create cloud (crosses fingers)
width=300
height=300
set image colorkey 255,255,255
make memblock 5,width*height*depth*4+12
write memblock dword 5,0,width
write memblock dword 5,4,height
write memblock dword 5,8,depth
white=rgb(255,255,255)
for x=1 to width
   for y=1 to height
      position=((y-1)*width+x-1)*4+12
      write memblock dword 5,position,white
   next z
next x
for circles=1 to 25
   cx=rnd(200)+50
   cy=rnd(200)+50
   radius=rnd(40)+10
   tr=abs(radius^2)
   c=rnd(60)+194
   cloudc=rgb(c,c,c)
   for x=cx-radius to cy+radius
      for y=cy-radius to cy+radius
         `sqrt takes too long
         dist#=abs((x-cx)^2+(y-cy)^2)
         if dist#<tr
            position=((y-1)*width+x-1)*4+12
            write memblock dword 5,position,cloudc
         endif
      next y
   next x
next circles
make image from memblock 5,5
`blur image
create bitmap 1,300,300
paste image 5,0,0
blur bitmap 1,6
get image 5,0,0,300,300
cls
set current bitmap 0
delete bitmap 1
`make world matrix
make matrix 1,100,100,25,25
prepare matrix texture 1,1,1,1
`add different flat levels
for cliff=1 to 10
   repeat
   xb=rnd(23)+1
   zb=rnd(23)+1
   xe=rnd(23)+1
   ze=rnd(23)+1
   until xb<>xe and zb<>ze
   elevation=rnd(9)+1
   xs=(xe-xb)/abs(xe-xb)
   zs=(ze-zb)/abs(ze-zb)
   for x=xb to xe step xs
      for z=zb to ze step zs
         set matrix height 1,x,z,get matrix height(1,x,z)+elevation
      next z
   next x
next cliff
`smooth by averaging
for x=1 to 24
   for z=1 to 24
      average#=(get matrix height(1,x-1,z)+get matrix height(1,x+1,z)+get matrix height(1,x,z-1)+get matrix height(1,x,z+1))/4.0
      set matrix height 1,x,z,average#
   next z
next x
update matrix 1
`store heights in array
for x=0 to 25
   for z=0 to 25
      MatHeight#(x,z)=get matrix height(1,x,z)
   next z
next x
`add shadows to matrix
`All hail Yarbles for this code
`http://forum.thegamecreators.com/?m=forum_view&t=24971&b=1 is where I found it
rem generate_normals
normal(1,26)

update matrix 1

`create water
make matrix 2,400,400,50,50
prepare matrix texture 2,2,1,1
position matrix 2,-200,2,-200
update matrix 2
`create sky
make object sphere 1,390
set object 1,1,0,0,0,0,0
texture object 1,3

position camera 50,20,50
`make plant objects
make object plain 2,3,3
texture object 2,4
set object transparency 2,4
for patch=1 to 10
   px=rnd(90)+5
   pz=rnd(90)+5
   for i=patch*10 to patch*10+9
      instance object i,2
      xo=rnd(10)-5
      zo=rnd(10)-5
      position object i,px+xo,get ground height(1,px+xo,pz+zo)+1.5,pz+zo
      yrotate object i,rnd(359)
   next i
next patch
x=rnd(100)
z=rnd(100)
position object 2,x,get ground height(1,x,z)+1.5,z
yrotate object 2,rnd(359)
`make cloud plain
make object plain 110,100,100
set object light 110,0
texture object 110,5
set object transparency 110,4
for i=111 to 150
   instance object i,110
   scale object i,rnd(100)+10,rnd(10)+5,100
   rotate object i,-(rnd(40)+20),rnd(359),0
   move object i,rnd(10)+100
   point object i,50,20,50
next i
rotate object 110,-(rnd(60)+20),rnd(359),0
move object 110,1000
point object 110,50,20,50
`view variables
view=1
wt=0
do
sync
`camera control
if view=1
   move camera (upkey()-downkey())/10.0
   x#=camera angle x()
   xrotate camera 0
   yrotate camera camera angle y()+90
   move camera (rightkey()-leftkey())/10.0
   yrotate camera camera angle y()-90+mousemovex()/2.0
   xrotate camera x#+mousemovey()/2.0
   view$="Free Flight"
else
   x#=camera angle x()
   xrotate camera 0
   move camera (upkey()-downkey())/50.0
   yrotate camera camera angle y()+90
   move camera (rightkey()-leftkey())/50.0
   yrotate camera camera angle y()-90+mousemovex()/2.0
   xrotate camera x#+mousemovey()/2.0
   cx#=camera position x()
   cz#=camera position z()
   position camera cx#,get ground height(1,cx#,cz#)+1,cz#
   view$="Walking"
endif
if wt=0
   if spacekey()=1
      view=view*-1
      position camera 50,get ground height(1,50,50),50
      wt=30
   endif
else
   dec wt
endif
`wavy water
`using function by Nicholas Thompson
`wavy water
for x=0 to 50
   for z=0 to 50
      height#=getHeight(x,z)
      set matrix height 2,x,z,height#
   next z
next x
update matrix 2
`move clouds
for i=110 to 150
   move object right i,rnd(5)/200.0
   move object up i,(rnd(2)-1)/400.0
   point object i,50,20,50
next i
set cursor 1,1
print "Camera Mode: "+view$+"  (spacekey)"
`store heights in array
for x=0 to 50
   for z=0 to 50
      MatHeight#(x,z)=get matrix height(2,x,z)
   next z
next x
normal(2,51)
inc time
loop

`Nicholas' function
function getHeight(x#, z#)
   h# = 2.0 * sin(0.8 *(x#*x# + z#*z#) + (timer() * -0.090))
endfunction h#

`Yarbles' function
rem generate_normals
function normal(MatNum,MapSize)
for x=1 to MapSize-1
   for z=1 to MapSize-1
      rem create regular normals for Terrain array

      rem  Vertices on the matrix
      rem    x-1,z-1    x,z-1
      rem    x-1,z      x,z

      rem Get stored heights
      h8#=MatHeight#(x,z-1)
      h4#=MatHeight#(x-1,z)
      h1#=MatHeight#(x,z)

      rem Calculate projected angle X using heights
      y1#=h1#
      y2#=h4#
      rem X distance is a function of stepX#
      dx#=stepX#/10
      rem Y distance is the difference in height
      dy#=y2#-y1#
      ax#=atanfull(dx#,dy#)
      ax#=wrapvalue(90-ax#)

      rem Calculate projected angle Z using heights
      y1#=h1#
      y2#=h8#
      rem Z distance is a function of stepZ#
      dz#=stepZ#/10
      rem Y distance is the difference in height
      dy#=y2#-y1#
      az#=atanfull(dz#,dy#)
      az#=wrapvalue(90-az#)

      rem Make normal from projected angle
      nx# = Sin(ax#)
      ny# = Cos(ax#)
      nz# = Sin(az#)

      rem Setting matrix normal for smoothness
      Set Matrix Normal MatNum,x,z,nx#,ny#,nz#

   Next x
Next z
EndFunction

set display mode 1024, 786, 32
sync on : sync rate 0
randomize timer()
set camera range 0, 0.1, 10000

`Create media
CreateGrassTex(2, 128, 128)
CreateWaterTex(3, 128, 128)
CreateSkyTex(4, 128, 128)

`Create world
CreateHeightMap()
CreateWorld(1, 10.0, 200.0)
texture object 1, 2

`Water
make object plain 2, 10000, 10000
xrotate object 2, 90
texture object 2, 3
scale object texture 2, 10, 10
position object 2, 320, 10, -320
set alpha mapping on 2, 80

make object plain 3, 150, 150
xrotate object 3, 90
texture object 3, 3
scale object texture 3, 1, 1
position object 3, 200, 80, -195
set alpha mapping on 3, 80

make object cylinder 4, 100
rotate object 4, 90, 0, 0 : scale object 4, 80, 70, 125
set object cull 4, 1 : texture object 4, 3
scale object texture 4, 3, 1
position object 4, 280, 18.5, -205
set alpha mapping on 4, 75

`Sky
make object sphere 5, 5000
set object cull 5, 0
texture object 5, 4
scale object texture 5, 1, 0.5
set object light 5, 0

`waterfall
wy# = 0

do

   ink rgb(255, 255, 255), 0
   text 0, 0, str$(statistic(1))
   text 0, 20, str$(screen fps())

   position camera 640, 100, -640
   point camera 320, 0, -320

   `handle waterfall
   scroll object texture 4, -0.01, 0

   `Handle sea
   scroll object texture 2, 0, 0.0001

   sync
loop

`************************************
`Functions
`************************************

function CreateSkyTex(nr, width, height)

   cls
   box 0, 0, width, height, rgb(255, 255, 255), rgb(100, 100, 255), rgb(255, 255, 255), rgb(100, 100, 255)
   get image nr, 0, 0, width, height, 1

endfunction

function CreateWaterTex(nr, width, height)

   `Create a memblock
   make memblock nr, 12 + (width*height*4)
   write memblock dword nr, 0, width
   write memblock dword nr, 4, height
   write memblock dword nr, 8, 32

   `fill memblock with blue colors
   for y = 1 to height
      for x = 1 to width

         `Get position
         pos = 12 + (((y-1)*width + x - 1) * 4)
         other = rnd(50)
         write memblock dword nr, pos, rgb(other, other, 150 + rnd(105))
      next x
   next y

   BlurImage(nr, nr + 1)
   BlurImage(nr + 1, nr)
   make image from memblock nr, nr + 1
   delete memblock nr
   delete memblock nr + 1

endfunction

function CreateGrassTex(nr, Width, Height)

   `create a memblock
   make memblock nr, 12 + (Width*Height*4)

   `write header
   write memblock DWORD nr,0, Width
   write memblock DWORD nr,4, Height
   write memblock DWORD nr,8, 32

   `write data
   for i = 1 to (Width*Height)
      green = 100 + rnd(55)
      write memblock byte nr, 12 + ((i-1)*4), 0
      write memblock byte nr, 13 + ((i-1)*4), green
      write memblock byte nr, 14 + ((i-1)*4), 0
      write memblock byte nr, 15 + ((i-1)*4), 255
   next i

   `create an image from the memblock and delete memblock
   make image from memblock nr,nr
   delete memblock nr

endfunction

function CreateWorld(nr, vertS#, maxH#)

   `Setup
   if image exist(nr) = 1 and object exist(nr) = 0

      `Get image data
      make memblock from image nr ,nr
      width = memblock dword(nr, 0)
      height = memblock dword(nr, 4)

      `Create mesh memblock
      make memblock nr + 1, 12 + (36*6 * width * height)
      write memblock dword nr + 1, 0, 338
      write memblock dword nr + 1, 4, 36
      write memblock dword nr + 1, 8, width * height * 6
   else
      exitfunction
   endif

   `Create world
   for y = 1 to height - 1
      for x = 1 to width - 1

         `Calculate vertex position
         pos = ((y-1) * width) + x - 1
         imgpos = 12 + (pos * 4)

         `Calculate height
         height1# = maxH# / 255.0 * memblock byte(nr, imgpos)
         height2# = maxH# / 255.0 * memblock byte(nr, imgpos + 4)
         height3# = maxH# / 255.0 * memblock byte(nr, imgpos + (width*4))
         height4# = maxH# / 255.0 * memblock byte(nr, imgpos + (width*4) + 4)

         `Write vertex data
         `First vertex
         x1# = (x - 1) * vertS# : x2# = x * vertS#
         y1# = (y - 1) * vertS# : y2# = y * vertS#
         WriteVertex(nr + 1, (pos * 6) + 1, x1#, height1#, -y1#, x1#, height1# + 10.0, -y1#, rgb(255, 255, 255), 0, 0)
         WriteVertex(nr + 1, (pos * 6) + 2, x2#, height2#, -y1#, x2#, height2# + 10.0, -y1#, rgb(255, 255, 255), 1, 0)
         WriteVertex(nr + 1, (pos * 6) + 3, x1#, height3#, -y2#, x1#, height3# + 10.0, -y2#, rgb(255, 255, 255), 0, 1)

         WriteVertex(nr + 1, (pos * 6) + 4, x2#, height2#, -y1#, x2#, height2# + 10.0, -y1#, rgb(255, 255, 255), 1, 0)
         WriteVertex(nr + 1, (pos * 6) + 5, x2#, height4#, -y2#, x2#, height4# + 10.0, -y2#, rgb(255, 255, 255), 1, 1)
         WriteVertex(nr + 1, (pos * 6) + 6, x1#, height3#, -y2#, x1#, height3# + 10.0, -y2#, rgb(255, 255, 255), 0, 1)

      next x
   next y

   `Create mesh
   make mesh from memblock nr, nr + 1
   delete memblock nr
   delete memblock nr + 1
   make object nr, nr, 0

endfunction

function CreateHeightMap()

   `Random terrain
   DrawRndBox(1, 1, 64, 64, 10, 20)

   `Draw waterfall mountain and river
   DrawRndBox(10, 10, 30, 30, 100, 10)

   DrawRndBox(15, 15, 23, 23, 80, 0)
   DrawRndBox(25, 20, 30, 23, 80, 0)

   `DrawRndBox(28, 28, 33, 33, 80, 10)
   `DrawRndBox(8, 9, 16, 13, 80, 10)

   DrawRndBox(7, 7, 28, 10, 30, 30)
   DrawRndBox(7, 7, 10, 28, 30, 30)

   ink rgb(0, 0, 0), 0
   Box 30, 16, 40, 28
   box 32, 14, 38, 30

   box 38, 28, 40, 35
   box 38, 35, 50, 37
   box 50, 35, 52, 64

   get image 1, 0, 0, 64, 64, 1
   make memblock from image 1 ,1
   BlurImage(1, 2)
   BlurImage(2, 1)
   make image from memblock 1, 1
   delete memblock 1
   delete memblock 2

endfunction

function BlurImage(mem, retmem)

   `Get data
   width = memblock dword(mem, 0)
   height = memblock dword(mem, 4)

   `Create returned memblock
   if memblock exist(retmem) = 0 then make memblock retmem, get memblock size(mem)
   write memblock dword retmem, 0, width
   write memblock dword retmem, 4, height
   write memblock dword retmem, 8, 32

   `Write data
   `No edges:
   for y = 2 to height - 1
      for x = 2 to width - 1

         `Get position
         pos = 12 + ((y-1)*width*4) + ((x-1)*4)

         `Initialize values
         blue# = memblock byte(mem, pos) * 0.5
         green# = memblock byte(mem, pos+1) * 0.5
         red# = memblock byte(mem, pos+2) * 0.5

         `Get surrounding data
         `Left
         npos = pos - 4
         blue# = blue# + (memblock byte(mem, npos)*0.08)
         green# = green# + (memblock byte(mem, npos+1)*0.08)
         red# = red# + (memblock byte(mem, npos+2)*0.08)

         `+-> Top Left
         npos = npos - (width*4)
         blue# = blue# + (memblock byte(mem, npos)*0.045)
         green# = green# + (memblock byte(mem, npos+1)*0.045)
         red# = red# + (memblock byte(mem, npos+2)*0.045)

         `Right
         npos = pos + 4
         blue# = blue# + (memblock byte(mem, npos)*0.08)
         green# = green# + (memblock byte(mem, npos+1)*0.08)
         red# = red# + (memblock byte(mem, npos+2)*0.08)

         `+-> Bottom right
         npos = npos + (width*4)
         blue# = blue# + (memblock byte(mem, npos)*0.045)
         green# = green# + (memblock byte(mem, npos+1)*0.045)
         red# = red# + (memblock byte(mem, npos+2)*0.045)

         `Top
         npos = pos - (width*4)
         blue# = blue# + (memblock byte(mem, npos)*0.08)
         green# = green# + (memblock byte(mem, npos+1)*0.08)
         red# = red# + (memblock byte(mem, npos+2)*0.08)

         `+-> top right
         npos = npos + 4
         blue# = blue# + (memblock byte(mem, npos)*0.045)
         green# = green# + (memblock byte(mem, npos+1)*0.045)
         red# = red# + (memblock byte(mem, npos+2)*0.045)

         `Bottom
         npos = pos + (width*4)
         blue# = blue# + (memblock byte(mem, npos)*0.08)
         green# = green# + (memblock byte(mem, npos+1)*0.08)
         red# = red# + (memblock byte(mem, npos+2)*0.08)

         `+-> Bottom left
         npos = npos - 4
         blue# = blue# + (memblock byte(mem, npos)*0.045)
         green# = green# + (memblock byte(mem, npos+1)*0.045)
         red# = red# + (memblock byte(mem, npos+2)*0.045)

         `Write away data
         write memblock byte retmem, pos, int(blue#+0.5)
         write memblock byte retmem, pos+1, int(green#+0.5)
         write memblock byte retmem, pos+2, int(red#+0.5)
         write memblock byte retmem, pos+3, 255

      next x
   next y

   `Edges
   for y = 1 to height step (height-1)
      for x = 1 to width

         `Get position
         pos = 12 + ((y-1)*width*4) + ((x-1)*4)

         `Initialize colors
         if x = 1 or x = width
            blue# = memblock byte(mem, pos) * 0.795
            green# = memblock byte(mem, pos+1) * 0.795
            red# = memblock byte(mem, pos+2) * 0.795
         else
            blue# = memblock byte(mem, pos) * 0.67
            green# = memblock byte(mem, pos+1) * 0.67
            red# = memblock byte(mem, pos+2) * 0.67
         endif

         `Get other colors
         if x > 1
            npos = pos - 4
            blue# = blue# + memblock byte(mem, npos) * 0.08
            green# = green# + memblock byte(mem, npos+1) * 0.08
            red# = red# + memblock byte(mem, npos+2) * 0.08
         endif
         if x < width
            npos = pos + 4
            blue# = blue# + memblock byte(mem, npos) * 0.08
            green# = green# + memblock byte(mem, npos+1) * 0.08
            red# = red# + memblock byte(mem, npos+2) * 0.08
         endif

         if y > 1 then npos = pos - (width*4) else npos = pos + (width*4)
         blue# = blue# + memblock byte(mem, npos) * 0.08
         green# = green# + memblock byte(mem, npos+1) * 0.08
         red# = red# + memblock byte(mem, npos+2) * 0.08

         if x > 1
            mpos = npos - 4
            blue# = blue# + memblock byte(mem, mpos) * 0.045
            green# = green# + memblock byte(mem, mpos+1) * 0.045
            red# = red# + memblock byte(mem, mpos+2) * 0.045
         endif
         if x < width
            mpos = npos + 4
            blue# = blue# + memblock byte(mem, mpos) * 0.045
            green# = green# + memblock byte(mem, mpos+1) * 0.045
            red# = red# + memblock byte(mem, mpos+2) * 0.045
         endif

         `Write away data
         write memblock byte retmem, pos, int(blue#+0.5)
         write memblock byte retmem, pos+1, int(green#+0.5)
         write memblock byte retmem, pos+2, int(red#+0.5)
         write memblock byte retmem, pos+3, 255

      next x
   next y

   `Left and right edges (no corners anymore)
   for x = 1 to width step (width-1)
      for y = 2 to height - 1

         `Get position
         pos = 12 + ((y-1)*width*4) + ((x-1)*4)

         `Initialize colors
         blue# = memblock byte(mem, pos) * 0.67
         green# = memblock byte(mem, pos+1) * 0.67
         red# = memblock byte(mem, pos+2) * 0.67

         `Get surrounding data
         npos = pos - (width*4)
         blue# = blue# + memblock byte(mem, npos) * 0.08
         green# = green# + memblock byte(mem, npos+1) * 0.08
         red# = red# + memblock byte(mem, npos+2) * 0.08

         npos = pos + (width*4)
         blue# = blue# + memblock byte(mem, npos) * 0.08
         green# = green# + memblock byte(mem, npos+1) * 0.08
         red# = red# + memblock byte(mem, npos+2) * 0.08

         if x > 1 then npos = pos - 4 else npos = pos + 4
         blue# = blue# + memblock byte(mem, npos) * 0.08
         green# = green# + memblock byte(mem, npos+1) * 0.08
         red# = red# + memblock byte(mem, npos+2) * 0.08

         mpos = npos - (width*4)
         blue# = blue# + memblock byte(mem, mpos) * 0.045
         green# = green# + memblock byte(mem, mpos+1) * 0.045
         red# = red# + memblock byte(mem, mpos+2) * 0.045
         mpos = npos + (width*4)
         blue# = blue# + memblock byte(mem, mpos) * 0.045
         green# = green# + memblock byte(mem, mpos+1) * 0.045
         red# = red# + memblock byte(mem, mpos+2) * 0.045

         `Write away data
         write memblock byte retmem, pos, int(blue#+0.5)
         write memblock byte retmem, pos+1, int(green#+0.5)
         write memblock byte retmem, pos+2, int(red#+0.5)
         write memblock byte retmem, pos+3, 255

      next y
   next x

endfunction

function WriteVertex(mem, v, x#, y#, z#, nx#, ny#, nz#, color, uvx#, uvy#)

   start = 12 + ((v-1)*36)

   `write vertex 1
   write memblock float mem,start, x#
   write memblock float mem,start+4, y#
   write memblock float mem,start+8, z#

   write memblock float mem,start+12, nx#
   write memblock float mem,start+16, ny#
   write memblock float mem,start+20, nz#

   write memblock dword mem,start+24, color

   write memblock float mem,start+28, uvx#
   write memblock float mem,start+32, uvy#

endfunction

function DrawRndBox(x1, y1, x2, y2, min, range)
   for y = y1 to y2
      for x = x1 to x2
         height = min + rnd(range)
         ink rgb(height, height, height), 0
         dot x - 1, y - 1
      next x
   next y
endfunction

set display mode 1024, 786, 32
sync on : sync rate 0
randomize timer()
set camera range 0, 0.1, 10000

`Create media
CreateGrassTex(2, 128, 128)
CreateWaterTex(3, 128, 128)
CreateSkyTex(4, 128, 128)
CreateSmogTex(5, 128, 128, 500, rgb(255, 255, 255))

`Create world
CreateHeightMap()
CreateWorld(1, 10.0, 200.0)
set object collision to polygons 1
texture object 1, 2

`Water
make object plain 2, 10000, 10000
xrotate object 2, 90
texture object 2, 3
scale object texture 2, 100, 100
position object 2, 320, 10, -320
set alpha mapping on 2, 80
set object light 2, 0

make object plain 3, 150, 150
xrotate object 3, 90
texture object 3, 3
scale object texture 3, 1, 1
position object 3, 200, 80, -195
set alpha mapping on 3, 80

`Waterfall
make object cylinder 4, 100
rotate object 4, 90, 0, 0 : scale object 4, 80, 70, 125
set object cull 4, 1 : texture object 4, 3
scale object texture 4, 3, 1
position object 4, 280, 18.5, -205
set alpha mapping on 4, 75

`Waterfall particles
make particles 1, 5, 30, 50
position particles 1, 310, 5.0, -205

`Sky
make object sphere 5, 5000
set object cull 5, 0
texture object 5, 4
scale object texture 5, 1, 0.5
set object light 5, 0

`Create trees
`Dummy object to get height
for i = 1 to 50
   CreateTree(5 + i, 6)
   scale object 5 + i, 300, 300, 300
   repeat
      x# = rnd(640)
      z# = -rnd(640)
      y# = 50.0
      position object 5 + i, x#, y#, z# : col = object collision(5 + i, 1)
      position object 5 + i, x#, 0, z# : col = object collision(5 + i, 1) + col
   until col = 0
   repeat
      y# = y# - 1.0
      position object 5 + i, x#, y#, z#
      col = object collision(5 + i, 1)
   until col > 0 or y# <= 0.0
next i

`waterfall
wy# = 0

do

   ink rgb(255, 255, 255), 0
   text 0, 0, str$(statistic(1))
   text 0, 20, str$(screen fps())

   position camera 640, 100, -640
   point camera 320, 0, -320

   `handle waterfall
   scroll object texture 4, -0.01, 0

   `Handle sea
   scroll object texture 2, 0, 0.0001

   sync
loop

`************************************
`Functions
`************************************

function CreateTree(nr, img)

   `Create leaf texture
   cls
   ink rgb(0, 150, 0), 0
   for i = 1 to 100 step 2
      line 50, i, 50 + (cos(i/1.2)*50), 10 + (sin(i/2.0)*100)
      line 50, i, 50 - (cos(i/1.2)*50), 10 + (sin(i/2.0)*100)
   next i
   get image img, 0, 0, 100, 100, 1

   `Create bark texture
   cls rgb(150, 75, 0)
   ink rgb(100, 50, 0), 0
   for i = 1 to 100
      dot rnd(50), rnd(50)
   next i
   get image img + 1, 0, 0, 50, 50, 1

   make object cube nr, 1 : color object nr, rgb(200, 100, 0)
   make mesh from object nr, nr

   texture limb nr, 0, img + 1
   for i = 1 to 4
      add limb nr, i, nr : offset limb nr, i, 0, i, 0 : rotate limb nr, i, 0, i*20, 0 : color limb nr, i, rgb(200, 100, 0)
      texture limb nr, i, img + 1
   next i

   `leafs
   make object plain nr + 1, 2, 7 : xrotate object nr + 1, 90 : fix object pivot nr + 1
   offset limb nr + 1, 0, 0, 4, 3 : rotate limb nr + 1, 0, 180, 0, 0
   make mesh from object nr, nr + 1
   delete object nr + 1

   for i = 1 to 10
      add limb nr, i + 4, nr : offset limb nr, i + 4, 0, 7.5, 0 : rotate limb nr, i + 4, 10 - rnd(30), i*36, -5 + rnd(10)
      texture limb nr, i + 4, img
   next i

   set object transparency nr, 1
   set object cull nr, 0
   set object light nr, 0

endfunction

function CreateSmogTex(nr, width, height, dens, color)

   `create memblock
   make memblock nr, 12 + (width*height*4)
   write memblock dword nr, 0, width
   write memblock dword nr, 4, height
   write memblock dword nr, 8, 32

   `Draw on memblock
   for i = 1 to dens

      `Random data
      a = rnd(360)
      ry = rnd((height-2)/2)
      rx = rnd((width-2)/2)

      x = (width/2) + (cos(a)*rx)
      y = (height/2) + (sin(a)*ry)
      pos = 12 + ((((y-1)*width) + x - 1) * 4)
      write memblock dword nr, pos, color

   next i

   `Blur for the smoggy effect
   BlurImage(nr, nr + 1)
   BlurImage(nr + 1, nr)
   make image from memblock nr, nr
   delete memblock nr
   delete memblock nr + 1

endfunction

function CreateSkyTex(nr, width, height)

   cls
   box 0, 0, width, height, rgb(255, 255, 255), rgb(100, 100, 255), rgb(255, 255, 255), rgb(100, 100, 255)
   get image nr, 0, 0, width, height, 1

endfunction

function CreateWaterTex(nr, width, height)

   `Create a memblock
   make memblock nr, 12 + (width*height*4)
   write memblock dword nr, 0, width
   write memblock dword nr, 4, height
   write memblock dword nr, 8, 32

   `fill memblock with blue colors
   for y = 1 to height
      for x = 1 to width

         `Get position
         pos = 12 + (((y-1)*width + x - 1) * 4)
         write memblock dword nr, pos, rgb(50, 50, 100 + rnd(105))
      next x
   next y

   BlurImage(nr, nr + 1)
   BlurImage(nr + 1, nr)
   make image from memblock nr, nr + 1
   delete memblock nr
   delete memblock nr + 1

endfunction

function CreateGrassTex(nr, Width, Height)

   `create a memblock
   make memblock nr, 12 + (Width*Height*4)

   `write header
   write memblock DWORD nr,0, Width
   write memblock DWORD nr,4, Height
   write memblock DWORD nr,8, 32

   `write data
   for i = 1 to (Width*Height)
      green = rnd(105)
      write memblock byte nr, 12 + ((i-1)*4), 100
      write memblock byte nr, 13 + ((i-1)*4), 150 + green
      write memblock byte nr, 14 + ((i-1)*4), 100
      write memblock byte nr, 15 + ((i-1)*4), 255
   next i

   `create an image from the memblock and delete memblock
   make image from memblock nr,nr
   delete memblock nr

endfunction

function CreateWorld(nr, vertS#, maxH#)

   `Setup
   if image exist(nr) = 1 and object exist(nr) = 0

      `Get image data
      make memblock from image nr ,nr
      width = memblock dword(nr, 0)
      height = memblock dword(nr, 4)

      `Create mesh memblock
      make memblock nr + 1, 12 + (36*6 * width * height)
      write memblock dword nr + 1, 0, 338
      write memblock dword nr + 1, 4, 36
      write memblock dword nr + 1, 8, width * height * 6
   else
      exitfunction
   endif

   `Create world
   for y = 1 to height - 1
      for x = 1 to width - 1

         `Calculate vertex position
         pos = ((y-1) * width) + x - 1
         imgpos = 12 + (pos * 4)

         `Calculate height
         height1# = maxH# / 255.0 * memblock byte(nr, imgpos)
         height2# = maxH# / 255.0 * memblock byte(nr, imgpos + 4)
         height3# = maxH# / 255.0 * memblock byte(nr, imgpos + (width*4))
         height4# = maxH# / 255.0 * memblock byte(nr, imgpos + (width*4) + 4)

         `Write vertex data
         `First vertex
         x1# = (x - 1) * vertS# : x2# = x * vertS#
         y1# = (y - 1) * vertS# : y2# = y * vertS#
         WriteVertex(nr + 1, (pos * 6) + 1, x1#, height1#, -y1#, x1#, height1# + 10.0, -y1#, rgb(255, 255, 255), 0, 0)
         WriteVertex(nr + 1, (pos * 6) + 2, x2#, height2#, -y1#, x2#, height2# + 10.0, -y1#, rgb(255, 255, 255), 1, 0)
         WriteVertex(nr + 1, (pos * 6) + 3, x1#, height3#, -y2#, x1#, height3# + 10.0, -y2#, rgb(255, 255, 255), 0, 1)

         WriteVertex(nr + 1, (pos * 6) + 4, x2#, height2#, -y1#, x2#, height2# + 10.0, -y1#, rgb(255, 255, 255), 1, 0)
         WriteVertex(nr + 1, (pos * 6) + 5, x2#, height4#, -y2#, x2#, height4# + 10.0, -y2#, rgb(255, 255, 255), 1, 1)
         WriteVertex(nr + 1, (pos * 6) + 6, x1#, height3#, -y2#, x1#, height3# + 10.0, -y2#, rgb(255, 255, 255), 0, 1)

      next x
   next y

   `Create mesh
   make mesh from memblock nr, nr + 1
   delete memblock nr
   delete memblock nr + 1
   make object nr, nr, 0

endfunction

function CreateHeightMap()

   `Random terrain
   DrawRndBox(1, 1, 64, 64, 10, 20)

   `Draw waterfall mountain and river
   DrawRndBox(10, 10, 30, 30, 100, 10)

   DrawRndBox(15, 15, 23, 23, 80, 0)
   DrawRndBox(25, 20, 30, 23, 80, 0)

   `DrawRndBox(28, 28, 33, 33, 80, 10)
   `DrawRndBox(8, 9, 16, 13, 80, 10)

   DrawRndBox(7, 7, 28, 10, 30, 30)
   DrawRndBox(7, 7, 10, 28, 30, 30)

   ink rgb(0, 0, 0), 0
   Box 30, 16, 40, 28
   box 32, 14, 38, 30

   box 38, 28, 40, 35
   box 38, 35, 50, 37
   box 50, 35, 52, 64

   `Beach surroundings
   ink 0, 0
   line 0,0,63,0
   line 0,0,0,63
   line 0,64,63,63
   line 63,0,63,63

   get image 1, 0, 0, 64, 64, 1
   make memblock from image 1 ,1
   BlurImage(1, 2)
   BlurImage(2, 1)
   make image from memblock 1, 1
   delete memblock 1
   delete memblock 2

endfunction

function BlurImage(mem, retmem)

   `Get data
   width = memblock dword(mem, 0)
   height = memblock dword(mem, 4)

   `Create returned memblock
   if memblock exist(retmem) = 0 then make memblock retmem, get memblock size(mem)
   write memblock dword retmem, 0, width
   write memblock dword retmem, 4, height
   write memblock dword retmem, 8, 32

   `Write data
   `No edges:
   for y = 2 to height - 1
      for x = 2 to width - 1

         `Get position
         pos = 12 + ((y-1)*width*4) + ((x-1)*4)

         `Initialize values
         blue# = memblock byte(mem, pos) * 0.5
         green# = memblock byte(mem, pos+1) * 0.5
         red# = memblock byte(mem, pos+2) * 0.5

         `Get surrounding data
         `Left
         npos = pos - 4
         blue# = blue# + (memblock byte(mem, npos)*0.08)
         green# = green# + (memblock byte(mem, npos+1)*0.08)
         red# = red# + (memblock byte(mem, npos+2)*0.08)

         `+-> Top Left
         npos = npos - (width*4)
         blue# = blue# + (memblock byte(mem, npos)*0.045)
         green# = green# + (memblock byte(mem, npos+1)*0.045)
         red# = red# + (memblock byte(mem, npos+2)*0.045)

         `Right
         npos = pos + 4
         blue# = blue# + (memblock byte(mem, npos)*0.08)
         green# = green# + (memblock byte(mem, npos+1)*0.08)
         red# = red# + (memblock byte(mem, npos+2)*0.08)

         `+-> Bottom right
         npos = npos + (width*4)
         blue# = blue# + (memblock byte(mem, npos)*0.045)
         green# = green# + (memblock byte(mem, npos+1)*0.045)
         red# = red# + (memblock byte(mem, npos+2)*0.045)

         `Top
         npos = pos - (width*4)
         blue# = blue# + (memblock byte(mem, npos)*0.08)
         green# = green# + (memblock byte(mem, npos+1)*0.08)
         red# = red# + (memblock byte(mem, npos+2)*0.08)

         `+-> top right
         npos = npos + 4
         blue# = blue# + (memblock byte(mem, npos)*0.045)
         green# = green# + (memblock byte(mem, npos+1)*0.045)
         red# = red# + (memblock byte(mem, npos+2)*0.045)

         `Bottom
         npos = pos + (width*4)
         blue# = blue# + (memblock byte(mem, npos)*0.08)
         green# = green# + (memblock byte(mem, npos+1)*0.08)
         red# = red# + (memblock byte(mem, npos+2)*0.08)

         `+-> Bottom left
         npos = npos - 4
         blue# = blue# + (memblock byte(mem, npos)*0.045)
         green# = green# + (memblock byte(mem, npos+1)*0.045)
         red# = red# + (memblock byte(mem, npos+2)*0.045)

         `Write away data
         write memblock byte retmem, pos, int(blue#+0.5)
         write memblock byte retmem, pos+1, int(green#+0.5)
         write memblock byte retmem, pos+2, int(red#+0.5)
         write memblock byte retmem, pos+3, 255

      next x
   next y

   `Edges
   for y = 1 to height step (height-1)
      for x = 1 to width

         `Get position
         pos = 12 + ((y-1)*width*4) + ((x-1)*4)

         `Initialize colors
         if x = 1 or x = width
            blue# = memblock byte(mem, pos) * 0.795
            green# = memblock byte(mem, pos+1) * 0.795
            red# = memblock byte(mem, pos+2) * 0.795
         else
            blue# = memblock byte(mem, pos) * 0.67
            green# = memblock byte(mem, pos+1) * 0.67
            red# = memblock byte(mem, pos+2) * 0.67
         endif

         `Get other colors
         if x > 1
            npos = pos - 4
            blue# = blue# + memblock byte(mem, npos) * 0.08
            green# = green# + memblock byte(mem, npos+1) * 0.08
            red# = red# + memblock byte(mem, npos+2) * 0.08
         endif
         if x < width
            npos = pos + 4
            blue# = blue# + memblock byte(mem, npos) * 0.08
            green# = green# + memblock byte(mem, npos+1) * 0.08
            red# = red# + memblock byte(mem, npos+2) * 0.08
         endif

         if y > 1 then npos = pos - (width*4) else npos = pos + (width*4)
         blue# = blue# + memblock byte(mem, npos) * 0.08
         green# = green# + memblock byte(mem, npos+1) * 0.08
         red# = red# + memblock byte(mem, npos+2) * 0.08

         if x > 1
            mpos = npos - 4
            blue# = blue# + memblock byte(mem, mpos) * 0.045
            green# = green# + memblock byte(mem, mpos+1) * 0.045
            red# = red# + memblock byte(mem, mpos+2) * 0.045
         endif
         if x < width
            mpos = npos + 4
            blue# = blue# + memblock byte(mem, mpos) * 0.045
            green# = green# + memblock byte(mem, mpos+1) * 0.045
            red# = red# + memblock byte(mem, mpos+2) * 0.045
         endif

         `Write away data
         write memblock byte retmem, pos, int(blue#+0.5)
         write memblock byte retmem, pos+1, int(green#+0.5)
         write memblock byte retmem, pos+2, int(red#+0.5)
         write memblock byte retmem, pos+3, 255

      next x
   next y

   `Left and right edges (no corners anymore)
   for x = 1 to width step (width-1)
      for y = 2 to height - 1

         `Get position
         pos = 12 + ((y-1)*width*4) + ((x-1)*4)

         `Initialize colors
         blue# = memblock byte(mem, pos) * 0.67
         green# = memblock byte(mem, pos+1) * 0.67
         red# = memblock byte(mem, pos+2) * 0.67

         `Get surrounding data
         npos = pos - (width*4)
         blue# = blue# + memblock byte(mem, npos) * 0.08
         green# = green# + memblock byte(mem, npos+1) * 0.08
         red# = red# + memblock byte(mem, npos+2) * 0.08

         npos = pos + (width*4)
         blue# = blue# + memblock byte(mem, npos) * 0.08
         green# = green# + memblock byte(mem, npos+1) * 0.08
         red# = red# + memblock byte(mem, npos+2) * 0.08

         if x > 1 then npos = pos - 4 else npos = pos + 4
         blue# = blue# + memblock byte(mem, npos) * 0.08
         green# = green# + memblock byte(mem, npos+1) * 0.08
         red# = red# + memblock byte(mem, npos+2) * 0.08

         mpos = npos - (width*4)
         blue# = blue# + memblock byte(mem, mpos) * 0.045
         green# = green# + memblock byte(mem, mpos+1) * 0.045
         red# = red# + memblock byte(mem, mpos+2) * 0.045
         mpos = npos + (width*4)
         blue# = blue# + memblock byte(mem, mpos) * 0.045
         green# = green# + memblock byte(mem, mpos+1) * 0.045
         red# = red# + memblock byte(mem, mpos+2) * 0.045

         `Write away data
         write memblock byte retmem, pos, int(blue#+0.5)
         write memblock byte retmem, pos+1, int(green#+0.5)
         write memblock byte retmem, pos+2, int(red#+0.5)
         write memblock byte retmem, pos+3, 255

      next y
   next x

endfunction

function WriteVertex(mem, v, x#, y#, z#, nx#, ny#, nz#, color, uvx#, uvy#)

   start = 12 + ((v-1)*36)

   `write vertex 1
   write memblock float mem,start, x#
   write memblock float mem,start+4, y#
   write memblock float mem,start+8, z#

   write memblock float mem,start+12, nx#
   write memblock float mem,start+16, ny#
   write memblock float mem,start+20, nz#

   write memblock dword mem,start+24, color

   write memblock float mem,start+28, uvx#
   write memblock float mem,start+32, uvy#

endfunction

function DrawRndBox(x1, y1, x2, y2, min, range)
   for y = y1 to y2
      for x = x1 to x2
         height = min + rnd(range)
         ink rgb(height, height, height), 0
         dot x - 1, y - 1
      next x
   next y
endfunction

sync on
sync rate 0
color backdrop 0
backdrop on
randomize timer()


`Wave settings
#constant WAVE_HEIGHT 4.0





null = make vector3(1)
null = make vector3(2)
set vector3 2, 1.0, 1.0, 1.0

#constant wS 128
make memblock 1, 12 + (wS * wS * 4)
write memblock dword 1, 0, wS
write memblock dword 1, 4, wS
write memblock dword 1, 8, 32


make object plain 1, 5, 5
setMemblockData(1)
make image from memblock 1, 1



make memblock 2, 12 + (32 * 32 * 4)
write memblock dword 2, 0, 32
write memblock dword 2, 4, 32
write memblock dword 2, 8, 32
for i = 12 to (32*32*4) step 4 : write memblock dword 2, i, rgb(128, 128, 255 - rnd(64)) : next i
make image from memblock 2, 2
delete memblock 2
texture object 1, 2








`color object 1, rgb(0,0,255)


position object 1, 0, 0, 0
point object 1, 0, -1, 0



set ambient light 50



a# = 160.0
d# = 17.5
positionCamera(a#, d#)
t_a# = 160.0
t_d# = 7.5


bm = 1
set bump mapping on 1, 1

frameTime# = 1.0
startTime = timer()
do
   frameTime# = (frameTime# * 0.8) + ((timer() - startTime) * 0.2)
   startTime = timer()

   text 0, 0, "angle: " + str$(a#)

   mX = mousemovex()
   mY = mousemovey()
   mZ = mousemovez()


   c = 0
   if mX <> 0 then inc t_a#, mX * frameTime# * 0.1 : c = 1
   if mY <> 0 then inc t_d#, mY * frameTime# * 0.01 : c = 1

   a# = curvevalue(t_a#, a#, 500.0 / frameTime#)
   d# = curvevalue(t_d#, d#, 500.0 / frameTime#)
   positionCamera(a#, d#)


   setMemblockData(1)
   make image from memblock 1, 1
   sync
loop





function positionCamera(a#, d#)
   position camera d# * sin(a#), d#, d# * cos(a#)
   point camera 0, 0, 0
   d# = d# * 5.0
   set point light 0, d# * sin(a#), d#, d# * cos(a#)
endfunction







function setMemblockData(mb)
   t# = timer() * -0.360

   `text 200, 10, "T: " + str$(t#)

   for x = 0 to wS-1
      hX# = x - (wS * 0.5)
      for z = 0 to wS-1
         hZ# = z - (wS * 0.5)
         createNormal(1, heightFunction(hX#, hZ#, t#),   heightFunction(hX#, hZ#-1, t#),   heightFunction(hX#+1, hZ#, t#),   heightFunction(hX#, hZ#+1, t#),   heightFunction(hX#-1, hZ#, t#))

         normalize vector3 1, 1
         add vector3 1, 1, 2
         multiply vector3 1, 127

         write memblock dword 1, 12 + (x + (z * wS)) * 4, rgb(x vector3(1), y vector3(1), z vector3(1))
      next z
   next x
endfunction


function heightFunction(x#, z#, t#)
   h# = 1.0 * sin(0.25 * (x#*x# + z#*z#) + t#)
endfunction h#


function createNormal(v, hMiddle#, hUp#, hRight#, hDown#, hLeft#)
   set vector3 v, hLeft#-hRight#, 1.0, hUp#-hDown#
endfunction

set display mode 1024, 786, 32
sync on : sync rate 0
randomize timer()
set camera range 0, 0.1, 10000

`Create media
CreateGrassTex(2, 128, 128)
CreateWaterTex(3, 128, 128)
CreateSkyTex(4, 128, 128)
CreateSmogTex(5, 128, 128, 500, rgb(255, 255, 255))

`Create world
CreateHeightMap()
CreateWorld(1, 10.0, 200.0)
set object collision to polygons 1
texture object 1, 2

`Water
make object plain 2, 10000, 10000
xrotate object 2, 90
texture object 2, 3
scale object texture 2, 100, 100
position object 2, 320, 10, -320
set alpha mapping on 2, 80
set object light 2, 0

make object plain 3, 150, 150
xrotate object 3, 90
texture object 3, 3
scale object texture 3, 1, 1
position object 3, 200, 80, -195
set alpha mapping on 3, 80

`Waterfall
make object cylinder 4, 100
rotate object 4, 90, 0, 0 : scale object 4, 80, 70, 125
set object cull 4, 1 : texture object 4, 3
scale object texture 4, 3, 1
position object 4, 280, 18.5, -205
set alpha mapping on 4, 75

`Waterfall particles
make particles 1, 5, 30, 50
position particles 1, 310, 5.0, -205

`Sky
make object sphere 5, 5000
set object cull 5, 0
texture object 5, 4
scale object texture 5, 1, 0.5
set object light 5, 0

`Create trees
`Dummy object to get height
for i = 1 to 50
   CreateTree(5 + i, 6)
   scale object 5 + i, 300, 300, 300
   repeat
      x# = rnd(640)
      z# = -rnd(640)
      y# = 50.0
      position object 5 + i, x#, y#, z# : col = object collision(5 + i, 1)
      position object 5 + i, x#, 0, z# : col = object collision(5 + i, 1) + col
   until col = 0
   repeat
      y# = y# - 1.0
      position object 5 + i, x#, y#, z#
      col = object collision(5 + i, 1)
   until col > 0 or y# <= 0.0
next i

`waterfall
wy# = 0

`initialize camera
position camera 640, 100, -640
point camera 320, 0, -320

hide mouse

do

   `Display data
   ink rgb(255, 255, 255), 0
   text 0, 0, str$(statistic(1))
   text 0, 20, str$(screen fps())

   `handle waterfall
   scroll object texture 4, -0.01, 0

   `Handle sea
   scroll object texture 2, 0, 0.0001

   `Control camera
   AngX# = wrapvalue(camera angle x() + (mousemovey()*0.2))
   AngY# = wrapvalue(camera angle y() + (mousemovex()*0.2))
   rotate camera AngX#, AngY#, 0

   if upkey() = 1 then move camera 0.5
   if downkey() = 1 then move camera -0.5

   sync
loop

`************************************
`Functions
`************************************

function CreateTree(nr, img)

   `Create leaf texture
   cls
   ink rgb(0, 150, 0), 0
   for i = 1 to 100 step 2
      line 50, i, 50 + (cos(i/1.2)*50), 10 + (sin(i/2.0)*100)
      line 50, i, 50 - (cos(i/1.2)*50), 10 + (sin(i/2.0)*100)
   next i
   get image img, 0, 0, 100, 100, 1

   `Create bark texture
   cls rgb(150, 75, 0)
   ink rgb(100, 50, 0), 0
   for i = 1 to 100
      dot rnd(50), rnd(50)
   next i
   get image img + 1, 0, 0, 50, 50, 1

   make object cube nr, 1 : color object nr, rgb(200, 100, 0)
   make mesh from object nr, nr

   texture limb nr, 0, img + 1
   for i = 1 to 4
      add limb nr, i, nr : offset limb nr, i, 0, i, 0 : rotate limb nr, i, 0, i*20, 0 : color limb nr, i, rgb(200, 100, 0)
      texture limb nr, i, img + 1
   next i

   `leafs
   make object plain nr + 1, 2, 7 : xrotate object nr + 1, 90 : fix object pivot nr + 1
   offset limb nr + 1, 0, 0, 4, 3 : rotate limb nr + 1, 0, 180, 0, 0
   make mesh from object nr, nr + 1
   delete object nr + 1

   for i = 1 to 10
      add limb nr, i + 4, nr : offset limb nr, i + 4, 0, 7.5, 0 : rotate limb nr, i + 4, 10 - rnd(30), i*36, -5 + rnd(10)
      texture limb nr, i + 4, img
   next i

   set object transparency nr, 1
   set object cull nr, 0
   set object light nr, 0

endfunction

function CreateSmogTex(nr, width, height, dens, color)

   `create memblock
   make memblock nr, 12 + (width*height*4)
   write memblock dword nr, 0, width
   write memblock dword nr, 4, height
   write memblock dword nr, 8, 32

   `Draw on memblock
   for i = 1 to dens

      `Random data
      a = rnd(360)
      ry = rnd((height-2)/2)
      rx = rnd((width-2)/2)

      x = (width/2) + (cos(a)*rx)
      y = (height/2) + (sin(a)*ry)
      pos = 12 + ((((y-1)*width) + x - 1) * 4)
      write memblock dword nr, pos, color

   next i

   `Blur for the smoggy effect
   BlurImage(nr, nr + 1)
   BlurImage(nr + 1, nr)
   make image from memblock nr, nr
   delete memblock nr
   delete memblock nr + 1

endfunction

function CreateSkyTex(nr, width, height)

   cls
   box 0, 0, width, height, rgb(255, 255, 255), rgb(100, 100, 255), rgb(255, 255, 255), rgb(100, 100, 255)
   get image nr, 0, 0, width, height, 1

endfunction

function CreateWaterTex(nr, width, height)

   `Create a memblock
   make memblock nr, 12 + (width*height*4)
   write memblock dword nr, 0, width
   write memblock dword nr, 4, height
   write memblock dword nr, 8, 32

   `fill memblock with blue colors
   for y = 1 to height
      for x = 1 to width

         `Get position
         pos = 12 + (((y-1)*width + x - 1) * 4)
         write memblock dword nr, pos, rgb(50, 50, 100 + rnd(105))
      next x
   next y

   BlurImage(nr, nr + 1)
   BlurImage(nr + 1, nr)
   make image from memblock nr, nr + 1
   delete memblock nr
   delete memblock nr + 1

endfunction

function CreateGrassTex(nr, Width, Height)

   `create a memblock
   make memblock nr, 12 + (Width*Height*4)

   `write header
   write memblock DWORD nr,0, Width
   write memblock DWORD nr,4, Height
   write memblock DWORD nr,8, 32

   `write data
   for i = 1 to (Width*Height)
      green = rnd(105)
      write memblock byte nr, 12 + ((i-1)*4), 100
      write memblock byte nr, 13 + ((i-1)*4), 150 + green
      write memblock byte nr, 14 + ((i-1)*4), 100
      write memblock byte nr, 15 + ((i-1)*4), 255
   next i

   `create an image from the memblock and delete memblock
   make image from memblock nr,nr
   delete memblock nr

endfunction

function CreateWorld(nr, vertS#, maxH#)

   `Setup
   if image exist(nr) = 1 and object exist(nr) = 0

      `Get image data
      make memblock from image nr ,nr
      width = memblock dword(nr, 0)
      height = memblock dword(nr, 4)

      `Create mesh memblock
      make memblock nr + 1, 12 + (36*6 * width * height)
      write memblock dword nr + 1, 0, 338
      write memblock dword nr + 1, 4, 36
      write memblock dword nr + 1, 8, width * height * 6
   else
      exitfunction
   endif

   `Create world
   for y = 1 to height - 1
      for x = 1 to width - 1

         `Calculate vertex position
         pos = ((y-1) * width) + x - 1
         imgpos = 12 + (pos * 4)

         `Calculate height
         height1# = maxH# / 255.0 * memblock byte(nr, imgpos)
         height2# = maxH# / 255.0 * memblock byte(nr, imgpos + 4)
         height3# = maxH# / 255.0 * memblock byte(nr, imgpos + (width*4))
         height4# = maxH# / 255.0 * memblock byte(nr, imgpos + (width*4) + 4)

         `Write vertex data
         `First vertex
         x1# = (x - 1) * vertS# : x2# = x * vertS#
         y1# = (y - 1) * vertS# : y2# = y * vertS#
         WriteVertex(nr + 1, (pos * 6) + 1, x1#, height1#, -y1#, x1#, height1# + 10.0, -y1#, rgb(255, 255, 255), 0, 0)
         WriteVertex(nr + 1, (pos * 6) + 2, x2#, height2#, -y1#, x2#, height2# + 10.0, -y1#, rgb(255, 255, 255), 1, 0)
         WriteVertex(nr + 1, (pos * 6) + 3, x1#, height3#, -y2#, x1#, height3# + 10.0, -y2#, rgb(255, 255, 255), 0, 1)

         WriteVertex(nr + 1, (pos * 6) + 4, x2#, height2#, -y1#, x2#, height2# + 10.0, -y1#, rgb(255, 255, 255), 1, 0)
         WriteVertex(nr + 1, (pos * 6) + 5, x2#, height4#, -y2#, x2#, height4# + 10.0, -y2#, rgb(255, 255, 255), 1, 1)
         WriteVertex(nr + 1, (pos * 6) + 6, x1#, height3#, -y2#, x1#, height3# + 10.0, -y2#, rgb(255, 255, 255), 0, 1)

      next x
   next y

   `Create mesh
   make mesh from memblock nr, nr + 1
   delete memblock nr
   delete memblock nr + 1
   make object nr, nr, 0

endfunction

function CreateHeightMap()

   `Random terrain
   DrawRndBox(1, 1, 64, 64, 10, 20)

   `Draw waterfall mountain and river
   DrawRndBox(10, 10, 30, 30, 100, 10)

   DrawRndBox(15, 15, 23, 23, 80, 0)
   DrawRndBox(25, 20, 30, 23, 80, 0)

   `DrawRndBox(28, 28, 33, 33, 80, 10)
   `DrawRndBox(8, 9, 16, 13, 80, 10)

   DrawRndBox(7, 7, 28, 10, 30, 30)
   DrawRndBox(7, 7, 10, 28, 30, 30)

   ink rgb(0, 0, 0), 0
   Box 30, 16, 40, 28
   box 32, 14, 38, 30

   box 38, 28, 40, 35
   box 38, 35, 50, 37
   box 50, 35, 52, 64

   `Beach surroundings
   ink 0, 0
   line 0,0,63,0
   line 0,0,0,63
   line 0,64,63,63
   line 63,0,63,63

   get image 1, 0, 0, 64, 64, 1
   make memblock from image 1 ,1
   BlurImage(1, 2)
   BlurImage(2, 1)
   make image from memblock 1, 1
   delete memblock 1
   delete memblock 2

endfunction

function BlurImage(mem, retmem)

   `Get data
   width = memblock dword(mem, 0)
   height = memblock dword(mem, 4)

   `Create returned memblock
   if memblock exist(retmem) = 0 then make memblock retmem, get memblock size(mem)
   write memblock dword retmem, 0, width
   write memblock dword retmem, 4, height
   write memblock dword retmem, 8, 32

   `Write data
   `No edges:
   for y = 2 to height - 1
      for x = 2 to width - 1

         `Get position
         pos = 12 + ((y-1)*width*4) + ((x-1)*4)

         `Initialize values
         blue# = memblock byte(mem, pos) * 0.5
         green# = memblock byte(mem, pos+1) * 0.5
         red# = memblock byte(mem, pos+2) * 0.5

         `Get surrounding data
         `Left
         npos = pos - 4
         blue# = blue# + (memblock byte(mem, npos)*0.08)
         green# = green# + (memblock byte(mem, npos+1)*0.08)
         red# = red# + (memblock byte(mem, npos+2)*0.08)

         `+-> Top Left
         npos = npos - (width*4)
         blue# = blue# + (memblock byte(mem, npos)*0.045)
         green# = green# + (memblock byte(mem, npos+1)*0.045)
         red# = red# + (memblock byte(mem, npos+2)*0.045)

         `Right
         npos = pos + 4
         blue# = blue# + (memblock byte(mem, npos)*0.08)
         green# = green# + (memblock byte(mem, npos+1)*0.08)
         red# = red# + (memblock byte(mem, npos+2)*0.08)

         `+-> Bottom right
         npos = npos + (width*4)
         blue# = blue# + (memblock byte(mem, npos)*0.045)
         green# = green# + (memblock byte(mem, npos+1)*0.045)
         red# = red# + (memblock byte(mem, npos+2)*0.045)

         `Top
         npos = pos - (width*4)
         blue# = blue# + (memblock byte(mem, npos)*0.08)
         green# = green# + (memblock byte(mem, npos+1)*0.08)
         red# = red# + (memblock byte(mem, npos+2)*0.08)

         `+-> top right
         npos = npos + 4
         blue# = blue# + (memblock byte(mem, npos)*0.045)
         green# = green# + (memblock byte(mem, npos+1)*0.045)
         red# = red# + (memblock byte(mem, npos+2)*0.045)

         `Bottom
         npos = pos + (width*4)
         blue# = blue# + (memblock byte(mem, npos)*0.08)
         green# = green# + (memblock byte(mem, npos+1)*0.08)
         red# = red# + (memblock byte(mem, npos+2)*0.08)

         `+-> Bottom left
         npos = npos - 4
         blue# = blue# + (memblock byte(mem, npos)*0.045)
         green# = green# + (memblock byte(mem, npos+1)*0.045)
         red# = red# + (memblock byte(mem, npos+2)*0.045)

         `Write away data
         write memblock byte retmem, pos, int(blue#+0.5)
         write memblock byte retmem, pos+1, int(green#+0.5)
         write memblock byte retmem, pos+2, int(red#+0.5)
         write memblock byte retmem, pos+3, 255

      next x
   next y

   `Edges
   for y = 1 to height step (height-1)
      for x = 1 to width

         `Get position
         pos = 12 + ((y-1)*width*4) + ((x-1)*4)

         `Initialize colors
         if x = 1 or x = width
            blue# = memblock byte(mem, pos) * 0.795
            green# = memblock byte(mem, pos+1) * 0.795
            red# = memblock byte(mem, pos+2) * 0.795
         else
            blue# = memblock byte(mem, pos) * 0.67
            green# = memblock byte(mem, pos+1) * 0.67
            red# = memblock byte(mem, pos+2) * 0.67
         endif

         `Get other colors
         if x > 1
            npos = pos - 4
            blue# = blue# + memblock byte(mem, npos) * 0.08
            green# = green# + memblock byte(mem, npos+1) * 0.08
            red# = red# + memblock byte(mem, npos+2) * 0.08
         endif
         if x < width
            npos = pos + 4
            blue# = blue# + memblock byte(mem, npos) * 0.08
            green# = green# + memblock byte(mem, npos+1) * 0.08
            red# = red# + memblock byte(mem, npos+2) * 0.08
         endif

         if y > 1 then npos = pos - (width*4) else npos = pos + (width*4)
         blue# = blue# + memblock byte(mem, npos) * 0.08
         green# = green# + memblock byte(mem, npos+1) * 0.08
         red# = red# + memblock byte(mem, npos+2) * 0.08

         if x > 1
            mpos = npos - 4
            blue# = blue# + memblock byte(mem, mpos) * 0.045
            green# = green# + memblock byte(mem, mpos+1) * 0.045
            red# = red# + memblock byte(mem, mpos+2) * 0.045
         endif
         if x < width
            mpos = npos + 4
            blue# = blue# + memblock byte(mem, mpos) * 0.045
            green# = green# + memblock byte(mem, mpos+1) * 0.045
            red# = red# + memblock byte(mem, mpos+2) * 0.045
         endif

         `Write away data
         write memblock byte retmem, pos, int(blue#+0.5)
         write memblock byte retmem, pos+1, int(green#+0.5)
         write memblock byte retmem, pos+2, int(red#+0.5)
         write memblock byte retmem, pos+3, 255

      next x
   next y

   `Left and right edges (no corners anymore)
   for x = 1 to width step (width-1)
      for y = 2 to height - 1

         `Get position
         pos = 12 + ((y-1)*width*4) + ((x-1)*4)

         `Initialize colors
         blue# = memblock byte(mem, pos) * 0.67
         green# = memblock byte(mem, pos+1) * 0.67
         red# = memblock byte(mem, pos+2) * 0.67

         `Get surrounding data
         npos = pos - (width*4)
         blue# = blue# + memblock byte(mem, npos) * 0.08
         green# = green# + memblock byte(mem, npos+1) * 0.08
         red# = red# + memblock byte(mem, npos+2) * 0.08

         npos = pos + (width*4)
         blue# = blue# + memblock byte(mem, npos) * 0.08
         green# = green# + memblock byte(mem, npos+1) * 0.08
         red# = red# + memblock byte(mem, npos+2) * 0.08

         if x > 1 then npos = pos - 4 else npos = pos + 4
         blue# = blue# + memblock byte(mem, npos) * 0.08
         green# = green# + memblock byte(mem, npos+1) * 0.08
         red# = red# + memblock byte(mem, npos+2) * 0.08

         mpos = npos - (width*4)
         blue# = blue# + memblock byte(mem, mpos) * 0.045
         green# = green# + memblock byte(mem, mpos+1) * 0.045
         red# = red# + memblock byte(mem, mpos+2) * 0.045
         mpos = npos + (width*4)
         blue# = blue# + memblock byte(mem, mpos) * 0.045
         green# = green# + memblock byte(mem, mpos+1) * 0.045
         red# = red# + memblock byte(mem, mpos+2) * 0.045

         `Write away data
         write memblock byte retmem, pos, int(blue#+0.5)
         write memblock byte retmem, pos+1, int(green#+0.5)
         write memblock byte retmem, pos+2, int(red#+0.5)
         write memblock byte retmem, pos+3, 255

      next y
   next x

endfunction

function WriteVertex(mem, v, x#, y#, z#, nx#, ny#, nz#, color, uvx#, uvy#)

   start = 12 + ((v-1)*36)

   `write vertex 1
   write memblock float mem,start, x#
   write memblock float mem,start+4, y#
   write memblock float mem,start+8, z#

   write memblock float mem,start+12, nx#
   write memblock float mem,start+16, ny#
   write memblock float mem,start+20, nz#

   write memblock dword mem,start+24, color

   write memblock float mem,start+28, uvx#
   write memblock float mem,start+32, uvy#

endfunction

function DrawRndBox(x1, y1, x2, y2, min, range)
   for y = y1 to y2
      for x = x1 to x2
         height = min + rnd(range)
         ink rgb(height, height, height), 0
         dot x - 1, y - 1
      next x
   next y
endfunction

set display mode 1024, 786, 32
sync on : sync rate 0
randomize timer()
set camera range 0, 0.1, 10000

`Create media
CreateGrassTex(2, 128, 128)
CreateWaterTex(3, 128, 128)
CreateSkyTex(4, 128, 128)
CreateSmogTex(5, 128, 5000, rgb(255, 255, 255))

`Create world
CreateHeightMap()
CreateWorld(1, 10.0, 200.0)
set object collision to polygons 1
texture object 1, 2

`Water
make object plain 2, 10000, 10000
xrotate object 2, 90
texture object 2, 3
scale object texture 2, 100, 100
position object 2, 320, 10, -320
set alpha mapping on 2, 75
set object light 2, 0

make object plain 3, 150, 150
xrotate object 3, 90
texture object 3, 3
scale object texture 3, 1, 1
position object 3, 200, 80, -195
set alpha mapping on 3, 75
set object light 3, 0

`Waterfall
make object cylinder 4, 100
rotate object 4, 90, 0, 0 : scale object 4, 80, 70, 125
set object cull 4, 1 : texture object 4, 3
scale object texture 4, 3, 1
position object 4, 280, 18.5, -205
set alpha mapping on 4, 75
set object cull 4, 0

`Waterfall particles
type particle
   x# as float
   y# as float
   z# as float
   xs# as float
   ys# as float
   zs# as float
   life as integer
endtype
#constant SPart = 100
Dim WaterFall(50) as particle
for i = 1 to 50
   make object plain SPart + i, 5, 5
   texture object SPart + i, 5
   `set object light SPart + i, 0
   ghost object on SPart + i
next i

`Sky
make object sphere 5, 5000
set object cull 5, 0
texture object 5, 4
scale object texture 5, 1, 0.5
set object light 5, 0

`Create trees
for i = 1 to 50
   CreateTree(5 + i, 6)
   scale object 5 + i, 300, 300, 300
   repeat
      x# = rnd(640)
      z# = -rnd(640)
      y# = 50.0
      position object 5 + i, x#, y#, z# : col = object collision(5 + i, 1)
      position object 5 + i, x#, 0, z# : col = object collision(5 + i, 1) + col
   until col = 0
   repeat
      y# = y# - 1.0
      position object 5 + i, x#, y#, z#
      col = object collision(5 + i, 1)
   until col > 0 or y# <= 0.0
next i

`waterfall
wy# = 0

`initialize camera
position camera 640, 100, -640
point camera 320, 0, -320

hide mouse

do

   `Display data
   ink rgb(255, 255, 255), 0
   text 0, 0, str$(statistic(1))
   text 0, 20, str$(screen fps())

   `handle waterfall
   scroll object texture 4, -0.01, 0
   scroll object texture 3, -0.005, 0

   for p = 1 to 50
      HandleParticle(p)
   next p

   `Handle sea
   scroll object texture 2, 0, 0.0001

   `Control camera
   AngX# = wrapvalue(camera angle x() + (mousemovey()*0.2))
   AngY# = wrapvalue(camera angle y() + (mousemovex()*0.2))
   rotate camera AngX#, AngY#, 0

   if upkey() = 1 then move camera 0.5
   if downkey() = 1 then move camera -0.5

   sync
loop

`************************************
`Functions
`************************************

function HandleParticle(p)

   `Get particle life
   if Waterfall(p).life > 0

      `Handle particle
      Waterfall(p).x# = Waterfall(p).x# + Waterfall(p).xs#
      Waterfall(p).y# = Waterfall(p).y# + Waterfall(p).ys#
      Waterfall(p).z# = Waterfall(p).z# + Waterfall(p).zs#

      `Gravity
      Waterfall(p).ys# = Waterfall(p).ys# - 0.02

      `Decrease particle life
      dec Waterfall(p).life

   else

      `Reset particle
      Waterfall(p).life = 50 + rnd(150)
      Waterfall(p).x# = 320
      Waterfall(p).y# = 10.0
      Waterfall(p).z# = 205 - 35 + rnd(70)

      Waterfall(p).xs# = 0.2 + (rnd(20)*0.01)
      Waterfall(p).ys# = 0.2 + (rnd(75)*0.01)
      Waterfall(p).zs# = -0.2 + (rnd(40)*0.01)
   endif

   `update particle
   position object SPart + p, Waterfall(p).x#, Waterfall(p).y#, -Waterfall(p).z#
   point object SPart + p, camera position x(), camera position y(), camera position z()

endfunction

function CreateTree(nr, img)

   `Create leaf texture
   cls
   ink rgb(0, 150, 0), 0
   for i = 1 to 100 step 2
      line 50, i, 50 + (cos(i/1.2)*50), 10 + (sin(i/2.0)*100)
      line 50, i, 50 - (cos(i/1.2)*50), 10 + (sin(i/2.0)*100)
   next i
   get image img, 0, 0, 100, 100, 1

   `Create bark texture
   cls rgb(150, 75, 0)
   ink rgb(100, 50, 0), 0
   for i = 1 to 100
      dot rnd(50), rnd(50)
   next i
   get image img + 1, 0, 0, 50, 50, 1

   make object cube nr, 1 : color object nr, rgb(200, 100, 0)
   make mesh from object nr, nr

   texture limb nr, 0, img + 1
   for i = 1 to 4
      add limb nr, i, nr : offset limb nr, i, 0, i, 0 : rotate limb nr, i, 0, i*20, 0 : color limb nr, i, rgb(200, 100, 0)
      texture limb nr, i, img + 1
   next i

   `leafs
   make object plain nr + 1, 2, 7 : xrotate object nr + 1, 90 : fix object pivot nr + 1
   offset limb nr + 1, 0, 0, 4, 3 : rotate limb nr + 1, 0, 180, 0, 0
   make mesh from object nr, nr + 1
   delete object nr + 1

   for i = 1 to 10
      add limb nr, i + 4, nr : offset limb nr, i + 4, 0, 7.5, 0 : rotate limb nr, i + 4, 10 - rnd(30), i*36, -5 + rnd(10)
      texture limb nr, i + 4, img
   next i

   set object transparency nr, 1
   set object cull nr, 0
   set object light nr, 0

endfunction

function CreateSmogTex(nr, size, dens, color)

   `create memblock
   make memblock nr, 12 + (size*size*4)
   write memblock dword nr, 0, size
   write memblock dword nr, 4, size
   write memblock dword nr, 8, 32

   `Draw on memblock
   for i = 1 to dens

      repeat
         `Random data
         x = 1 + rnd(size-1)
         y = 1 + rnd(size-1)
         d = sqrt((x-(size/2))^2 + (y-(size/2))^2)
      until d < (size/2)
      pos = 12 + ((((y-1)*size) + x - 1) * 4)
      write memblock dword nr, pos, color

   next i

   `Blur for the smoggy effect
   BlurImage(nr, nr + 1)
   BlurImage(nr + 1, nr)
   make image from memblock nr, nr
   delete memblock nr
   delete memblock nr + 1

endfunction

function CreateSkyTex(nr, width, height)

   cls
   box 0, 0, width, height, rgb(255, 255, 255), rgb(100, 100, 255), rgb(255, 255, 255), rgb(100, 100, 255)
   get image nr, 0, 0, width, height, 1

endfunction

function CreateWaterTex(nr, width, height)

   `Create a memblock
   make memblock nr, 12 + (width*height*4)
   write memblock dword nr, 0, width
   write memblock dword nr, 4, height
   write memblock dword nr, 8, 32

   `fill memblock with blue colors
   for y = 1 to height
      for x = 1 to width

         `Get position
         pos = 12 + (((y-1)*width + x - 1) * 4)
         write memblock dword nr, pos, rgb(50, 50, 100 + rnd(105))
      next x
   next y

   BlurImage(nr, nr + 1)
   BlurImage(nr + 1, nr)
   make image from memblock nr, nr + 1
   delete memblock nr
   delete memblock nr + 1

endfunction

function CreateGrassTex(nr, Width, Height)

   `create a memblock
   make memblock nr, 12 + (Width*Height*4)

   `write header
   write memblock DWORD nr,0, Width
   write memblock DWORD nr,4, Height
   write memblock DWORD nr,8, 32

   `write data
   for i = 1 to (Width*Height)
      green = rnd(105)
      write memblock byte nr, 12 + ((i-1)*4), 100
      write memblock byte nr, 13 + ((i-1)*4), 150 + green
      write memblock byte nr, 14 + ((i-1)*4), 100
      write memblock byte nr, 15 + ((i-1)*4), 255
   next i

   `create an image from the memblock and delete memblock
   make image from memblock nr,nr
   delete memblock nr

endfunction

function CreateWorld(nr, vertS#, maxH#)

   `Setup
   if image exist(nr) = 1 and object exist(nr) = 0

      `Get image data
      make memblock from image nr ,nr
      width = memblock dword(nr, 0)
      height = memblock dword(nr, 4)

      `Create mesh memblock
      make memblock nr + 1, 12 + (36*6 * width * height)
      write memblock dword nr + 1, 0, 338
      write memblock dword nr + 1, 4, 36
      write memblock dword nr + 1, 8, width * height * 6
   else
      exitfunction
   endif

   `Create world
   for y = 1 to height - 1
      for x = 1 to width - 1

         `Calculate vertex position
         pos = ((y-1) * width) + x - 1
         imgpos = 12 + (pos * 4)

         `Calculate height
         height1# = maxH# / 255.0 * memblock byte(nr, imgpos)
         height2# = maxH# / 255.0 * memblock byte(nr, imgpos + 4)
         height3# = maxH# / 255.0 * memblock byte(nr, imgpos + (width*4))
         height4# = maxH# / 255.0 * memblock byte(nr, imgpos + (width*4) + 4)

         `Write vertex data
         `First vertex
         x1# = (x - 1) * vertS# : x2# = x * vertS#
         y1# = (y - 1) * vertS# : y2# = y * vertS#
         WriteVertex(nr + 1, (pos * 6) + 1, x1#, height1#, -y1#, x1#, height1# + 10.0, -y1#, rgb(255, 255, 255), 0, 0)
         WriteVertex(nr + 1, (pos * 6) + 2, x2#, height2#, -y1#, x2#, height2# + 10.0, -y1#, rgb(255, 255, 255), 1, 0)
         WriteVertex(nr + 1, (pos * 6) + 3, x1#, height3#, -y2#, x1#, height3# + 10.0, -y2#, rgb(255, 255, 255), 0, 1)

         WriteVertex(nr + 1, (pos * 6) + 4, x2#, height2#, -y1#, x2#, height2# + 10.0, -y1#, rgb(255, 255, 255), 1, 0)
         WriteVertex(nr + 1, (pos * 6) + 5, x2#, height4#, -y2#, x2#, height4# + 10.0, -y2#, rgb(255, 255, 255), 1, 1)
         WriteVertex(nr + 1, (pos * 6) + 6, x1#, height3#, -y2#, x1#, height3# + 10.0, -y2#, rgb(255, 255, 255), 0, 1)

      next x
   next y

   `Create mesh
   make mesh from memblock nr, nr + 1
   delete memblock nr
   delete memblock nr + 1
   make object nr, nr, 0

endfunction

function CreateHeightMap()

   `Random terrain
   DrawRndBox(1, 1, 64, 64, 10, 20)

   `Draw waterfall mountain and river
   DrawRndBox(10, 10, 30, 30, 105, 10)

   DrawRndBox(15, 15, 23, 23, 80, 0)
   DrawRndBox(25, 20, 30, 23, 80, 0)

   `DrawRndBox(28, 28, 33, 33, 80, 10)
   `DrawRndBox(8, 9, 16, 13, 80, 10)

   DrawRndBox(7, 7, 28, 10, 30, 30)
   DrawRndBox(7, 7, 10, 28, 30, 30)

   ink rgb(0, 0, 0), 0
   Box 30, 16, 40, 28
   box 32, 14, 38, 30

   box 38, 28, 40, 35
   box 38, 35, 50, 37
   box 50, 35, 52, 64

   `Beach surroundings
   ink 0, 0
   line 0,0,63,0
   line 0,0,0,63
   line 0,64,63,63
   line 63,0,63,63

   get image 1, 0, 0, 64, 64, 1
   make memblock from image 1 ,1
   BlurImage(1, 2)
   BlurImage(2, 1)
   make image from memblock 1, 1
   delete memblock 1
   delete memblock 2

endfunction

function BlurImage(mem, retmem)

   `Get data
   width = memblock dword(mem, 0)
   height = memblock dword(mem, 4)

   `Create returned memblock
   if memblock exist(retmem) = 0 then make memblock retmem, get memblock size(mem)
   write memblock dword retmem, 0, width
   write memblock dword retmem, 4, height
   write memblock dword retmem, 8, 32

   `Write data
   `No edges:
   for y = 2 to height - 1
      for x = 2 to width - 1

         `Get position
         pos = 12 + ((y-1)*width*4) + ((x-1)*4)

         `Initialize values
         blue# = memblock byte(mem, pos) * 0.5
         green# = memblock byte(mem, pos+1) * 0.5
         red# = memblock byte(mem, pos+2) * 0.5

         `Get surrounding data
         `Left
         npos = pos - 4
         blue# = blue# + (memblock byte(mem, npos)*0.08)
         green# = green# + (memblock byte(mem, npos+1)*0.08)
         red# = red# + (memblock byte(mem, npos+2)*0.08)

         `+-> Top Left
         npos = npos - (width*4)
         blue# = blue# + (memblock byte(mem, npos)*0.045)
         green# = green# + (memblock byte(mem, npos+1)*0.045)
         red# = red# + (memblock byte(mem, npos+2)*0.045)

         `Right
         npos = pos + 4
         blue# = blue# + (memblock byte(mem, npos)*0.08)
         green# = green# + (memblock byte(mem, npos+1)*0.08)
         red# = red# + (memblock byte(mem, npos+2)*0.08)

         `+-> Bottom right
         npos = npos + (width*4)
         blue# = blue# + (memblock byte(mem, npos)*0.045)
         green# = green# + (memblock byte(mem, npos+1)*0.045)
         red# = red# + (memblock byte(mem, npos+2)*0.045)

         `Top
         npos = pos - (width*4)
         blue# = blue# + (memblock byte(mem, npos)*0.08)
         green# = green# + (memblock byte(mem, npos+1)*0.08)
         red# = red# + (memblock byte(mem, npos+2)*0.08)

         `+-> top right
         npos = npos + 4
         blue# = blue# + (memblock byte(mem, npos)*0.045)
         green# = green# + (memblock byte(mem, npos+1)*0.045)
         red# = red# + (memblock byte(mem, npos+2)*0.045)

         `Bottom
         npos = pos + (width*4)
         blue# = blue# + (memblock byte(mem, npos)*0.08)
         green# = green# + (memblock byte(mem, npos+1)*0.08)
         red# = red# + (memblock byte(mem, npos+2)*0.08)

         `+-> Bottom left
         npos = npos - 4
         blue# = blue# + (memblock byte(mem, npos)*0.045)
         green# = green# + (memblock byte(mem, npos+1)*0.045)
         red# = red# + (memblock byte(mem, npos+2)*0.045)

         `Write away data
         write memblock byte retmem, pos, int(blue#+0.5)
         write memblock byte retmem, pos+1, int(green#+0.5)
         write memblock byte retmem, pos+2, int(red#+0.5)
         write memblock byte retmem, pos+3, 255

      next x
   next y

   `Edges
   for y = 1 to height step (height-1)
      for x = 1 to width

         `Get position
         pos = 12 + ((y-1)*width*4) + ((x-1)*4)

         `Initialize colors
         if x = 1 or x = width
            blue# = memblock byte(mem, pos) * 0.795
            green# = memblock byte(mem, pos+1) * 0.795
            red# = memblock byte(mem, pos+2) * 0.795
         else
            blue# = memblock byte(mem, pos) * 0.67
            green# = memblock byte(mem, pos+1) * 0.67
            red# = memblock byte(mem, pos+2) * 0.67
         endif

         `Get other colors
         if x > 1
            npos = pos - 4
            blue# = blue# + memblock byte(mem, npos) * 0.08
            green# = green# + memblock byte(mem, npos+1) * 0.08
            red# = red# + memblock byte(mem, npos+2) * 0.08
         endif
         if x < width
            npos = pos + 4
            blue# = blue# + memblock byte(mem, npos) * 0.08
            green# = green# + memblock byte(mem, npos+1) * 0.08
            red# = red# + memblock byte(mem, npos+2) * 0.08
         endif

         if y > 1 then npos = pos - (width*4) else npos = pos + (width*4)
         blue# = blue# + memblock byte(mem, npos) * 0.08
         green# = green# + memblock byte(mem, npos+1) * 0.08
         red# = red# + memblock byte(mem, npos+2) * 0.08

         if x > 1
            mpos = npos - 4
            blue# = blue# + memblock byte(mem, mpos) * 0.045
            green# = green# + memblock byte(mem, mpos+1) * 0.045
            red# = red# + memblock byte(mem, mpos+2) * 0.045
         endif
         if x < width
            mpos = npos + 4
            blue# = blue# + memblock byte(mem, mpos) * 0.045
            green# = green# + memblock byte(mem, mpos+1) * 0.045
            red# = red# + memblock byte(mem, mpos+2) * 0.045
         endif

         `Write away data
         write memblock byte retmem, pos, int(blue#+0.5)
         write memblock byte retmem, pos+1, int(green#+0.5)
         write memblock byte retmem, pos+2, int(red#+0.5)
         write memblock byte retmem, pos+3, 255

      next x
   next y

   `Left and right edges (no corners anymore)
   for x = 1 to width step (width-1)
      for y = 2 to height - 1

         `Get position
         pos = 12 + ((y-1)*width*4) + ((x-1)*4)

         `Initialize colors
         blue# = memblock byte(mem, pos) * 0.67
         green# = memblock byte(mem, pos+1) * 0.67
         red# = memblock byte(mem, pos+2) * 0.67

         `Get surrounding data
         npos = pos - (width*4)
         blue# = blue# + memblock byte(mem, npos) * 0.08
         green# = green# + memblock byte(mem, npos+1) * 0.08
         red# = red# + memblock byte(mem, npos+2) * 0.08

         npos = pos + (width*4)
         blue# = blue# + memblock byte(mem, npos) * 0.08
         green# = green# + memblock byte(mem, npos+1) * 0.08
         red# = red# + memblock byte(mem, npos+2) * 0.08

         if x > 1 then npos = pos - 4 else npos = pos + 4
         blue# = blue# + memblock byte(mem, npos) * 0.08
         green# = green# + memblock byte(mem, npos+1) * 0.08
         red# = red# + memblock byte(mem, npos+2) * 0.08

         mpos = npos - (width*4)
         blue# = blue# + memblock byte(mem, mpos) * 0.045
         green# = green# + memblock byte(mem, mpos+1) * 0.045
         red# = red# + memblock byte(mem, mpos+2) * 0.045
         mpos = npos + (width*4)
         blue# = blue# + memblock byte(mem, mpos) * 0.045
         green# = green# + memblock byte(mem, mpos+1) * 0.045
         red# = red# + memblock byte(mem, mpos+2) * 0.045

         `Write away data
         write memblock byte retmem, pos, int(blue#+0.5)
         write memblock byte retmem, pos+1, int(green#+0.5)
         write memblock byte retmem, pos+2, int(red#+0.5)
         write memblock byte retmem, pos+3, 255

      next y
   next x

endfunction

function WriteVertex(mem, v, x#, y#, z#, nx#, ny#, nz#, color, uvx#, uvy#)

   start = 12 + ((v-1)*36)

   `write vertex 1
   write memblock float mem,start, x#
   write memblock float mem,start+4, y#
   write memblock float mem,start+8, z#

   write memblock float mem,start+12, nx#
   write memblock float mem,start+16, ny#
   write memblock float mem,start+20, nz#

   write memblock dword mem,start+24, color

   write memblock float mem,start+28, uvx#
   write memblock float mem,start+32, uvy#

endfunction

function DrawRndBox(x1, y1, x2, y2, min, range)
   for y = y1 to y2
      for x = x1 to x2
         height = min + rnd(range)
         ink rgb(height, height, height), 0
         dot x - 1, y - 1
      next x
   next y
endfunction

autocam off
Sync On
set camera range 1,10000
color backdrop rgb(100,100,250)

fog on
fog color rgb(100,100,250)
fog distance 450

numberofclouds=400
cloudseed=freeobject()
create_clouds(cloudseed,numberofclouds)

do
control camera using arrowkeys 0,0.1,1

move_clouds(cloudseed,numberofclouds)
text 0,0,str$(screen fps())

sync
loop

function create_clouds(cloudseed,numberofclouds)

create bitmap 1,50,50
ink rgb(255,255,200),0
for x=1 to 1000
   ang=rnd(360)
   rad=rnd(20)
   box 25+sin(ang)*rad,25+cos(ang)*rad,rnd(3)+25+sin(ang)*rad,rnd(3)+25+cos(ang)*rad
next x
blur bitmap 1,4
cloudimage = freeimage()
get image cloudimage, 0, 0, 50, 50

delete bitmap 1


for cloudnumber=cloudseed to cloudseed+numberofclouds
make object plain cloudnumber,rnd(50)+100,rnd(50)+100
position object cloudnumber,rnd(1000)-500,rnd(100)+10,rnd(1000)-500
xrotate object cloudnumber,90
texture object cloudnumber,cloudimage
`set object transparency cloudnumber,4
`set alpha mapping on cloudnumber,50
ghost object on cloudnumber,0
disable object zwrite cloudnumber
set object light cloudnumber,0
next n

endfunction

function move_clouds(cloudseed,numberofclouds)

for cloudnumber=cloudseed to cloudseed+numberofclouds
move object down cloudnumber,-.05
if object position z(cloudnumber)<-500 then position object cloudnumber,rnd(1000)-500,rnd(100)+10,500
next cloudnumber

endfunction


function freeobject()
   repeat
      inc n
   until object exist(n) = 0
endfunction n

function freeimage()
   repeat
      inc n
   until image exist(n) = 0
endfunction n

sync on

backdrop on
color backdrop 0
hide mouse
randomize timer()
set camera range 1, 18000


grass()
get image 1, 0,0,128,128

cloud()
get image 2, 0,0,50,50

#constant N1 = 3
#constant N2 = 4
#constant N3 = 5
#constant N4 = 6

for t = 1 to 6
   null = make vector3(t)
next t


global cStart = 10
global cCount = 400



for t = cStart to cStart+cCount
   make object plain t, 1000+rnd(1000),1000+rnd(1000)
   position object t, rnd(18000)-7000,rnd(100)+4000,rnd(18000)-7000
   xrotate object t, 90
   texture object t, 2
   ghost object on t, 0
   disable object zwrite t
   set object light t,0
   set object fog t, 0

next t



tx = 100
tz = 100
tsx# = 3000.0/tx
tsz# = 3000.0/tz

mSize = 4000

dim heights#(tx,tz)



make matrix 1, mSize, mSize,tx,tz
`set matrix 1, 0, 0, 1, 1, 1, 1, 1
prepare matrix texture 1,1,1,1


rem water plane
make object plain 2, 18500, 18500
`make object plain 2, 5000,5000

set object fog 2,0
`set object light 2,0
`set object ambient 2, 0
position object 2, 2000,10,2000
xrotate object 2, 270
color object 2, rgb(30,60,250)

rem sky sphere
make object sphere 3, 18000
set object light 3,0
position object 3, 2000,0,2000
set object cull 3, 0
color object 3, rgb(60,120,250)


position camera 0,300,0
point camera 500,100,500


make light 1
`set point light 0,2000,3000,2000
set light range 1, 4000

fog on
fog distance 4000
fog color rgb(230,230,250)



DO


   gosub camera_stuff



   if inkey$()="f" and flag=0
      flag = 1
      x1 = rnd(mSize)
      y1 = rnd(mSize)
      x2 = rnd(mSize)
      y2 = rnd(mSize)
      gosub _calc_matrix
   endif

   if inkey$()="s" and flag2=0
      flag2 = 1
      gosub _smooth_matrix
   endif

   if inkey$()="r" and flag3=0
      flag3=1
      gosub _randomize_matrix
   endif

   if inkey$()="n" and flag4=0 then gosub calc_normals

   if inkey$()<>"f" then flag = 0
   if inkey$()<>"s" then flag2 = 0
   if inkey$()<>"r" then flag3 = 0
   if inkey$()<>"n" then flag4 = 0

   moveClouds()

   set cursor 0,0
   print "FPS: ",screen fps()
   print "X: ",cx#
   print "Z: ",cz#



   angle# = wrapvalue(angle#+0.1)
   lx# = 2000+sin(angle#)*2000
   lz# = 2000+cos(angle#)*2000
   set point light 1, lx#,sin(angle#)*500+1000,lz#




   sync
LOOP



_randomize_matrix:
   for z = 1 to tz-1
      for x = 1 to tx-1
         h# = rnd(50)
         set matrix height 1,x,z,heights#(x,z)+h#
         heights#(x,z) = heights#(x,z)+h#
      next x
   next z
   update matrix 1
RETURN


_calc_matrix:

   h0# = 50
   h1# = 20

   for z = 1 to tz-1
      for x = 1 to tx-1
         px# = x*tsx#
         pz# = z*tsz#
         if point_line(px#,pz#,x1,y1,x2,y2) >= 0
            h# = get matrix height(1,x,z)+h0#
            set matrix height 1, x, z, h#
         else
            h# = get matrix height(1,x,z)-h1#
            set matrix height 1, x, z, h#
         endif
         heights#(x,z) = h#
      next x
   next z

   update matrix 1
RETURN



_smooth_matrix:

   for z = 1 to tz-1
      for x = 1 to tx-1
         count = 0
         h1# = 0
         h2# = 0
         h3# = 0
         h4# = 0
         h5# = 0
         h6# = 0
         h7# = 0
         h8# = 0
         if z < tz
            if x > 0 then h1# = heights#(x-1,z+1) : inc count
            h2# = heights#(x,z+1) : inc count
            if x < tx then h3# = heights#(x+1,z+1) : inc count
         endif

         if x > 0 then h4# = heights#(x-1,z) : inc count
         if x < tx then h5# = heights#(x+1,z) : inc count

         if z > 0
            if x > 0 then h6# = heights#(x-1,z-1) : inc count
            h7# = heights#(x,z-1) : inc count
            if x < tx then h8# = heights#(x+1,z-1) : inc count
         endif

         `count=count+5 : h1#=h1#+(5.0*heights#(x,z))

         avg# = (h1#+h2#+h3#+h4#+h5#+h6#+h7#+h8#) / count

         set matrix height 1,x,z,avg#
      next x
   next z

   update matrix 1

   for z = 0 to tz
      for x = 0 to tx
         heights#(x,z) = get matrix height(1,x,z)
      next x
   next z

RETURN



calc_normals2:
   for z = 0 to tz
      for x = 0 to tx
         aa# = rnd(360)
         nx#=0.0 : ny#=(sin(aa#)+1.0)/2.0 : nz#=0.0
         set matrix normal 1, x, z, nx#, ny#, nz#
      next x
   next z
RETURN



calc_normals:
   for z = 1 to tz-1
      for x = 1 to tx-1

         rem upper right
         set vector3 1,x*tsx#,get matrix height(1,x,z+1),(z+1)*tsz#
         set vector3 2,(x+1)*tsx#,get matrix height(1,x+1,z),z*tsz#
         cross product vector3 N1,1,2
         normalize vector3 N1, 1

         rem upper left
         set vector3 1,x*tsx#,get matrix height(1,x,z+1),(z+1)*tsz#
         set vector3 2,(x-1)*tsx#,get matrix height(1,x-1,z),z*tsz#
         cross product vector3 N2,1,2
         normalize vector3 N2, 1

         rem lower left
         set vector3 1,x*tsx#,get matrix height(1,x,z-1),(z-1)*tsz#
         set vector3 2,(x-1)*tsx#,get matrix height(1,x-1,z),z*tsz#
         cross product vector3 N3,1,2
         normalize vector3 N3, 1

         rem lower right
         set vector3 1,x*tsx#,get matrix height(1,x,z-1),(z-1)*tsz#
         set vector3 2,(x+1)*tsx#,get matrix height(1,x+1,z),z*tsz#
         cross product vector3 N4,1,2
         normalize vector3 N4, 1

         rem average 4 normals
         add vector3 N1,N1,N2
         add vector3 N1,N1,N3
         add vector3 N1,N1,N4
         divide vector3 N1,4
         normalize vector3 N1, N1

         nx# = x vector3(N1)
         ny# = y vector3(N1)
         nz# = z vector3(N1)
         set matrix normal 1, x, z, nx#, ny#, nz#
      next x
   next z
   update matrix 1

RETURN





camera_stuff:
  oldcx#=cx#
  oldcz#=cz#
  speed# = 5
  if upkey()=1
    cx#=newxvalue(cx#,a#,speed#)
    cz#=newzvalue(cz#,a#,speed#)
  endif
  if downkey()=1
    cx#=newxvalue(cx#,a#,-speed#)
    cz#=newzvalue(cz#,a#,-speed#)
  endif
  if leftkey()=1
    cx#=newxvalue(cx#,wrapvalue(a#-90.0),speed#)
    cz#=newzvalue(cz#,wrapvalue(a#-90.0),speed#)
  endif
  if rightkey()=1
    cx#=newxvalue(cx#,wrapvalue(a#+90.0),speed#)
    cz#=newzvalue(cz#,wrapvalue(a#+90.0),speed#)
  endif

   if shiftkey() then inc cy#, 2
   if controlkey() then dec cy#, 2



  a#=wrapvalue(a#+(mousemovex()/3.0))
  cxa#=cxa#+(mousemovey()/3.0)
  if cxa#<-90.0 then cxa#=-90.0
  if cxa#>90.0 then cxa#=90.0
  cy# = get ground height(1,cx#,cz#)
  position camera cx#,cy#+100,cz#
  rotate camera wrapvalue(cxa#),a#,0
RETURN



function point_line(px#,py#, x1#,y1#,x2#,y2#)
   dp# = (x2# - x1#) * (py# - y1#) - (px# - x1#) * (y2# - y1#)
endfunction dp#


function moveClouds()
   for t = cStart to cStart+cCount
      hh# = (object position y(t) - 4000) / 100
      if hh# < 2 then hh# = 0.04
      hh# = (1.04 - hh#)
      position object t, object position x(t),object position y(t),object position z(t)-hh#
      if object position z(t) < -8000 then position object t, rnd(18000)-7000,rnd(100)+4000,11000+rnd(1000)
   next t
endfunction



function grass()
   cls
   ink rgb(30,150,0),0
   box 0,0,128,128
   for t = 1 to 1000
      x = rnd(128)
      y = rnd(128)
      g = rnd(200)+55
      r = rnd(50)+65
      if r > g then r = g
      ink rgb(r,g,rnd(50)),0
      box x,y,x+4,y+4
   next t
   blur bitmap 0,4
endfunction



function cloud()
   cls
   ink rgb(255,255,200),0
   for x=1 to 1000
      ang=rnd(360)
      rad=rnd(20)
      box 25+sin(ang)*rad,25+cos(ang)*rad,rnd(3)+25+sin(ang)*rad,rnd(3)+25+cos(ang)*rad
   next x
   blur bitmap 0,4
endfunction