Sorry your browser is not supported!

REM Project: Waterfall
REM Created: 20/05/2008 11:34:54
REM
REM ***** Main Source File *****
REM programed by Penfold AKA Argmentum

`declare variables
global matrixheights

sync on
sync rate 60

`put everything in place
MakeMatrix()
MakeWater()
SkySphere()
MakeLight()
`create objects, all follow rules (objnum,x,y,z,size)
`create trees nums 300-399
`temp tree texture
   create bitmap 3, 100,100
   for i=1 to 100
      for t=1 to 100
         color=rnd(255)
         ink rgb(0,color,0),0
         box i-1,t-1,i+1,t+1
      next t
   next i
   get image 3,0,0,100,100
   set current bitmap 0
`left lower bank
MakeTree(300,350,0,50,80)
MakeTree(301,350,0,140,60)
MakeTree(302,390,0,60,80)
MakeTree(303,390,0,100,60)
MakeTree(304,390,0,120,80)
MakeTree(305,450,0,80,50)
MakeTree(306,600,0,80,80)
MakeTree(307,620,0,160,80)
MakeTree(308,630,0,100,50)
MakeTree(309,900,0,80,70)
MakeTree(310,930,0,130,100)
`right lower bank
MakeTree(311,390,0,950,100)
MakeTree(312,420,0,900,80)
MakeTree(313,440,0,970,80)
MakeTree(314,540,0,930,50)
MakeTree(315,550,0,990,80)
MakeTree(316,800,0,900,70)
MakeTree(317,820,0,950,80)
MakeTree(318,950,0,980,80)
MakeTree(319,900,0,800,70)
MakeTree(320,940,0,840,40)
MakeTree(321,980,0,800,80)
MakeTree(322,980,0,900,60)

`create rocks nums 200-299
MakeRock(200,900,0,300,40)
`create bushs nums 400-499
MakeBush(400,800,0,100,20)

`particles
`water flow texture
create bitmap 1, 15,15
   for i=1 to 15
      for t=1 to 15
         color=rnd(5)
         ink rgb(color,color,color),0
         box i-1,t-1,i+1,t+1
      next t
   next i
   get image 5,0,0,15,15
   cls
   set current bitmap 0
`water mist coming back up1
make particles 1,5,30,30
position particles 1,320,5,460
SET PARTICLE VELOCITY 1,5
SET PARTICLE GRAVITY 1,1
SET PARTICLE LIFE 1,50

`water mist coming back up2
make particles 2,5,30,30
position particles 2,320,5,500
SET PARTICLE VELOCITY 2,5
SET PARTICLE GRAVITY 2,1
SET PARTICLE LIFE 2,50

`water mist coming back up3
make particles 3,5,30,30
position particles 3,320,5,540
SET PARTICLE VELOCITY 3,5
SET PARTICLE GRAVITY 3,1
SET PARTICLE LIFE 3,50

`water mist coming back up4 -high mist power
make particles 4,5,300,100
position particles 4,320,5,500
SET PARTICLE VELOCITY 4,20
SET PARTICLE GRAVITY 4,3
SET PARTICLE LIFE 4,50

`waterfall emiter1
make particles 10,5,300,500
position particles 10,300,240,460
SET PARTICLE VELOCITY 10,20
SET PARTICLE GRAVITY 10,3
SET PARTICLE LIFE 10,20
ROTATE PARTICLES 10,0,90,190

`waterfall emiter2
make particles 11,5,300,500
position particles 11,300,240,480
SET PARTICLE VELOCITY 11,20
SET PARTICLE GRAVITY 11,3
SET PARTICLE LIFE 11,20
ROTATE PARTICLES 11,0,90,190

`waterfall emiter3
make particles 12,5,300,500
position particles 12,300,240,500
SET PARTICLE VELOCITY 12,20
SET PARTICLE GRAVITY 12,3
SET PARTICLE LIFE 12,20
ROTATE PARTICLES 12,0,90,190

`waterfall emiter4
make particles 13,5,300,500
position particles 13,300,240,520
SET PARTICLE VELOCITY 13,20
SET PARTICLE GRAVITY 13,3
SET PARTICLE LIFE 13,20
ROTATE PARTICLES 13,0,90,190

`waterfall emiter5
make particles 14,5,300,500
position particles 14,300,240,540
SET PARTICLE VELOCITY 14,20
SET PARTICLE GRAVITY 14,3
SET PARTICLE LIFE 14,20
ROTATE PARTICLES 14,0,90,190



`set up camera
position camera 1300,500,0
point camera  0,500,0,500
ax# = camera angle x() : ay# = camera Angle y()

`reset ink
ink rgb(255,255,255),0

`----------------------------------Main Looop-----------------------------
do

`camera move code
ax# = wrapvalue(ax# + mousemovey())
ay# = wrapvalue(ay# + mousemovex())
rotate camera ax#, ay#, 0.0
if mouseclick()=1 then move camera 1
if mouseclick()=2 then move camera -1

`WaterEffect()
for m=2 to 2
 a#=wrapvalue(a#-1)
 for z=0 to 100
  for x=0 to 100
   x#=cos(a#+(x*80))
   y#=sin(a#+(z*80))
   nx#=0.0-(cos(a#+(x*80))*0.15)
   nz#=0.0-(sin(a#+(z*80))*0.15)
   ny#=1.0-nx#-nz#
   set matrix height m,x,z,(x#+y#)*2.0
   set matrix normal m,x,z,nx#,ny#,nz#
  next x
 next z
 update matrix m
next m

text 0,15,"FPS: "+str$(screen fps())

sync
loop
end

function WaterEffect
rem Control matrix like water

endfunction

Function MakeWater
make matrix 2,1000,1000,100,100
`temp texture
create bitmap 1, 100,100
   for i=1 to 100
      for t=1 to 100
         color=rnd(200)+55
         ink rgb(0,0,color),0
         box i-1,t-1,i+1,t+1
      next t
   next i
   get image 6,0,0,100,100
   set current bitmap 0
   prepare matrix texture 2,6,1,1
   position matrix 2,0,15,0
update matrix 2
`debug to wireframe
`SET MATRIX WIREFRAME ON 2
endfunction

function MakeMatrix
make matrix 1,1000,1000,100,100
`temp texture
create bitmap 1, 100,100
   for i=1 to 100
      for t=1 to 100
         color=rnd(50)+132
         ink rgb(color,color,100),0
         box i-1,t-1,i+1,t+1
      next t
   next i
   get image 1,0,0,100,100
   set current bitmap 0
   prepare matrix texture 1,1,1,1
`read the matrix data
   for i = 0 to 100
      for n= 0 to 100
         Read matrixheights
         set matrix height 1,i,n,matrixheights*5
         set matrix priority 1,0
      next n
   next i

update matrix 1
`debug to wireframe
`SET MATRIX WIREFRAME ON 1
endfunction

function SkySphere
`skysphere
   make object sphere 50,-3000
   position object 50,500,0,500
   `temp sky texture
   create bitmap 1, 100,100
   for i=1 to 100
      for t=1 to 100
         color=rnd(255)
         ink rgb(0,0,color),0
         box i-1,t-1,i+1,t+1
      next t
   next i
   get image 2,0,0,100,100
   set current bitmap 0
   texture object 50,2
endfunction

function MakeLight()
   fog on
   fog color 255,100,100
   fog distance 2000
   set ambient light 20
   make light 1
   color light 1,100,100,100
   position light 1,500,100,500
   make light 2
set point light 2,50,500,50
position light 2, 500,100,500
color light 0,1000,1000,200

endfunction

function MakeTree(objnum,x,y,z,size)
`the tree
make object cone objnum,size
position object objnum, x ,get ground height (1,x,z)+(size/2),z
`add random scale to base x,z
`add tree to array code if time
   texture object objnum,3
`add stumps to large?
endfunction

function MakeRock(objnum,x,y,z,size)
`the rock
make object sphere objnum,size
position object objnum, x ,get ground height (1,x,z)+(size/4),z
`add rock to array code if time
`temp texture
create bitmap 4, 100,100
   for i=1 to 100
      for t=1 to 100
         color=rnd(255)
         ink rgb(color,color,color),0
         box i-1,t-1,i+1,t+1
      next t
   next i
   get image 4,0,0,100,100
   set current bitmap 0
   texture object objnum,4
`add moss to large?
endfunction

function MakeBush(objnum,x,y,z,size)
`the bush
make object sphere objnum,size
position object objnum, x ,get ground height (1,x,z)+(size/2-2),z
`add bush to array code if time
 texture object objnum,3
endfunction


data 60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
data 60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
data 60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
data 60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
data 60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
data 60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
data 60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
data 60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
data 60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
data 60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
`line 11 below
data 60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
data 60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
data 60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
data 60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
data 60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
data 60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
data 60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
data 60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
data 60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
data 60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
`line 21 below
data 60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
data 60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
data 60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
data 60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
data 60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
data 60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
data 59,59,59,59,59,59,59,59,59,59,59,59,59,59,59,59,60,60,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
data 59,59,59,59,59,59,59,59,59,59,59,59,59,59,59,59,60,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
data 58,58,58,58,58,58,58,58,58,58,58,58,58,58,58,58,58,58,60,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
data 58,58,58,58,58,58,58,58,58,58,58,58,58,58,58,58,58,58,58,60,60,60,60,60,60,60,60,50,50,50,50,50,50,50,50,50,50,50,50,50,50,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,50,50,50,50,50,50,50,50,50,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
`line 31 below
data 55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,36,1,1,1,1,1,1,0,1,0,1,1,1,0,1,1,0,1,1,1,0,0,0,1,1,1,0,0,1,1,0,1,1,0,0,0,0,0,0,0,1,1,1,1,0,2,2,2,2,1,0,0,0,1,0,0,0,0,1,1,0,0,0,1,1,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 50,50,50,50,50,50,50,50,50,50,50,50,50,50,50,50,50,50,50,25,1,1,1,1,1,1,1,0,1,0,1,1,1,0,1,1,0,1,1,1,0,0,0,1,1,1,0,0,1,1,0,1,1,0,0,0,0,0,0,0,1,1,1,1,0,2,2,2,2,1,0,0,0,1,0,0,0,0,1,1,0,0,0,1,1,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,12,1,1,1,1,1,1,1,0,1,0,1,1,1,0,1,1,0,1,1,1,0,0,0,1,1,1,0,0,1,1,0,1,1,0,0,0,0,0,0,0,1,1,1,1,0,2,2,2,2,1,0,0,0,1,0,0,0,0,1,1,0,0,0,1,1,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,1,1,1,1,1,1,1,1,1,0,1,0,1,1,1,0,1,1,0,1,1,1,0,0,0,1,1,1,0,0,1,1,0,1,1,0,0,0,0,0,0,0,1,1,1,1,0,2,2,2,2,1,0,0,0,1,0,0,0,0,1,1,0,0,0,1,1,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 43,43,43,43,43,43,43,43,43,43,43,43,43,43,43,43,43,19,1,1,1,1,1,1,1,1,1,0,1,0,1,1,1,0,1,1,0,1,1,1,0,0,0,1,1,1,0,0,1,1,0,1,1,0,0,0,0,0,0,0,1,1,1,1,0,2,2,2,2,1,0,0,0,1,0,0,0,0,1,1,0,0,0,1,1,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 40,40,40,40,40,40,40,40,40,40,40,40,40,40,40,30,6,6,1,1,1,1,1,1,1,1,1,0,1,0,1,1,1,0,1,1,0,1,1,1,0,0,0,1,1,1,0,0,1,1,0,1,1,0,0,0,0,0,0,0,1,1,1,1,0,2,2,2,2,1,0,0,0,1,0,0,0,0,1,1,0,0,0,1,1,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 38,38,38,38,38,38,38,38,38,38,38,38,38,38,38,22,6,6,1,1,1,1,1,1,1,1,1,0,1,0,1,1,1,0,1,1,0,1,1,1,0,0,0,1,1,1,0,0,1,1,0,1,1,0,0,0,0,0,0,0,1,1,1,1,0,2,2,2,2,1,0,0,0,1,0,0,0,0,1,1,0,0,0,1,1,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 33,33,33,33,33,33,33,33,33,33,33,33,33,35,33,18,6,1,1,1,1,1,1,1,1,1,1,0,1,0,1,1,1,0,1,1,0,1,1,1,0,0,0,1,1,1,0,0,1,1,0,1,1,0,0,0,0,0,0,0,1,1,1,1,0,2,2,2,2,1,0,0,0,1,0,0,0,0,1,1,0,0,0,1,1,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 33,33,33,33,33,33,33,33,33,33,33,33,33,33,33,33,10,6,1,1,1,1,1,1,1,1,1,0,1,0,1,1,1,0,1,1,0,1,1,1,0,0,0,1,1,1,0,0,1,1,0,1,1,0,0,0,0,0,0,0,1,1,1,1,0,2,2,2,2,1,0,0,0,1,0,0,0,0,1,1,0,0,0,1,1,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 31,31,31,31,31,31,31,31,31,31,31,31,31,31,31,6,6,6,1,1,1,1,1,1,1,1,1,0,1,0,1,1,1,0,1,1,0,1,1,1,0,0,0,1,1,1,0,0,1,1,0,1,1,0,0,0,0,0,0,0,1,1,1,1,0,2,2,2,2,1,0,0,0,1,0,0,0,0,1,1,0,0,0,1,1,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
`line41 below
data 30,30,30,30,30,30,30,30,30,30,30,30,30,30,30,25,5,5,5,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,5,5,5,6,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22
data 30,30,30,30,30,30,30,30,30,30,30,30,30,30,30,18,5,5,5,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,5,5,5,6,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22
data 29,29,29,29,29,29,29,29,29,29,29,29,29,29,29,12,5,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,5,5,5,6,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22
data 28,28,28,28,28,28,28,28,28,28,28,28,28,28,28,4,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,5,5,5,6,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22
data 27,27,27,27,27,27,27,27,27,27,27,27,27,27,27,4,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,5,5,5,6,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22
data 26,26,26,26,26,26,26,26,26,26,26,26,26,26,26,15,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,5,5,5,6,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22
data 25,25,25,25,25,25,25,25,25,25,25,25,25,25,25,13,7,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,5,5,5,6,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22
data 24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,13,8,5,5,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,5,5,5,6,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22
data 23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,9,5,5,5,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,5,5,5,6,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22
data 22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,12,5,5,5,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,5,5,5,6,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22
`line51 below
data 20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,8,5,5,5,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,5,5,5,6,20,20,20,20,20,20,20,20,20,20,20,20,20,20,20
data 19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,13,5,5,5,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,5,5,5,6,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19
data 17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,12,5,5,5,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,5,5,5,6,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17
data 16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,8,5,5,5,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,5,5,5,6,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16
data 15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,6,5,5,5,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,5,5,5,6,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15
data 14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,6,5,5,5,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,5,5,5,6,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14
data 12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,6,5,5,5,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,5,5,5,6,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12
data 11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,6,5,5,5,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,5,5,5,6,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11
data 10,10,10,10,10,10,10,10,10,10,10,10,10,10,9,8,5,5,5,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,5,5,5,8,9,10,10,10,10,10,10,10,10,10,10,10,10,10,10
data 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,7,5,5,5,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,5,5,5,7,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8
`line 61 below
data 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,6,6,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,6,6,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
`line 71 below
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
`line 81 below
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
`line 91 below
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
data 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,4,4,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,3,3,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6

`Started: 5/19/08
`Waterfall!!

sync on
sync rate 60

hide mouse
color backdrop rgb(0,0,0)

`======= Variable Setup ===============

#Constant SprayImage 20

WRate#=11.0
WGravity=4
WDrop=55

WNumImages=10
WMaxSprites=900

Ground=500

SVelocity=3
SDrop=25
SMaxSprites=40
SDelay=14

MParticleMaxSprites=70
MDelay=7
MFade=2
MParticleVelocity=3
MistOffset=5

NoMistImages=7

type WaterParticle
    XPos as float
    YPos as float
    Angle as float
    SpriteNum as integer
endtype

DIM WaterParticles(WMaxSprites) as WaterParticle

type MistParticle
    XPos as float
    YPos as float
    Angle as float
    SpriteNum as integer
    AlphaVal as byte
endtype

DIM MistParticles(MParticleMaxSprites) as MistParticle

`======= Media Setup ==================

for j=1 to WNumImages
    cls
    ink rgb(rnd(60)+80,rnd(30)+185,rnd(50)+205),0
    for c#=1.0 to 5.0 step 0.2
        circle 5,5,c#
    next c#
    get image j,0,0,10,10,1
    sprite j,-100,-100,j
    set sprite alpha j,150
    offset sprite j,sprite width(j)/2,sprite height(j)/2
next j

cls
ink rgb(240,240,255),0
FilledCircle(2,2,2)
get image SprayImage,0,0,4,4,1

ink rgb(200,200,200),0
for j=1 to NoMistImages
    cls
    for c=1 to 14
        FilledCircle(rnd(10)+5,rnd(10)+5,5)
    next c
    get image j+300,0,0,40,40,1
    TempSpriteNo=j+3000
    sprite TempSpriteNo,-100,-100,j+300
    set sprite alpha TempSpriteNo,100
    offset sprite TempSpriteNo,sprite width(TempSpriteNo)/2,sprite height(TempSpriteNo)/2
next j

cls
ink rgb(70,70,70),0
FilledCircle(20,20,20)
ink rgb(10,10,10),0
FilledCircle(20,20,15)
get image 3001,0,0,40,40,1

ink rgb(70,70,70),0
cls
circle 0,20,20
get image 3002,0,0,21,40,1
cls
circle 10,-4,9
get image 3003,0,0,26,8,1

ink rgb(50,50,50),0
cls
FilledCircle(20,20,20)
get image 3010,0,0,40,40,1
sprite 3010,mousex(),mousey(),3010
offset sprite 3010,sprite width(3010)/2,sprite height(3010)/2

`<<<<<<<<< LOOOOOOOOOOOOOOOOOPPP!!! >>>>>>>>>>>>


do

ink rgb(240,240,240),0
text 10,10,"FPS: "+str$(screen fps())
text 10,30,"Use the left and right arrowkeys to change the flow."

ink rgb(50,50,50),0

if rightkey()=1 and WDrop>5
    inc RateCounter
    dec WRate#,0.15
    dec WDrop
endif
if leftkey()=1 and WDrop<55
    inc RateCounter
    inc WRate#,0.15
    inc WDrop
endif

sprite 3010,mousex(),mousey(),3010

box 680,190,screen width(),230
paste image 3001,660,190,1
box 720,190,740,Ground
for c=680 to screen width() step 50
    paste image 3002,c,190,1
next c
for c=240 to Ground step 50
    paste image 3003,720,c,1
next c

for j=1 to int(WRate#)
    inc WParticleNo
    if WParticleNo>WMaxSprites then WParticleNo=1
    WaterParticles(WParticleNo).SpriteNum=rnd(WNumImages-1)+1
    WaterParticles(WParticleNo).Angle=rnd(35)+190
    WaterParticles(WParticleNo).XPos=680
    WaterParticles(WParticleNo).YPos=222
next j
for j=1 to WMaxSprites
    if WaterParticles(j).SpriteNum>0
        XMovement#=WGravity*sin(WaterParticles(j).Angle)
        YMovement#=WGravity*cos(WaterParticles(j).Angle)
        WaterParticles(j).Angle=WaterParticles(j).Angle-(WaterParticles(j).Angle-180)/WDrop
        rotate sprite WaterParticles(j).SpriteNum,WaterParticles(j).Angle
        inc WaterParticles(j).XPos,XMovement#
        dec WaterParticles(j).YPos,YMovement#
        paste sprite WaterParticles(j).SpriteNum,WaterParticles(j).XPos,WaterParticles(j).YPos
        if WaterParticles(j).YPos>Ground or Distance(j)<25
            WaterParticles(j).SpriteNum=0
            if SCounter=1
                inc SParticleNo
                if SParticleNo>SMaxSprites then SParticleNo=1
                TempSpriteNo=SParticleNo+1000
                sprite TempSpriteNo,WaterParticles(j).XPos,WaterParticles(j).YPos,20
                rotate sprite TempSpriteNo,wrapvalue(300+rnd(120))
                set sprite priority TempSpriteNo,1
                set sprite alpha TempSpriteNo,150
            endif
            inc SCounter
            if SCounter>SDelay then SCounter=1
            if MCounter=1
                inc MParticleNo
                if MParticleNo>MParticleMaxSprites then MParticleNo=1
                MistParticles(MParticleNo).XPos=WaterParticles(j).XPos
                if WaterParticles(j).YPos>Ground
                    MistParticles(MParticleNo).YPos=WaterParticles(j).YPos-MistOffset
                    else
                    MistParticles(MParticleNo).YPos=WaterParticles(j).YPos
                endif
                MistParticles(MParticleNo).Angle=rnd(30)+290
                MistParticles(MParticleNo).SpriteNum=rnd(NoMistImages-1)+3001
                MistParticles(MParticleNo).AlphaVal=100
            endif
            inc MCounter
            if MCounter>MDelay then MCounter=1
        endif
    endif
next j
for j=1 to SMaxSprites
    if sprite exist(j+1000)=1
        if sprite angle(j+1000)>180
            rotate sprite j+1000,sprite angle(j+1000)-((sprite angle(j+1000)-180)/SDrop)
            else
            rotate sprite j+1000,sprite angle(j+1000)+((180-sprite angle(j+1000))/SDrop)
        endif
        move sprite j+1000,SVelocity
        if sprite y(j+1000)>Ground then delete sprite j+1000
    endif
next j
for j=1 to MParticleMaxSprites
    TempSpriteNo=MistParticles(j).SpriteNum
    if TempSpriteNo>0
        XMovement#=MParticleVelocity*cos(MistParticles(j).Angle)
        YMovement#=MParticleVelocity*sin(MistParticles(j).Angle)
        dec MistParticles(j).XPos,XMovement#
        inc MistParticles(j).YPos,YMovement#
        dec MistParticles(j).AlphaVal,MFade
        if MistParticles(j).AlphaVal>0 and MistParticles(j).AlphaVal<101
            set sprite alpha TempSpriteNo,MistParticles(j).AlphaVal
            else
            set sprite alpha TempSpriteNo,0
        endif
        rotate sprite TempSpriteNo,MistParticles(j).Angle
        paste sprite TempSpriteNo,MistParticles(j).XPos,MistParticles(j).YPos
        if sprite alpha(TempSpriteNo)=0 then MistParticles(j).SpriteNum=0
    endif
next j

sync
loop

`<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>

function FilledCircle( CX as integer, CY as integer, R as integer )
`BY IanM
   local x as integer
   local y as integer
   local i as integer
   local s as integer

   ` Precalculate the square of the radius - this is the hypotenuse
   i=R*R

   ` Calculate the size of the central square
   s=R*sin(45)

   ` Draw it
   box CX-s, CY-s, CX+s+1, CY+s+1
   s=s+1

   ` Loop through the bit we have not yet drawn
   for y=s to R
      x=sqrt( i-(y*y) )

      ` Draw top and bottom
      box CX-x, CY-y, CX+x+1, CY-y+1
      box CX-x, CY+y, CX+x+1, CY+y+1

      ` Draw left and right
      box CX-y, CY-x, CX-y+1, CY+x+1
      box CX+y, CY-x, CX+y+1, CY+x+1
   next y
endfunction

function Distance(ParticleNo)
Dist#=SQRT((WaterParticles(ParticleNo).XPos-sprite x(3010))^2+(WaterParticles(ParticleNo).YPos-sprite y(3010))^2)
endfunction Dist#

function FindFreeSprite()
repeat
inc TempSpriteNo
until sprite exist(TempSpriteNo)=0
endfunction

Rem Project: Waterfall
Rem Created: 5/20/2008
Rem Author: Ruler8163

Rem ***** Main Source File *****

sync on
sync rate 30

randomize timer()
make camera 1
position camera 1,30,30,40
xrotate camera 1,30
yrotate camera 1,30
set camera range 1,.1,1000

type Position
   x as float
   y as float
   z as float
endtype
type Velocity
   xv as float
   yv as float
   zv as float
endtype
type Collidable
   x as float
   y as float
   z as float
   xv as float
   yv as float
   zv as float
   mass as float
   elasticity as float
endtype
global returnCollidable as Collidable
type WaterParticles
   stream as dword
   vertice as dword
   objectIndex as word
endtype
global dim particles() as WaterParticles
global lastUpdate

global staticFriction as float   :staticFriction=.001
global kineticFriction as float  :kineticFriction=.0005
global gravity as float          :gravity=.01

`Establish my beatiful colorblind picked colors
global dirtColor as dword:    dirtColor=rgb(111,55,0)
global grassColor as dword:   grassColor=rgb(0,148,23)
global sandColor as dword:    sandColor=rgb(224,184,114)
global rockColor as dword:    rockColor=rgb(96,96,96)
global waterColor as dword:   waterColor=rgb(80,200,200)
global skyColor as dword:     skyColor=rgb(180,255,255)
color backdrop 1,skyColor

global waterPlain:waterPlain=getFreeObject()

`Make some not so pretty textures
global dirtTexture:  dirtTexture=makeTexture(32,32,dirtcolor,10)
global grassTexture: grassTexture=makeTexture(32,32,grassColor,10)
global rockTexture:  rockTexture=makeTexture(32,32,rockColor,10)
global waterTexture: waterTexture=makeTexture(32,32,waterColor,10)

paste image grassTexture,0,0
paste image dirtTexture,32,0
paste image rockTexture,64,0
matrixTile=getFreeImage()
get image matrixTile,0,0,96,32

theGround=getFreeMatrix()
make matrix theGround,100,100,50,50
prepare matrix texture theGround,matrixTile,3,1
fill matrix theGround,0,1
set matrix trim theGround,.1,0


makeEnvironment(theGround)


newPos1 as Position
newPos1.x=45
newPos1.y=25
newPos1.z=95
newPos2 as Position
newPos2.x=55
newPos2.y=25
newPos2.z=95
newVel as Velocity
newVel.xv=0
newVel.yv=0
newVel.zv=0


remstart
newPos1 as Position
newPos1.x=2
newPos1.y=2
newPos1.z=2
newPos2 as Position
newPos2.x=4
newPos2.y=2
newPos2.z=4
newVel as Velocity
newVel.xv=0
newVel.yv=0
newVel.zv=1
remend

global numberStreams:numberStreams=10
global numberVertices:numberVertices=500
global dim waterStreams(numberStreams-1,numberVertices-1) as Position
createStreams(numberStreams,numberVertices,newPos1,newPos2,newVel,gravity,theGround)

global waterOn:waterOn=1
global spaceRelease:spaceRelease=0

ink rgb(0,0,0),0
Rem MAIN LOOP
while escapekey()=0


   set cursor 0,0

   if waterOn=1
      print "Press Space to Toggle Water (On)"
   else
      print "Press Space to Toggle Water (Off)"
   endif
   print "Arrow Keys to Move"
   print "Enjoy the bad water!"

   if spacekey()=1
      if spaceRelease=1
         spaceRelease=0
         if waterOn=1
            waterOn=0
         else
            waterOn=1
         endif
      endif
   else
      spaceRelease=1
   endif
   lastUpdate=updateWater(lastUpdate,100)


   scroll object texture waterPlain,0,-.002

   rotate camera 1,camera angle x(1)+mousemovey()/2,camera angle y(1)+mousemovex()/2,0
   mousemovex()=0
   mousemovey()=0
   if mouseclick()=1 or upkey()
      move camera 1,.5
   else
      if mouseclick()=2 or downkey()
         move camera 1,-.5
      endif
   endif
   `position camera 1,camera position x(1),get ground height(theGround,camera position x(1),camera position z(1))+1,camera position z(1)
   sync
endwhile


function makeTexture(width as dword,height as dword,color as dword,change as byte)
   mem=getFreeMemblock()
   make memblock mem,(4*3+width*height*4)
   write memblock dword mem,0,width
   write memblock dword mem,4,height
   write memblock dword mem,8,32 `the depth of image
   for x=1 to width
      for y=1 to height
         pos=((y-1)*width + x - 1)*4 + 12

         r=rgbr(color)-change+rnd(change*2)
         if r<0 then r=0:if r>255 then r=255
         g=rgbg(color)-change+rnd(change*2)
         if g<0 then g=0:if g>255 then g=255
         b=rgbb(color)-change+rnd(change*2)
         if b<0 then b=0:if b>255 then b=255

         `Write to the memblock
         write memblock byte mem,pos,b
         write memblock byte mem,pos+1,g
         write memblock byte mem,pos+2,r
         write memblock byte mem,pos+3,255
      next y
   next x

   img=getFreeImage()
   make image from memblock img,mem

endfunction img

function updateWater(lastTime,interval)
   if timer()-lastTime>=interval and waterOn=1
      lastTime=timer()
      for i=0 to numberStreams-1
         array insert at top particles(0)
         index=0
         particles(index).stream=i
         particles(index).vertice=0
         obj=getFreeObject()
         particles(index).objectIndex=obj
         make object plain obj,2,2
         `make object sphere obj,1
         ghost object on obj
         texture object obj,waterTexture
         xPos#=waterStreams(particles(i).stream,particles(i).vertice).x
         yPos#=waterStreams(particles(i).stream,particles(i).vertice).y
         zPos#=waterStreams(particles(i).stream,particles(i).vertice).z
         position object obj,xPos#,yPos#,zPos#
      next i
   endif
   for i=0 to array count(particles(0))-1
      if particles(i).vertice<numberVertices-1
         inc particles(i).vertice,1
         xPos#=waterStreams(particles(i).stream,particles(i).vertice).x
         yPos#=waterStreams(particles(i).stream,particles(i).vertice).y
         zPos#=waterStreams(particles(i).stream,particles(i).vertice).z
         if yPos#>object position y(waterPlain)-1
            position object particles(i).objectIndex,xPos#,yPos#,zPos#
            point object particles(i).objectIndex,camera position x(1),camera position y(1),camera position z(1)
         else
            delete object particles(i).objectIndex
            array delete element particles(0),i
         endif
      else
         delete object particles(i).objectIndex
         array delete element particles(0),i
      endif
   next i
endfunction lastTime

`Rem Extemely overcomplicated method to compute a premade path for water particles to follow.
`Rem Returned in a rather large array. Could be made more efficent by using a memblock
`Rem but i simply dont have the time.
function createStreams(numStreams as byte,numVertices as word,sPos1 as Position,sPos2 as Position,startVelocity as Velocity,gravity as float,matrix as byte)

   if matrix exist(matrix)

      dim tempData(numStreams-1) as Velocity`(Stream)(xv,yv,zv)
      dim waterStreams(numStreams-1,numVertices-1) as Position `(Stream)(Vert)(x,y,z)

      num#=numStreams

      cx#=(sPos2.x-sPos1.x)/num#
      cy#=(sPos2.y-sPos1.y)/num#
      cz#=(sPos2.z-sPos1.z)/num#
      for i=0 to numStreams-1
         waterStreams(i,0).x=sPos1.x+cx#*i
         waterStreams(i,0).y=sPos1.y+cy#*i
         waterStreams(i,0).z=sPos1.z+cz#*i
         tempData(i).xv=startVelocity.xv
         tempData(i).yv=startVelocity.yv
         tempData(i).zv=startVelocity.zv
      next i

      thisStream as Collidable
      thisStream.mass=10
      thisStream.elasticity=.3

      for countVertices=1 to numVertices-1
         for i=0 to numStreams-1
            thisStream.x=waterStreams(i,countVertices-1).x
            thisStream.y=waterStreams(i,countVertices-1).y
            thisStream.z=waterStreams(i,countVertices-1).z
            thisStream.xv=tempData(i).xv
            thisStream.yv=tempData(i).yv
            thisStream.zv=tempData(i).zv

            calculateTrajectory(thisStream,matrix,gravity,staticFriction,kineticFriction)

            waterStreams(i,countVertices).x=returnCollidable.x
            waterStreams(i,countVertices).y=returnCollidable.y
            waterStreams(i,countVertices).z=returnCollidable.z

            tempData(i).xv=returnCollidable.xv
            tempData(i).yv=returnCollidable.yv
            tempData(i).zv=returnCollidable.zv

         next i
      next countVertices

      surface=getFreeMatrix()

   endif
endfunction

function calculateTrajectory(object as Collidable,matrixNumber as byte,gravity as float,staticFriction as float,kineticFriction as float)

   dec object.yv,gravity

   object.x=object.x+object.xv
   object.y=object.y+object.yv
   object.z=object.z+object.zv

   range#=.1
   upHeight#=get ground height(matrixNumber,object.x,object.z+range#)
   downHeight#=get ground height(matrixNumber,object.x,object.z-range#)
   rightHeight#=get ground height(matrixNumber,object.x+range#,object.z)
   leftHeight#=get ground height(matrixNumber,object.x-range#,object.z)

   xSlope#=(rightHeight#-leftHeight#)/(2*range#)
   zSlope#=(upHeight#-downHeight#)/(2*range#)

   height#=get ground height(matrixNumber,object.x,object.z)
   objectWeight#=object.mass*gravity
   if object.y<height#
      `Set Y position above ground
      object.y=height#

      `XY PLANE
      pforceAngle#=-(getDirection(object.xv,object.yv)-90)
      systemAngle#=atan(xSlope#)
      pforceSystemAngle#=pforceAngle#-systemAngle#
      pforceVelocity#=getVelocity(object.xv,object.yv)
      pforceSystemHorizontalVelocity#=cos(pforceSystemAngle#)*pforceVelocity#
      pforceSystemVerticalVelocity#=-sin(pforceSystemAngle#)*pforceVelocity#*object.elasticity`fixed equation

      normalForce#=pforceSystemVerticalVelocity#*object.mass+cos(systemAngle#)*objectWeight#
      if abs(pforceSystemHorizontalVelocity#*object.mass-sin(systemAngle#)*objectWeight#)>staticFriction*normalForce#
         pforceSystemHorizontalVelocity#=shift(pforceSystemHorizontalVelocity#-sin(systemAngle#)*objectWeight#,0,kineticFriction*normalForce#)
         `shift(pforceSystemHorizontalVelocity#*object.mass-sin(systemAngle#)*objectWeight#,0,kineticFriction*normalForce#)/(objectWeight#)
      else
         pforceSystemHorizontalVelocity#=0
      endif

      pforceSystemAngle#=-(getDirection(pforceSystemHorizontalVelocity#,pforceSystemVerticalVelocity#)-90)
      pforceSystemVelocity#=getVelocity(pforceSystemHorizontalVelocity#,pforceSystemVerticalVelocity#)
      pforceAngle#=pforceSystemAngle#+systemAngle#
      object.xv=cos(pforceAngle#)*pforceSystemVelocity#
      tang1#=abs(systemAngle#)
      tyv1#=sin(pforceAngle#)*pforceSystemVelocity#
      `|||||||||||||||||||||||||||||||||||||||||||||||
      `ZY PLANE
      `|||||||||||||||||||||||||||||||||||||||||||||||
      pforceAngle#=-(getDirection(object.zv,object.yv)-90)
      systemAngle#=atan(zSlope#)
      pforceSystemAngle#=pforceAngle#-systemAngle#
      pforceVelocity#=getVelocity(object.zv,object.yv)
      pforceSystemHorizontalVelocity#=cos(pforceSystemAngle#)*pforceVelocity#
      pforceSystemVerticalVelocity#=-sin(pforceSystemAngle#)*pforceVelocity#*object.elasticity`fixed equation

      normalForce#=pforceSystemVerticalVelocity#*object.mass+cos(systemAngle#)*objectWeight#
      if abs(pforceSystemHorizontalVelocity#*object.mass-sin(systemAngle#)*objectWeight#)>staticFriction*normalForce#
         pforceSystemHorizontalVelocity#=shift(pforceSystemHorizontalVelocity#-sin(systemAngle#)*objectWeight#,0,kineticFriction*normalForce#)
      else
         pforceSystemHorizontalVelocity#=0
      endif

      pforceSystemAngle#=-(getDirection(pforceSystemHorizontalVelocity#,pforceSystemVerticalVelocity#)-90)
      pforceSystemVelocity#=getVelocity(pforceSystemHorizontalVelocity#,pforceSystemVerticalVelocity#)
      pforceAngle#=pforceSystemAngle#+systemAngle#
      object.zv=cos(pforceAngle#)*pforceSystemVelocity#
      tang2#=abs(systemAngle#)
      tyv2#=sin(pforceAngle#)*pforceSystemVelocity#

      if tang1#<>0 or tang2#<>0
         object.yv=(sin(tang1#)*tyv1#+sin(tang2#)*tyv2#)/(sin(tang1#)+sin(tang2#))
      else
         if object.yv<=0
            object.yv=tyv1#
         endif
      endif
   else
      if object.y=height#
         endVelocity#=getVelocity(object.xv,object.zv)
         endVelDirection#=getDirection(object.xv,object.zv)
         endVelocity#=shift(endVelocity#,0,kineticFriction*objectWeight#)
         object.xv=get_xmove(endVelocity#,endVelDirection#)
         object.zv=get_zmove(endVelocity#,endVelDirection#)
      endif
   endif
   returnCollidable=object
endfunction

function makeEnvironment(matrix as byte)

   pondX=10
   pondY=5
   pondDepth#=10
   pondRadius#=15
   cliffX=25
   cliffFrontZ#=26
   cliffBackZ#=50
   cliffBackHeight#=24
   cliffFrontHeight#=16
   cliffLength#=3
   cliffWidth=50
   trenchX=25
   trenchFrontZ=cliffFrontZ#+1`+cliffLength#
   trenchBackZ=cliffBackZ#
   trenchRadius#=3
   trenchLength=50-trenchFrontZ
   trenchDepth#=5

   random#=30

   for x=pondX to pondX+pondRadius#*2
      for z=pondZ to pondZ+pondRadius#*2
         d#=dist(x,z,0,pondX+pondRadius#,pondZ+pondRadius#,0)
         if d#<=pondRadius#
            set matrix height matrix,x,z,(-pondDepth#+pondDepth#*(d#/pondRadius#)^2)
            set matrix tile matrix,x,z,2
         endif
      next y
   next x

   for x=trenchX-int(trenchRadius#) to trenchX+int(trenchRadius#)
      for z=trenchFrontZ to trenchBackZ
         d#=dist(x,z,0,trenchX,z,0)
         if d#<=trenchRadius#
            set matrix height matrix,x,z,get matrix height(matrix,x,z)+(-trenchDepth#+trenchDepth#*(d#/trenchRadius#)^2)   -(random#/2.0+rnd(random#))*.01
            if z<50
               set matrix tile matrix,x,z,2
            endif
         endif
      next y
   next x

   for z=int(cliffFrontZ#) to int(cliffBackZ#)
      curHeight#=cliffFrontHeight#+(cliffBackHeight#-cliffFrontHeight#)*((z-cliffFrontZ#)/(cliffBackZ#-cliffFrontZ#))
      for x=cliffX-cliffWidth/2 to cliffX+cliffWidth/2
         if z-cliffFrontZ#<cliffLength#
            if x<50
               set matrix tile matrix,x,z,3
            endif
            set matrix height matrix,x,z,get matrix height(matrix,x,z)+cliffFrontHeight#*((z-cliffFrontZ#)/cliffLength#)   -(random#/2.0+rnd(random#))*.01
         else
            set matrix height matrix,x,z,get matrix height(matrix,x,z)+curHeight#   -(random#/2.0+rnd(random#))*.01
         endif
      next x
   next z

   make object plain waterPlain,100,100
   position object waterPlain,50,-1,50
   texture object waterPlain,waterTexture
   `set alpha mapping on waterPlain,60
   ghost object on waterPlain
   scale object texture waterPlain,2,2
   xrotate object waterPlain,-90
   update matrix matrix
endfunction

function getFreeMemblock()
   i=1
   while memblock exist(i)
      inc i
   endwhile
endfunction i

function getFreeImage()
   i=1
   while image exist(i)
      inc i
   endwhile
endfunction i

function getFreeMatrix()
   i=1
   while matrix exist(i)
      inc i
   endwhile
endfunction i

function getFreeObject()
   i=1
   while object exist(i)
      inc i
   endwhile
endfunction i

function getVelocity(xmove#,ymove#)
   velocity#=dist(0,0,0,xmove#,ymove#,0)
endfunction velocity#

function getDirection(xmove#,ymove#)
   direction#=atanfull(xmove#,ymove#)
endfunction direction#

function get_xmove(velocity#,direction#)
   xmove#=sin(direction#)*velocity#
endfunction xmove#

function get_zmove(velocity#,direction#)
   zmove#=cos(direction#)*velocity#
endfunction zmove#

function shift(cur#,dest#,mov#)
   if cur#>dest#
      dec cur#,mov#
      if cur#<dest# then cur#=dest#
      exitfunction cur#
   endif
   if cur#<dest#
      inc cur#,mov#
      if cur#>dest# then cur#=dest#
      exitfunction cur#
   endif
endfunction cur#

function dist(x1#,y1#,z1#,x2#,y2#,z2#)
   dist#=sqrt((x2#-x1#)^2+(y2#-y1#)^2+(z2#-z1#)^2)
endfunction dist#

Ruler8163 – This one was really nice, but it could’nt beat the winner. You were just 1% from eachother!!

http://b.imagehost.org/0440/who.jpg

SYNC ON : SYNC RATE 0 : HIDE MOUSE
MAKE OBJECT CUBE 1, 1

DO
   LINE SCREEN WIDTH()/2, (SCREEN HEIGHT()/2)-10, SCREEN WIDTH()/2, (SCREEN HEIGHT()/2)+10
   LINE (SCREEN WIDTH()/2)-10, SCREEN HEIGHT()/2, (SCREEN WIDTH()/2)+10, SCREEN HEIGHT()/2
   IF MOUSECLICK() = 1 AND boomTime = 0
      boomTime = TIMER()
   ENDIF
   IF boomTime > 0
      CENTER TEXT SCREEN WIDTH()/2, SCREEN HEIGHT()/2-25, "BOOM!"
      IF TIMER() > boomTime+1000 THEN boomTime = 0
   ENDIF
   SYNC
LOOP

`*********************************
`* CODE CHALLENGE: WEAPON EFFECT *
`*********************************

`--- You can change this to whatever you like ---
name1$ = "Sven B"

`Setup
sync on : sync rate 100
autocam off
randomize timer()

`Constants
#constant scrX screen width()
#constant scrY screen height()
#constant scrFPS screen fps()

global Gravity# as float
Gravity# = -0.02

`Types
type tPlayer
	Obj as integer : `Object
	Name$ as string : `Name
	CWeapon as integer : `Current weapon
	Speed# as float : `moving speed
	YSpeed# as float : `Vertical speed
	Delay, DontMove as integer : `Weapon delay
endtype
type tParticle
	Obj as integer : `Object
	ax#, ay#, az# as float : `Acceleration
	vx#, vy#, vz# as float : `Velocity
	Tex as integer : `Texture
	rz#, vrz# as float : `Rotation and rotation speed
	sx#, sy#, vsx#, vsy# as float : `Size and size speed
	MaxLife, Life as integer : `Life span
endtype
type tWeapon
	Name$ as string
endtype
type tProjectile
	Obj as integer
	Life as integer
	EmitterType as integer
	EmitterTimer as integer
	EmitterInterval as integer
	ax#, ay#, az# as float
	vx#, vy#, vz# as float
	Bounce as integer
	Delay as integer
endtype

`Globals
global SmokeImage, FireImage, SparkleImageGrey, SparkleImageFire as integer

`Arrays
dim Player(1) as tPlayer
dim Particle(0) as tParticle
dim Weapon(3) as tWeapon
dim Projectile(0) as tProjectile

`Create a moke particle
cls : center text scrX / 2, scrY / 2 - 10, "--- LOADING SMOKE EFFECT ---"
sync : sync
SmokeImage = CreateSmokeImage(128, 128, 250)

`Create a fire particle
ink rgb(255, 255, 255), 0
cls : center text scrX / 2, scrY / 2 - 10, "--- LOADING FIRE EFFECT ---"
sync : sync
FireImageTopLayer = Colorize( SmokeImage, rgb(255, 255, 0) )
FireImageBottomLayer = Colorize( SmokeImage, rgb(255, 66, 0) )
FireImage = MergeLayers(FireImageTopLayer, FireImageBottomLayer)
delete image FireImageTopLayer
delete image FireImageBottomLayer

`Create a focus
ink rgb(255, 255, 255), 0
cls : center text scrX / 2, scrY / 2 - 10, "--- LOADING SPARKLE EFFECT ---"
sync : sync
SparkleImageGrey = CreateSparkle()
SparkleImageFire = Colorize( SparkleImageGrey, rgb(255, 255, 0) )

`Create a player
cls : center text scrX / 2, scrY / 2 - 10, "--- CREATING PLAYERS ---"
sync : sync

`Create players
obj = CreatePlayer( 1, Name1$ )
position object obj, 0, 7.5, 0

`Create the world
cls : center text scrX / 2, scrY / 2 - 10, "--- CREATING WORLD ---"
sync : sync
FloorObj = CreateWorldObject(0, -2.5, 0, 1000, 5, 1000)
WallObj = CreateWorldObject(100, 20, 100, 50, 40, 50)

`Create the weapons
cls : center text scrX / 2, scrY / 2 - 10, "--- CREATING WEAPONS ---"
sync : sync

`Load weapon names
restore Weapons
for i = 1 to array count(Weapon())
	read name$
	Weapon(i).Name$ = name$
next i

do

	`Get mouse
	mvx# = mousemovex()
	mvz = mousemovez()

	`Display screen fps
	text 5, 5, str$(scrFPS)
	text 5, 45, Weapon(Player(1).CWeapon).Name$

	`Handle player
	HandlePlayer(1, keystate(17), keystate(31), keystate(30), keystate(32), -mvx#, mvx#, spacekey(), mouseclick())
	HandleCamera(1, 50.0, 30.0)
	`Toggle between weapons
	if mvz > 0 then inc Player(1).CWeapon
	if mvz < 0 then dec Player(1).CWeapon
	if Player(1).CWeapon < 1 then Player(1).CWeapon = array count(Weapon())
	if Player(1).CWeapon > array count(Weapon()) then Player(1).CWeapon = 1

	`Handle projectiles
	for i = 1 to array count(Projectile())
		HandleProjectile( i )
	next i

	`Handle particles
	for i = 1 to array count(Particle())
		HandleParticle( i )
	next i

	sync
loop

`*************
`* FUNCTIONS *
`*************

`*** GAME FUNCTIONS ***

`-- Handle Player --
function HandlePlayer(pl, Up, Down, StrafeLeft, StrafeRight, Left#, Right#, Jump, UseWeapon)

	`First of all, get some data
	obj = Player(pl).Obj
	x# = object position x(obj)
	y# = object position y(obj)
	z# = object position z(obj)
	ay# = object angle y(obj)
	s# = Player(pl).Speed#

	`Move the object
	if Player(pl).DontMove = 0
		if Up > 0
			x# = newxvalue(x#, ay#, s#)
			z# = newzvalue(z#, ay#, s#)
		endif
		if Down > 0
			x# = newxvalue(x#, ay#, -s#)
			z# = newzvalue(z#, ay#, -s#)
		endif
		if StrafeLeft > 0
			x# = newxvalue(x#, wrapvalue(ay# - 90), s#)
			z# = newzvalue(z#, wrapvalue(ay# - 90), s#)
		endif
		if StrafeRight > 0
			x# = newxvalue(x#, wrapvalue(ay# + 90), s#)
			z# = newzvalue(z#, wrapvalue(ay# + 90), s#)
		endif
		if Left# > 0
			yrotate object obj, wrapvalue(ay# - Left#)
		endif
		if Right# > 0
			yrotate object obj, wrapvalue(ay# + Right#)
		endif
		if UseWeapon > 0 and Player( pl ).Delay < timer()
			UseWeapon( pl )
		endif
	else
	
		`Decrease the delay
		dec Player(pl).DontMove
	endif

	`Gravity
	inc Player(pl).YSpeed#, Gravity#
	inc y#, Player(pl).YSpeed#

	`Calculate collision
	position object obj, x#, y#, z#
	if object collision(obj, 0) > 0
	
		`Vertical movement
		cy# = get object collision y()
		if cy# <> 0.0
			dec y#, cy#
			if cy# < 0.0
				Player(pl).YSpeed# = 0.0
			
				`Jump
				if Jump > 0
					Player(pl).YSpeed# = 1.5
				endif
			endif
		endif
		
		`Horizontal movement
		dec x#, get object collision x()
		dec z#, get object collision z()
	endif
	
	`Update the object
	position object obj, x#, y#, z#
endfunction

`-- Handle Camera --
function HandleCamera( pl, CamDistance#, CamHeight# )

	`Get information
	obj = Player(pl).Obj
	x# = object position x(obj)
	y# = object position y(obj)
	z# = object position z(obj)
	ay# = object angle y(obj)
	
	`Calc positions
	camX# = newxvalue(x#, wrapvalue(ay# + 180), CamDistance# )
	camY# = y# + CamHeight#
	camZ# = newzvalue(z#, wrapvalue(ay# + 180), CamDistance# )
	
	`Smoothen positions
	camX# = curvevalue(camX#, camera position x(), 15)
	camY# = curvevalue(camY#, camera position y(), 15)
	camZ# = curvevalue(camZ#, camera position z(), 15)

	`Update camera
	position camera camX#, camY#, camZ#
	point camera x#, y# + (CamHeight#/2), z#

endfunction

`-- Use Weapon --
function UseWeapon( pl )

	`Get information
	obj = Player(pl).Obj
	x# = object position x(obj)
	y# = object position y(obj)
	z# = object position z(obj)
	ay# = object angle y(obj)
	cw = Player(pl).CWeapon
	
	`Handle weapons
	select cw
		case 1 : `FireBall
		
			`Start Projectile
			array insert at top Projectile()
			Projectile(1).Life = 300
			Projectile(1).EmitterType = 1
			Projectile(1).EmitterTimer = timer()
			Projectile(1).EmitterInterval = 50
			Projectile(1).vx# = newxvalue(0, ay#, 2)
			Projectile(1).vy# = 0
			Projectile(1).vz# = newzvalue(0, ay#, 2)
			Projectile(1).Bounce = 0
			Projectile(1).Delay = 75

			`Create projectile
			obj = FindFreeObject()
			Projectile(1).Obj = obj
			make object cube obj, 1
			make object collision box obj, -.5, -.5, -.5, .5, .5, .5, 0
			position object obj, newxvalue(x#, ay#, 6), y#, newzvalue(z#, ay#, 6)

			`One second delay
			Player(pl).Delay = timer() + 1000
			Player(pl).DontMove = 75
		endcase
		case 2 : `Smoke Bomb
		
			`Start projectile
			array insert at top Projectile()
			Projectile(1).Life = 2000
			Projectile(1).EmitterType = 2
			Projectile(1).EmitterTimer = timer()
			Projectile(1).EmitterInterval = 50
			Projectile(1).ay# = Gravity#
			Projectile(1).vx# = newxvalue(0, ay#, 0.5)
			Projectile(1).vy# = 1.0
			Projectile(1).vz# = newzvalue(0, ay#, 0.5)
			Projectile(1).Bounce = 1
			
			`Create projectile
			obj = FindFreeObject()
			Projectile(1).Obj = obj
			make object cube obj, 1
			make object collision box obj, -.5, -.5, -.5, .5, .5, .5, 0
			position object obj, newxvalue(x#, ay#, 6), y#, newzvalue(z#, ay#, 6)
			
			`Delay
			Player(pl).Delay = timer() + 1500
		endcase
		case 3 : `Grenade
		
			`Start projectile
			array insert at top Projectile()
			Projectile(1).Life = 300
			Projectile(1).EmitterType = 3
			Projectile(1).EmitterTimer = timer()
			Projectile(1).EmitterInterval = 75
			Projectile(1).ay# = Gravity#
			Projectile(1).vx# = newxvalue(0, ay#, 1)
			Projectile(1).vy# = 1.0
			Projectile(1).vz# = newzvalue(0, ay#, 1)
			Projectile(1).Bounce = 1
			
			`Create projectile
			obj = FindFreeObject()
			Projectile(1).Obj = obj
			make object cube obj, 1
			make object collision box obj, -.5, -.5, -.5, .5, .5, .5, 0
			position object obj, newxvalue(x#, ay#, 6), y#, newzvalue(z#, ay#, 6)

			`Delay
			Player(pl).Delay = timer() + 1500
		endcase
	endselect

endfunction

`-- Handle Projectile --
function HandleProjectile( p )
	
	`Get information
	obj = Projectile(p).Obj
	x# = object position x(obj)
	y# = object position y(obj)
	z# = object position z(obj)
	
	if Projectile(p).Delay <= 0
	
		`Speed
		inc Projectile(p).vx#, Projectile(p).ax#
		inc Projectile(p).vy#, Projectile(p).ay#
		inc Projectile(p).vz#, Projectile(p).az#
	
		`Positions
		inc x#, Projectile(p).vx#
		inc y#, Projectile(p).vy#
		inc z#, Projectile(p).vz#
	
		`Update object
		position object obj, x#, y#, z#
		ForceDelete = 0
		if object collision(obj, 0) > 0
			if Projectile(p).Bounce > 0
				if get object collision x() <> 0.0
                    Projectile(p).vx# = -Projectile(p).vx# * 0.8
                    dec x#, get object collision x()
                endif
				if get object collision y() <> 0.0
					Projectile(p).vy# = -Projectile(p).vy# * 0.8
					Projectile(p).vx# = Projectile(p).vx# * 0.8
					Projectile(p).vz# = Projectile(p).vz# * 0.8
					dec y#, get object collision y()
				endif
				if get object collision z() <> 0.0
                    Projectile(p).vz# = -Projectile(p).vz# * 0.8
                    dec z#, get object collision y()
                endif
			else
				ForceDelete = 1
			endif
		endif
		
		`Update projectile
		position object obj, x#, y#, z#
		
		`Particles
		if timer() - Projectile(p).EmitterTimer > Projectile(p).EmitterInterval
			Projectile(p).EmitterTimer = timer()
	
			select Projectile(p).EmitterType
				case 1 : `Fireball
	
					`Create a particle
					CreateParticle( 20, 20, FireImage )
					Particle(1).vx# = -0.1 + (0.01*rnd(20))
					Particle(1).vy# = -0.1 + (0.01*rnd(20))
					Particle(1).vz# = -0.1 + (0.01*rnd(20))
					Particle(1).vsx# = 1
					Particle(1).vsy# = 1
					Particle(1).rz# = rnd(360)
					Particle(1).vrz# = -0.5 + (0.1*rnd(10))
					Particle(1).Life = 50
					Particle(1).MaxLife = 50
					position object Particle(1).Obj, x#, y#, z#
					
					`Create some smoke
					CreateParticle( 20, 20, SmokeImage )
					Particle(1).vx# = -0.5 + (0.05*rnd(20))
					Particle(1).vy# = 0.05*rnd(20)
					Particle(1).vz# = -0.5 + (0.05*rnd(20))
					Particle(1).ay# = 0.005
					Particle(1).vsx# = 1
					Particle(1).vsy# = 1
					Particle(1).rz# = rnd(360)
					Particle(1).vrz# = -0.5 + (0.1*rnd(10))
					Particle(1).Life = 50
					Particle(1).MaxLife = 100
					position object Particle(1).Obj, x#, y#, z#
				endcase
				
				case 2 : `Smoke bomb
				
					`Create a particle
					CreateParticle(100, 100, SmokeImage)
					Particle(1).vx# = -0.5 + (0.05*rnd(20))
					Particle(1).vy# = 0.05*rnd(20)
					Particle(1).vz# = -0.5 + (0.05*rnd(20))
					Particle(1).ay# = 0.005
					Particle(1).vsx# = 1
					Particle(1).vsy# = 1
					Particle(1).rz# = rnd(360)
					Particle(1).vrz# = -0.5 + (0.1*rnd(10))
					Particle(1).Life = 100
					Particle(1).MaxLife = 50
					position object Particle(1).Obj, x#, y#, z#
				endcase
				
				case 3 : `Grenade
	
					`Create some smoke
					CreateParticle( 20, 20, SmokeImage )
					Particle(1).vx# = -0.5 + (0.05*rnd(20))
					Particle(1).vy# = -0.5 + (0.05*rnd(20))
					Particle(1).vz# = -0.5 + (0.05*rnd(20))
					Particle(1).ay# = 0.005
					Particle(1).vsx# = 1
					Particle(1).vsy# = 1
					Particle(1).rz# = rnd(360)
					Particle(1).vrz# = -0.5 + (0.1*rnd(10))
					Particle(1).Life = 50
					Particle(1).MaxLife = 100
					position object Particle(1).Obj, x#, y#, z#
				endcase
			endselect
		endif
	
		`Life and delete
		dec Projectile(p).Life
		if Projectile(p).Life <= 0 or ForceDelete = 1
		
			`Explode if explosion type
			if Projectile(p).EmitterType = 3
			
				`Create a bunch of particles
				for i = 1 to 20
					
					`Create a particle
					CreateParticle(75, 75, FireImage)
					Particle(1).vx# = -1.0 + (0.01*rnd(200))
					Particle(1).vy# = 0.01*rnd(200)
					Particle(1).vz# = -1.0 + (0.01*rnd(200))
					Particle(1).ay# = Gravity#
					Particle(1).Life = 75
					Particle(1).MaxLife = 50
					position object Particle(1).Obj, x#, y#, z#
				next i
			endif
		
			delete object Projectile(p).Obj
			array delete element Projectile(), p
		endif
	else
	
		`Decrease
		dec Projectile( p ).Delay
		
		`Action on fire here
		if Projectile(p).Delay = 0
			select Projectile(p).EmitterType
				case 1 : `Fire ball
				
					`Create a ring of wind
					for i = 1 to 40
					
						`Angle
						ang = rnd(360)
						v# = 0.5
						
						`Create particle
						point object obj, x# + Particle(p).vx#, y# + Particle(p).vy#, z# + Particle(p).vz#
						ay# = object angle y(obj)
						CreateParticle( 25, 25, SmokeImage )
						Particle(1).vx# = newxvalue(0, wrapvalue(ay# + 90), cos(ang)*v#)
						Particle(1).vz# = newzvalue(0, wrapvalue(ay# + 90), sin(ang)*v#)
						Particle(1).vy# = sin(ang)*v#
						Particle(1).ay# = -Particle(1).vy# * 0.005
						Particle(1).ax# = -Particle(1).vx# * 0.005
						Particle(1).az# = -Particle(1).vz# * 0.005
						Particle(1).Life = 80
						Particle(1).MaxLife = 100
						position object Particle(1).Obj, x#, y#, z#
					next i
				endcase
			endselect
		else
		
			`Action on waiting here
			select Projectile(p).EmitterType
				case 1 :  `Fire ball
					
					`Emmit from surroundings
					ex# = x# - 30.0 + (0.1*rnd(600))
					ey# = y# - 7.5
					ez# = z# - 30.0 + (0.1*rnd(600))
					CreateParticle(5, 5, SparkleImageFire)
					Particle(1).vy# = 0.1 + (0.01*rnd(50))
					Particle(1).ay# = -vy#/20
					Particle(1).rz# = rnd(360)
					Particle(1).vrz# = 0.1*rnd(20)
					Particle(1).Life = 40
					Particle(1).MaxLife = 20
					position object Particle(1).Obj, ex#, ey#, ez#
				endcase
			endselect
		endif
	endif
endfunction

`-- Start Particle --
function CreateParticle( sx#, sy#, tex )

	`Find a free object
	array insert at top Particle()
	obj = FindFreeObject()
	Particle(1).Obj = obj
	Particle(1).Tex = tex
	
	`Create object
	make object plain obj, 100, 100
	Particle(1).sx# = sx#
	Particle(1).sy# = sy#
	texture object obj, tex
	set object transparency obj, 3
	disable object zwrite obj
	set object collision off obj
	set object rotation ZYX obj
	set object light obj, 0
	hide object obj
endfunction

`-- Handle Particle --
function HandleParticle( p )

	`Increase values
	obj = Particle(p).Obj
	x# = object position x( obj )
	y# = object position y( obj )
	z# = object position z( obj )

	`Acceleration
	inc Particle(p).vx#, Particle(p).ax#
	inc Particle(p).vy#, Particle(p).ay#
	inc Particle(p).vz#, Particle(p).az#
	
	`Velocity
	inc x#, Particle(p).vx#
	inc y#, Particle(p).vy#
	inc z#, Particle(p).vz#

	`Rotation
	Particle(p).rz# = wrapvalue(Particle(p).rz# + Particle(p).vrz#)
	
	`Size
	inc Particle(p).sx#, Particle(p).vsx#
	inc Particle(p).sy#, Particle(p).vsy#

	`Life
	dec Particle(p).Life
	
	`Update particle
	position object obj, x#, y#, z#
	point object obj, camera position x(), camera position y(), camera position z()
	zrotate object obj, Particle(p).rz#
	scale object obj, Particle(p).sx#, Particle(p).sy#, 0
	if Particle(p).Life < Particle(p).MaxLife then set alpha mapping on obj, 100.0 / Particle(p).MaxLife * Particle(p).Life
	show object obj

	`If life reaches 0, destroy particle
	if Particle(p).Life = 0
	
		`Delete object
		delete object obj
		array delete element Particle(), p
	endif

endfunction

`*** CREATION FUNCTIONS ***

`-- Create Players --
function CreatePlayer(pl, Name$)

	`Free object number
	obj = FindFreeObject()
	
	`Create box and collision box
	make object box obj, 5, 15, 5
	make object collision box obj, -2.5, -7.5, -2.5, 2.5, 7.5, 2.5, 0
	
	`Set data
	Player(pl).Obj = obj
	Player(pl).Name$ = Name$
	Player(pl).CWeapon = 1
	Player(pl).Speed# = 0.5
endfunction obj

`--- Create World ---
function CreateWorldObject(x#, y#, z#, sx#, sy#, sz#)

	`Free object number
	obj = FindFreeObject()
	
	`Create box
	make object box obj, sx#, sy#, sz#
	make object collision box obj, -sx#/2, -sy#/2, -sz#/2, sx#/2, sy#/2, sz#/2, 0
	position object obj, x#, y#, z#
	color object obj, rgb(100, 100, 100)
endfunction obj

`-- Create Smoke Particle --
function CreateSmokeImage(width, height, seeds)

	`Create a bitmap
	create bitmap 1, width, height
	set current bitmap 1
	if width < height then size = width else size = height

	`Draw on the bitmap
	for i = 1 to seeds
	
		`Calculate random values
		ang = rnd(360)
		dist = size / 2 - int( sqrt(rnd((size / 2)^2 - 10)) + 0.5)
		x = width / 2 + (cos(ang) * dist)
		y = height / 2 + (sin(ang) * dist)
		
		`Get color
		grey = int(255.0 / (size/2) * ((size/2) - dist) + 0.5)
		if grey < 0 then grey = 0 else if grey > 255 then grey = 255
		
		`Draw a small box
		ink rgb(grey, grey, grey), 0
		box x - 2, y - 2, x + 2, y + 2
	next i

	`Blur this bitmap
	blur bitmap 1, 6
	blur bitmap 1, 6
	
	`Convert to image
	img = FindFreeImage()
	get image img, 0, 0, bitmap width(1), bitmap height(1), 1
	
	`Now delete the bitmap
	delete bitmap 1

	`Finally, convert to alpha values
	make memblock from image 1, img
	width = memblock dword(1, 0)
	for x = 0 to width - 1
		for y = 0 to memblock dword(1, 4) - 1

			`Read grey values
			pos = 12 + (((y * width) + x) * 4)
			grey = memblock byte(1, pos)
			write memblock dword 1, pos, rgb(255, 255, 255)
			write memblock byte 1, pos + 3, grey
		next y
	next x
	
	`Convert back to an image
	make image from memblock img, 1
	delete memblock 1
endfunction img

`-- Create sparkle image
function CreateSparkle()

	`Create a bitmap
	create bitmap 1, 64, 64
	
	`Draw on bitmap
	box 22, 22, 42, 42
	
	`Make some more
	for i = 1 to 10
		x = 12 + rnd(40)
		y = 12 + rnd(40)
		box x - 2, y - 2, x + 2, y + 2
	next i
	
	`Blur
	for i = 1 to 5
		blur bitmap 1, 6
	next i
	
	`Get image
	img = FindFreeImage()
	get image img, 0, 0, 64, 64, 1
	
	`Now delete the bitmap
	delete bitmap 1

	`Finally, convert to alpha values
	make memblock from image 1, img
	width = memblock dword(1, 0)
	for x = 0 to width - 1
		for y = 0 to memblock dword(1, 4) - 1

			`Read grey values
			pos = 12 + (((y * width) + x) * 4)
			grey = memblock byte(1, pos)
			write memblock dword 1, pos, rgb(255, 255, 255)
			write memblock byte 1, pos + 3, grey

		next y
	next x
	
	`Convert back to an image
	make image from memblock img, 1
	delete memblock 1

endfunction img

`-- Colorize a greyscale image --
function Colorize(GreyScaleImg, color)

	`Transform into a memblock
	make memblock from image 1, GreyScaleImg
	width = memblock dword(1, 0)
	height = memblock dword(1, 4)
	tRed = rgbr(color)
	tGreen = rgbg(color)
	tBlue = rgbb(color)
	
	`Transform
	for x = 0 to width - 1
		for y = 0 to height - 1
		
			`Get position
			pos = 12 + (((y*width) + x) * 4)
			
			`Read color
			blue =  int( memblock byte(1, pos    ) / 255.0 * tBlue  + 0.5 )
			if blue > 255  then blue = 255  else if blue < 0  then blue = 0
			green = int( memblock byte(1, pos + 1) / 255.0 * tGreen + 0.5 )
			if green > 255 then green = 255 else if green < 0 then green = 0
			red =   int( memblock byte(1, pos + 2) / 255.0 * tRed   + 0.5 )
			if red > 255   then red = 255   else if red < 0   then red = 0
			
			`Write color
			write memblock byte 1, pos, blue
			write memblock byte 1, pos + 1, green
			write memblock byte 1, pos + 2, red
		next y
	next x
	
	`Transform into image
	img = FindFreeImage()
	make image from memblock img, 1
	delete memblock 1
endfunction img

`--- Merge Layers ---
function MergeLayers(Layer1img, Layer2img)

	`Convert both to a memblock
	make memblock from image 1, Layer1img
	make memblock from image 2, Layer2img
	width = memblock dword(1, 0)
	height = memblock dword(1, 4)

	`Use alpha values to create one
	for x = 0 to width - 1
		for y = 0 to height - 1
		
			`Calculate position
			pos = 12 + (((y * width) + x) * 4)
			
			`Get data
			write memblock byte 1, pos, int((memblock byte(1, pos) + memblock byte(2, pos)) *0.5 + 0.5)
			write memblock byte 1, pos + 1, int((memblock byte(1, pos + 1) + memblock byte(2, pos + 1)) * 0.5 + 0.5)
			write memblock byte 1, pos + 2, int((memblock byte(1, pos + 2) + memblock byte(2, pos + 2)) * 0.5 + 0.5)
			write memblock byte 1, pos + 3, int((memblock byte(1, pos + 3) + memblock byte(2, pos + 3)) * 0.5 + 0.5)
		next y
	next x
	
	`Convert to image
	img = FindFreeImage()
	make image from memblock img, 1
	
	`Delete memblocks
	delete memblock 1
	delete memblock 2
endfunction img

`-- Find free image --
function FindFreeImage()
	img = 0
	repeat
		inc img
	until image exist(img) = 0
endfunction img

`-- Find free object --
function FindFreeObject()
	repeat
		obj = 1 + rnd(65534)
	until object exist(obj) = 0
endfunction obj

`********
`* DATA *
`********

Weapons:
data "Fire Ball"
data "Smoke Bomb"
data "Grenade"

Jimmy 8-#

`Coding Challenge - Dancing Challenge
`Bill Robinson
`Started 6-28-08 --- Deadline 7-9-08
`
`
`
`Press SPACE bar to start and stop Random mode.
`
set display mode 1024,768,32
sync on
sync rate 0
set text opaque
sync
autocam off
randomize timer()

global numdancers=3

dim stickman_poses(20,12,12)
dim stickman_inmotion#(numdancers,3,12,12)
dim stickman_info(20,4)
dim sequence(1000)
dim menu(3,3)
dim danceroffsetx(numdancers)

dim stickman_frame(numdancers)
dim pose_start(numdancers)
dim dancercount(numdancers)

danceroffsetx(1)=-200
danceroffsetx(2)=0
danceroffsetx(3)=200

global playerx#
global playery#
global playerxinc#=0
global playeryinc#=0
global animspeed#=10.0
global numframes
global scale#=1.0
global numposes


global ground=500
global posenum
global autoflag=-1
global seqptr=0

global posenumber=1
global posesync=0


startdrum=27
enddrum=64
numdrums=lastdrum-startdrum+1
musicnum=1

`Make MIDI drum files
for i=startdrum to enddrum
   print "Making Drum #";i
   sync
   _make_drum(i)
   sync

   num=startdrum-1+musicnum
   fname$="tempmidi-"+str$(num)+".mid"
   load music fname$,musicnum
   inc musicnum
next i

gosub _intro

`--- build small icons for screen
scale#=1.0
numposes=7

restore stickman_static
_store_pose(1)
restore stickman_tut1
_store_pose(2)
restore stickman_tut2
_store_pose(3)
restore stickman_armsout
_store_pose(4)
restore stickman_armstouching
_store_pose(5)
restore stickman_leftlean
_store_pose(6)
restore stickman_rightlean
_store_pose(7)

remstart
restore stickman_handstand1
_store_pose(8)
restore stickman_handstand2
_store_pose(9)
remend

_build_pose_icons()
_show_poses()

`--- build full size stickman for dancing
scale#=5.0
restore stickman_static
_store_pose(1)
restore stickman_tut1
_store_pose(2)
restore stickman_tut2
_store_pose(3)
restore stickman_armsout
_store_pose(4)
restore stickman_armstouching
_store_pose(5)
restore stickman_leftlean
_store_pose(6)
restore stickman_rightlean
_store_pose(7)

remstart
restore stickman_handstand1
_store_pose(8)
restore stickman_handstand2
_store_pose(9)
remend

playerx#=screen width()/2
playery#=ground

` --- build stickman
numframes=int(animspeed#)
posenum=1
for dancer=1 to numdancers
   _stickman_init(posenum,dancer)
   _draw_stickman2(1,0,dancer)
next dancer

ink rgb(0,255,255),0
rem ----- main loop -----------------------------------------------------

startdrum=27
enddrum=64
numdrums=enddrum-startdrum+1


dim pose_sound(128)
`assign midi drum sound to a dance pose for manual mode
posesounds:
`manual assignment for QWERTYU keys - needs more work - using random drums for now
`data 1,9,10,1,9,10,1,1,9,10

`Auto mode assignments - then chosen at random
data 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38
restore posesounds
for i=1 to numdrums
   read musicnum
   pose_sound(i)=musicnum
next i


global poseflag=0
global posedelaytime=300
global syncflag=-1


sync rate 60
do
   for musicnum=1 to numdrums
      if music playing(musicnum)<>1 then stop music musicnum
   next musicnum

remstart
   for keynum=16 to 25     :`QWERTYU keys
      if keystate(keynum)=1
         musicnum=keynum-15
         play music musicnum
      endif
   next keynum
remend

   cls
   line 0,ground,1024,ground

   keypress=scancode()                             :`scan for keys pressed, subroutine to hadle keys
   if keypress>0 then _key_action(keypress)

   if upkey()=1
      if posedelaytime<300 then inc posedelaytime,5
   endif

   if downkey()=1
      if posedelaytime>0 then dec posedelaytime,5
   endif

   if autoflag>0
      if pose_delay(posedelaytime,1)=1
         num=rnd(38-1)+1
         play music pose_sound(num)     :`was pose_number(posenumber)
      endif
   endif

   for dancer=1 to numdancers
      if stickman_frame(dancer)<numframes
         _update_frame(dancer)
         inc stickman_frame(dancer)

      else
         `if pose delay time is over, get a new pose
         if pose_delay(posedelaytime,dancer)=1
            if autoflag>0
               `only run this code once per pose change, key off of dancer1
               `for synchronized dancing
               if dancer=1
                  if posecount=0
                     syncflag=syncflag * -1
                     if syncflag<0
                        posesyncmsg$="OFF"
                        posecount=20
                     else
                        posesyncmsg$="ON"
                        posecount=20
                     endif
                  else
                     dec posecount
                  endif
               endif

               posenumber=rnd(numposes-1)+1
               if dancer=1 then dancer1pose=posenumber
               if syncflag>0 and dancer>1
                  posenumber=dancer1pose
               endif
               _load_newpose(posenumber,dancer)
               if dancer>0 then inc dancercount(dancer)
               pose_start(dancer)=timer()
            endif
         endif
      endif
      _draw_stickman2(1,0,dancer)
   next dancer

   ` I know - quick and dirty print statements - sprites in the future, not enough time now
   set cursor 0,100
   print "Press SPACE key to start & Stop Auto Dancing"
   print " "
   if autoflag>0
      print "Use Up & Down Arrow Keys to change Auto Dancing Pose Delay"
      print "PoseDelay=";posedelaytime
      mess$="Sync Countdown: "+str$(posecount)
      center text 512,130,mess$
      mess$="Synchronized Dancing is: "+posesyncmsg$
      center text 512,150,mess$
   else
      Print "Manual Dancing - Use the QWERTYU keys"
   endif
   sync
loop
rem --------------------------------------------------------------------
end


function pose_delay(posedelay,dancer)
delayflagok=0
curtime=timer()
if curtime-pose_start(dancer)>posedelay
   delayflagok=1
endif
endfunction delayflagok


rem --- show score on screen
_show_score:
`set cursor 1,100
`print screen fps()
`print stickman_frame
`center text screenxcenter,2,"StickMan"
return


function _key_action(keypress)
select keypress
   case 57
      autoflag=autoflag*-1
      wait 100
   endcase
   case default
      if keypress>=16 and keypress<=25
         saveposenum=posenum
         ptemp=keypress-15
         if ptemp<=numposes
            posenum=ptemp
            num=rnd(38-1)+1
            play music pose_sound(num)
            for dancer=1 to numdancers
               _load_newpose(posenum,dancer)
            next dancer
         endif
      endif
   endcase
endselect
endfunction


`load initial pose for making icons and starting pose
function _stickman_init(num,dancer)
for i=1 to 10
   for j=1 to 4
      `load first pose into stickman array
      stickman_inmotion#(dancer,1,i,j)=stickman_poses(num,i,j)
      stickman_inmotion#(dancer,2,i,j)=stickman_poses(num,i,j)
      `calculate delta for each frame update
      v1#=stickman_inmotion#(dancer,1,i,j)
      v2#=stickman_inmotion#(dancer,2,i,j)
      stickman_inmotion#(dancer,3,i,j)=(v2#-v1#)/animspeed#
   next j
next i
stickman_frame(dancer)=0
endfunction


function _update_frame(dancer)
for i=1 to 10
   for j=1 to 4
      v1#=stickman_inmotion#(dancer,3,i,j)
      inc stickman_inmotion#(dancer,1,i,j),v1#
   next j
next i
endfunction


`loads next target pose after initial starting pose
function _load_newpose(num,dancer)
for i=1 to 10
   for j=1 to 4
      `load new pose into slot2
      stickman_inmotion#(dancer,2,i,j)=stickman_poses(num,i,j)
      `calculate delta for each frame update
      v1#=stickman_inmotion#(dancer,1,i,j)
      v2#=stickman_inmotion#(dancer,2,i,j)
      stickman_inmotion#(dancer,3,i,j)=(v2#-v1#)/animspeed#
   next j
next i
stickman_frame(dancer)=0
endfunction


function _draw_stickman2(num,iconflag,dancer)
playerxorig#=playerx#
   if iconflag=1
      groundoffset=0
   else
      groundoffset=stickman_inmotion#(dancer,num,stickman_info(posenum,1),4)
   endif
   if iconflag=0 then playerx#=playerx#+danceroffsetx(dancer)
   for i=1 to 9
      x1#=playerx#+stickman_inmotion#(dancer,num,i,1)
      y1#=playery#+stickman_inmotion#(dancer,num,i,2)-groundoffset
      x2#=playerx#+stickman_inmotion#(dancer,num,i,3)
      y2#=playery#+stickman_inmotion#(dancer,num,i,4)-groundoffset
      line x1#,y1#,x2#,y2#
   next i
   circle playerx#+stickman_inmotion#(dancer,num,10,1),playery#+stickman_inmotion#(dancer,num,10,2)-groundoffset,5.0*scale#
   playerx#=playerxorig#
endfunction



stickman_static:
`body
data 0,0,0,-20
`left upper arm
data 0,-20,-10,-15
`right upper arm
data 0,-20,10,-15
`left thigh
data 0,0,-7,7
`right thigh
data 0,0,7,7
`left forearm
data -10,-15,-15,-5
`righ forearm
data 10,-15,15,-5
`left leg
data -7,7,-12,18
`right leg
data 7,7,12,18
`head
data 0,-25,0,-25
`ground touching node
data 8

stickman_tut1:
`body
data 0,0,0,-20
`left upper arm
data 0,-20,-10,-20
`right upper arm
data 0,-20,10,-20
`left thigh
data 0,0,-10,0
`right thigh
data 0,0,10,0
`left forearm
data -10,-20,-10,-30
`righ forearm
data 10,-20,10,-10
`left leg
data -10,0,-10,10
`right leg
data 10,0,10,10
`head
data 0,-25,0,-25
`ground touching node
data 8

stickman_tut2:
`body
data 0,0,0,-20
`left upper arm
data 0,-20,-10,-20
`right upper arm
data 0,-20,10,-20
`left thigh
data 0,0,-10,0
`right thigh
data 0,0,10,0
`left forearm
data -10,-20,-10,-10
`righ forearm
data 10,-20,10,-30
`left leg
data -10,0,-10,10
`right leg
data 10,0,10,10
`head
data 0,-25,0,-25
`ground touching node
data 8


stickman_armsout:
`body
data 0,0,0,-20
`left upper arm
data 0,-20,-10,-20
`right upper arm
data 0,-20,10,-20
`left thigh
data 0,0,-7,7
`right thigh
data 0,0,7,7
`left forearm
data -10,-20,-20,-20
`righ forearm
data 10,-20,20,-20
`left leg
data -7,7,-12,18
`right leg
data 7,7,12,18
`head
data 0,-25,0,-25
`ground touching node
data 8


stickman_armstouching:
`body
data 0,0,0,-20
`left upper arm
data 0,-20,-8,-27
`right upper arm
data 0,-20,8,-27
`left thigh
data 0,0,-6,9
`right thigh
data 0,0,6,9
`left forearm
data -8,-27,0,-35
`righ forearm
data 8,-27,0,-35
`left leg
data -6,9,-3,18
`right leg
data 6,9,3,18
`head
data 0,-25,0,-25
`ground touching node
data 8

stickman_leftlean:
`body
data 0,0,-10,-20
`left upper arm
data -10,-20,-16,-8
`right upper arm
data -10,-20,4,-16
`left thigh
data 0,0,-6,9
`right thigh
data 0,0,6,9
`left forearm
data -16,-8,-6,-5
`righ forearm
data 4,-16,3,-5
`left leg
data -6,9,-3,18
`right leg
data 6,9,3,18
`head
data -10,-25,-10,-25
`ground touching node
data 8

stickman_rightlean:
`body
data 0,0,10,-20
`left upper arm
data 10,-20,-6,-15
`right upper arm
data 10,-20,13,-10
`left thigh
data 0,0,-6,9
`right thigh
data 0,0,6,9
`left forearm
data -6,-15,-3,-5
`righ forearm
data 13,-10,7,-5
`left leg
data -6,9,-3,18
`right leg
data 6,9,3,18
`head
data 10,-25,10,-25
`ground touching node
data 8


stickman_handstand1:
`body
data 0,-20,0,0
`left upper arm
data 0,0,10,0
`right upper arm
data 0,0,-10,0
`left thigh
data 0,-20,-10,-20
`right thigh
data 0,-20,10,-20
`left forearm
data -10,0,-10,10
`righ forearm
data 10,0,10,10
`left leg
data -10,-20,-10,-30
`right leg
data 10,-20,10,-30
`head
data 0,5,0,5
`ground touching node
data 6

stickman_handstand2:
`body
data 0,-20,0,0
`left upper arm
data 0,0,10,0
`right upper arm
data 0,0,-10,0
`left thigh
data 0,-20,-10,-20
`right thigh
data 0,-20,10,-20
`left forearm
data -10,0,-10,10
`righ forearm
data 10,0,10,10
`left leg
data -10,-20,-20,-20
`right leg
data 10,-20,20,-20
`head
data 0,5,0,5
`ground touching node
data 6



function _store_pose(posenum)
for i=1 to 10
   for j=1 to 4
      read d
      stickman_poses(posenum,i,j)=d * scale#
   next j
next i
read stickman_info(posenum,1)
endfunction


_intro:
sync
set text font "Arial"
set text size 30
set text opaque
cx=screen width()/2
cy=100

introtext:
data "-green"
data "StickMan Dancing"
data "   "
data "-purple"
data "Random mode - Press SPACE bar to start and stop random dance moves"
data "   "
data "Live Dance mode - Use QWERTYU keys to manually pose dancer"
data "   "
data "-cyan"
data "   "
data "-yellow"
data "Press a key to continue"
data "999"

cls
restore introtext
read t$
while t$<>"999"
   if left$(t$,1)="-"
      if t$="-green" then ink rgb(0,255,0),0
      if t$="-purple" then ink rgb(200,0,200),0
      if t$="-yellow" then ink rgb(255,255,0),0
      if t$="-cyan" then ink rgb(0,255,255),0
   else
      center text cx,cy,t$
      inc cy,30
   endif
   read t$
endwhile

sync
wait key
ink rgb(0,255,255),0
cls
set text size 16
sync
return


function _build_pose_icons()
pose$="QWERTYUIOP"
xsize=60
ysize=60
playerx#=xsize/2
playery#=ysize/2+7
dancer=1
for i=1 to numposes
   cls
   ink rgb(255,255,255),0
   _stickman_init(i,1)
   _draw_stickman2(1,1,1)
   ink rgb(0,200,0),0
   line 0,0,xsize,0
   line xsize,0,xsize,ysize
   line xsize,ysize,0,ysize
   line 0,ysize,0,0
   ink rgb(0,255,255),0
   text xsize-13,ysize-17,mid$(pose$,i)
   get image i,0,0,xsize+1,ysize+1,1
next i
endfunction


function _show_poses()
xpos=0
ypos=0
for i=1 to numposes
   sprite i,xpos,ypos,i
   inc xpos,60
next i
endfunction



`------------------------------------------------------------------------------

function _write_midi(filenum,numbytes)
for i=1 to numbytes
   read v
   write byte 1,v
next i
endfunction


function _write_drum_number(drum_number)
write byte 1,drum_number
endfunction

`MIDI - using no media is not very useful really, far to limited to use for sound effects
`DBPro seems to only let you load the same file name once with load music
`so I needed to name each drum sound file something different
`to limit the number of files left on the hard drive, I delete the previous file
`each time I create a new drum file

`create the actual midi file
function _make_drum(drum_number)
fname1$="tempmidi-"+str$(drum_number-1)+".mid"
fname2$="tempmidi-"+str$(drum_number)+".mid"

if file exist(fname1$)=1 then delete file fname1$
if file exist(fname2$)=1 then delete file fname2$

open to write 1,fname2$

restore mididata

mididata:
`midi header
`"MThd"(4 bytes)   num_bytes_in_header=6(4 bytes)   midi_type=1(4 bytes)
data 77,84,104,100, 0,0,0,6, 0,0,0,1
_write_midi(1,12)

`midi track header
`tempo   clock_ticks
data 7,192,77,84,114,107
_write_midi(1,6)

`number of bytes in the track
`only 29 bytes in this small midi track(4 byte long word)
data 0,0,0,29
_write_midi(1,4)

`instrument and delta set up
`Drums track 9 for drums
data 0,192,63,0,255,89,2,0,0,0,255,81,3,9,39,192,0
_write_midi(1,17)

`midi note on - drum 34
`turn the note on (144(90hex) + 9(9hex))=153 decimal
data 153
_write_midi(1,1)
_write_drum_number(drum_number)
data 127,135,64
_write_midi(1,3)


`midi note off - drum 34
`turn it off (128(80hex) + 9(9hex))=137 decial
data 137
_write_midi(1,1)
_write_drum_number(drum_number)
data 0,0
_write_midi(1,2)

`end of midi track
data 255,47,0,1
_write_midi(1,4)

close file 1
endfunction

`Sample MIDI File - created from the above code for drum#64 - output from a hex editor, all bytes listed as hex numbers
`Hex numbers are how MIDI commands are labeled in the MIDI file format
`Hex numbers use digit values of 16 and 1 for each byte, just like our decimal number system uses 10 and 1
`Hex digits can be 0-9 or A-F,0123456789ABCDEF
`For example '4d' is the first hex byte means (16 x 4)+(1 x 13(d=13decimal)= 64+13 = 77 ascii='M'
`

`4d 54 68 64 00 00 00 06 00 00 00 01 07 c0 4d 54    MThd.........ÀMT
`72 6b 00 00 00 1d 00 c0 3f 00 ff 59 02 00 00 00    rk.....À?.ÿY....
`ff 51 03 09 27 c0 00 99 40 7f 87 40 89 40 00 00    ÿQ..'À.™@‡@‰@..
`ff 2f 00 01                                        ÿ/..


`--- Here is a breakdown of the MIDI bytes ---
`4d 54 68 64      MIDI Header="MThd"
`00 00 00 06      #bytes in header=6
`00 00 00 01      midi file type=1
`07 c0            tempo
`4d 54 72 6b      MIDI Track Header="MTrk"
`00 00 00 1d      #bytes in track
`00               midi timing starts at 0
`c0 3f
`ff 59 02 00
`00
`ff 51 03 09 27
`c0 00
`99 40 7f 87 40   99 means, 90=note on, 9=track 9(drum track is always track 9), note=40 hex or 64 decial
`89 40 00 00      89 means, 80=note off, 9=track 9(drum track is always track 9), note=40 hex or 64 decial
`ff 2f 00 01