Sorry your browser is not supported!

type physinfotype
    gravityx as float
    gravityy as float
    gravityz as float 
    positionx as float
    positiony as float
    positionz as float  
    velocityx as float
    velocityy as float
    velocityz as float   
    accelerationx as float
    accelerationy as float
    accelerationz as float   
    restitution as float   
    size as float
endtype
global globalgravityx# = 0.0
global globalgravityy# = -9.8
global globalgravityz# = 0.0
global extent# = 4096.0 
global num
set window off
set display mode 1024,768,32
input "             How many spheres would like to generate? ",num
`sync rate 60
`sync on
autocam off
position camera 2048,0,2048
point camera 0,-4096,0
set camera range 1,10000
dim physinfo(num) as physinfotype
for i = 1 to num
    physinfo(i).size=256
    make object sphere i,physinfo(i).size,15,15 
    physinfo(i).restitution=0.85   
    physinfo(i).positionx=rnd(extent#*2)-extent#
    physinfo(i).positiony=rnd(extent#)
    physinfo(i).positionz=rnd(extent#*2)-extent#
    applyacceleration(i,rnd(1000)-50.0,rnd(1000)-50.0,rnd(1000)-50.0)
next i
do
for i = 1 to num
    updateobject(i)
next i
`updatecollisions()
`sync
set cursor 0,0
print "             FPS = ",screen fps()
loop
end

` FUNCTIONS

function setposition(obj,x#,y#,z#)
    physinfo(obj).positionx=x#
    physinfo(obj).positiony=y#
    physinfo(obj).positionz=z#
endfunction

function applyposition(obj,x#,y#,z#)
    physinfo(obj).positionx=physinfo(obj).positionx+x#
    physinfo(obj).positiony=physinfo(obj).positiony+y#
    physinfo(obj).positionz=physinfo(obj).positionz+z#
endfunction

function setvelocity(obj,x#,y#,z#)
    physinfo(obj).velocityx=x#
    physinfo(obj).velocityy=y#
    physinfo(obj).velocityz=z#
endfunction

function applyvelocity(obj,x#,y#,z#)
    physinfo(obj).velocityx=physinfo(obj).velocityx+x#
    physinfo(obj).velocityy=physinfo(obj).velocityy+y#
    physinfo(obj).velocityz=physinfo(obj).velocityz+z#
endfunction

function setacceleration(obj,x#,y#,z#)
    physinfo(obj).accelerationx=x#
    physinfo(obj).accelerationy=y#
    physinfo(obj).accelerationz=z#
endfunction

function applyacceleration(obj,x#,y#,z#)
    physinfo(obj).accelerationx=physinfo(obj).accelerationx+x#
    physinfo(obj).accelerationy=physinfo(obj).accelerationy+y#
    physinfo(obj).accelerationz=physinfo(obj).accelerationz+z#
endfunction

function updateobject(i)
    
    applyacceleration(i,globalgravityx#+physinfo(i).gravityx,globalgravityy#+physinfo(i).gravityy,globalgravityz#+physinfo(i).gravityz)    `set gravity
    applyvelocity(i,physinfo(i).accelerationx,physinfo(i).accelerationy,physinfo(i).accelerationz)
    applyposition(i,physinfo(i).velocityx,physinfo(i).velocityy,physinfo(i).velocityz)
    setacceleration(i,0.0,0.0,0.0)
        vx=physinfo(i).velocityx*physinfo(i).restitution
        vy=physinfo(i).velocityy*physinfo(i).restitution
        vz=physinfo(i).velocityz*physinfo(i).restitution
    if physinfo(i).positionx<-extent#+physinfo(i).size/2
        physinfo(i).positionx=-extent#+physinfo(i).size/2       
        setvelocity(i,-vx,vy,vz)
    endif
    if physinfo(i).positionx>extent#-physinfo(i).size/2
        physinfo(i).positionx=extent#-physinfo(i).size/2      
        setvelocity(i,-vx,vy,vz)
    endif
    if physinfo(i).positiony<-extent#+physinfo(i).size/2
        physinfo(i).positiony=-extent#+physinfo(i).size/2      
        setvelocity(i,vx,-vy,vz)
    endif
    if physinfo(i).positiony>extent#-physinfo(i).size/2
        physinfo(i).positiony=extent#-physinfo(i).size/2       
        setvelocity(i,vx,-vy,vz)
    endif
    if physinfo(i).positionz<-extent#+physinfo(i).size/2
        physinfo(i).positionz=-extent#+physinfo(i).size/2       
        setvelocity(i,vx,vy,-vz)
    endif
    if physinfo(i).positionz>extent#-physinfo(i).size/2
        physinfo(i).positionz=extent#-physinfo(i).size/2
        setvelocity(i,vx,vy,-vz)
    endif
    
    position object i,physinfo(i).positionx,physinfo(i).positiony,physinfo(i).positionz
endfunction

 `Kinetix - Physics Library #857584
`Alastair Zotos (Zotoaster)
`Main Source File


`setup
sync on : sync rate 60
set display mode 1024,768,32 : hide mouse
autocam off : set camera range 1,0x7fffffff
backdrop on : color backdrop 0
`set ambient light 75

`start Kinetix
kx_startKinetix()

`setup Kinetix world
kx_setupWorld(-1.3,0.02)

`create a simple sphere
//create bitmap 1,50,50 : set current bitmap 1
//   ink rgb(0,0,0),0 : box 0,0,50,50
//   ink rgb(255,0,0),0 : box 0,23,50,27
//   get image 1,0,0,50,50
//set current bitmap 0 : delete bitmap 1
make object sphere 1,100,100,100 : position object 1,-200,45,20

//make object cube 1,100 : position object 1,-200,45,20
//texture object 1,1 : 
set object rotation zyx 1
//kx_createBody==(Object, Dynamic mode, Mass, Drag Constant, Density, Material)
//kx_createMaterial==(Friction, Collision Object)
//kx_createBody==(Object, Dynamic mode, Mass, Drag Constant, Density, Material)

mat = kx_createMaterial(0.1,20)
sph = kx_createBody(1,1,500,0.1,1.1,mat)
vec1 = kx_makeVector()
vec2 = kx_makeVector()
frc#=100


remstart
make object sphere 2,100 : position object 2,-200,45,20
set object rotation zyx 2
jmat = kx_createMaterial(0.5,1)
jsph = kx_createBody(2,1,50,0.03,0.02,mat)
jsph2 = kx_createBody(2,1,50,0.03,0.02,jmat)
jvec1 = kx_makeVector()
jvec2 = kx_makeVector()
jfrc#=100
remend




`level
rem start
make matrix 1,10000,10000,30,30
for z=1 to 29
   for x=1 to 29
      height#=50.0-(abs(sin((x*40))*400))
      height#=height#+(50.0-(abs(cos((z*40))*400)))
      height#=height#/1.5
      set matrix height 1,x,z,height#
   next x
next z
update matrix 1
matrix_to_mesh(1,10000,10000,30,30,1)
make object 20,1,0 : delete mesh 1 : set object normals 20
position object 20,-5000,0,-50 : delete matrix 1
rem end
`load object "kintest3.x",2 : scale object 2,70,70,70 : yrotate object 2,180 : xrotate object 2,355 : fix object pivot 2
flr = kx_createBody(20,0,0,0,0.2,0)

`Main Loop
do
   set cursor 0,0
   print Screen fps()
   `get object positions
   x#=object position x(1)
   y#=object position y(1)
   z#=object position z(1)

   `control object
   if upkey()
      frcx#=sin(ay#)*frc#
      frcz#=cos(ay#)*frc#
   endif
   if downkey()
      frcx#=-sin(ay#)*frc#
      frcz#=-cos(ay#)*frc#
   endif
   if upkey()=0 and downkey()=0 then frcx#=0 : frcz#=0
   if leftkey() then a#=-3
   if rightkey() then a#=3
   if leftkey()=0 and rightkey()=0 then a#=0
   ay#=wrapvalue(ay#+a#)
   if spacekey() and kx_getColliding(sph)
      frcy#=5500
   else
      frcy#=0
   endif
   kx_setVector(vec1,frcx#,frcy#,frcz#) : kx_setBodyForce(sph)
   kx_setVector(vec2,frcz#,0,frcx#) : kx_setBodyTorque(sph)
   kx_updateBody(sph)
   frcx#=curvevalue(0,frcx#,0.05)
   frcy#=curvevalue(0,frcy#,0.05)
   frcz#=curvevalue(0,frcz#,0.05)

//-------------
remstart
   kx_setVector(jvec1,jfrcx#,frcy#,jfrcz#) : kx_setBodyForce(jsph) 
   kx_setVector(jvec2,jfrcz#,0,jfrcx#) : kx_setBodyTorque(jsph)

   kx_setVector(jvec1,jfrcx#,frcy#,jfrcz#) : kx_setBodyForce(jsph2) 
   kx_setVector(jvec2,jfrcz#,0,jfrcx#) : kx_setBodyTorque(jsph2)
   kx_updateBody(jsph)
   kx_updateBody(jsph2)
remend




   `camera
   ca#=curveangle(ay#,ca#,6.0)
   cx#=x#-sin(ca#)*600
   cy#=y#+300
   cz#=z#-cos(ca#)*600
   position camera cx#,cy#,cz#
   point camera x#,y#,z#


sync
loop



`*Kinetix Physics Functions*
`---------------------------

function kx_startKinetix()
   Global kxcontvec as integer
   Global kxworlddata as tkxworlddata
   dim kxbody(0) as tkxbodydata
   dim kxmat(0) as tkxmatdata
   dim kxvec(0) as vec3
endfunction
function kx_setupWorld(grav as float, dens as float)
   kxworlddata.grav=grav
   kxworlddata.dens=dens
endfunction

function kx_makeVector()
local vec as integer
   array insert at bottom kxvec() : vec=array count(kxvec())
endfunction vec
function kx_setVector(vec,x as float, y as float, z as float)
   kxcontvec=vec
   kxvec(vec).x=x
   kxvec(vec).y=y
   kxvec(vec).z=z
endfunction

function kx_createMaterial(fric as float, cobj)
local mat as integer
   array insert at bottom kxmat() : mat=array count(kxmat())
   kxmat(mat).fric=fric
   if cobj>0
      kxmat(mat).cobj=cobj
      kxmat(mat).coll=1
   endif
endfunction mat
function kx_createBody(obj, mode, mass as float, dragc as float, dens as float, mat)
local body as integer
   array insert at bottom kxbody() : body=array count(kxbody())
   kxbody(body).obj=obj
   kxbody(body).mass=mass
   kxbody(body).dragc=dragc
   kxbody(body).dens=dens
   kxbody(body).size=object size(obj)
   kxbody(body).mat=mat
   kxbody(body).cobj=kxmat(mat).cobj
   kxbody(body).mode=mode
   kxbody(body).pos.x=object position x(obj)
   kxbody(body).pos.y=object position y(obj)
   kxbody(body).pos.z=object position z(obj)
   kxbody(body).circ=kxbody(body).size*3.14
   sc_setupComplexObject obj,0,2
endfunction body

function kx_setBodyForce(body)
   kxbody(body).frct.x=kxvec(kxcontvec).x
   kxbody(body).frct.y=kxvec(kxcontvec).y
   kxbody(body).frct.z=kxvec(kxcontvec).z
endfunction
function kx_setBodyTorque(body)
   kxbody(body).trqt.x=kxvec(kxcontvec).x
   kxbody(body).trqt.y=kxvec(kxcontvec).y
   kxbody(body).trqt.z=kxvec(kxcontvec).z
endfunction
function kx_setBodyVelocity(body)
   kxbody(body).vel.x=kxvec(kxcontvec).x
   kxbody(body).vel.y=kxvec(kxcontvec).y
   kxbody(body).vel.z=kxvec(kxcontvec).z
endfunction
function kx_setBodyOmega(body)
   kxbody(body).omega.x=kxvec(kxcontvec).x
   kxbody(body).omega.y=kxvec(kxcontvec).y
   kxbody(body).omega.z=kxvec(kxcontvec).z
endfunction
function kx_updateBody(body)
   kxbody(body).mang.x=atanfull(kxbody(body).vel.y,kxbody(body).vel.z)
   kxbody(body).mang.y=atanfull(kxbody(body).vel.x,kxbody(body).vel.z)
   kxbody(body).mang.z=atanfull(kxbody(body).vel.x,kxbody(body).vel.y)
   kxbody(body).fdir.x=sin(kxbody(body).ang.y)*cos(kxbody(body).ang.x)
   kxbody(body).fdir.y=-sin(kxbody(body).ang.x)
   kxbody(body).fdir.z=cos(kxbody(body).ang.y)*cos(kxbody(body).ang.x)
   kxbody(body).mdir.x=sin(kxbody(body).mang.y)*cos(kxbody(body).mang.x)
   kxbody(body).mdir.y=-sin(kxbody(body).mang.x)
   kxbody(body).mdir.z=cos(kxbody(body).mang.y)*cos(kxbody(body).mang.x)
      kxbody(body).frcw.x=0
      kxbody(body).frcw.y=kxbody(body).mass*kxworlddata.grav
      kxbody(body).frcw.z=0
      kxbody(body).frcd.x=-(((kxbody(body).dragc+(kxmat(kxbody(body).mat).fric*kxbody(body).ccoll))/2)*kxbody(body).size*kxworlddata.dens*((kxbody(body).vel.x^2)*sgn(kxbody(body).vel.x)))
      kxbody(body).frcd.y=-(((kxbody(body).dragc+(kxmat(kxbody(body).mat).fric*kxbody(body).ccoll))/2)*kxbody(body).size*kxworlddata.dens*((kxbody(body).vel.y^2)*sgn(kxbody(body).vel.y)))
      kxbody(body).frcd.z=-(((kxbody(body).dragc+(kxmat(kxbody(body).mat).fric*kxbody(body).ccoll))/2)*kxbody(body).size*kxworlddata.dens*((kxbody(body).vel.z^2)*sgn(kxbody(body).vel.z)))
   kxbody(body).frc.x=kxbody(body).frct.x+kxbody(body).frcw.x+kxbody(body).frcd.x+kxbody(body).frcc.x
   kxbody(body).frc.y=kxbody(body).frct.y+(kxbody(body).frcw.y*(1-kxbody(body).ccoll))+kxbody(body).frcd.y+kxbody(body).frcc.y
   kxbody(body).frc.z=kxbody(body).frct.z+kxbody(body).frcw.z+kxbody(body).frcd.z+kxbody(body).frcc.z
   kxbody(body).acc.x=kxbody(body).frc.x/kxbody(body).mass
   kxbody(body).acc.y=kxbody(body).frc.y/kxbody(body).mass
   kxbody(body).acc.z=kxbody(body).frc.z/kxbody(body).mass
      kxbody(body).vel.x=kxbody(body).vel.x+kxbody(body).acc.x
      kxbody(body).vel.y=kxbody(body).vel.y+kxbody(body).acc.y
      kxbody(body).vel.z=kxbody(body).vel.z+kxbody(body).acc.z
      kxbody(body).speed=sqrt(kxbody(body).vel.x^2+kxbody(body).vel.y^2+kxbody(body).vel.z^2)
   kxbody(body).pos.x=kxbody(body).pos.x+kxbody(body).vel.x
   kxbody(body).pos.y=kxbody(body).pos.y+kxbody(body).vel.y
   kxbody(body).pos.z=kxbody(body).pos.z+kxbody(body).vel.z
   kxbody(body).trq.x=kxbody(body).trqt.x+kxbody(body).trqd.x+kxbody(body).trqc.x
   kxbody(body).trq.y=kxbody(body).trqt.y+kxbody(body).trqd.y+kxbody(body).trqc.y
   kxbody(body).trq.z=kxbody(body).trqt.z+kxbody(body).trqd.z+kxbody(body).trqc.z
      kxbody(body).angacc.x=kxbody(body).trq.x/kxbody(body).mass
      kxbody(body).angacc.y=kxbody(body).trq.y/kxbody(body).mass
      kxbody(body).angacc.z=kxbody(body).trq.z/kxbody(body).mass
   kxbody(body).omega.x=kxbody(body).omega.x+kxbody(body).angacc.x
   kxbody(body).omega.y=kxbody(body).omega.y+kxbody(body).angacc.y
   kxbody(body).omega.z=kxbody(body).omega.z+kxbody(body).angacc.z
      kxbody(body).ang.x=kxbody(body).ang.x+kxbody(body).omega.x
      kxbody(body).ang.y=kxbody(body).ang.y+kxbody(body).omega.y
      kxbody(body).ang.z=kxbody(body).ang.z+kxbody(body).omega.z
      if kxbody(body).mode=1
         c=sc_sphereSlide(kxbody(body).cobj,kxbody(body).pos.x-kxbody(body).vel.x,kxbody(body).pos.y-kxbody(body).vel.y,kxbody(body).pos.z-kxbody(body).vel.z,kxbody(body).pos.x,kxbody(body).pos.y,kxbody(body).pos.z,kxbody(body).size,0)
         if c>0 then kxbody(body).ccoll=1 else kxbody(body).ccoll=0
            if kxbody(body).ccoll=1
               kxbody(body).vel.x=sc_getCollisionbounceX()
               kxbody(body).vel.y=sc_getCollisionbounceY()
               kxbody(body).vel.z=sc_getCollisionbounceZ()
               kxbody(body).cnorm.x=sc_getCollisionNormalX()
               kxbody(body).cnorm.y=sc_getCollisionNormalY()
               kxbody(body).cnorm.z=sc_getCollisionNormalZ()
            endif
      kxbody(body).mom.x=kxbody(body).mass*kxbody(body).vel.x
      kxbody(body).mom.y=kxbody(body).mass*kxbody(body).vel.y
      kxbody(body).mom.z=kxbody(body).mass*kxbody(body).vel.z
      endif
   position object kxbody(body).obj,kxbody(body).pos.x,kxbody(body).pos.y,kxbody(body).pos.z
   rotate object kxbody(body).obj,kxbody(body).ang.x,kxbody(body).ang.y,kxbody(body).ang.z
   sc_updateObject kxbody(body).obj
endfunction

function kx_getColliding(body)
local coll as boolean
   coll=kxbody(body).ccoll
endfunction coll
function kx_getCollisionNormalX(body)
local nx as float
   nx=kxbody(body).cnorm.x
endfunction nx
function kx_getCollisionNormalY(body)
local ny as float
   ny=kxbody(body).cnorm.y
endfunction ny
function kx_getCollisionNormalZ(body)
local nz as float
   nz=kxbody(body).cnorm.z
endfunction nz

function kx_getBodyVelocityX(body)
local vx as float
   vx=kxbody(body).vel.x
endfunction vx
function kx_getBodyVelocityY(body)
local vy as float
   vy=kxbody(body).vel.y
endfunction vy
function kx_getBodyVelocityZ(body)
local vz as float
   vz=kxbody(body).vel.z
endfunction vz

function sgn(value#)
   if value#>=0 then exitfunction 1
endfunction -1
function startsparky()
   make memblock 1,0
   delete memblock 1
endfunction


`Impotant Types
Type vec3
   x as float
   y as float
   z as float
endtype
type tkxworlddata
   grav as float
   dens as float
endtype
type tkxmatdata
   fric as float
   cobj as integer
   coll as boolean
endtype
type tkxbodydata
   obj as integer
   circ as float
      pos as vec3
      vel as vec3
      acc as vec3
      fdir as vec3
      mdir as vec3
         frct as vec3
         frcw as vec3
         frcd as vec3
         frcc as vec3
         frc as vec3
         mom as vec3
      mang as vec3
      ang as vec3
      omega as vec3
      angacc as vec3
      angmove as vec3
         trqt as vec3
         trqd as vec3
         trqc as vec3
         trq as vec3
      mass as float
      dens as float
      mat as integer
      dragc as float
      size as float
      speed as float
   cobj as integer
   coll as vec3
   cnorm as vec3
   ccoll as boolean
   mode as boolean
endtype


`Deamon's Functions (Thanks)
function matrix_to_mesh(matrixnum,width,height,xtiles,ztiles,meshnum)
create_memblockobject(meshnum,xtiles*ztiles*6)
for x=0 to xtiles-1
   for z=0 to ztiles-1
      div#=2
      create_vertex(meshnum,vertex,x*width/(xtiles+0.0),get matrix height(matrixnum,x,z),z*height/(ztiles+0.0),rgb(get matrix height(matrixnum,x,z)/div#,get matrix height(matrixnum,x,z)/div#,get matrix height(matrixnum,x,z)/div#),0,0)
      create_vertex(meshnum,vertex+1,x*width/(xtiles+0.0),get matrix height(matrixnum,x,z+1),(z+1)*height/(ztiles+0.0),rgb(get matrix height(matrixnum,x,z+1)/div#,get matrix height(matrixnum,x,z+1)/div#,get matrix height(matrixnum,x,z+1)/div#),0,0)
      create_vertex(meshnum,vertex+2,(x+1)*width/(xtiles+0.0),get matrix height(matrixnum,x+1,z),z*height/(ztiles+0.0),rgb(get matrix height(matrixnum,x+1,z)/div#,get matrix height(matrixnum,x+1,z)/div#,get matrix height(matrixnum,x+1,z)/div#),0,0)
      create_vertex(meshnum,vertex+3,(x+1)*width/(xtiles+0.0),get matrix height(matrixnum,x+1,z),z*height/(ztiles+0.0),rgb(get matrix height(matrixnum,x+1,z)/div#,get matrix height(matrixnum,x+1,z)/div#,get matrix height(matrixnum,x+1,z)/div#),0,0)
      create_vertex(meshnum,vertex+4,x*width/(xtiles+0.0),get matrix height(matrixnum,x,z+1),(z+1)*height/(ztiles+0.0),rgb(get matrix height(matrixnum,x,z+1)/div#,get matrix height(matrixnum,x,z+1)/div#,get matrix height(matrixnum,x,z+1)/div#),0,0)
      create_vertex(meshnum,vertex+5,(x+1)*width/(xtiles+0.0),get matrix height(matrixnum,x+1,z+1),(z+1)*height/(ztiles+0.0),rgb(get matrix height(matrixnum,x+1,z+1)/div#,get matrix height(matrixnum,x+1,z+1)/div#,get matrix height(matrixnum,x+1,z+1)/div#),0,0)
      for i=0 to 5
         set_normal(meshnum,vertex+i,1,1,1)
      next i
      inc vertex,6
   next z
next x
make mesh from memblock meshnum,meshnum
delete memblock meshnum
endfunction
function create_memblockobject(memnum,v)
   make memblock memnum,12+(36*v)
   write memblock dword memnum,0,338
   write memblock dword memnum,4,36
   write memblock dword memnum,8,v
endfunction
function create_vertex(memnum,v,vposx#,vposy#,vposz#,color as dword,u#,v#)
   write memblock float memnum,v*36+12,vposx#
   write memblock float memnum,v*36+16,vposy#
   write memblock float memnum,v*36+20,vposz#
   write memblock dword memnum,v*36+36,color
   write memblock float memnum,v*36+40,u#
   write memblock float memnum,v*36+44,v#
endfunction
function set_normal(memnum,v,normalx#,normaly#,normalz#)
   write memblock float memnum,v*36+24,normalx#
   write memblock float memnum,v*36+28,normaly#
   write memblock float memnum,v*36+32,normalz#
endfunction
function make_object(objnum,meshnum,memnum,imgnum)
   make mesh from memblock meshnum,memnum
   make object objnum,meshnum,imgnum
endfunction


`*Command List*
`--------------
remstart
Ignore the stupid layout, they're like that so they can be put in a keywords file.
   Main Functions:
   kx_startKinetix==(*No Parameters*)
   kx_setupWorld==(Gravity, Air Density)
   kx_makeVector==(*No Parameters*)
   kx_setVector==(Vec, X, Y, Z)
   kx_createMaterial==(Friction, Collision Object)
   kx_createBody==(Object, Dynamic mode, Mass, Drag Constant, Density, Material)
   kx_setBodyForce==(Body)
   kx_setBodyTorque==(Body)
   kx_setBodyVelocity==(Body)
   kx_setBodyOmega==(Body)
   kx_updateBody==(Body)
   kx_getColliding==(Body)
   kx_getCollisionNormalX==(Body)
   kx_getCollisionNormalY==(Body)
   kx_getCollisionNormalZ==(Body)
   kx_getBodyVelocityX==(body)
   kx_getBodyVelocityY==(body)
   kx_getBodyVelocityZ==(body)

   Extra Functions:
   sgn==(Value)
   startsparky==(*No Parameters*)

   You will need:
   Sparky's DLL V2.0
remend

C:\program files\The Game Creators\Dark Basic Professional Online\Compiler\plugins-user

set display mode 800,600,32
set window on
set window title "Bounce!"
sync on
sync rate 60
backdrop on
color backdrop 0

global g#   as float
global t#   as float

type balls
   exist    as boolean
   x        as float
   y        as float
   ox       as float
   oy       as float
   vx       as float
   vy       as float
   c        as integer
   cx       as boolean
   cy       as boolean
endtype

type objects
   exist    as boolean
   vis      as boolean
   col      as boolean
   typ      as integer
   x        as float
   y        as float
   para1    as float
   para2    as float
endtype

dim ball(16)   as balls
dim objs(128)  as objects

make_ball(200,44,0,0)

make_obj(1,0,1,0,0,800,32)
make_obj(1,0,1,0,568,800,32)
make_obj(1,0,1,0,32,32,546)
make_obj(1,0,1,768,32,32,546)


g# = 0.25
t# = -7

i = 0
iw = 0
mode = 0

do

ink rgb(255,255,255),0
line 32,32,768,32
line 32,568,768,568
line 32,32,32,568
line 768,32,768,568

gosub control_objects
gosub control_ball
gosub control_input

sync

loop

control_input:

if iw > 0 then iw = iw - 1

if mode = 0 : ink rgb(255,255,255),0 : else : ink rgb(128,128,128),0 : endif
text 32,8,"[B]uild"
if mode = 1 : ink rgb(255,255,255),0 : else : ink rgb(128,128,128),0 : endif
text 128,8,"[P]lay"

if scancode() = 48 then mode = 0 : b = 1 : bp = 0
if scancode() = 25 then mode = 1

ink rgb(255,255,255),0

if mode = 0

   text 256,8,str$(b)

   if shiftkey() = 1 and iw = 0 then b = b + 1 : iw = 30
   if b > 4 then b = 1

      if bp = 0 and mouseclick() = 1 and iw = 0
      if mousex() > 32 and mousey() > 32 and mousex() < 768 and mousey() < 568
      iw = 60
      bpx = mousex()
      bpy = mousey()
      bp = 1
      endif
      endif

      if bp = 1
      if b = 1 then ink rgb(128,128,128),0
      if b = 2 then ink rgb(192,192,0),0
      if b = 3 then ink rgb(255,255,0),0
      if b = 4 then ink rgb(255,0,0),0
      if mousex() > 32 and mousey() > 32 and mousex() < 768 and mousey() < 568
      if mousex() > bpx and mousey() > bpy
      box bpx,bpy,mousex(),mousey()
      if mouseclick() = 1 and iw = 0
      iw = 30
      bp = 0
      make_obj(b,1,1,bpx,bpy,mousex()-bpx,mousey()-bpy)
      endif
      endif
      endif
      endif

endif

if mode = 1

    if i = 0 and mouseclick() = 1 and iw = 0
       iw = 60
       lx = mousex()
       ly = mousey()
       i = 1
    endif
    if i = 1
       line lx,ly,mousex(),mousey()
       a = 360-wrapvalue((atanfull(mousex()-lx,mousey()-ly))+180)
       p# = sqrt((mousex()-lx)^2+(mousey()-ly)^2)/30
       if p# > 6 then p# = 6
       text mousex(),mousey()-32,str$(a)+chr$(176)
       text mousex(),mousey()-16,left$(str$(p#),3)
       if mouseclick() = 1 and iw = 0
          iw = 60
          i = 0
          tx = newxvalue(lx,a,1)
          ty = newzvalue(ly,a,1)
          nx = lx-tx: if nx = 0 then nx = -1
          ny = ly-ty : if ny = 0 then ny = -1
          make_ball(lx,ly,nx*p#,ny*p#)
       endif
    endif
endif

return

control_objects:
   for co = 1 to 128
      if objs(co).exist

               szx = objs(co).para1
               szy = objs(co).para2
               if objs(co).vis
                  if objs(co).typ = 1 then ink rgb(128,128,128),0
                  if objs(co).typ = 2 then ink rgb(192,192,0),0
                  if objs(co).typ = 3 then ink rgb(255,255,0),0
                  if objs(co).typ = 4 then ink rgb(255,0,0),0
                  box objs(co).x,objs(co).y,objs(co).x+objs(co).para1, objs(co).y+objs(co).para2
               endif

         if objs(co).col
            for cb = 1 to 16
               if ball(cb).exist

                  if objs(co).typ = 4

                     in = 150-sqrt((ball(cb).x-(objs(co).x+(szx/2)))^2+(ball(cb).y-(objs(co).y+(szy/2)))^2)
                     if in < 0 then in = 0

                     if ball(cb).x > objs(co).x then ball(cb).x = ball(cb).x + in/100
                     if ball(cb).x < objs(co).x then ball(cb).x = ball(cb).x - in/100

                     text ball(cb).x, ball(cb).y, str$(in)

                  endif

                  if ball(cb).x > objs(co).x-6 and ball(cb).x < objs(co).x+szx+6
                  if ball(cb).y > objs(co).y-6 and ball(cb).y < objs(co).y+szy+6

                     ball(cb).c = co

                     if ball(cb).ox > objs(co).x-6 and ball(cb).ox < objs(co).x+szx+6
                     if ball(cb).y > objs(co).y-6 and ball(cb).y < objs(co).y+szy+6
                        ball(cb).y = ball(cb).oy
                        ball(cb).cy = 1
                     endif
                     endif

                     if ball(cb).x > objs(co).x-6 and ball(cb).x < objs(co).x+szx+6
                     if ball(cb).oy > objs(co).y-6 and ball(cb).oy < objs(co).y+szy+6
                        ball(cb).x = ball(cb).ox
                        ball(cb).cx = 1
                     endif
                     endif

                  endif
                  endif

               endif
            next cb
         endif

         if mousex() > objs(co).x and mousex() < objs(co).x+szx and mousey() > objs(co).y and mousey() < objs(co).y+szy
         if mouseclick() = 2 and iw = 0 and objs(co).vis
         iw = 60
         objs(co).exist = 0
         endif
         endif

      endif
   next co
return

control_ball:
   for db = 1 to 16
      if ball(db).exist

         if mousex() > ball(db).x-6 and mousex() < ball(db).x+6 and mousey() > ball(db).y-6 and mousey() < ball(db).y+6
            sel = 1
            ink rgb(0,255,255),0
         else
            sel = 0
            ink rgb(0,192,192),0
         endif

         circle ball(db).x, ball(db).y, 6

         ball(db).ox = ball(db).x
         ball(db).oy = ball(db).y

         if ball(db).c > 0

            if objs(ball(db).c).typ = 1
               if ball(db).cy
               ball(db).vy = (ball(db).vy*-1)*0.75
               endif
               if ball(db).cx
               ball(db).vx = (ball(db).vx*-1)*0.75
               endif
            endif

            if objs(ball(db).c).typ = 2
               if ball(db).cy
               ball(db).vy = (ball(db).vy*-1)*(2+(rnd(1)/2))
               endif
               if ball(db).cx
               ball(db).vx = (ball(db).vx*-1)*(2+(rnd(1)/2))
               endif
            endif

           if objs(ball(db).c).typ = 3
               if ball(db).cy
               ball(db).vy = (ball(db).vy*-1)*(2.25+(rnd(1)/2))
               endif
               if ball(db).cx
               ball(db).vx = (ball(db).vx*-1)*(2.25+(rnd(1)/2))
               endif
           endif

            if objs(ball(db).c).typ = 4
               if ball(db).cy
               ball(db).vy = (ball(db).vy*-1)*0.75
               endif
               if ball(db).cx
               ball(db).vx = (ball(db).vx*-1)*0.75
               endif
            endif

         endif

         if ball(db).vx < -8 then ball(db).vx = -8
         if ball(db).vx > 8 then ball(db).vx = 8
         if ball(db).vy < -8 then ball(db).vy = -8
         if ball(db).vy > 8 then ball(db).vy = 8


         if ball(db).cy = 0
         if ball(db).vx > 0 then ball(db).vx = ball(db).vx - 0.005
         if ball(db).vx < 0 then ball(db).vx = ball(db).vx + 0.005
         else
         if ball(db).vx > 0 then ball(db).vx = ball(db).vx - 0.06
         if ball(db).vx < 0 then ball(db).vx = ball(db).vx + 0.06
         endif

         if ball(db).vx > g# and ball(db).vx < g# then ball(db).vx = 0

         ball(db).vy = ball(db).vy - g#
         if ball(db).vy < t# then ball(db).vy = t#
         if ball(db).vy > g# and ball(db).vy < g# then ball(db).vy = 0

         ball(db).x = ball(db).x + ball(db).vx
         ball(db).y = ball(db).y - ball(db).vy

         ball(db).c = 0
         ball(db).cx = 0
         ball(db).cy = 0

         if mouseclick() = 2 and sel
            ball(db).exist = 0
         endif

      endif
   next db
return

function make_obj(typ,vis,col,x,y,p1,p2)

   for ffo = 1 to 128
      if objs(ffo).exist = 0
         exit
      endif
   next ffo

   objs(ffo).typ     = typ
   objs(ffo).col     = col
   objs(ffo).x       = x
   objs(ffo).y       = y
   objs(ffo).para1   = p1
   objs(ffo).para2   = p2
   objs(ffo).vis     = vis
   objs(ffo).exist   = 1

endfunction

function make_ball(x,y,vx,vy)

   for ffb = 1 to 16
      if ball(ffb).exist = 0
         exit
      endif
   next ffb

   ball(ffb).x       = x
   ball(ffb).y       = y
   ball(ffb).vx      = vx
   ball(ffb).vy      = vy
   ball(ffb).exist   = 1

endfunction

sync on
sync rate 45
set display mode 800, 600, 32
set window on
set window position 100,100
autocam off
set text size 32
global ball as integer : ball = 2
global board as integer : board = 1
global back as integer : back = 3
global wall as integer : wall = 4
global hole as integer : hole = 5
global xspd as float : xspd = 0
global zspd as float : zspd = 0
global bx as float
global bz as float
global fall as integer : fall = 0
global level as integer : level = 1
global holes as integer : holes = 35
texture(1,2,3,4)
createboard(500,500)
createball(15)
createback(-1000)
camera()
set camera range 1,1,1000
createholes(holes)
makeflag()
createfinish(holes)

do
text 0,0, "ox"+str$(object angle x(1))
text 0,10,"oy"+str$(object angle z(1))
text 0,20, "xspd"+str$(xspd)
text 0,30,"zspd"+str$(zspd)
text 0,40,"ba"+str$(ba)
if leftkey() = 1 then xspd = xspd - 0.1
if leftkey() = 0 and rightkey() = 0 and xspd < -0.9 then xspd = xspd + 0.1
if rightkey() = 1 then xspd = xspd + 0.1
if leftkey() = 0 and rightkey() = 0 and xspd > 0.9 then xspd = xspd - 0.1
if upkey() = 1 then zspd = zspd + 0.1
if upkey() = 0 and downkey() = 0 and zspd > -0.9 then zspd = zspd - 0.1
if downkey() = 1 then zspd = zspd - 0.1
if upkey() = 0 and downkey() = 0 and zspd < 0.9 then zspd = zspd + 0.1
moveball(1)
xrotate object board, zspd
zrotate object board, -xspd
if xspd > 4 then xspd = 3.9
if zspd > 4 then zspd = 3.9
if xspd < -4 then xspd = -3.9
if zspd < -4 then zspd = -3.9
checkiffall(holes)
checkiffinish(6)
sync
loop

function texture(board,ball,back,wall)

create bitmap 1,800,800
ink rgb(111,98,32),rgb(255,255,255)`board
box 0,0,200,200
ink rgb(173,169,163),rgb(255,255,255)`ball
box 200,0,400,200
ink rgb(13,24,132),rgb(255,255,255)`back
box 400,0,600,200
ink rgb(107,84,39),rgb(255,255,255)`wall
box 600,0,800,200


get image board,0,0,200,200
get image ball,200,0,400,200
get image back,400,0,600,200
get image wall,600,0,800,200
get image hole,100,500,200,600
delete bitmap 1

endfunction

function createboard(w,h)

make object box board,h,5,w
position object board,0,0,0
texture object board,board

endfunction

function createball(rad)

make object sphere ball,rad
position object ball, 10,10+rad/2,10
texture object ball,ball

endfunction

function createback(size)

make object sphere back, size
position object back,0,0,0
texture object back,back

endfunction

function camera()

make camera 1
position camera 1, 0,500,0
point camera 1, 0,0,0

endfunction

function moveball(spd)

bx = object position x(ball)
by = object position y(ball)
bz = object position z(ball)
ox = object angle x(board)
oz = object angle z(board)
x = xspd
z = zspd
position object ball, bx+x ,20+ox+oz ,bz+z
if bx > 230 then position object ball, 229,by,bz
if bx < -230 then position object ball, -229,by,bz
if bz > 230 then position object ball, bx,by,229
if bz < -230 then position object ball, bx,by,-229

endfunction

function createfinish(holes)

position object 6, rnd(480)-240,20,rnd(480)-240
for h = 10 to 10+holes
   if object position x(6) < object position x(h)+10
      if object position x(6) > object position x(h)-10
         if object position z(6) < object position z(h)+10
            if object position z(6) > object position z(h)-10
               position object 6, object position x(6)+rnd(50),20,object position z(6)+rnd(50)
               if object position x(6) > 250 then position object 6, object position x(6)-100,object position y(6), object position z(6)
               if object position z(6) > 250 then position object 6, object position x(6),object position y(6), object position z(6)-100
            endif
         endif
      endif
   endif
next h

endfunction

function createholes(holes)

for h = 10 to 10+holes
hx = rnd(460)-220
if hx < 0 then hx = hx - 20
if hx >= 0 then hx = hx + 20
hz = rnd(460)-220
if hz < 0 then hz = hz - 20
if hz >= 0 then hz = hz + 20
make object cube h, 20
texture object h, hole
position object h, hx,20,hz
if object position x(h) < 20
   if object position x(h) > -20
      if object position z(h) < 20
         if object position z(h) > -20
            position object h, object position x(h)+20,20,object position z(h)+20
            if object position x(h) > 250 then position object h, object position x(h)-100,object position y(h), object position z(h)
            if object position z(h) > 250 then position object h, object position x(h),object position y(h), object position z(h)-100
         endif
      endif
   endif
endif
next h

endfunction

function checkiffall(holes)

for h = 10 to 10+holes
if object position x(ball) < object position x(h)+10
   if object position x(ball) > object position x(h)-10
      if object position z(ball) < object position z(h)+10
         if object position z(ball) > object position z(h)-10
            fall = 1
            position object ball, object position x(h),0,object position z(h)
            wait 300
            position object ball,object position x(h),-20,object position z(h)
         endif
      endif
   endif
endif
next h
if fall = 1
   repeat
      ink 65535,65535
      text 200,200,"You Fell! - Press Space"
      sync
   until spacekey() =1
   fall = 0
   xrotate object board, 0
   zrotate object board, 0
   position object ball,0,0,0
   xspd = 0 : zspd = 0
endif

endfunction

function checkiffinish(flag)

if object position x(ball) < object position x(flag)+10
   if object position x(ball) > object position x(flag)-10
      if object position z(ball) < object position z(flag)+10
         if object position z(ball) > object position z(flag)-10
            finish = 1
         endif
      endif
   endif
endif
if finish = 1
   repeat
      ink 65535,65535
      text 200,200,"Congratulations! - Level "+str$(level)+" complete!"
      text 200,300,"Press Space to go to next level"
      sync
   until spacekey() =1
   finish = 0
   xrotate object board, 0
   zrotate object board, 0
   position object ball,0,0,0
   xspd = 0 : zspd = 0
   level = level + 1
   holes = holes + 5
   placeholes(holes)
   createfinish(holes)
endif

endfunction

function makeflag()

make object box 6, 10,15,10
position object 6, rnd(480)-240,20,rnd(480)-240

endfunction

function placeholes(holes)

for h = 10 to 10+(holes-5)
if object exist(h) = 1 then delete object h
next h

for h = 10 to 10+holes
make object cube h, 20
texture object h, hole
position object h, rnd(480)-240,20,rnd(480)-240
next h

endfunction

rem Challenge: bouncing balls
rem Author: Ace LePage
rem Challenge Date: Jan 21/09

global shadow_support
if tnl available()
  shadow_support=1
else
  shadow_support=0
endif
set display mode 1024,768,32
backdrop on
color backdrop 0
hide mouse
sync on
global groundx=500
global groundz=500
global gndsegx=50
global gndsegz=50
make matrix 1,groundx,groundz,gndsegx,gndsegz
set matrix 1,0,0,1,0,1,0,0
textures()
prepare matrix texture 1,1,4,4
global spacepress as integer
global mousepress as integer
global gravity as float
gravity=0.05
global friction as float
friction=0.9
global total_balls=200
global dim ballx(total_balls) as float
global dim bally(total_balls) as float
global dim ballz(total_balls) as float
global dim ballxv(total_balls) as float
global dim ballyv(total_balls) as float
global dim ballzv(total_balls) as float
global dim ballxp(total_balls) as float
global dim ballyp(total_balls) as float
global dim ballzp(total_balls) as float
global dim ballp(total_balls) as integer
global dim ballon(total_balls) as integer
global camangle
global top
global bottom
global camera_speed as float
global init=1
global terrain_offset as float
terrain_offset=0
global anim=0
global button=2
global shape
global timekeeper
global elapsed
position light 0,groundx/2,1000,groundz/2
make_balls()
buttons()
position camera 0,50,0
point camera groundx/2,50,groundz/2
select_terrain()
show mouse
keeptime()
while not escapekey()
  user_input()
  move_balls()
  if anim=1 then anim_terrain()
  update matrix 1
  position_camera()
  sync
endwhile
end

function keeptime() rem Measures elapsed time from last frame to adjust speed of animation for objects
  elapsed=(timer()-timekeeper)/10
  timekeeper=timer()
endfunction
function position_camera() rem Places camera above the terrain in a position and rotation defined by user_input
  yrotate camera camangle
  camx#=camera position x()
  camz#=camera position z()
  if camx#>=0 and camx#<=groundx and camz#>=0 and camz#<=groundz
    camy#=get ground height(1,camx#,camz#)+50
  else
    camy#=50
  endif
  position camera camx#,camy#,camz#
endfunction
function move_balls() rem Move any active/onscreen balls
  keeptime() rem Calculate speed adjustment
  for i=1 to total_balls
    if ballon(i)=1 rem Ball is on screen/active
      rem Add velocity to ball
      ballx(i)=ballx(i)+ballxv(i)*elapsed
      bally(i)=bally(i)+ballyv(i)*elapsed
      ballz(i)=ballz(i)+ballzv(i)*elapsed
      ballxp(i)=0
      ballyp(i)=0
      ballzp(i)=0
      ballp(i)=0
      if ground_hit(i) rem If ball hit the ground, bounce it
        bounce(i)
      endif
      j=object hit(i,0)
      if j>0 rem If ball hit another ball, rebound both balls
        collide_bounce(i,j)
      endif
      if falling(i) rem If ball fell off edge of ground, take off screen/deactivate it
        clear_ball(i)
      endif
      ballyv(i)=ballyv(i)-gravity*elapsed rem Add gravity force to ball
    endif
    position object i,ballx(i),bally(i),ballz(i)
  next i
  rem Apply collision vectors to balls
  for i=1 to total_balls
    if ballp(i)=1
      ballxv(i)=ballxp(i)
      ballyv(i)=ballyp(i)
      ballzv(i)=ballzp(i)
    endif
  next i
endfunction
function object_hit(i,j)
  hit=0
  if j=0
    for j=1 to total_balls
      if ballon(j) and i<>j
        dist#=sqrt((object position x(i)-object position x(j))^2+(object position y(i)-object position y(j))^2+(object position z(i)-object position z(j))^2)
        if dist#<(object size(i)+object size(j))/2
          hit=1
        endif
      endif
    next j
  else
    dist#=sqrt((object position x(i)-object position x(j))^2+(object position y(i)-object position y(j))^2+(object position z(i)-object position z(j))^2)
    if dist#<(object size(i)+object size(j))/2
      hit=1
    endif
  endif
endfunction hit
function falling(i) rem If ball falls below lower boundary, flag it for removal
  if bally(i)<-500
    fall=1
  else
    fall=0
  endif
endfunction fall
function clear_ball(i) rem Deactivate ball and remove from screen
  ballon(i)=0
  hide object i
endfunction
function bounce(i) rem Bounce the ball off the ground
  rem Calculate angle of ground at impact along X axis
  y1#=get ground height(1,ballx(i)-1,ballz(i))
  y2#=get ground height(1,ballx(i)+1,ballz(i))
  y#=y2#-y1#
  gx#=atan(y#/2)
  vx#=sqrt(ballxv(i)^2+ballyv(i)^2)*friction rem Calculate velocity of ball in XY plane
  if ballxv(i)<>0 rem Calculate angle of ball velocity in XY plane
    ax#=atan(ballyv(i)/ballxv(i))
  else
    ax#=90.0
  endif
  ax#=ax#-gx# rem Remove ground angle from ball velocity angle
  if (ax#<0) rem Rotate velocity angle around vertical to get bounce angle
    bx#=-ax#
  else
    bx#=180-ax#
  endif
  bx#=bx#+gx# rem Add ground angle back to bounce angle
  rem Calculate angle of ground at impact along Z axis
  y3#=get ground height(1,ballx(i),ballz(i)-1)
  y4#=get ground height(1,ballx(i),ballz(i)+1)
  y#=y4#-y3#
  gz#=atan(y#/2)
  vz#=sqrt(ballzv(i)^2+ballyv(i)^2)*friction rem Calculate velocity of ball in ZY plane
  if ballzv(i)<>0 rem Calculate angle of ball velocity in ZY plane
    az#=atan(ballyv(i)/ballzv(i))
  else
    az#=90
  endif
  az#=az#-gz# rem Remove ground angle from ball velocity angle
  if (az#<0) rem Rotate velocity angle around vertical to get bounce angle
    bz#=-az#
  else
    bz#=180-az#
  endif
  bz#=bz#+gz# rem Add ground angle back to bounce angle
  rem Position the ball so it is not below the ground, based on ground angle and ball radius
  bally(i)=get ground height(1,ballx(i),ballz(i))+sin(90-gx#)*object size(i)
  ballx(i)=ballx(i)-cos(90-gx#)*object size(i)
  ballz(i)=ballz(i)-cos(90-gz#)*object size(i)
  rem Calculate new vector based on bounce angle and velocity
  ballxv(i)=cos(bx#)*vx#
  ballyv(i)=sin(bx#)*vx#
  ballzv(i)=cos(bz#)*vz#
endfunction
function collide_bounce(i,j)
  rem Get current distance between 2 balls using current vector
  disti#=sqrt((ballx(j)-(ballx(i)+ballxv(i)))^2+(bally(j)-(bally(i)+ballyv(i)))^2+(ballz(j)-(ballz(i)+ballzv(i)))^2)
  distj#=sqrt((ballx(i)-(ballx(j)+ballxv(j)))^2+(bally(i)-(bally(j)+ballyv(j)))^2+(ballz(i)-(ballz(j)+ballzv(j)))^2)
  rem Calculate angle of collision
  anglex#=atanfull((bally(j)-bally(i)),(ballx(j)-ballx(i)))
  anglez#=atanfull((bally(j)-bally(i)),(ballz(j)-ballz(i)))
  rem Calculate velocity of other ball
  vx1#=sqrt(ballxv(j)^2+ballyv(j)^2)
  vz1#=sqrt(ballzv(j)^2+ballyv(j)^2)
  rem Get angle of collision
  ax#=atanfull(ballyv(i),ballxv(i))
  az#=atanfull(ballyv(i),ballzv(i))
  rem Calculate angle of bounce
  bx#=180-ax#+anglex#*2
  bz#=180-az#+anglez#*2
  rem Calculate new position of ball after bounce
  xv#=cos(bx#)*vx1#
  yv#=sin(bx#)*vx1#
  zv#=sin(bz#)*vz1#
  rem Calculate distance between balls with bounce vector
  newdisti#=sqrt((ballx(j)-(ballx(i)+xv#))^2+(bally(j)-(bally(i)+yv#))^2+(ballz(j)-(ballz(i)+zv#))^2)
  if disti#>newdisti# rem make sure vector is bouncing ball away from other ball
    ballxp(i)=ballxp(i)-xv#
    ballyp(i)=ballyp(i)-yv#
    ballzp(i)=ballzp(i)-zv#
  else
    ballxp(i)=ballxp(i)+xv#
    ballyp(i)=ballyp(i)+yv#
    ballzp(i)=ballzp(i)+zv#
  endif
  ballp(i)=1 rem Flag collision on ball, to be applied when all collisions are calculated
endfunction
function ground_hit(i) rem Ground impact based on Y axis of ball and ground
  hit=0
  if (ballx(i)>0 and ballx(i)<groundx and ballz(i)>0 and ballz(i)<groundz)
    y#=get ground height(1,ballx(i),ballz(i))
    if y#>bally(i)-object size(i)
      hit=1
    endif
  endif
endfunction hit
function user_input() rem Handle keyboard and mouse input
  if spacekey() and spacepress
    fire_ball()
    spacepress=0
  endif
  if not spacekey() then spacepress=1
  if leftkey()
    camangle=wrapvalue(camangle-elapsed)
  endif
  if rightkey()
    camangle=wrapvalue(camangle+elapsed)
  endif
  if upkey()
    camera_speed=camera_speed+0.1
    if camera_speed>5 then camera_speed=5
  endif
  if downkey()
    camera_speed=camera_speed-0.1
    if camera_speed<-5 then camera_speed=-5
  endif
  move camera camera_speed
  if (not upkey()) and (not downkey()) rem Slow down camera movement when user stops pressing key
    camera_speed=camera_speed/1.1
  endif
  if mouseclick()=1 and mousepress
    if mousex()>0 and mousex()<200 and mousey()>0 and mousey()<32
      if (shape && 1) rem Only terrains 1,3,5 have waves to animate
        anim=1-anim rem Toggle animation
        button=5-button rem Toggle button (Move/Halt)
        set sprite image 1,button
      endif
    endif
    if mousex()>250 and mousex()<400 and mousey()>0 and mousey()<32
      megadrop()
    endif
    mousepress=0
  endif
  if not mouseclick()
    mousepress=1
  endif
endfunction
function fire_ball() rem Get next available ball object and assign position and vector
  x=next_ball()
  if (x>0) rem If a ball is available, set it up
    reset_ball(x)
  endif
endfunction
function next_ball() rem Find next available ball object
  nextball=0
  for i=1 to total_balls
    if ballon(i)=0
      nextball=i
      i=total_balls
    endif
  next i
endfunction nextball
function reset_ball(x) rem Position ball and assign velocity based on camera position
  move camera 50
  x#=camera position x()
  z#=camera position z()
  move camera -50
  ballxv(x)=sin(camera angle y())
  ballyv(x)=0.0
  ballzv(x)=cos(camera angle y())
  ballx(x)=x#
  ballz(x)=z#
  bally(x)=camera position y()
  ballon(x)=1
  show object x
endfunction
function megadrop()
  i=1
  done=0
  while i<40 and done=0
    x=next_ball()
    if x>0
      ballx(x)=rnd(groundx/2)+groundx/4
      ballz(x)=rnd(groundz/2)+groundz/4
      bally(x)=50
      ballxv(x)=0
      ballyv(x)=0
      ballzv(x)=0
      if not object hit(x,0)
        ballon(x)=1
        show object x
      endif
    else
      done=1
    endif
    inc i
  endwhile
endfunction
function make_balls() rem Create all ball objects
  for i=1 to total_balls
    make object sphere i,5
    color object i,rgb(0,0,255)
    if shadow_support then set shadow shading on i
    set object collision on i
    hide object i
    ballon(i)=0
  next i
endfunction
function buttons() rem Create button images for user control
  create bitmap 1,200,32
  for image=2 to 4
    for i=0 to 3
      j=i*32
      if image=3
        r=255
      else
        r=0
      endif
      ink rgb(r,96+j,0),0
      box i*2,i*2,200-i*2,32-i*2
    next i
    ink 0,0
    if image=2
      text 7,7,"Click to Move Waves"
    endif
    if image=3
      text 7,7,"Click to Halt Waves"
    endif
    if image=4
      text 7,7,"Click for Mega Drop"
    endif
    get image image,0,0,199,31
  next image
  delete bitmap 1
  x=0:y=30
  create bitmap 1,256,256
  ink 0,0
  box 0,0,255,255
  ink rgb(128,255,128),0
  box x,y+1,x+12,y+15
  box x+244,y+1,x+255,y+15
  box x,y+23,x+12,y+37
  box x+244,y+23,x+255,y+37
  box x,y+43,x+41,y+57
  box x+155,y+43,x+180,y+57
  set cursor x+15,y+0
  print "turn left"
  set cursor x+155,y+0
  print "turn right"
  set cursor x+15,y+22
  print "forward"
  set cursor x+155,y+22
  print "backward"
  set cursor x+50,y+43
  print "drop ball"
  set cursor x+185,y+43
  print "exit"
  set cursor 80,0
  print "CONTROLS"
  ink 0,0
  line x+1,y+8,x+6,y+3:line x+2,y+8,x+7,y+3
  line x+1,y+8,x+6,y+13:line x+2,y+8,x+7,y+13
  line x+1,y+8,x+11,y+8
  line x+254,y+8,x+249,y+3:line x+253,y+8,x+248,y+3
  line x+254,y+8,x+249,y+13:line x+253,y+8,x+248,y+13
  line x+254,y+8,x+244,y+8
  line x+6,y+25,x+3,y+28:line x+6,y+26,x+3,y+29
  line x+6,y+25,x+10,y+29:line x+6,y+26,x+10,y+30
  line x+6,y+25,x+6,y+35
  line x+250,y+35,x+247,y+32:line x+250,y+34,x+247,y+31
  line x+250,y+35,x+254,y+31:line x+250,y+34,x+254,y+30
  line x+250,y+25,x+250,y+35
  set cursor x,y+43
  print "SPACE"
  set cursor x+155,y+43
  print "ESC"
  get image 5,0,0,256,256
  delete bitmap 1
  set current bitmap 0
endfunction
function textures() rem Create shaded texture segments for terrain
  create bitmap 1,256,256
  for tilex=0 to 3
    for tilez=0 to 3
      image=16-(tilex*4+tilez)
      ink rgb(25,255,25),0
      box tilez*64,tilex*64,tilez*64+64,tilex*64+64
      ink rgb(2*image,5*image+100,2*image),0
      box tilez*64+2,tilex*64+2,tilez*64+61,tilex*64+61
    next tilez
  next tilex
  get image 1,0,0,255,255
  delete bitmap 1
  set current bitmap 0
endfunction
function terrain_matrix() rem Create terrain height and texture
  top=0
  bottom=10
  if shape=1
    for i=0 to gndsegx
      for j=0 to gndsegz
        height#=sin(wrapvalue(i*j)+terrain_offset)*10
        if height#<bottom then bottom=height#
        if height#>top then top=height#
        set matrix height 1,i,j,height#
      next j
    next i
  endif
  if shape=2
    xcen=gndsegx/2
    zcen=gndsegz/2
    for i=0 to gndsegx
      for j=0 to gndsegz
        height#=(((xcen-i))^2+((zcen-j))^2)/10-50
        if height#<bottom then bottom=height#
        if height#>top then top=height#
        set matrix height 1,i,j,height#
      next j
    next i
  endif
  if shape=3
    xcen=gndsegx/2
    zcen=gndsegz/2
    for i=0 to gndsegx
      for j=0 to gndsegz
        height#=sin((sqrt((xcen-i)^2+(zcen-j)^2)*30-terrain_offset))*15
        if height#<bottom then bottom=height#
        if height#>top then top=height#
        set matrix height 1,i,j,height#
      next j
    next i
  endif
  if shape=4
    xcen=gndsegx/2
    zcen=gndsegz/2
    for i=0 to gndsegx
      for j=0 to gndsegz
        set#=((((xcen-i))^2+((zcen-j))^2)^2)
        if set#=0 then set#=0.01
        height#=-100000/set#
        if height#<bottom then bottom=height#
        if height#>top then top=height#
        set matrix height 1,i,j,height#
      next j
    next i
  endif
  if shape=5
    for i=0 to gndsegx
      for j=0 to gndsegz
        height#=(sin(i*30-terrain_offset)+sin(j*30))*10
        set matrix height 1,i,j,height#
      next j
    next i
  endif
  if init then shade_terrain()
endfunction
function anim_terrain() rem Slowly rotate through 360 degrees for calculating waves on terrain
  terrain_offset=terrain_offset+1
  if terrain_offset>360
    terrain_offset=0
  endif
  terrain_matrix()
endfunction
function shade_terrain() rem Assign texture to terrain tiles based on tile height
  scale=(top-bottom)/16
  offset=bottom
  for x=1 to gndsegx-1
    for z=1 to gndsegz-1
      height=(get matrix height(1,x,z)-offset)/scale
      if height<1 then height=1
      if height>16 then height=16
      set matrix tile 1,x,z,17-height
    next z
  next x
endfunction
function select_terrain() rem Pick a terrain to start
  max=5
  dim name$(max)
  name$(1)="Waves"
  name$(2)="Bowl"
  name$(3)="Pond"
  name$(4)="Hole"
  name$(5)="Eggs"
  shape=1
  press=0
  terrain_matrix()
  update matrix 1
  keeptime()
  while not returnkey()
    keeptime()
    ink rgb(255,255,255),0
    set text font "arial"
    set text size 40
    set cursor 100,0
    center text 512,100, name$(shape)
    set text size 20
    center text 512,140,"Use left/right arrow to change terrain"
    center text 512,160, "[ENTER] to select this terrain"
    if (leftkey() or rightkey()) and press=0
      press=1
      if leftkey()
        dec shape
      else
        inc shape
      endif
      if shape<1 or shape>max then shape=abs(shape-max)
      terrain_matrix()
      update matrix 1
    endif
    if (not leftkey()) and (not rightkey())
      press=0
    endif
    turn camera right 90
    move camera elapsed
    point camera groundx/2,0,groundz/2
    sync
  endwhile
  camangle=camera angle y()
  if (shape && 1)
    sprite 1,0,0,button
  endif
  init=0
  sprite 2,750,0,5
  sprite 3,250,0,4
endfunction

sync on
sync rate 45
set display mode 800, 600, 32
set window on
set window position 100,100
autocam off
set text size 32
global ball as integer : ball = 2
global board as integer : board = 1
global back as integer : back = 3
global wall as integer : wall = 4
global hole as integer : hole = 5
global xspd as float : xspd = 0
global zspd as float : zspd = 0
global bx as float
global bz as float
global fall as integer : fall = 0
global level as integer : level = 1
global holes as integer : holes = 35
texture(1,2,3,4)
createboard(500,500)
createball(15)
createback(-1000)
camera()
set camera range 1,1,1000
createholes(holes)
falls = 0
gosub run

run:
randomize timer()
placeholes(holes)
makeflag()
createfinish(holes)
do
text 0,0, "Level: "+str$(level)
`text 0,100,"Holes: "+str$(holes)
text 0,40,"Lives: "+str$(5-falls)
text 0,70,"Best: "+str$(best)
if leftkey() = 1 then xspd = xspd - 0.1
if leftkey() = 0 and rightkey() = 0 and xspd < -0.9 then xspd = xspd + 0.1
if rightkey() = 1 then xspd = xspd + 0.1
if leftkey() = 0 and rightkey() = 0 and xspd > 0.9 then xspd = xspd - 0.1
if upkey() = 1 then zspd = zspd + 0.1
if upkey() = 0 and downkey() = 0 and zspd > -0.9 then zspd = zspd - 0.1
if downkey() = 1 then zspd = zspd - 0.1
if upkey() = 0 and downkey() = 0 and zspd < 0.9 then zspd = zspd + 0.1
moveball(1)
xrotate object board, zspd
zrotate object board, -xspd
if xspd > 4 then xspd = 3.9
if zspd > 4 then zspd = 3.9
if xspd < -4 then xspd = -3.9
if zspd < -4 then zspd = -3.9
checkiffall(holes)
checkiffinish(6)
sync
loop

function texture(board,ball,back,wall)

create bitmap 1,800,800
ink rgb(111,98,32),rgb(255,255,255)`board
box 0,0,200,200
ink rgb(173,169,163),rgb(255,255,255)`ball
box 200,0,400,200
ink rgb(13,24,132),rgb(255,255,255)`back
box 400,0,600,200
ink rgb(107,84,39),rgb(255,255,255)`wall
box 600,0,800,200


get image board,0,0,200,200
get image ball,200,0,400,200
get image back,400,0,600,200
get image wall,600,0,800,200
get image hole,100,500,200,600
delete bitmap 1

endfunction

function createboard(w,h)

make object box board,h,5,w
position object board,250,0,250
texture object board,board

endfunction

function createball(rad)

make object sphere ball,rad
position object ball, 10,10+rad/2,10
texture object ball,ball

endfunction

function createback(size)

make object sphere back, size
position object back,250,0,250
texture object back,back

endfunction

function camera()

make camera 1
position camera 1, 250,500,250
point camera 1, 250,0,250

endfunction

function moveball(spd)

bx = object position x(ball)
by = object position y(ball)
bz = object position z(ball)
ox = object angle x(board)
oz = object angle z(board)
x = xspd
z = zspd
position object ball, bx+x ,20+ox+oz ,bz+z
if bx > 480 then position object ball, 479,by,bz
if bx < 20 then position object ball, 21,by,bz
if bz > 480 then position object ball, bx,by,479
if bz < 20 then position object ball, bx,by,21

endfunction

function createfinish(holes)

position object 6, rnd(450)+30,20,rnd(450)+30
for h = 10 to 10+holes
   if object position x(6) < object position x(h)+10
      if object position x(6) > object position x(h)-10
         if object position z(6) < object position z(h)+10
            if object position z(6) > object position z(h)-10
               position object 6, object position x(6)+rnd(50),20,object position z(6)+rnd(50)
               if object position x(6) > 480 then position object 6, object position x(6)-100,object position y(6), object position z(6)
               if object position z(6) > 480 then position object 6, object position x(6),object position y(6), object position z(6)-100
            endif
         endif
      endif
   endif
next h

endfunction

function createholes(holes)

for h = 10 to 10+holes
hx = rnd(450)+30
if hx < 0 then hx = hx - 20
if hx >= 0 then hx = hx + 20
hz = rnd(450)+30
if hz < 0 then hz = hz - 20
if hz >= 0 then hz = hz + 20
make object cube h, 20
texture object h, hole
position object h, hx,20,hz
if object position x(h) < 20
   if object position x(h) > -20
      if object position z(h) < 20
         if object position z(h) > -20
            position object h, object position x(h)+20,20,object position z(h)+20
            if object position x(h) > 480 then position object h, object position x(h)-100,object position y(h), object position z(h)
            if object position z(h) > 480 then position object h, object position x(h),object position y(h), object position z(h)-100
         endif
      endif
   endif
endif
next h

endfunction

function checkiffall(holes)

for h = 10 to 10+holes
if object position x(ball) < object position x(h)+10
   if object position x(ball) > object position x(h)-10
      if object position z(ball) < object position z(h)+10
         if object position z(ball) > object position z(h)-10
            fall = 1
            position object ball, object position x(h),0,object position z(h)
            wait 300
            position object ball,object position x(h),-20,object position z(h)
         endif
      endif
   endif
endif
next h
if fall = 1
   repeat
      ink 65535,65535
      text 200,200,"You Fell! - Press Space"
      sync
   until spacekey() =1
   fall = 0
   gosub reset
endif

endfunction

function checkiffinish(flag)

if object position x(ball) < object position x(flag)+10
   if object position x(ball) > object position x(flag)-10
      if object position z(ball) < object position z(flag)+10
         if object position z(ball) > object position z(flag)-10
            finish = 1
         endif
      endif
   endif
endif
if finish = 1
   repeat
      ink 65535,65535
      text 200,200,"Congratulations! - Level "+str$(level)+" complete!"
      text 200,300,"Press Space to go to next level"
      sync
   until spacekey() =1
   finish = 0
   xrotate object board, 0
   zrotate object board, 0
   position object ball,10,0,10
   xspd = 0 : zspd = 0
   level = level + 1
   holes = holes + 5
   placeholes(holes)
   createfinish(holes)
endif

endfunction

function makeflag()

if object exist(6) = 0
   make object box 6, 10,25,10
   position object 6, rnd(450)+30,20,rnd(450)+30
endif

endfunction

function placeholes(holes)

for h = 10 to 10+(holes)
if object exist(h) = 1 then delete object h
next h

for h = 10 to 10+holes
make object cube h, 20
texture object h, hole
position object h, rnd(450)+30,20,rnd(450)+30
next h

endfunction

reset:

xrotate object board, 0
zrotate object board, 0
randomize timer()
position object ball,10,0,10
xspd = 0 : zspd = 0
falls = falls + 1
If falls = 5 then gosub restart
placeholes(holes)

return

restart:

best = level - 1
level = 1
fall = 0
falls = 0
holes = 35

repeat
   text 200,200,"You have fallen 5 times!"
   text 200,300,"Game Over!"
   text 200,400,"Press r to restart"
   sync
until inkey$() = "r"

gosub run

return

return `run

Pricey
- Good job, but it was a little glitchy, and the blocks didn't slow down the ball it just stopped it until it went around it, then it sped up again.

Monk
 - Very nicely done, I like how you incorporated a game instead of just doing a demo. Very fun, also hard. Although the ball did go through the finish zone a couple of times...(either that or I suck...?:-|)

Acelepage!
 - I'm in awe of the physics you've come up with, and all the different way you've done them. Very well done, physics are practically perfect. One suggestion though...when you click the drop ball button, don't make it drop from the cameras position, make it fall from a selected point by the user, I had a few drop into the abyss because I didn't have the camera over it.(and its hard to see when you get it right)

rem setup screen
sync on
sync rate 0
autocam off
set display mode 1024,768,32
set window on
randomize 100`timer()

mat = 1
makematrix(mat,2000,2000,200,200,25,100)
splitmatrix(mat,2,2,2000,2000,200,200)
texturematrix(2,2)

set camera range 0,1,10000
position camera 0,0,100,0

do
text 0,0,str$(screen fps())

control camera using arrowkeys 0,5,2
if inkey$() = "w" then camup = 2
if inkey$() = "s" then camup = -2
position camera 0,camera position x(0), camera position y(0)+camup, camera position z(0)
if camup <> 0 then camup = 0
`makemesh()
sync
loop
end


function gaussian_function(x as float,z as float,centerx as float,centerz as float,spread as float,intensity as float)

xterm#=((x-centerx)/spread)^2
zterm#=((z-centerz)/spread)^2
height#=intensity*EXP(0-(xterm#+zterm#)) ` # signs added as well

endfunction height#


function makematrix(matno,matx,matz,sizex,sizez,spread,intensity)

rem make a matrix
make matrix matno,matx,matz,sizex,sizez
`position matrix matno, matx*matno,0,matz

hillno = 30
dim hill(hillno,3) `0 = cntx 1= cntz 2= sprd 3 = int
dim height#(hillno)

for h = 1 to hillno
   hill(h,0) = rnd(sizex)
   hill(h,1) = rnd(sizez)
   hill(h,2) = rnd(spread-10)+10
   hill(h,3) = rnd(intensity/3) + intensity/2
next h

cumulheight# = 0
rem make the gaussian hill
for x=0 to sizex `maximum matrix width
   for z=0 to sizez `maximum matrix height
      cumulheight# = 0
      x# = x
      z# = z
      for hill = 1 to hillno
         height#(hill) = gaussian_function(x#,z#,hill(hill,0),hill(hill,1),hill(hill,2),hill(hill,3))
         cumulheight# = cumulheight# + height#(hill)
      next hill

      set matrix height matno,x,z,cumulheight#`height#(1) + height#(2) + height#(3) + height#(4) + height#(5) + height#(6) + height#(7) + height#(8) + height#(9) + height#(10)
   next y
next x

update matrix matno

endfunction


function splitmatrix(mat,splitx,splity,oldsizex,oldsizey,oldnox,oldnoy) `split value is how many new smaller matrices you want

dim oldheight#(oldnox,oldnoy)

newsizex = oldsizex / splitx
newsizey = oldsizey / splity
newnox = newsizex / 10
newnoy = newsizey / 10

for x = 0 to oldnox
   for y = 0 to oldnoy
      oldheight#(x,y) = get matrix height(mat,x,y)
   next y
next x

for m = 2 to splitx*splity+1
   wait 10
   make matrix m, newsizex,newsizey,newnox,newnoy
   if m = 2
      startx = 0
      starty = 0
   endif
   if m = 3
      startx = 100
      starty = 0
   endif
   if m = 4
      startx = 0
      starty = 100
   endif
   if m = 5
      startx = 100
      starty = 100
   endif

   for x = 0 to newnox
       for y = 0 to newnoy
           newheight# = oldheight#(startx+x,starty+y)
           set matrix height m, x,y,newheight#
       next y
   next x
next m

position matrix 2, 0,0,0
position matrix 3, newsizex,0,0
position matrix 4, 0,0,newsizey
position matrix 5, newsizex,0,newsizey

update matrix 1
update matrix 2
update matrix 3
update matrix 4

endfunction


function texturematrix(splitx,splity)

create bitmap 1, 400,400
set current bitmap 1
ink rgb(rnd(100),rnd(100)+100,rnd(100)),0
box 0,0,400,400
for l = 1 to 100
   line rnd(400),rnd(400),rnd(400),rnd(400)
next l
get image 1,0,0,400,400
set current bitmap 0
delete bitmap 1
paste image 1,0,0
ink rgb(255,255,255),0

for mat = 2 to 5
   prepare matrix texture mat,1,1,1
   update matrix mat
next mat

endfunction


function makemesh()

`make mesh from object


endfunction