`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
make memblock 3,4*256*256+12 : write memblock dword 3,0,256 : write memblock dword 3,4,256 : write memblock dword 3,8,32 : for x=1 to 256 : for y=1 to 256 : write memblock dword 3,((y-1)*256+x-1)*4+12,rgb(0,(y+120)/2,int((y+120)*255.0/256.0)) : next y : next x : make image from memblock 3,3
`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