Sorry your browser is not supported!

Sync On:Sync Rate 0:Autocam Off

Global Limbcount as Integer
Make_Branch(1)
Position Object 1,0,-8,25

For i = 1 to 3
   Fractal_Limb(1,0,0)
Next i


Sync Rate 60
Do
   Turn Object Right 1,.2
   Sync
Loop

Function Fractal_Limb(Obj,Parent,Depth)
   If Depth>=5
      ExitFunction
   Endif
   Inc Limbcount
   Make object from Limb 101,Obj,Parent
   y#=Object Size Y(101)
   e=Rnd(15)
   Scale object 101,60+e,60+e,60+e
   Make Mesh From Object 101,101
   Delete Object 101
   Add Limb Obj,LimbCount,101
   Offset Limb Obj,LimbCount,0,Rnd(y#/3.0)+2*y#/3.0,0
   Link Limb Obj,Parent,LimbCount
   Texture Limb Obj,LimbCount,Obj
   P2=Limbcount
   i=1
   For i = 1 to rnd(2)+2
      Fractal_Limb(obj,P2,Depth+1)
   Next i
   Rotate Limb 1,P2,rnd(160)-80,rnd(360),0
   `Sync
Endfunction

Function Make_Branch(obj)
   Ink RGB(128,10,0),0
   Box 0,0,64,64
   Get Image obj,0,0,63,63,1
   Make Object Triangle obj,1,0,0,0,10,.5,-1,0,0
   Make Mesh From Object obj,obj
   Add Limb Obj,1,obj
   Rotate Limb Obj,1,0,180,0
   Add Limb Obj,2,obj
   Rotate Limb Obj,2,180,90,0
   Offset Limb Obj,2,0,10,0
   Add Limb Obj,3,obj
   Rotate Limb Obj,3,180,-90,0
   Offset Limb Obj,3,0,10,0
   Make Mesh From Object Obj,Obj
   Delete Object Obj
   Make Object Obj,obj,obj
   Set Object Cull Obj,0
Endfunction

Sync On:Sync Rate 0:Autocam Off

Global Limbcount as Integer


Make_Branch(1)
Position Object 1,0,-8,25

For i = 1 to 3
   Fractal_Limb(1,0,0)
Next i

Leaves(8)
Make Object Sphere 2,6,5,5
Texture Object 2,8
Set Object Cull 2,0
Set Object Transparency 2,1
For i = 1 to Limbcount
   if rnd(12)=1
      Instance Object i+2,2
      Glue Object To Limb i+2,1,i
   Endif
Next i
limb=Rnd(Limbcount-2)+2
Glue Object To Limb 2,1,limb
Sync


Do
   Turn Object Right 1,.2
   Sync
Loop

Function Fractal_Limb(Obj,Parent,Depth)
   If Depth>=5
      ExitFunction
   Endif
   Inc Limbcount
   Make object from Limb 101,Obj,Parent
   y#=Object Size Y(101)
   e=Rnd(15)
   Scale object 101,60+e,60+e,60+e
   Make Mesh From Object 101,101
   Delete Object 101
   Add Limb Obj,LimbCount,101
   Offset Limb Obj,LimbCount,0,Rnd(y#/3.0)+2*y#/3.0,0
   Link Limb Obj,Parent,LimbCount
   Texture Limb Obj,LimbCount,Obj
   P2=Limbcount
   i=1
   For i = 1 to rnd(2)+2
      Fractal_Limb(obj,P2,Depth+1)
   Next i
   Rotate Limb 1,P2,rnd(160)-80,rnd(360),0
   `Sync
Endfunction

Function Make_Branch(obj)
   Ink RGB(128,10,0),0
   Box 0,0,64,64
   Get Image obj,0,0,63,63,1
   Make Object Triangle obj,1,0,0,0,10,.5,-1,0,0
   Make Mesh From Object obj,obj
   Add Limb Obj,1,obj
   Rotate Limb Obj,1,0,180,0
   Add Limb Obj,2,obj
   Rotate Limb Obj,2,180,90,0
   Offset Limb Obj,2,0,10,0
   Add Limb Obj,3,obj
   Rotate Limb Obj,3,180,-90,0
   Offset Limb Obj,3,0,10,0
   Make Mesh From Object Obj,Obj
   Delete Object Obj
   Make Object Obj,obj,obj
   Set Object Cull Obj,0
Endfunction

Function Leaf(img)
   Ink Rgb(0,0,0),0
   Box 0,0,20,20
   Ink Rgb(0,200,0),0
   For y=1 to 19
      x=cos(y*9)*19
      Line 10-x,y,10+x,y
   Next y
   Get Image img,0,0,20,20,1
Endfunction

Function Leaves(img)
   Leaf(7)
   Ink Rgb(0,0,0),0
   Box 0,0,256,256
   For i = 1 to 70
      Sprite 7,rnd(255),Rnd(255),7
      Rotate Sprite 7,rnd(360)
      Paste Sprite 7,rnd(255),Rnd(255)
   Next i
   Get Image img,0,0,255,255,1
   Delete Sprite 7
Endfunction

limit#=200.0
for cr#=(-3+y#) to (3+y#) step 0.016
for ci#=(-3+x#) to (3+x#) step 0.016
zr#=cr#
zi#=ci#
it#=0.0
repeat
zrnew#=(((zr#)^2)-2*(zi#^2)+cr#*3)
zinew#=((2*zr#*zi#)+ci#)
it#=it#+2
zr#=zrnew#
zi#=zinew#
until sqrt(zr#)>20 or it#>limit#
if it#>limit# then ink rgb(0,200,0),0 else ink rgb (it#*0,it#*12,it#*0),0 ` black if it was straight away (no iterations)
box ((ci#-x#)*60+(screen width()/2)),((cr#-y#)*60+(screen height()/2)),1+((ci#-x#)*60+(screen width()/2)),1+((cr#-y#)*60+(screen height()/2))
next ci#
sync
if escapekey()=1 then exit
next cr#

autocam off
color backdrop 0
hide light 0
make light 1
position light 1,2,20,-5
set camera range 0.1,10000
randomize timer()
sync on

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()
global theta#
global treeimage
create_tree()

ink 0,0
do
move_camera()
move_water()
for n#=1.0 to 100.0
xrotate object n#,(n#/5.0)*sin(theta#)
yrotate object n#,(n#/3.0)*sin(theta#)
inc theta#,0.01
next n#
text 0,0,str$(screen fps())
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

`set camera position to ground level
position camera 5*sin(theta#/3.0)+(matrixsize/2.0),get ground height(1,camera position x(),camera position z())+1,3*cos(theta#/3.0)+(matrixsize/2.0)
point camera (matrixsize/2.0),get ground height(1,(matrixsize/2.0),(matrixsize/2.0)),(matrixsize/2.0)

endfunction

function create_tree

treeimage=check_free_image_number()
bushiness=rnd(180)+20
cls
for l=1 to bushiness
if rnd(2)=0 then ink rgb(rnd(90),rnd(250),rnd(50)),0 else ink 0,0
for d=1 to bushiness
if rnd(3)=0 then dot d,l
next d
next l
get image treeimage,1,1,bushiness,bushiness,1
roundness=rnd(100)+50
ob=1
for a#=0.01 to 1.0 step 0.01
make object sphere ob,0.05+a#,20,20
scale object ob,100,roundness,100
position object ob,50,get ground height(1,50,50)+1,50
set object transparency ob,5
texture object ob,treeimage
inc ob
next a#


make object cone 1000,1
ghost object on 1000
scale object 1000,10,200,10
position object 1000,50,get ground height(1,50,50),50
color object 1000,rgb(200,100,80)

for n#=1.0 to 100.0
xrotate object n#,n#/50.0
next n#

endfunction

#constant C_basicLengthFactor 75.0

#constant C_basicSizeFactor 15.0

#constant C_BranchRadiusDecline 0.55
#constant C_BranchLengthDecline 0.70

#constant C_maxDownAngle 135

#constant C_branchMinAngle 30.0
#constant C_branchRndAngle 10.0

#constant C_trunkMinAngle 5.0
#constant C_trunkRndAngle 5.5

#constant C_textureDeScale 5.0

#constant C_BranchesPerLayer 3
#constant C_NumberOfLayers 5

#constant C_NumberOfLeaves 2

#constant C_XuprightOffset 270

#constant C_BarkTextureStart 1
#constant C_BarkTextureEnd 5
#constant C_LeafTextureStart 6
#constant C_LeafTextureEnd 10
#constant C_GroundTexture 100
#constant C_RainTexture 200


type XYZfloat
	x as float
	y as float
	z as float
endtype

gosub setupEnvironment

do
	text 10,10,"Screen FPS: " + str$(screen FPS())
	text 10,30,"Polygons on Screen: " + str$(Statistic(1))
	text 10,50,"Hold [Shift] and move mouse to turn, RMB goes forward, LMB goes backward"
	text 10,70,"Press [Space] to generate a new tree..."
	MouseControl(2)
	
	`update rain
	updateRain()
	
	
	if spacekey() = 1
		repeat
			text 10,10,"Screen FPS: " + str$(screen FPS())
			text 10,30,"Polygons on Screen: " + str$(Statistic(1))
			text 10,50,"Hold [Shift] and move mouse to turn, RMB goes forward, LMB goes backward"
			center text screen width()/2,70,"...Release [Space] to generate a new tree..."
			MouseControl(2)
			syn 
		   il spacekey() = 0
		
		if limbedTreeObj <> 0
			if object exist(limbedTreeObj) = 1 then delete object limbedTreeObj
		endif
		
		text screen width()-text width("...Constructing New Tree   "),70, "...Constructing New Tree   "
		sync
		
		limbedTreeObj = CreateLimbedTree(XYZstartPos, XYZstartDir, C_BranchesPerLayer, C_NumberOfLayers, C_basicLengthFactor, C_basicSizeFactor)
		
		pause("...New Tree Created, Press [space] to resume...")
	endif
	
	sync
loop

setupEnvironment:

sync on
sync rate 0
autocam off
set display mode 800,600,32
position camera 200,200,200
point camera 0,100,0
randomize timer()
`randomize 1

text 0,0,"Generating Bark Texture..."
sync
sync
for n = C_BarkTextureStart to C_BarkTextureEnd
	BarkTexture(n)
next n

cls rgb(0,0,0)
ink rgb(255,255,255),0
text 0,0,"Generating Leaf Textures..."
sync
sync
for n = C_LeafTextureStart to C_LeafTextureEnd
	LeafTexture(n)
next n

GroundTexture(C_GroundTexture)


global XYZfReturn as XYZfloat
global XYZstartDir as XYZfloat
global XYZstartPos as XYZfloat
global rainObj as integer

global limbedTreeObj as integer

XYZstartDir.x = 0
XYZstartDir.y = 0
XYZstartDir.z = 0

XYZstartPos.x = 0
XYZstartPos.y = 0
XYZstartPos.z = 0

make matrix 1, 5000, 5000, 35, 35
position matrix 1,-2500,0,-2500
set matrix wireframe on 1
prepare matrix texture 1, C_GroundTexture, 1, 1
fill matrix 1, 0, 1
randomize matrix 1,30
update matrix 1

ink rgb(255,255,255),0

fog on
fog color RGB(189,193,196)
fog distance 1000
color backdrop RGB(189,193,196)

limbedTreeObj = CreateLimbedTree(XYZstartPos, XYZstartDir, C_BranchesPerLayer, C_NumberOfLayers, C_basicLengthFactor, C_basicSizeFactor)

make light 1
set point light 1, -100, 100, -100

rainSpout()

ink rgb(150,150,150),0

return

function rainSpout()
	RainTexture(C_RainTexture)
	rainObj = FreeObject()
	
	`MemblockTCone(rainObj, 20, 50, 30, 800)
	`MemblockTCone(rainObj+1,20,75, 45, 800)
	
	make object cylinder rainObj, 100 : scale object rainObj,200,800,200
	make object cylinder rainObj+1, 100 : scale object rainObj+1,400,800,400
	
	
	texture object rainObj, C_RainTexture
	texture object rainObj+1, C_RainTexture
	
	set object transparency rainObj, 0
	set object transparency rainObj+1, 0
	
	ghost object on rainObj
	ghost object on rainObj+1
	
	set object cull rainObj, 0
	set object cull rainObj+1, 0
	
	disable object zwrite rainObj
	disable object zwrite rainObj+1
	
	set object light rainObj, 0
	set object light rainObj+1, 0
endfunction

function updateRain()
	position object rainObj, camera position x(), 0, camera position z()
	position object rainObj+1, camera position x(), 0, camera position z()
	`position object rainObj, 0, 400, 0  
	`position object rainObj+1, 0, 400, 0
	
	scroll object texture rainObj,0.0001,-0.005
	scroll object texture rainObj+1,-0.0001,-0.005

endfunction




function CreateLimbedTree(pos as XYZfloat, direction as XYZfloat, BPL as integer, numLayers as integer, length as float, width as float)

	local treeobj as integer
	treeobj = FreeObject()
	
	make object box treeobj, 0, 0, 0
	
	
	
	DrawLimbedTree(numLayers, BPL, treeobj, 0, direction, pos, length, width)
	`DrawLimbedTree(6, BPL, treeobj, 0, direction, pos, length, width)
	
	set object transparency treeobj,1

endfunction treeobj

function DrawLimbedTree(n as integer,BPL as integer, obj as integer, limb as integer, direction as XYZfloat, pos as XYZfloat, length as float, width as float)
	local RndBchDir as XYZfloat
	local RndBchPos as XYZfloat
	if n > 0
		limb = DrawLimbedTrunk(n, obj, limb, pos, direction, length, width)
		
		`sync
		`pause("Created a Trunk")
		
		if n > 1
			rem trunk stem
			RandomLimbedBranchDirection(C_trunkRndAngle, C_trunkMinAngle) : RndBchDir = XYZfReturn
			 NewLimbedTrunkPos(length) : RndBchPos = XYZfReturn
			
			`pause("Stem")
			DrawLimbedTree(n-1,BPL,obj,limb,RndBchDir,RndBchPos,LengthDeScale(n,length), SizeDeScale(n,width))
			
			rem branches ahoy!!!
			for i = 1 to BPL
				RandomLimbedBranchDirection(C_branchRndAngle, C_branchMinAngle) : RndBchDir = XYZfReturn
				RandomLimbedBranchPosition(length) : RndBchPos = XYZfReturn

				`pause("Branches")
				DrawLimbedTree(n-1,BPL,obj,limb,RndBchDir,RndBchPos,LengthDeScale(n,length), SizeDeScale(n,width))
				
			next i
		endif
		
	endif
	
	rem draw leaves...
	if n <= 1 and C_NumberOfLeaves > 0
		for i = 1 to C_NumberOfLeaves
			RndBchPos.x = 0
			RndBchPos.y = (i-1.0)*1.0*(length*0.666666 / (C_NumberOfLeaves*1.0)) + (length*0.3)
			RndBchpos.z = 0
		
			RndBchDir.x = -10 + rnd(20)
			RndBchDir.y = -20 + rnd(40)
			RndBchDir.z = 0
		
			DrawLimbedLeaf(obj, limb, RndBchPos, RndBchDir, 6, 3)
			
			RndBchDir.x = -10 + rnd(20)
			RndBchDir.y = 160 + rnd(40)
			
			DrawLimbedLeaf(obj, limb, RndBchPos, RndBchDir, 6, 3)
		next i
		
		RndBchDir.x = rnd(360)
		RndBchDir.y = 0
		RndBchDir.z = 90
		RndBchPos.y = length - length * 0.125
		
		DrawLimbedLeaf(obj, limb, RndBchPos, RndBchDir, 6, 3)
	endif
	
endfunction

function DrawLimbedTrunk(n, obj, limb, pos as XYZfloat, direction as XYZfloat, length as float, width as float)
	local meshNum as integer
	local newLimb as integer
	meshNum = FreeMesh()
	newLimb = FreeLimb(obj)
	
	`clone object objnum, baseTrunkObj
	if n <= 1
		MemblockMeshCone(meshNum, n+4, width, length)
		`MemblockMeshTCone(meshNum, n+4, C_BranchRadiusDecline * width, width, length)
		
	else
		MemblockMeshTCone(meshNum, n+4, C_BranchRadiusDecline * width, width, length)
	endif
	
	add limb obj, newLimb, meshNum
	link limb obj, limb, newLimb

	rotate limb obj, newLimb, direction.x, direction.y, direction.z
	offset limb obj, newLimb, pos.x, pos.y, pos.z
	
	texture limb obj, newLimb, C_BarkTextureStart + rnd(C_BarkTextureEnd-C_BarkTextureStart)
	`scale limb texture obj, newLimb, width/C_textureDeScale, width/C_textureDeScale
endfunction newLimb

function DrawLimbedLeaf(obj, limb, pos as XYZfloat, direction as XYZfloat, length as float, width as float)

	local meshNum as integer
	local newLimb as integer
	meshNum = FreeMesh()
	newLimb = FreeLimb(obj)
	
	`clone object objnum, baseTrunkObj
	MemblockMeshPlain(meshNum, width, length)
	
	add limb obj, newLimb, meshNum
	link limb obj, limb, newLimb

	rotate limb obj, newLimb, direction.x, direction.y, direction.z
	offset limb obj, newLimb, pos.x, pos.y, pos.z
	
	texture limb obj, newLimb, C_LeafTextureStart+rnd(C_LeafTextureEnd - C_LeafTextureStart)
endfunction

function RandomLimbedBranchDirection(randomAngle as float, minAngle as float)
	XYZfReturn.x = minAngle + rnd(randomAngle)
	XYZfReturn.y = rnd(360)
	XYZfReturn.z = 0
endfunction

function NewLimbedTrunkPos(length as float)
	XYZfReturn.x = 0
	XYZfReturn.y = length - length/40.0
	XYZfReturn.z = 0
endfunction

function RandomLimbedBranchPosition(length as float)
	XYZfReturn.x = 0
	XYZfReturn.y = length/2.0 + rnd(length/3.0)
	XYZfReturn.z = 0
endfunction

function SizeDeScale(n as integer, size as float)
	rem more work, for n anyways...
	local rtrn as float
	rtrn = size*C_BranchRadiusDecline
endfunction rtrn

function LengthDeScale(n as integer, size as float)
	local rtrn as float
	rtrn = size*C_BranchLengthDecline
endfunction rtrn

function BarkTexture(imgNum as integer)
	local xSize as integer
	local ySize as integer
	
	local tmpXa as integer
	local tmpYa as integer
	local tmpXb as integer
	local tmpYb as integer
	
	local extream as integer
	
	xSize = 255
	ySize = 255
	
	cls rgb(120,90,70)
	for n = 1 to (xSize+ySize)*50
		extream = -60 + rnd(100)
		ink rgb(110+rnd(20)+extream,80+rnd(20)+extream,60+rnd(20)+extream),0
		circle rnd(xSize), rnd(ySize),3
	next n
	
	for n = 1 to (xSize+ySize)*3
		extream = -60 + rnd(100)
		ink rgb(110+rnd(20)+extream,80+rnd(20)+extream,60+rnd(20)+extream),0
		tmpXa = rnd(xSize)
		tmpYa = rnd(ySize - ySize/3)
		tmpXb = tmpXa-3+rnd(6)
			if tmpXb < 0 then tmpXb = 0
			if tmpXb > xSize then tmpXb = xSize
		tmpYb = tmpYa + rnd(ySize/2)
			if tmpYb > ySize then tmpYb = ySize
			
		line tmpXa, tmpYa, tmpXb, tmpYb
		
		extream = -60 + rnd(100)
		ink rgb(110+rnd(20)+extream,80+rnd(20)+extream,60+rnd(20)+extream),0
		tmpXa = rnd(10)
		for x = 1 to 5
			circle rnd(xSize), rnd(ySize),5+tmpXa+x
		next x
	next n
	
	blur bitmap 0,2
	
	get image imgNum,xSize/4,ySize/4,(xSize*3)/4,(ySize*3)/4,0
endfunction

function LeafTexture(imgNum as integer)
	cls rgb(0,0,0)
	
	local xSize as integer
	local ySize as integer
	local fractQty as integer
	
	local tmpXa as integer
	local tmpYa as integer
	local tmpXb as integer
	local tmpYb as integer
	
	local color as dword
	local extream as integer
	
	xSize = 100
	ySize = 200
	fractQty = 100
	
	ink rgb(rnd(40),150+rnd(40)+extream,rnd(40)),0
	for n = 0 to ySize*2
		tmpXb = (sin(180.0*n*1.0/ySize*2.0)+1.0)*xSize/2.0
		tmpXa = (sin(180.0*n*1.0/ySize*2.0+180)+1.0)*xSize/2.0
		tmpYa = (cos(180.0*n*1.0/ySize*2.0)+1.0)*(ySize)/2.0
		tmpYb = (cos(180.0*(n+1)*1.0/ySize*2.0)+1.0)*(ySize)/2.0
		box tmpXb, tmpYa, tmpXa, tmpYb
	next n
	
	for n = 1 to fractQty
		tmpXa = xSize/2
		tmpYa = ySize-(abs(n-fractQty/2)/(fractQty/2.0))*ySize*0.7
		
		tmpXb = (sin(360.0*n*1.0/fractQty*1.0 + 180)+1.0)*xSize/2.0
		tmpYb = (cos(360.0*n*1.0/fractQty*1.0 + 180)+1.0)*(ySize)/2.0
		
		extream = -50 + rnd(100)
		color = rgb(rnd(40),100+rnd(40)+extream,rnd(40))
		fracture(tmpXa,tmpYa,tmpXb,tmpYb, 50, 7, color)
	next n
	
	get image imgNum,0,0,xSize,ySize,0
	
endfunction


function GroundTexture(imgNum as integer)
	local xSize as integer
	local ySize as integer
	
	local tmpXa as integer
	local tmpYa as integer
	local tmpXb as integer
	local tmpYb as integer
	
	local extream as integer
	
	xSize = 255
	ySize = 255
	
	cls rgb(120,90,70)
	for n = 1 to (xSize+ySize)*50
		extream = -60 + rnd(100)
		ink rgb(110+rnd(20)+extream,80+rnd(20)+extream,60+rnd(20)+extream),0
		circle rnd(xSize), rnd(ySize),3
	next n
	
	for n = 1 to (xSize+ySize)*3
		extream = -60 + rnd(100)
		ink rgb(110+rnd(20)+extream,80+rnd(20)+extream,60+rnd(20)+extream),0
		tmpXa = rnd(xSize)
		tmpYa = rnd(ySize)
		tmpXb = rnd(xSize)
		tmpYb = rnd(ySize)
			
		line tmpXa, tmpYa, tmpXb, tmpYb
		
		extream = -60 + rnd(100)
		ink rgb(110+rnd(20)+extream,80+rnd(20)+extream,60+rnd(20)+extream),0
		tmpXa = rnd(10)
		for x = 1 to 5
			circle rnd(xSize), rnd(ySize),5+tmpXa+x
		next x
	next n
	
	blur bitmap 0,2
	
	get image imgNum,xSize/4,ySize/4,(xSize*3)/4,(ySize*3)/4,0
endfunction


function RainTexture(imgNum as integer)
	local xSize as integer
	local ySize as integer
	
	local tmpXa as integer
	local tmpYa as integer
	local tmpXb as integer
	local tmpYb as integer
	
	local extream as integer
	
	cls rgb(0,0,0)
	
	xSize = 1200
	ySize = 1200
	
	create bitmap 1, xSize, ySize
	set current bitmap 1
	
	cls rgb(0,0,0)
	
	for n = 1 to (xSize)*4
		extream = -120 + rnd(40)
		ink rgb(200+rnd(10)+extream,200+rnd(10)+extream,210+rnd(10)+extream),0
		tmpXa = rnd(xSize)
		tmpYa = rnd(ySize - 20)
		tmpXb = tmpXa-3+rnd(6)
			if tmpXb < 0 then tmpXb = 0
			if tmpXb > xSize then tmpXb = xSize
		tmpYb = tmpYa + rnd(10) + 10
			if tmpYb > ySize then tmpYb = ySize
			
		line tmpXa, tmpYa, tmpXb, tmpYb
	next n
	
	
	get image imgNum,0,0,xSize,ySize,0
	
	delete bitmap 1
	set current bitmap 0
endfunction


    

function MemblockTCone(object as integer, density as integer, topSize as float, btmSize as float, height as float)
	local tmpmesh as integer
	tmpmesh = FreeMesh()
	
	MemblockMeshTCone(tmpmesh, density, topSize, btmSize, height)
	
	make object object, tmpmesh, 1
	delete mesh tmpmesh
endfunction

function MemblockCone(object as integer, density as integer, size as float, height as float)
	local tmpmesh as integer
	tmpmesh = FreeMesh()
	
	MemblockMeshCone(tmpmesh, density, size, height)
	
	make object object, tmpmesh, 1
	delete mesh tmpmesh
endfunction

function MemblockMeshTCone(mesh as integer, density as integer, topSize as float, btmSize as float, height as float)
	local memblock as integer
   local vertexCount as integer
   local offset as integer
   
   memblock = FreeMemblock()

   make memblock memblock, 12 + (32 * density * 6)

   write memblock dword memblock, 0, 275
   write memblock dword memblock, 4, 32
   write memblock dword memblock, 8, density * 6
   offset = 12

   for i = 1 to density

      `write poly one and two-------------------------------------
         writeVertex275(memblock, offset    , sin((i-1.0)*360.0/density)*topSize/2.0, height, cos((i-1.0)*360.0/density)*topSize/2.0,   cos((i-1.0)*360.0/density*1.0), 0, sin((i-1.0)*360.0/density), (i-1.0)/density, 0.0)
         writeVertex275(memblock, offset+32 , sin((i-1.0)*360.0/density)*btmSize/2.0,      0, cos((i-1.0)*360.0/density)*btmSize/2.0,   cos((i-1.0)*360.0/density*1.0), 0, sin((i-1.0)*360.0/density), (i-1.0)/density, 1.0)
         writeVertex275(memblock, offset+64 , sin((i*1.0)*360.0/density)*topSize/2.0, height, cos((i*1.0)*360.0/density)*topSize/2.0,   cos((i*1.0)*360.0/density*1.0), 0, sin((i*1.0)*360.0/density), (i*1.0)/density, 0.0)

         writeVertex275(memblock, offset+96 , sin((i-1.0)*360.0/density)*btmSize/2.0,      0, cos((i-1.0)*360.0/density)*btmSize/2.0,   cos((i-1.0)*360.0/density*1.0), 0, sin((i-1.0)*360.0/density), (i-1.0)/density, 1.0)
         writeVertex275(memblock, offset+128, sin((i*1.0)*360.0/density)*btmSize/2.0,      0, cos((i*1.0)*360.0/density)*btmSize/2.0,   cos((i*1.0)*360.0/density*1.0), 0, sin((i*1.0)*360.0/density), (i*1.0)/density, 1.0)
         writeVertex275(memblock, offset+160, sin((i*1.0)*360.0/density)*topSize/2.0, height, cos((i*1.0)*360.0/density)*topSize/2.0,   cos((i*1.0)*360.0/density*1.0), 0, sin((i*1.0)*360.0/density), (i*1.0)/density, 0.0)
         inc offset, 192
   next i

   make mesh from memblock mesh, memblock

   delete memblock memblock
endfunction

function MemblockMeshCone(mesh as integer, density as integer, size as float, height as float)
	local memblock as integer
   local vertexCount as integer
   local offset as integer

   memblock = FreeMemblock()

   make memblock memblock, 12 + (32 * density * 3)

   write memblock dword memblock, 0, 275
   write memblock dword memblock, 4, 32
   write memblock dword memblock, 8, density * 3
   offset = 12

   for i = 1 to density

      `write poly one-------------------------------------
         writeVertex275(memblock, offset   , sin((i-1.0)*360.0/density)*size/2.0,      0, cos((i-1.0)*360.0/density)*size/2.0,   cos((i-1.0)*360.0/density*1.0), 0, sin((i-1.0)*360.0/density), (i-1.0)/density    , 1.0)
         writeVertex275(memblock, offset+32, sin((i*1.0)*360.0/density)*size/2.0,      0, cos((i*1.0)*360.0/density)*size/2.0,   cos((i*1.0)*360.0/density*1.0), 0, sin((i*1.0)*360.0/density), (i*1.0)/density    , 1.0)
         writeVertex275(memblock, offset+64, 0                                  , height, 0                                  ,   cos((i*1.0)*360.0/density*1.0), 0, sin((i*1.0)*360.0/density), (i-1.0)/(density-1), 0.0)
         inc offset, 96
   next i

   make mesh from memblock mesh, memblock

   delete memblock memblock
endfunction

function MemblockMeshPlain(mesh as integer, width as float, height as float)
	local memblock as integer
   local vertexCount as integer
   local offset as integer

   memblock = FreeMemblock()

   make memblock memblock, 12 + (32 * 4 * 3)

   write memblock dword memblock, 0, 275
   write memblock dword memblock, 4, 32
   write memblock dword memblock, 8, 12
   offset = 12

      `write poly one and two  and invert-------------------------------------
         writeVertex275(memblock, offset    , 0     , 0, width/-2.0, 0,  1, 0, 0.0, 1.0)
         writeVertex275(memblock, offset+32 , 0     , 0, width/2.0 , 0,  1, 0, 1.0, 1.0)
         writeVertex275(memblock, offset+64 , height, 0, width/-2.0, 0,  1, 0, 0.0, 0.0)
	                                                                                    
			inc offset, 96                                                                
                                                                                       
			writeVertex275(memblock, offset    , 0     , 0, width/2.0 , 0,  1, 0, 1.0, 1.0)
         writeVertex275(memblock, offset+32 , height, 0, width/2.0,  0,  1, 0, 1.0, 0.0)
         writeVertex275(memblock, offset+64 , height, 0, width/-2.0, 0,  1, 0, 0.0, 0.0)
                                                                                       
         inc offset, 96                                                                
                                                                                       
         writeVertex275(memblock, offset    , 0     , 0, width/2.0 , 0, -1, 0, 1.0, 1.0)
         writeVertex275(memblock, offset+32 , 0     , 0, width/-2.0, 0, -1, 0, 0.0, 1.0)
         writeVertex275(memblock, offset+64 , height, 0, width/-2.0, 0, -1, 0, 0.0, 0.0)
                                                                                       
			inc offset, 96                                                                
			                                                                              
			writeVertex275(memblock, offset    , height, 0, width/2.0,  0, -1, 0, 1.0, 0.0)
			writeVertex275(memblock, offset+32 , 0     , 0, width/2.0 , 0, -1, 0, 1.0, 1.0)
         writeVertex275(memblock, offset+64 , height, 0, width/-2.0, 0, -1, 0, 0.0, 0.0)

   make mesh from memblock mesh, memblock

   delete memblock memblock
endfunction


function writeVertex275(memblock, offset, x#, y#, z#,  nx#, ny#, nz#,  u#, v#)
      write memblock float memblock, offset + 0, x#
      write memblock float memblock, offset + 4, y#
      write memblock float memblock, offset + 8, z#

      `write normal data
      write memblock float memblock, offset + 12, nx#
      write memblock float memblock, offset + 16, ny#
      write memblock float memblock, offset + 20, nz#

      `write UV information
      write memblock float memblock, offset + 24, u#
      write memblock float memblock, offset + 28, v#
endfunction

`an electric function pulled from one of my 20 liners that never went...

function fracture(startx, starty, endx, endy, devdegree, points, color)
	rem this scales the number of points acording to the distance traversed
	`test# = (2D_Distance(startx, starty, endx, endy)*density) / 2D_Distance(0, 0, screen width(), screen height())
	dim lines(points,1)
	#constant xposition=0
	#constant yposition=1
	lines(0,xposition) = startx
	lines(0,yposition) = starty
	alpha = 0
	distance = 0
	angle = 0
	for n = 1 to points
   	angle = rnd(devdegree) - int(devdegree/2)
   	if n = points - 1
      	angle = 0
   	endif
   	distance = sqrt((startx - endx)*(startx - endx) + (starty - endy)*(starty - endy)) / (points - n)
   	alpha = atanfull((endy - starty),(endx - startx))
   	lines(n,xposition) = distance * cos(alpha + angle) + startx
   	lines(n,yposition) = distance * sin(alpha + angle) + starty
   	startx = lines(n,xposition)
   	starty = lines(n,yposition)
	next n
	ink color,0
	for n = 1 to points
   	line lines(n-1,xposition),lines(n-1,yposition),lines(n,xposition),lines(n,yposition)
	next n
endfunction

`pauses untill the space key is pressed
function pause(prompt as string)

	repeat
		center text screen width()/2, 15, prompt
		MouseControl(0.5)
		syn 
	   il spacekey() = 1
	
	repeat
		center text screen width()/2, 15, prompt
		MouseControl(0.5)
		syn 
	   il spacekey() = 0
endfunction

function MouseControl(Speed as float)
	if shiftkey() = 1
		
		xrotate camera camera angle x()+mousemovey()/3.0
		yrotate camera camera angle y()+mousemovex()/6.0
		if mouseclick()=1 then move camera Speed
		if mouseclick()=2 then move camera (0-Speed)
		
	endif
	
	r=mousemovex()
	r=mousemovey()

endfunction

`hides and or deletes objects
function ClearObjects(maxSearch as integer)
	for i = 1 to maxSearch
		`if object exist(i) = 1 then delete object i
		if object exist(i) = 1 then hide object i
	next i
endfunction

function FreeObject()
	repeat
		inc i 
		if object exist(i)=0 then found=1
	until found
endfunction i

function FreeImage()
	repeat
		inc i
		if image exist(i)=0 then found=1
	until found
endfunction i

function FreeLimb(objNum)
	repeat
		inc i
		if limb exist(objNum,i)=0 then found=1
	until found
endfunction i

function FreeMemblock()
	repeat
		inc i
		if memblock exist(i)=0 then found=1
	until found
endfunction i

function FreeMesh()
	repeat
		inc i
		if mesh exist(i)=0 then found=1
	until found
endfunction i

#constant C_basicLengthFactor 75.0 ` length of the first "trunk"

#constant C_basicSizeFactor 15.0 `width of the first "trunk"

#constant C_BranchRadiusDecline 0.55 `multiplyed times each consecutive branch to the radius so that the branches get thiner
#constant C_BranchLengthDecline 0.70 `same as above except this relates to length

#constant C_maxDownAngle 135 ` unused i think

#constant C_branchMinAngle 30.0 ` for the "Branches" this is the min angle they stick out from vertical from the parent branch
#constant C_branchRndAngle 10.0 ` randomness added to the angle above

#constant C_trunkMinAngle 5.0 `same as above two except these apply to the strait branches to give the tree form.
#constant C_trunkRndAngle 5.5

#constant C_textureDeScale 5.0 `scaling of the texture

#constant C_BranchesPerLayer 3 `number of branches per layer, ex first trunk would have 3 offshoot branches and 1 continuing upward
#constant C_NumberOfLayers 5 `number of branch generations, leave it at 5 if you have leaves and don't go above 7 otherwise it gets realy dense and high poly

#constant C_NumberOfLeaves 2 ` number of leaves per small branch * 2 + 1, setting it to zero makes it so there are no leaves made

autocam off
color backdrop 0
hide light 0
make light 1
position light 1,2,20,-5
set camera range 0.1,10000
randomize timer()
sync on
sync rate 40

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()
global theta#
global treeimage
sync
create_tree()



do
if spacekey()=1 then delete_tree():create_tree()
move_camera()
move_water()
for n#=1.0 to 100.0
scroll object texture n#,((n#/5.0)*sin(theta#))*0.0001,((n#/3.0)*sin(theta#))*0.00005

inc theta#,0.01
next n#
ink rgb(255,255,255),0
text 0,0,"Press Spacebar to regenerate"
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

`set camera position to ground level
position camera 5*sin(theta#/4.0)+(matrixsize/2.0),get ground height(1,camera position x(),camera position z())+1,3*cos(theta#/4.0)+(matrixsize/2.0)
point camera (matrixsize/2.0),get ground height(1,(matrixsize/2.0),(matrixsize/2.0)),(matrixsize/2.0)

endfunction

function create_tree

treeimage=check_free_image_number()
bushiness=rnd(180)+20
droopiness#=rnd(20)/10.0
height#=rnd(5)/10.0
roundness=rnd(150)+50
fuzziness=rnd(5)
redness#=rnd(155)

create bitmap 2,200,200
set current bitmap 2
cls
for l=1 to bushiness
if rnd(2)=0 then ink rgb(rnd(100)+redness#,rnd(250),rnd(50)),0 else ink 0,0
for d=1 to bushiness
if rnd(5)=0 then dot d,l
next d
next l
get image treeimage,1,1,bushiness,bushiness,1
set current bitmap 0
delete bitmap 2

ob=1
for a#=0.01 to 1.0 step 0.01
make object sphere ob,0.05+a#,10,10
scale object ob,100-roundness#/2.0,roundness*a#,100-roundness#/2.0
f#=rnd(fuzziness)/10.0
polarity=polarity*-1
position object ob,50+(f#*polarity),get ground height(1,50,50)+1.2-(a#/droopiness#)+height#,50+(f#*polarity)
set object transparency ob,5
texture object ob,treeimage
inc ob
next a#


make object cone 1000,1
ghost object on 1000
scale object 1000,10,200+height#,10
position object 1000,50,get ground height(1,50,50)+height#,50
color object 1000,rgb(200,100,80)

for n#=1.0 to 100.0
xrotate object n#,n#/50.0
next n#

endfunction

function delete_tree

delete object 1000
for object=1 to 100
delete object object
next object

endfunction

#constant C_basicLengthFactor 75.0

#constant C_basicSizeFactor 15.0

#constant C_BranchRadiusDecline 0.55
#constant C_BranchLengthDecline 0.70

#constant C_maxDownAngle 135

#constant C_branchMinAngle 30.0
#constant C_branchRndAngle 10.0

#constant C_trunkMinAngle 5.0
#constant C_trunkRndAngle 5.5

#constant C_textureDeScale 5.0

#constant C_BranchesPerLayer 3
#constant C_NumberOfLayers 5

#constant C_NumberOfLeaves 2

#constant C_XuprightOffset 270

#constant C_BarkTextureStart 1
#constant C_BarkTextureEnd 5
#constant C_LeafTextureStart 6
#constant C_LeafTextureEnd 10
#constant C_GroundTexture 100
#constant C_RainTexture 200


type XYZfloat
   x as float
   y as float
   z as float
endtype

gosub setupEnvironment

do
   text 10,10,"Screen FPS: " + str$(screen FPS())
   text 10,30,"Polygons on Screen: " + str$(Statistic(1))
   text 10,50,"Hold [Shift] and move mouse to turn, RMB goes forward, LMB goes backward"
   text 10,70,"Press [Space] to generate a new tree..."
   MouseControl(2)

   `update rain
   updateRain()


   if spacekey() = 1
      repeat
         text 10,10,"Screen FPS: " + str$(screen FPS())
         text 10,30,"Polygons on Screen: " + str$(Statistic(1))
         text 10,50,"Hold [Shift] and move mouse to turn, RMB goes forward, LMB goes backward"
         center text screen width()/2,70,"...Release [Space] to generate a new tree..."
         MouseControl(2)
         sync
         until spacekey() = 0

      if limbedTreeObj <> 0
         if object exist(limbedTreeObj) = 1 then delete object limbedTreeObj
      endif

      text screen width()-text width("...Constructing New Tree   "),70, "...Constructing New Tree   "
      sync

      limbedTreeObj = CreateLimbedTree(XYZstartPos, XYZstartDir, C_BranchesPerLayer, C_NumberOfLayers, C_basicLengthFactor, C_basicSizeFactor)

      pause("...New Tree Created, Press [space] to resume...")
   endif

   sync
loop

setupEnvironment:

sync on
sync rate 0
autocam off
set display mode 800,600,32
position camera 200,200,200
point camera 0,100,0
randomize timer()
`randomize 1

text 0,0,"Generating Bark Texture..."
sync
sync
for n = C_BarkTextureStart to C_BarkTextureEnd
   BarkTexture(n)
next n

cls rgb(0,0,0)
ink rgb(255,255,255),0
text 0,0,"Generating Leaf Textures..."
sync
sync
for n = C_LeafTextureStart to C_LeafTextureEnd
   LeafTexture(n)
next n

GroundTexture(C_GroundTexture)


global XYZfReturn as XYZfloat
global XYZstartDir as XYZfloat
global XYZstartPos as XYZfloat
global rainObj as integer

global limbedTreeObj as integer

XYZstartDir.x = 0
XYZstartDir.y = 0
XYZstartDir.z = 0

XYZstartPos.x = 0
XYZstartPos.y = 0
XYZstartPos.z = 0

make matrix 1, 5000, 5000, 35, 35
position matrix 1,-2500,0,-2500
set matrix wireframe on 1
prepare matrix texture 1, C_GroundTexture, 1, 1
fill matrix 1, 0, 1
randomize matrix 1,30
update matrix 1

ink rgb(255,255,255),0

fog on
fog color RGB(189,193,196)
fog distance 1000
color backdrop RGB(189,193,196)

limbedTreeObj = CreateLimbedTree(XYZstartPos, XYZstartDir, C_BranchesPerLayer, C_NumberOfLayers, C_basicLengthFactor, C_basicSizeFactor)

make light 1
set point light 1, -100, 100, -100

rainSpout()

ink rgb(150,150,150),0

return

function rainSpout()
   RainTexture(C_RainTexture)
   rainObj = FreeObject()

   `MemblockTCone(rainObj, 20, 50, 30, 800)
   `MemblockTCone(rainObj+1,20,75, 45, 800)

   make object cylinder rainObj, 100 : scale object rainObj,200,800,200
   make object cylinder rainObj+1, 100 : scale object rainObj+1,400,800,400


   texture object rainObj, C_RainTexture
   texture object rainObj+1, C_RainTexture

   set object transparency rainObj, 0
   set object transparency rainObj+1, 0

   ghost object on rainObj
   ghost object on rainObj+1

   set object cull rainObj, 0
   set object cull rainObj+1, 0

   disable object zwrite rainObj
   disable object zwrite rainObj+1

   set object light rainObj, 0
   set object light rainObj+1, 0
endfunction

function updateRain()
   position object rainObj, camera position x(), 0, camera position z()
   position object rainObj+1, camera position x(), 0, camera position z()
   `position object rainObj, 0, 400, 0
   `position object rainObj+1, 0, 400, 0

   scroll object texture rainObj,0.0001,-0.005
   scroll object texture rainObj+1,-0.0001,-0.005

endfunction




function CreateLimbedTree(pos as XYZfloat, direction as XYZfloat, BPL as integer, numLayers as integer, length as float, width as float)

   local treeobj as integer
   treeobj = FreeObject()

   make object box treeobj, 0, 0, 0



   DrawLimbedTree(numLayers, BPL, treeobj, 0, direction, pos, length, width)
   `DrawLimbedTree(6, BPL, treeobj, 0, direction, pos, length, width)

   set object transparency treeobj,1

endfunction treeobj

function DrawLimbedTree(n as integer,BPL as integer, obj as integer, limb as integer, direction as XYZfloat, pos as XYZfloat, length as float, width as float)
   local RndBchDir as XYZfloat
   local RndBchPos as XYZfloat
   if n > 0
      limb = DrawLimbedTrunk(n, obj, limb, pos, direction, length, width)

      `sync
      `pause("Created a Trunk")

      if n > 1
         rem trunk stem
         RandomLimbedBranchDirection(C_trunkRndAngle, C_trunkMinAngle) : RndBchDir = XYZfReturn
          NewLimbedTrunkPos(length) : RndBchPos = XYZfReturn

         `pause("Stem")
         DrawLimbedTree(n-1,BPL,obj,limb,RndBchDir,RndBchPos,LengthDeScale(n,length), SizeDeScale(n,width))

         rem branches ahoy!!!
         for i = 1 to BPL
            RandomLimbedBranchDirection(C_branchRndAngle, C_branchMinAngle) : RndBchDir = XYZfReturn
            RandomLimbedBranchPosition(length) : RndBchPos = XYZfReturn

            `pause("Branches")
            DrawLimbedTree(n-1,BPL,obj,limb,RndBchDir,RndBchPos,LengthDeScale(n,length), SizeDeScale(n,width))

         next i
      endif

   endif

   rem draw leaves...
   if n <= 1 and C_NumberOfLeaves > 0
      for i = 1 to C_NumberOfLeaves
         RndBchPos.x = 0
         RndBchPos.y = (i-1.0)*1.0*(length*0.666666 / (C_NumberOfLeaves*1.0)) + (length*0.3)
         RndBchpos.z = 0

         RndBchDir.x = -10 + rnd(20)
         RndBchDir.y = -20 + rnd(40)
         RndBchDir.z = 0

         DrawLimbedLeaf(obj, limb, RndBchPos, RndBchDir, 6, 3)

         RndBchDir.x = -10 + rnd(20)
         RndBchDir.y = 160 + rnd(40)

         DrawLimbedLeaf(obj, limb, RndBchPos, RndBchDir, 6, 3)
      next i

      RndBchDir.x = rnd(360)
      RndBchDir.y = 0
      RndBchDir.z = 90
      RndBchPos.y = length - length * 0.125

      DrawLimbedLeaf(obj, limb, RndBchPos, RndBchDir, 6, 3)
   endif

endfunction

function DrawLimbedTrunk(n, obj, limb, pos as XYZfloat, direction as XYZfloat, length as float, width as float)
   local meshNum as integer
   local newLimb as integer
   meshNum = FreeMesh()
   newLimb = FreeLimb(obj)

   `clone object objnum, baseTrunkObj
   if n <= 1
      MemblockMeshCone(meshNum, n+4, width, length)
      `MemblockMeshTCone(meshNum, n+4, C_BranchRadiusDecline * width, width, length)

   else
      MemblockMeshTCone(meshNum, n+4, C_BranchRadiusDecline * width, width, length)
   endif

   add limb obj, newLimb, meshNum
   link limb obj, limb, newLimb

   rotate limb obj, newLimb, direction.x, direction.y, direction.z
   offset limb obj, newLimb, pos.x, pos.y, pos.z

   texture limb obj, newLimb, C_BarkTextureStart + rnd(C_BarkTextureEnd-C_BarkTextureStart)
   `scale limb texture obj, newLimb, width/C_textureDeScale, width/C_textureDeScale
endfunction newLimb

function DrawLimbedLeaf(obj, limb, pos as XYZfloat, direction as XYZfloat, length as float, width as float)

   local meshNum as integer
   local newLimb as integer
   meshNum = FreeMesh()
   newLimb = FreeLimb(obj)

   `clone object objnum, baseTrunkObj
   MemblockMeshPlain(meshNum, width, length)

   add limb obj, newLimb, meshNum
   link limb obj, limb, newLimb

   rotate limb obj, newLimb, direction.x, direction.y, direction.z
   offset limb obj, newLimb, pos.x, pos.y, pos.z

   texture limb obj, newLimb, C_LeafTextureStart+rnd(C_LeafTextureEnd - C_LeafTextureStart)
endfunction

function RandomLimbedBranchDirection(randomAngle as float, minAngle as float)
   XYZfReturn.x = minAngle + rnd(randomAngle)
   XYZfReturn.y = rnd(360)
   XYZfReturn.z = 0
endfunction

function NewLimbedTrunkPos(length as float)
   XYZfReturn.x = 0
   XYZfReturn.y = length - length/40.0
   XYZfReturn.z = 0
endfunction

function RandomLimbedBranchPosition(length as float)
   XYZfReturn.x = 0
   XYZfReturn.y = length/2.0 + rnd(length/3.0)
   XYZfReturn.z = 0
endfunction

function SizeDeScale(n as integer, size as float)
   rem more work, for n anyways...
   local rtrn as float
   rtrn = size*C_BranchRadiusDecline
endfunction rtrn

function LengthDeScale(n as integer, size as float)
   local rtrn as float
   rtrn = size*C_BranchLengthDecline
endfunction rtrn

function BarkTexture(imgNum as integer)
   local xSize as integer
   local ySize as integer

   local tmpXa as integer
   local tmpYa as integer
   local tmpXb as integer
   local tmpYb as integer

   local extream as integer

   xSize = 255
   ySize = 255

   cls rgb(120,90,70)
   for n = 1 to (xSize+ySize)*50
      extream = -60 + rnd(100)
      ink rgb(110+rnd(20)+extream,80+rnd(20)+extream,60+rnd(20)+extream),0
      circle rnd(xSize), rnd(ySize),3
   next n

   for n = 1 to (xSize+ySize)*3
      extream = -60 + rnd(100)
      ink rgb(110+rnd(20)+extream,80+rnd(20)+extream,60+rnd(20)+extream),0
      tmpXa = rnd(xSize)
      tmpYa = rnd(ySize - ySize/3)
      tmpXb = tmpXa-3+rnd(6)
         if tmpXb < 0 then tmpXb = 0
         if tmpXb > xSize then tmpXb = xSize
      tmpYb = tmpYa + rnd(ySize/2)
         if tmpYb > ySize then tmpYb = ySize

      line tmpXa, tmpYa, tmpXb, tmpYb

      extream = -60 + rnd(100)
      ink rgb(110+rnd(20)+extream,80+rnd(20)+extream,60+rnd(20)+extream),0
      tmpXa = rnd(10)
      for x = 1 to 5
         circle rnd(xSize), rnd(ySize),5+tmpXa+x
      next x
   next n

   blur bitmap 0,2

   get image imgNum,xSize/4,ySize/4,(xSize*3)/4,(ySize*3)/4,0
endfunction

function LeafTexture(imgNum as integer)
   cls rgb(0,0,0)

   local xSize as integer
   local ySize as integer
   local fractQty as integer

   local tmpXa as integer
   local tmpYa as integer
   local tmpXb as integer
   local tmpYb as integer

   local color as dword
   local extream as integer

   xSize = 100
   ySize = 200
   fractQty = 100

   ink rgb(rnd(40),150+rnd(40)+extream,rnd(40)),0
   for n = 0 to ySize*2
      tmpXb = (sin(180.0*n*1.0/ySize*2.0)+1.0)*xSize/2.0
      tmpXa = (sin(180.0*n*1.0/ySize*2.0+180)+1.0)*xSize/2.0
      tmpYa = (cos(180.0*n*1.0/ySize*2.0)+1.0)*(ySize)/2.0
      tmpYb = (cos(180.0*(n+1)*1.0/ySize*2.0)+1.0)*(ySize)/2.0
      box tmpXb, tmpYa, tmpXa, tmpYb
   next n

   for n = 1 to fractQty
      tmpXa = xSize/2
      tmpYa = ySize-(abs(n-fractQty/2)/(fractQty/2.0))*ySize*0.7

      tmpXb = (sin(360.0*n*1.0/fractQty*1.0 + 180)+1.0)*xSize/2.0
      tmpYb = (cos(360.0*n*1.0/fractQty*1.0 + 180)+1.0)*(ySize)/2.0

      extream = -50 + rnd(100)
      color = rgb(rnd(40),100+rnd(40)+extream,rnd(40))
      fracture(tmpXa,tmpYa,tmpXb,tmpYb, 50, 7, color)
   next n

   get image imgNum,0,0,xSize,ySize,0

endfunction


function GroundTexture(imgNum as integer)
   local xSize as integer
   local ySize as integer

   local tmpXa as integer
   local tmpYa as integer
   local tmpXb as integer
   local tmpYb as integer

   local extream as integer

   xSize = 255
   ySize = 255

   cls rgb(120,90,70)
   for n = 1 to (xSize+ySize)*50
      extream = -60 + rnd(100)
      ink rgb(110+rnd(20)+extream,80+rnd(20)+extream,60+rnd(20)+extream),0
      circle rnd(xSize), rnd(ySize),3
   next n

   for n = 1 to (xSize+ySize)*3
      extream = -60 + rnd(100)
      ink rgb(110+rnd(20)+extream,80+rnd(20)+extream,60+rnd(20)+extream),0
      tmpXa = rnd(xSize)
      tmpYa = rnd(ySize)
      tmpXb = rnd(xSize)
      tmpYb = rnd(ySize)

      line tmpXa, tmpYa, tmpXb, tmpYb

      extream = -60 + rnd(100)
      ink rgb(110+rnd(20)+extream,80+rnd(20)+extream,60+rnd(20)+extream),0
      tmpXa = rnd(10)
      for x = 1 to 5
         circle rnd(xSize), rnd(ySize),5+tmpXa+x
      next x
   next n

   blur bitmap 0,2

   get image imgNum,xSize/4,ySize/4,(xSize*3)/4,(ySize*3)/4,0
endfunction


function RainTexture(imgNum as integer)
   local xSize as integer
   local ySize as integer

   local tmpXa as integer
   local tmpYa as integer
   local tmpXb as integer
   local tmpYb as integer

   local extream as integer

   cls rgb(0,0,0)

   xSize = 1200
   ySize = 1200

   create bitmap 1, xSize, ySize
   set current bitmap 1

   cls rgb(0,0,0)

   for n = 1 to (xSize)*4
      extream = -120 + rnd(40)
      ink rgb(200+rnd(10)+extream,200+rnd(10)+extream,210+rnd(10)+extream),0
      tmpXa = rnd(xSize)
      tmpYa = rnd(ySize - 20)
      tmpXb = tmpXa-3+rnd(6)
         if tmpXb < 0 then tmpXb = 0
         if tmpXb > xSize then tmpXb = xSize
      tmpYb = tmpYa + rnd(10) + 10
         if tmpYb > ySize then tmpYb = ySize

      line tmpXa, tmpYa, tmpXb, tmpYb
   next n


   get image imgNum,0,0,xSize,ySize,0

   delete bitmap 1
   set current bitmap 0
endfunction



function MemblockTCone(object as integer, density as integer, topSize as float, btmSize as float, height as float)
   local tmpmesh as integer
   tmpmesh = FreeMesh()

   MemblockMeshTCone(tmpmesh, density, topSize, btmSize, height)

   make object object, tmpmesh, 1
   delete mesh tmpmesh
endfunction

function MemblockCone(object as integer, density as integer, size as float, height as float)
   local tmpmesh as integer
   tmpmesh = FreeMesh()

   MemblockMeshCone(tmpmesh, density, size, height)

   make object object, tmpmesh, 1
   delete mesh tmpmesh
endfunction

function MemblockMeshTCone(mesh as integer, density as integer, topSize as float, btmSize as float, height as float)
   local memblock as integer
   local vertexCount as integer
   local offset as integer

   memblock = FreeMemblock()

   make memblock memblock, 12 + (32 * density * 6)

   write memblock dword memblock, 0, 275
   write memblock dword memblock, 4, 32
   write memblock dword memblock, 8, density * 6
   offset = 12

   for i = 1 to density

      `write poly one and two-------------------------------------
         writeVertex275(memblock, offset    , sin((i-1.0)*360.0/density)*topSize/2.0, height, cos((i-1.0)*360.0/density)*topSize/2.0,   cos((i-1.0)*360.0/density*1.0), 0, sin((i-1.0)*360.0/density), (i-1.0)/density, 0.0)
         writeVertex275(memblock, offset+32 , sin((i-1.0)*360.0/density)*btmSize/2.0,      0, cos((i-1.0)*360.0/density)*btmSize/2.0,   cos((i-1.0)*360.0/density*1.0), 0, sin((i-1.0)*360.0/density), (i-1.0)/density, 1.0)
         writeVertex275(memblock, offset+64 , sin((i*1.0)*360.0/density)*topSize/2.0, height, cos((i*1.0)*360.0/density)*topSize/2.0,   cos((i*1.0)*360.0/density*1.0), 0, sin((i*1.0)*360.0/density), (i*1.0)/density, 0.0)

         writeVertex275(memblock, offset+96 , sin((i-1.0)*360.0/density)*btmSize/2.0,      0, cos((i-1.0)*360.0/density)*btmSize/2.0,   cos((i-1.0)*360.0/density*1.0), 0, sin((i-1.0)*360.0/density), (i-1.0)/density, 1.0)
         writeVertex275(memblock, offset+128, sin((i*1.0)*360.0/density)*btmSize/2.0,      0, cos((i*1.0)*360.0/density)*btmSize/2.0,   cos((i*1.0)*360.0/density*1.0), 0, sin((i*1.0)*360.0/density), (i*1.0)/density, 1.0)
         writeVertex275(memblock, offset+160, sin((i*1.0)*360.0/density)*topSize/2.0, height, cos((i*1.0)*360.0/density)*topSize/2.0,   cos((i*1.0)*360.0/density*1.0), 0, sin((i*1.0)*360.0/density), (i*1.0)/density, 0.0)
         inc offset, 192
   next i

   make mesh from memblock mesh, memblock

   delete memblock memblock
endfunction

function MemblockMeshCone(mesh as integer, density as integer, size as float, height as float)
   local memblock as integer
   local vertexCount as integer
   local offset as integer

   memblock = FreeMemblock()

   make memblock memblock, 12 + (32 * density * 3)

   write memblock dword memblock, 0, 275
   write memblock dword memblock, 4, 32
   write memblock dword memblock, 8, density * 3
   offset = 12

   for i = 1 to density

      `write poly one-------------------------------------
         writeVertex275(memblock, offset   , sin((i-1.0)*360.0/density)*size/2.0,      0, cos((i-1.0)*360.0/density)*size/2.0,   cos((i-1.0)*360.0/density*1.0), 0, sin((i-1.0)*360.0/density), (i-1.0)/density    , 1.0)
         writeVertex275(memblock, offset+32, sin((i*1.0)*360.0/density)*size/2.0,      0, cos((i*1.0)*360.0/density)*size/2.0,   cos((i*1.0)*360.0/density*1.0), 0, sin((i*1.0)*360.0/density), (i*1.0)/density    , 1.0)
         writeVertex275(memblock, offset+64, 0                                  , height, 0                                  ,   cos((i*1.0)*360.0/density*1.0), 0, sin((i*1.0)*360.0/density), (i-1.0)/(density-1), 0.0)
         inc offset, 96
   next i

   make mesh from memblock mesh, memblock

   delete memblock memblock
endfunction

function MemblockMeshPlain(mesh as integer, width as float, height as float)
   local memblock as integer
   local vertexCount as integer
   local offset as integer

   memblock = FreeMemblock()

   make memblock memblock, 12 + (32 * 4 * 3)

   write memblock dword memblock, 0, 275
   write memblock dword memblock, 4, 32
   write memblock dword memblock, 8, 12
   offset = 12

      `write poly one and two  and invert-------------------------------------
         writeVertex275(memblock, offset    , 0     , 0, width/-2.0, 0,  1, 0, 0.0, 1.0)
         writeVertex275(memblock, offset+32 , 0     , 0, width/2.0 , 0,  1, 0, 1.0, 1.0)
         writeVertex275(memblock, offset+64 , height, 0, width/-2.0, 0,  1, 0, 0.0, 0.0)

         inc offset, 96

         writeVertex275(memblock, offset    , 0     , 0, width/2.0 , 0,  1, 0, 1.0, 1.0)
         writeVertex275(memblock, offset+32 , height, 0, width/2.0,  0,  1, 0, 1.0, 0.0)
         writeVertex275(memblock, offset+64 , height, 0, width/-2.0, 0,  1, 0, 0.0, 0.0)

         inc offset, 96

         writeVertex275(memblock, offset    , 0     , 0, width/2.0 , 0, -1, 0, 1.0, 1.0)
         writeVertex275(memblock, offset+32 , 0     , 0, width/-2.0, 0, -1, 0, 0.0, 1.0)
         writeVertex275(memblock, offset+64 , height, 0, width/-2.0, 0, -1, 0, 0.0, 0.0)

         inc offset, 96

         writeVertex275(memblock, offset    , height, 0, width/2.0,  0, -1, 0, 1.0, 0.0)
         writeVertex275(memblock, offset+32 , 0     , 0, width/2.0 , 0, -1, 0, 1.0, 1.0)
         writeVertex275(memblock, offset+64 , height, 0, width/-2.0, 0, -1, 0, 0.0, 0.0)

   make mesh from memblock mesh, memblock

   delete memblock memblock
endfunction


function writeVertex275(memblock, offset, x#, y#, z#,  nx#, ny#, nz#,  u#, v#)
      write memblock float memblock, offset + 0, x#
      write memblock float memblock, offset + 4, y#
      write memblock float memblock, offset + 8, z#

      `write normal data
      write memblock float memblock, offset + 12, nx#
      write memblock float memblock, offset + 16, ny#
      write memblock float memblock, offset + 20, nz#

      `write UV information
      write memblock float memblock, offset + 24, u#
      write memblock float memblock, offset + 28, v#
endfunction

`an electric function pulled from one of my 20 liners that never went...

function fracture(startx, starty, endx, endy, devdegree, points, color)
   rem this scales the number of points acording to the distance traversed
   `test# = (2D_Distance(startx, starty, endx, endy)*density) / 2D_Distance(0, 0, screen width(), screen height())
   dim lines(points,1)
   #constant xposition=0
   #constant yposition=1
   lines(0,xposition) = startx
   lines(0,yposition) = starty
   alpha = 0
   distance = 0
   angle = 0
   for n = 1 to points
      angle = rnd(devdegree) - int(devdegree/2)
      if n = points - 1
         angle = 0
      endif
      distance = sqrt((startx - endx)*(startx - endx) + (starty - endy)*(starty - endy)) / (points - n)
      alpha = atanfull((endy - starty),(endx - startx))
      lines(n,xposition) = distance * cos(alpha + angle) + startx
      lines(n,yposition) = distance * sin(alpha + angle) + starty
      startx = lines(n,xposition)
      starty = lines(n,yposition)
   next n
   ink color,0
   for n = 1 to points
      line lines(n-1,xposition),lines(n-1,yposition),lines(n,xposition),lines(n,yposition)
   next n
endfunction

`pauses untill the space key is pressed
function pause(prompt as string)

   repeat
      center text screen width()/2, 15, prompt
      MouseControl(0.5)
      sync
      until spacekey() = 1

   repeat
      center text screen width()/2, 15, prompt
      MouseControl(0.5)
      sync
      until spacekey() = 0
endfunction

function MouseControl(Speed as float)
   if shiftkey() = 1

      xrotate camera camera angle x()+mousemovey()/3.0
      yrotate camera camera angle y()+mousemovex()/6.0
      if mouseclick()=1 then move camera Speed
      if mouseclick()=2 then move camera (0-Speed)

   endif

   r=mousemovex()
   r=mousemovey()

endfunction

`hides and or deletes objects
function ClearObjects(maxSearch as integer)
   for i = 1 to maxSearch
      `if object exist(i) = 1 then delete object i
      if object exist(i) = 1 then hide object i
   next i
endfunction

function FreeObject()
   repeat
      inc i
      if object exist(i)=0 then found=1
   until found
endfunction i

function FreeImage()
   repeat
      inc i
      if image exist(i)=0 then found=1
   until found
endfunction i

function FreeLimb(objNum)
   repeat
      inc i
      if limb exist(objNum,i)=0 then found=1
   until found
endfunction i

function FreeMemblock()
   repeat
      inc i
      if memblock exist(i)=0 then found=1
   until found
endfunction i

function FreeMesh()
   repeat
      inc i
      if mesh exist(i)=0 then found=1
   until found
endfunction i

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

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()
global theta#
global treeimage
sync
create_tree()



do
if spacekey()=1 then delete_tree():create_tree()
move_camera()
move_water()
for n#=1.0 to 100.0
scroll object texture n#,((n#/5.0)*sin(theta#))*0.0001,((n#/3.0)*sin(theta#))*0.00005

inc theta#,0.01
next n#
ink rgb(255,255,255),0
text 0,0,"Press Spacebar to regenerate"
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

`set camera position to ground level
position camera 5*sin(theta#/4.0)+(matrixsize/2.0),get ground height(1,camera position x(),camera position z())+1,3*cos(theta#/4.0)+(matrixsize/2.0)
point camera (matrixsize/2.0),get ground height(1,(matrixsize/2.0),(matrixsize/2.0)),(matrixsize/2.0)

endfunction

function create_tree

treeimage=check_free_image_number()
bushiness=rnd(380)+20
droopiness#=(rnd(20)/10.0)+0.5
height#=rnd(5)/10.0
roundness=rnd(150)+50
fuzziness=rnd(2)
redness#=rnd(155)
density=rnd(6)+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,1,1,bushiness,bushiness,1
set current bitmap 0
delete bitmap 2

ob=1
polarity=1
for a#=0.01 to 1.0 step 0.01
make object sphere ob,0.05+a#,10,10
scale object ob,100-roundness#/2.0,roundness*a#,100-roundness#/2.0
f#=rnd(fuzziness)/10.0
polarity=polarity*-1
position object ob,50+(f#*polarity),get ground height(1,50,50)+1.2-(a#/(droopiness#/0.5))+height#,50+(f#*polarity)
set object transparency ob,5
texture object ob,treeimage
inc ob
next a#


make object cone 1000,1
ghost object on 1000
scale object 1000,10,200+height#,10
position object 1000,50,get ground height(1,50,50)+height#,50
color object 1000,rgb(200,100,80)

for n#=1.0 to 100.0
xrotate object n#,n#/50.0
next n#

endfunction

function delete_tree

delete object 1000
for object=1 to 100
delete object object
next object

endfunction

Sync On: Sync rate 60:Autocam Off
Color Backdrop 0,0
Ink 0,0
Box 0,0,255,255
Ink Rgb(0,255,0),0
For i=1 to 3000
   x=Rnd(127)*2
   y=Rnd(127)*2
   Box x,y,x+1,y+1
Next i
Get Image 1,0,0,255,255,1

For i = 1 to 10
   s#=i
   Make Object Plain i,200-s#*.01,200-s#*.01
   Texture Object i,1
   Set Object i,1,1,0
   Set Object transparency i,3
   Set Object Emissive i,Rgb(0,100,0)
   `Set Object Smoothing i,100
   Pitch Object Down i,90
   y#=i
   y#=y#*.1-20.0
   Position Object i,0,y#,50
Next i

Do
   Control Camera Using Arrowkeys 0,.2,.5
   Gosub Windy
   Sync
Loop
End

Windy:
wx#=wx#+rnd(200.0)/100000.0-rnd(200.0)/100000.0
wz#=wz#+rnd(200.0)/100000.0-rnd(200.0)/100000.0
If wx#>.005 then wx#=.005
If wx#<-.005 then wx#=-.005
If wz#>.005 then wz#=.005
If wz#<-.005 then wz#=-.005
Offsetx# = Offsetx# + wx#
If Offsetx#>1 Then Offsetx#=1
If Offsetx#<-1 Then Offsetx#=-1
Offsetz# = Offsetz# + wz#
If Offsetz#>1 Then Offsetz#=1
If Offsetz#<-1 Then Offsetz#=-1
For i# = 1.0 to 10.0
   x#=(OffsetX#*(i#/10.0))
   z#=(OffsetZ#*(i#/10.0))
   Position Object i#,x#,i#*.3-20.0,50.0+z#
Next i#
Return

Sync On: Sync rate 60:Autocam Off
Color Backdrop 0,0
Create Bitmap 1,1024,1024
Ink 0,0
Box 0,0,1024,1024
For i=1 to 5000
   x=Rnd(1024)
   y=Rnd(1024)
   Ink rgb(0,150,0),0
   Box x-1,y-1,x+1,y+1
   Ink Rgb(0,255,0),0
   Dot x,y
Next i
Get Image 1,0,0,1023,1023,1
Set Current Bitmap 0
Delete Bitmap 1

Make Object Triangle 101,0,0,0,0,.1,0,0,0,0

For i = 1 to 50
   s#=i
   Make Object Plain i,100-s#*.01,100-s#*.01
   Texture Object i,1
   Set Object i,1,1,0
   Set Object Transparency i,3
   Set Alpha Mapping on i,102-i*2
   Set Object Emissive i,Rgb(0,255,0)
   `Set Object Smoothing i,100
   Pitch Object Down i,90
   y#=i
   y#=y#*.05-20.0
   Position Object i,0,y#,50
Next i
Ink Rgb(60,100,0),0
Box 0,0,128,128
For i = 1 to 500
   Ink Rgb(Rnd(50)+20,Rnd(50)+50,0),0
   Dot rnd(128),rnd(128)
Next i
Get Image 2,0,0,127,127,1


Make object Plain 51,100,100
Texture Object 51,2
Set Object Emissive 51,Rgb(0,0,0)
Pitch Object Down 51,90
Position Object 51,0,-20,50

Do
   Control Camera Using Arrowkeys 0,1,3
   Gosub Windy
   Sync
Loop
End

Windy:
wx#=wx#+rnd(200.0)/100000.0-rnd(200.0)/100000.0
wz#=wz#+rnd(200.0)/100000.0-rnd(200.0)/100000.0
If wx#>.005 then wx#=.005
If wx#<-.005 then wx#=-.005
If wz#>.005 then wz#=.005
If wz#<-.005 then wz#=-.005
Offsetx# = Offsetx# + wx#
If Offsetx#>1 Then Offsetx#=1
If Offsetx#<-1 Then Offsetx#=-1
Offsetz# = Offsetz# + wz#
If Offsetz#>1 Then Offsetz#=1
If Offsetz#<-1 Then Offsetz#=-1
Position Object 101,Object Position X(1),Object Position Y(1),Object Position Z(1)
Point Object 101,Offsetx#,3.0-20.0,50.0+Offsetz#
For i# = 1.0 to 50.0
   Position Object i#,Object Position X(101),Object Position Y(101),Object Position Z(101)
   Move object 101,.05
Next i#
Return

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

function RainTexture(imgNum as integer)
	local xSize as integer
	local ySize as integer
	
	local tmpXa as integer
	local tmpYa as integer
	local tmpXb as integer
	local tmpYb as integer
	
	local extream as integer
	
	cls rgb(0,0,0)
	
	xSize = 1200
	ySize = 1200
	
	create bitmap 1, xSize, ySize
	set current bitmap 1
	
	cls rgb(0,0,0)
	
	for n = 1 to (xSize)*4
		extream = -140 + rnd(40)
		ink rgb(200+rnd(10)+extream,200+rnd(10)+extream,210+rnd(10)+extream),0
		tmpXa = rnd(xSize)
		tmpYa = rnd(ySize - 20)
		tmpXb = tmpXa-3+rnd(6)
			if tmpXb < 0 then tmpXb = 0
			if tmpXb > xSize then tmpXb = xSize
		tmpYb = tmpYa + rnd(10) + 10
			if tmpYb > ySize then tmpYb = ySize
			
		line tmpXa, tmpYa, tmpXb, tmpYb
	next n
	
	
	get image imgNum,0,0,xSize,ySize,0
	
	delete bitmap 1
	set current bitmap 0
endfunction

function rainSpout()
	RainTexture(C_RainTexture)
	rainObj = FreeObject()
	
	`MemblockTCone(rainObj, 20, 50, 30, 800)
	`MemblockTCone(rainObj+1,20,75, 45, 800)
	
	make object cylinder rainObj, 100 : scale object rainObj,200,800,200
	make object cylinder rainObj+1, 100 : scale object rainObj+1,400,800,400
	
	
	texture object rainObj, C_RainTexture
	texture object rainObj+1, C_RainTexture
	
	set object transparency rainObj, 0
	set object transparency rainObj+1, 0
	
	ghost object on rainObj
	ghost object on rainObj+1
	
	set object cull rainObj, 0
	set object cull rainObj+1, 0
	
	disable object zwrite rainObj
	disable object zwrite rainObj+1
	
	set object light rainObj, 0
	set object light rainObj+1, 0
	
	scale object texture rainObj  , 3.0, 1.0
	scale object texture rainObj+1, 6.0, 1.0
endfunction