set display mode 1024,768,32
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
 
cls
ink rgb(0,255,0),0
fern(512,668,7,90,7,50,150)
   fern(511,668,7,90,7,50,150)
   fern(513,668,7,90,7,50,150)
   fern(510,668,7,90,7,50,150)
   fern(514,668,7,90,7,50,150)
   line 512,668,512,768
   box 510,668,514,768
   blur bitmap 0,4
 
get image 3, 346,376,714,767
 
 
#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
 
global fStart = 600
global fCount = 600
 
 
 
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
 
 
 
REM fern
tempObject = 599
make object plain tempObject,50,100
offset limb tempObject,0,0,50,0
texture object tempObject,3
set object transparency tempObject, 1
set object cull tempObject, 0
 
rem populate ferns
for t = fStart to fStart+fCount step 3
   instance object t,tempObject
   instance object t+1,tempObject
   instance object t+2,tempObject
   x = rnd(4000)
   z = rnd(4000)
   position object t, x, 0, z
   position object t+1, x, 0, z
   position object t+2, x, 0, z
 
   yrotate object t+1,120 : fix object pivot t+1
   yrotate object t+2,240 : fix object pivot t+2
 
   x = wrapvalue(rnd(150)-75)
   y = rnd(360)
   z = wrapvalue(rnd(150)-75)
   rotate object t,x,y,z
   rotate object t+1,x,y,z
   rotate object t+2,x,y,z
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 : flag4=1
 
   if inkey$()="p" and flag5=0 then repopulateFerns() : flag5=1
 
   if inkey$()<>"f" then flag = 0
   if inkey$()<>"s" then flag2 = 0
   if inkey$()<>"r" then flag3 = 0
   if inkey$()<>"n" then flag4 = 0
   if inkey$()<>"p" then flag5 = 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#,get ground height(1,lx#,lz#)+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
 
 
REM ====== FERN FRACTAL =======
REM X,Y         - starting position for fern, root of first stem
REM passes      - number of iterations
REM startAngle  - angle to start drawing on this pass
REM bendAngle   - overall bending angle of the whole leaf
REM branchAngle - angle to branch off each stem at
REM height      - starting height
function fern(x as float, y as float, passes as integer, startAngle as float, bendAngle as float, branchAngle as float, height as float)
 
   rootAngle# = wrapvalue(startAngle - bendAngle)
 
   x2 = x + cos(rootAngle#)*height
   y2 = y - sin(rootAngle#)*height
   line x,y,x2,y2
 
   height = height*0.5
 
   x3 = x + cos(wrapvalue(rootAngle#+branchAngle))*height
   y3 = y - sin(wrapvalue(rootAngle#+branchAngle))*height
   line x,y,x3,y3
 
   x4 = x + cos(wrapvalue(rootAngle#-branchAngle))*height
   y4 = y - sin(wrapvalue(rootAngle#-branchAngle))*height
   line x,y,x4,y4
 
   if passes > 1
      fern(x2,y2,passes-1, rootAngle#, bendAngle, branchAngle, height)
      fern(x3,y3,passes-1, wrapvalue(rootAngle#+branchAngle), bendAngle, branchAngle, height)
      fern(x4,y4,passes-1, wrapvalue(rootAngle#-branchAngle), bendAngle, branchAngle, height)
   endif
 
endfunction
 
 
 
function repopulateFerns()
   for t = fStart to fStart+fCount step 3
      x = rnd(4000)
      z = rnd(4000)
      position object t, x, get ground height(1,x,z), z
      position object t+1, x, get ground height(1,x,z), z
      position object t+2, x, get ground height(1,x,z), z
 
      x = wrapvalue(rnd(90)-45)
      y = rnd(360)
      z = wrapvalue(rnd(90)-45)
      rotate object t,x,y,z
      rotate object t+1,x,y,z
      rotate object t+2,x,y,z
   next t
endfunction