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