set display mode 1024,768,32
autocam off
color backdrop 0
hide light 0
make light 1
hide mouse
position light 1,2,20,-5
set camera range 0.1,10000
randomize timer()
sync on
sync rate 40
sync
text 0,0,"Generating terrain ....."
sync
create bitmap 1,screen width(),screen height()
set current bitmap 1
global matrixsize
matrixsize=100
fog on
fog color rgb(180,180,250)
fog distance matrixsize*0.6
global object_seed
object_seed=1000000
global image_seed
image_seed=1000000
global grassimage
create_grass()
global skyimage
create_sky()
global waterimage
global water
global water2
create_water_image()
create_water()
terraform()
create_skysphere()
position camera 65,get ground height(1,65,65)+2,65
point camera 75,get ground height(1,75,75),75
global theta#
global numberoftrees
numberoftrees=20
global dim treeimage(numberoftrees)
global resolution
resolution=6
global bark
create_bark()
set current bitmap 0
for number=1 to numberoftrees
create_tree(number)
ink rgb(255,255,255),0
text 0,0,"Generating trees: "+str$(number)+" out of "+str$(numberoftrees)
sync
next number
 
 
 
do
if spacekey()=1
  delete_tree()
  for number=1 to numberoftrees
  create_tree(number)
  ink rgb(255,255,255),0
  text 0,0,"Generating trees: "+str$(number)+" out of "+str$(numberoftrees)
  sync
  next number
endif
move_camera()
move_water()
move_trees()
 
ink rgb(255,255,255),0
text 0,0,"Press Spacebar to regenerate"
text 0,20,"Polygons: "+str$(statistic(1))
text 0,40,"FPS: "+str$(screen fps())
text 0,60,"Trees: "+str$(numberoftrees)
 
sync
loop
 
 
 
 
 
 
`functions
 
function terraform
 
`set size of terrain
rows=60
columns=60
 
`create terrain
make matrix 1,matrixsize,matrixsize,columns,rows
 
`set mountain peaks
number_of_peaks=rnd(35)+10
max_height=15
 
dim peakx(number_of_peaks)
dim peakz(number_of_peaks)
dim height(number_of_peaks)
for peak=1 to number_of_peaks
  `set x,z coordinates for peak
  peakx(peak)=rnd(columns-10)+5
  peakz(peak)=rnd(rows-10)+5
  `set height of peak
  height(peak)=rnd(max_height)+10
  `create peak
  set matrix height 1,peakx(peak),peakz(peak),height(peak)
next peak
 
num=rows*columns
dim obnum(rows+1,columns+1)
dim v#(rows,columns)
 
`give each tile an x,z coordinate for use later
for x=1 to rows
for z=1 to columns
obnum(x,z)=ob
ob=ob+1
next z
next x
 
`texture matrix
prepare matrix texture 1,grassimage,rows,columns
tile=1
for x=rows-1 to 0 step -1
for z=0 to columns-1
set matrix tile 1,z,x,tile
inc tile
next z
next x
 
 
`adjust height of points between peaks
elasticity#=0.3
damping#=0
 
for time=1 to 100
 
for peak=1 to number_of_peaks
  set matrix height 1,peakx(peak),peakz(peak),height(peak)
next peak
 
for x=1+1 to rows-1
for z=1+1 to columns-1
if x<rows
distxp1#=get matrix height(1,x+1,z)-get matrix height (1,x,z)
endif
if x>1
distxm1#=get matrix height(1,x-1,z)-get matrix height (1,x,z)
endif
if z<columns
distzp1#=get matrix height(1,x,z+1)-get matrix height (1,x,z)
endif
if z>1
distzm1#=get matrix height(1,x,z-1)-get matrix height (1,x,z)
endif
vectorsum#=distxp1#+distxm1#+distzp1#+distzm1#
a#=vectorsum#*elasticity#
v#(obnum(x,z))=v#(obnum(x,z))+a#
set matrix height 1,x,z,get matrix height(1,x,z)+v#(obnum(x,z))
v#(obnum(x,z))=v#(obnum(x,z))*damping#
next z
next x
update matrix 1
next time
 
 
 
endfunction
 
 
 
 
function check_free_object_number
 
`this handy function means that you never have to worry about
`remembering object numbers.  You just give them names you can remember,
`and this function will find the next available number to assosciate
`with that name.  Just call the function by, for example, writing:
`
`ball=check_free_object_number
`make object sphere ball,1
 
object=object_seed
repeat
inc object
until object exist(object)=0
 
endfunction object
 
function check_free_image_number()
 
`this functionworks in the same way as the check_free_object function,
`except it works for images.
 
image=image_seed
repeat
inc image
until image exist(image)=0
 
endfunction image
 
function create_grass
 
`make a shaded box
box 0,0,100,100,rgb(100,150,100),rgb(50,200,20),rgb(80,0,10),rgb(150,200,0)
 
`and speckle it with random dots
for x=0 to 100
  for y=0 to 100
    if rnd(5)=0
      r=rnd(150)
      g=rnd(250)
      b=rnd(100)
      ink rgb(r,g,b),0
      dot x,y
    endif
  next x
next y
 
 
grassimage=check_free_image_number()
get image grassimage,0,0,100,100
 
endfunction
 
function create_skysphere
 
`get image for sphere by taking snapshot of terrain
image=check_free_image_number()
set camera fov 90
position camera matrixsize/2.0,3,-matrixsize*0.3
sync
get image image,0,0,screen width(),screen height()
set camera fov 60
 
`sphere 1 (mountains near) - just a sphere textured with the captured image
object=check_free_object_number()
make object sphere object,matrixsize*2
set object cull object,0
texture object object,image
set object texture object,2,1
scale object texture object,3,1
set object fog object,0
set object light object,0
set object transparency object,4
position object object,matrixsize/2,0,matrixsize/2
 
`sphere 2 (mountains far) - and another one further out. The inner sphere must be
`transparent, though, to see this one.
object=check_free_object_number()
make object sphere object,matrixsize*2.5
yrotate object object,30
set object cull object,0
texture object object,image
set object texture object,2,1
scale object texture object,3,1
set object fog object,0
`set object light object,0
set object transparency object,4
ghost object on object,4
set object emissive object,rgb(180,150,250)
fade object object,70
position object object,matrixsize/2,0,matrixsize/2
 
`sphere 3 (sky) - a third, outer sphere for the sky
object=check_free_object_number()
make object sphere object,matrixsize*4
set object cull object,0
texture object object,skyimage
scale object texture object,1,1.8
set object light object,0
set object fog object,0
 
endfunction
 
function create_sky()
`creates a dark to light bluish gradient
cls
for n=0 to 250
  ink rgb(n,n,250),0
  line 0,n,250,n
next n
 
skyimage=check_free_image_number()
get image skyimage,0,0,250,250
 
endfunction
 
 
function create_water_image
 
`creates a shaded box
box 0,0,100,100,rgb(150,150,200),rgb(50,200,200),rgb(80,0,200),rgb(150,100,200)
 
`and speckles with white bits
for x=0 to 100
  for y=0 to 100
    if rnd(5)=0
      r=(250)
      g=(250)
      b=(250)
      ink rgb(r,g,b),0
      dot x,y
    endif
  next x
next y
 
 
waterimage=check_free_image_number()
get image waterimage,0,0,100,100
 
 
 
endfunction
 
 
function create_water
 
`just a plane textured with the water image
water=check_free_object_number()
make object plain water,matrixsize*4,matrixsize*4
texture object water,waterimage
set object texture water,2,1
scale object texture water,4,4
xrotate object water,90
set object fog water,0
set object emissive water,rgb(220,220,200)
ghost object on water
set alpha mapping on water,20
water2=check_free_object_number()
make object plain water2,matrixsize*4,matrixsize*4
texture object water2,waterimage
xrotate object water2,90
position object water2,0,1,0
set object texture water2,2,1
scale object texture water2,4,4
set object light water2,0
set object fog water2,0
 
endfunction
 
function move_water
 
`moves the texture along a bit
scroll object texture water,0.001,0
scroll object texture water2,-0.001,0
`and moves the water up and down according to a sine wave
position object water,0,0.5*sin(theta#)+3,0
inc theta#,1
 
endfunction
 
function move_camera
 rem - swap camera code for these three lines for 'helicam' mode
`set camera position to ground level
`position camera 5*sin(theta#/3.0)+(matrixsize/2.0)+3,get ground height(1,camera position x(),camera position z())+1,3*cos(theta#/3.0)+(matrixsize/2.0)+3
`point camera (matrixsize/2.0)+3,get ground height(1,(matrixsize/2.0),(matrixsize/2.0)),(matrixsize/2.0)+3
 
control camera using arrowkeys 0,0.2,2.5
position camera camera position x(),get ground height(1,camera position x(),camera position z())+0.2,camera position z()
 
endfunction
 
function create_tree(number)
 
treeimage(number)=check_free_image_number()
bushiness=rnd(280)+60
droopiness#=(rnd(20)/10.0)+0.5
height#=rnd(5)/10.0
roundness=rnd(150)+50
fuzziness=rnd(2)
redness#=rnd(155)
density=rnd(4)+1
 
 
create bitmap 2,400,400
set current bitmap 2
cls
for l=1 to bushiness
if rnd(density)=0 then ink rgb(rnd(100)+redness#,rnd(250),rnd(50)),0 else ink 0,0
for d=1 to bushiness
if rnd(density)=0 then dot d,l
next d
next l
get image treeimage(number),1,1,bushiness,bushiness
set current bitmap 0
delete bitmap 2
 
make object sphere number,0.01
`hide object number
limb=1
polarity=1
for a#=0.01 to 1.0 step 0.01*resolution
objectformesh=check_free_object_number()
make object sphere objectformesh,0.05+a#,5,5
make mesh from object limb,objectformesh
add limb number,limb,limb
delete object objectformesh
delete mesh limb
f#=rnd(fuzziness)/10.0
polarity=polarity*-1
offset limb number,limb,(f#*polarity),-(a#/(droopiness#/0.5)),(f#*polarity)
texture limb number,limb,treeimage(number)
inc limb
next a#
 
randomx#=rnd(50)/10.0+20
randomz#=rnd(50)/10.0+20
position object number,randomx#+50,get ground height(1,randomx#+50,randomz#+50)+1.2+height#,randomz#+50
scale object number,100-roundness#/2.0,roundness*a#,100-roundness#/2.0
set object transparency number,2
 
make object cone 1000+number,1
scale object 1000+number,10+rnd(20),200+height#,10
position object 1000+number,randomx#+50,get ground height(1,randomx#+50,randomz#+50)+height#,randomz#+50
texture object 1000+number,bark
 
for n#=1.0 to 100.0/resolution
rotate limb number,n#,n#/50.0,0,0
next n#
 
endfunction
 
function delete_tree
 
 
for object=1 to numberoftrees
delete object 1000+object
delete object object
next object
 
endfunction
 
function move_trees()
 
for tree=1 to numberoftrees
for n#=1.0 to 100.0/resolution
scroll limb texture tree,n#,(((n#*resolution)/5.0)*sin(theta#+tree*10))*0.0001,(((n#*resolution)/3.0)*sin(theta#+tree*10))*0.00005
inc theta#,0.01
next n#
next tree
 
endfunction
 
function create_bark
 
bark=check_free_image_number()
cls
box 0,0,500,500,rgb(100,80,40),rgb(70,30,20),rgb(150,120,80),rgb(80,60,20)
 
for x=1 to 2500
ink rgb(rnd(50)+50,40,20),0
dot rnd(500),rnd(500)
next x
for x=0 to 500
if rnd(3)=1
line x,0,x+rnd(100)-50,500
endif
next x
get image bark,0,0,500,500
 
endfunction