set display mode 1280, 1024, 32
sync on
sync rate 0
autocam off
backdrop on
color backdrop 0
randomize timer()
set directional light 0, -1, -1, -1
 
 
Type Vert
   x as float
   y as float
   z as float
   nx as float
   ny as float
   nz as float
EndType
 
 
#constant IMG_SIZE 64
#constant TERRAIN_SIZE 128
#constant TERRAIN_SCALE 4.0
 
 
 
 
 
 
 
make memblock 1, 12 + (IMG_SIZE*IMG_SIZE*4)
write memblock dword 1, 0, IMG_SIZE
write memblock dword 1, 4, IMG_SIZE
write memblock dword 1, 8, 32
for i = 12 to get memblock size(1)-1 step 4
   write memblock dword 1, i, rgb(64, 160 + rnd(95), 64)
next i
make image from memblock 1, 1
delete memblock 1
 
 
 
 
 
 
 
 
 
 
T_MIN# =  10000
T_MAX# = -10000
gosub GENERATE_TERRAIN
 
 
T_SCALE# = 255.0 / (T_MAX# - T_MIN#)
 
 
 
 
make memblock 1, 12 + (TERRAIN_SIZE * TERRAIN_SIZE * 4)
write memblock dword 1, 0, TERRAIN_SIZE
write memblock dword 1, 4, TERRAIN_SIZE
write memblock dword 1, 8, 32
 
c as dword
for x = 0 to TERRAIN_SIZE-1
   for z = 0 to TERRAIN_SIZE -1
      b = 112 + rnd(32)
      c = rgb(b, b, b)
      h = int((H(x,z).y - T_MIN#) * T_SCALE#)
      if h < 32 then h = 32 else if h > 224 then h = 224
      c = (h << 24) + c
 
      write memblock dword 1, 12 + ((x * TERRAIN_SIZE) + z) * 4, c
   next z
next x
make image from memblock 2, 1
delete memblock 1
 
 
 
 
 
 
make object plain 2, TERRAIN_SIZE * TERRAIN_SCALE, TERRAIN_SIZE * TERRAIN_SCALE
texture object 2, 2
set object transparency 2, 3
cloud_height# = 0.75
position object 2, TERRAIN_SIZE * TERRAIN_SCALE * 0.5,     (T_MAX# * cloud_height#) + (T_MIN# * (1.0 - cloud_height#)),      TERRAIN_SIZE * TERRAIN_SCALE * 0.5
point object 2, object position x(2), object position y(2) + 1, object position z(2)
yrotate object 2, 90
 
 
 
 
 
 
 
camCenter# = TERRAIN_SIZE * TERRAIN_SCALE * 0.5
a# = 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())
   text 0, 10, "MAX: " + str$(T_MAX#);
 
 
 
 
 
 
   inc a#, frameTime# * 0.045
   position camera camCenter# + (sin(a#) * (TERRAIN_SIZE * TERRAIN_SCALE)), T_MAX# * 4.0, camCenter# + (cos(a#) * TERRAIN_SIZE * TERRAIN_SCALE)
   point camera TERRAIN_SIZE * TERRAIN_SCALE * 0.5, T_MIN#, TERRAIN_SIZE * TERRAIN_SCALE * 0.5
 
   sync
loop
 
 
 
GENERATE_TERRAIN:
   Dim H(TERRAIN_SIZE, TERRAIN_SIZE) as Vert
 
   d# = sqrt(2.0 * (TERRAIN_SIZE * TERRAIN_SIZE))
 
   for i = 100 to 0 step -1
      angle# = rnd(360)
      a# = sin(angle#)
      b# = cos(angle#)
      c# = (RndFloat(1.0) * d#) - (d# / 2.0)
 
      for x = 0 to TERRAIN_SIZE
         for z =0 to TERRAIN_SIZE
            if ((a# * x) + (b# * z) - c#) > 0
               inc H(x, z).y, i * 0.1
            else
               dec H(x, z).y, i * 0.1
            endif
         next z
      next x
   next i
 
 
 
   for x = 0 to TERRAIN_SIZE
      for z =0 to TERRAIN_SIZE
         H(x, z).x = x * TERRAIN_SCALE : H(x, z).z = z * TERRAIN_SCALE
      next z
   next x
 
 
 
   `Smoothing time baby...
   `k# = a constant reducing factor
   k# = 0.90
   invk# = 1.0 - k#
   ` pass left to right, right to left, top to bottom and bottom to top... 8 times.
   for iters = 0 to 32
      for x = 0   to TERRAIN_SIZE-1       : for z = 0 to TERRAIN_SIZE           : H(x,z).y = (H(x,z).y * k#) + (H(x+1,z).y * invk#) : next z : next x
      for x = TERRAIN_SIZE-1 to 0  step -1: for z = 0 to TERRAIN_SIZE           : H(x,z).y = (H(x,z).y * k#) + (H(x+1,z).y * invk#) : next z : next x
      for x = 0 to TERRAIN_SIZE           : for z = 0 to TERRAIN_SIZE-1         : H(x,z).y = (H(x,z).y * k#) + (H(x,z+1).y * invk#) : next z : next x
      for x = 0 to TERRAIN_SIZE           : for z = TERRAIN_SIZE-1 to 0 step -1 : H(x,z).y = (H(x,z).y * k#) + (H(x,z+1).y * invk#) : next z : next x
   next iters
 
   null = make vector3(1)
   `Its Normal time baby!!
    for x = 1 to TERRAIN_SIZE-1
      for z = 1 to TERRAIN_SIZE-1
         createNormal(1, TERRAIN_SCALE, H(x,z-1).y, H(x+1,z).y, H(x,z+1).y, H(x-1,z).y)
         H(x,z).nx = x vector3(1)
         H(x,z).ny = y vector3(1)
         H(x,z).nz = z vector3(1)
      next z
    next x
    null = delete vector3(1)
 
 
 
   `Now the fun bit - the terrain!
   make memblock 1, 12 + (TERRAIN_SIZE * TERRAIN_SIZE * 6 * 32)
   write memblock dword 1, 0, 274 : `FVF FORMAT
   write memblock dword 1, 4, 32  : `SIZE PER VERT
   write memblock dword 1, 8, TERRAIN_SIZE * TERRAIN_SIZE * 6 : `VERT NO
 
   n = 12
   for i = 0 to TERRAIN_SIZE-1
      for j = 0 to TERRAIN_SIZE-1
         `Poly 1
         x = i   : z = j   : n = WriteMemblockMeshVert(1, n,   H(x,z).x, H(x,z).y, H(x,z).z,   H(x,z).nx, H(x,z).ny, H(x,z).nz,   0.0, 0.0)
         x = i   : z = j+1 : n = WriteMemblockMeshVert(1, n,   H(x,z).x, H(x,z).y, H(x,z).z,   H(x,z).nx, H(x,z).ny, H(x,z).nz,   0.0, 1.0)
         x = i+1 : z = j   : n = WriteMemblockMeshVert(1, n,   H(x,z).x, H(x,z).y, H(x,z).z,   H(x,z).nx, H(x,z).ny, H(x,z).nz,   1.0, 0.0)
         `Poly 2
         x = i+1 : z = j   : n = WriteMemblockMeshVert(1, n,   H(x,z).x, H(x,z).y, H(x,z).z,   H(x,z).nx, H(x,z).ny, H(x,z).nz,   1.0, 0.0)
         x = i   : z = j+1 : n = WriteMemblockMeshVert(1, n,   H(x,z).x, H(x,z).y, H(x,z).z,   H(x,z).nx, H(x,z).ny, H(x,z).nz,   0.0, 1.0)
         x = i+1 : z = j+1 : n = WriteMemblockMeshVert(1, n,   H(x,z).x, H(x,z).y, H(x,z).z,   H(x,z).nx, H(x,z).ny, H(x,z).nz,   1.0, 1.0)
 
         if T_MIN# > H(i,j).y then T_MIN# = H(i,j).y
         if T_MAX# < H(i,j).y then T_MAX# = H(i,j).y
      next j
   next i
 
   make mesh from memblock 1, 1
   make object 1, 1, 1
   delete mesh 1
   delete memblock 1
 
 
   set object cull 1, 0
return
 
 
 
 
function createNormal(v, SIZE#, hUp#, hRight#, hDown#, hLeft#)
   set vector3 v, hLeft#-hRight#, SIZE#, hUp#-hDown#
   normalize vector3 v, v
endfunction
 
 
 
function WriteMemblockMeshVert(m, n,    x#, y#, z#,     nx#, ny#, nz#,     u#, v#)
   write memblock float 1, n +  0, x#  :`X
   write memblock float 1, n +  4, y#  :`Y
   write memblock float 1, n +  8, z#  :`Z
   write memblock float 1, n + 12, nx# :`NX
   write memblock float 1, n + 16, ny# :`NY
   write memblock float 1, n + 20, nz# :`NZ
   write memblock float 1, n + 24, u#  :`X
   write memblock float 1, n + 28, v#  :`Y
   n = n + 32
endfunction n
 
 
 
 
function RndFloat(max#)
   r# = (rnd(100000.0) / 100000.0) * max#
endfunction r#