'PS2 YABASIC POOL
'CanardDeChien

'https://www.youtube.com/watch?v=CdpR3hU5bAI

'SIX BALL POOL


winx=640
winy=512
wx=winx

open window winx,winy
window origin "lb"
setrgb 0,0,0,5
setrgb 1,200,255,200

gosub setdims
gosub initmnodes
gosub starsinit
gosub tblinit
'###############
'#####START#####
'###############
gosub showcontroller
setrgb 0,0,0,5

label start
setrgb 1,0,0,0
clear window
gosub fire
gosub eventhdl
gosub eventdo
gosub choreo
rem gosub drawstars
gosub drawdots

'some collision resets here
for i = 1 to ballcnt
 if ballcoll(i)>0 then
    bcnt(i)=bcnt(i)-1
    if bcnt(i)=0 ballcoll(i)=0
 fi
next i

'DEBUG 1ST!!!
rem setrgb 1,200,200,200
rem text 20,20,"FPS: "+str$(FPS)
rem text 20,40,"FPS: "+str$(ballmov(5))
rem text 20,40,"drno: "+str$(drno)

if repstate>0 then
  setrgb 1,150,50,50
  fill rectangle 590,490 to 600,500
fi
gosub drawcue
gosub doinfo
gosub doscore
gosub frate

goto start

label doinfo

'Calc. Altimeter...

l4y=ballmv1+l3yinit

  l1y=l1yinit
  l2y=l2yinit
  l3y=l3yinit

camyl=ballmov(1)
setrgb 1,0,0,0
fill rectangle l123x,l3yinit to l123x+lsz,l1ytop
setrgb 1,ballmv1,ballmov-ballmv1,50
fill rectangle l123x,l3yinit to l123x+lsz,l4y

setrgb 1,80,80,80
line l123x,l1y to l123x+lsz,l1y
line l123x,l2y to l123x+lsz,l2y
line l123x,l3y to l123x+lsz,l3y


setrgb 1,120,220,180
rectangle l123x,l3yinit to l123x+lsz,l1ytop

return

label align
  drno=0 :rem draw count
  for sit=1 to num_mesh
   mit=sortz(sit)
   meshdr(mit)=0
   if meshmov(mit)>0 then
'rotat alp,bet,gam
      mx1= sinD(gam(mit))*sinD(bet(mit))*sinD(alp(mit))+cosD(gam(mit))*cosD(alp(mit))
      my1= cosD(bet(mit))*sinD(alp(mit))
      mz1= sinD(gam(mit))*cosD(alp(mit))-cosD(gam(mit))*sinD(bet(mit))*sinD(alp(mit))

      mx2= sinD(gam(mit))*sinD(bet(mit))*cosD(alp(mit))-cosD(gam(mit))*sinD(alp(mit))
      my2= cosD(bet(mit))*cosD(alp(mit))
      mz2=-cosD(gam(mit))*sinD(bet(mit))*cosD(alp(mit))-sinD(gam(mit))*sinD(alp(mit))

      mx3= -sinD(gam(mit))*cosD(bet(mit))
      my3= sinD(bet(mit))
      mz3= cosD(gam(mit))*cosD(bet(mit))
    for mnit=1 to meshnmx(mit)
      if meshmov(mit)>0 then
        newx=meshnx(mit,mnit)*mx1 +meshny(mit,mnit)*my1 + meshnz(mit,mnit)*mz1
        newy=meshnx(mit,mnit)*mx2 +meshny(mit,mnit)*my2 + meshnz(mit,mnit)*mz2
        newz=meshnx(mit,mnit)*mx3 +meshny(mit,mnit)*my3 + meshnz(mit,mnit)*mz3
        meshnx(mit,mnit)=newx
        meshny(mit,mnit)=newy
        meshnz(mit,mnit)=newz
      fi
    next mnit
   fi :rem if move
  next sit

return 


'Stupid name, but basically view space main render routine
label drawdots

  drno=0 :rem draw count
  for sit=1 to num_mesh
   mit=sortz(sit)
   meshdr(mit)=0

    camcgx=meshcgx(mit)-camx
    camcgy=meshcgy(mit)-camy
    camcgz=meshcgz(mit)-camz

    nrest=frpln  :rem oh tooo big.....!
    nzc=0
    for mnit=1 to meshnmx(mit)
      newx=meshnx(mit,mnit)
      newy=meshny(mit,mnit)
      newz=meshnz(mit,mnit)
      newx=newx+camcgx
      newy=newy+camcgy
      newz=newz+camcgz

      ctnx=newx*coscroty-newz*sincroty
     
      ctnz=newx*sincroty+newz*coscroty

      ctny=newy*coscrotx+ctnz*sincrotx
      ctnz=ctnz*coscrotx-newy*sincrotx

      ctnz=ctnz*0.25
      zbuf(mit,mnit)=ctnz

      if ctnz<0 nzc=nzc+1
      xoff=FOV*ctnx/ctnz
      yoff=FOV*ctny/ctnz

      screenx(mit,mnit)=midx+xoff
      screeny(mit,mnit)=midy+yoff
      dist=newx*newx+newy*newy+newz*newz
'rem eh too much???????^
      if nrest>dist then
          znrst=mnit
          nrest=dist 
          scrd=xoff*xoff+yoff*yoff
      fi
    next mnit

    if nzc<meshnmx(mit)  then
       meshdr(mit)=1
       znrst(mit)=znrst
       scrd(mit)=scrd
    fi

    sortz(sit)=mit
    if meshtype(mit)<>3 then
      if abs(meshnx(mit,znrst)+meshcgx(mit))<500 and abs(meshnz(mit,znrst)+meshcgz(mit))<1000 then
         nrest=nrest+100000000
      fi
      mdist(sit)=nrest
    else
      nrest=nrest+200000
      mdist(sit)=nrest

    fi

    if meshtype(mit)=2 then
      mdist(sit)=frpln+100000000 
    fi 
 next sit

  gosub rendersort


'###########DRAW THE RESULT############ 

  for sortit=1 to num_mesh
  mit=sortz(sortit) 
  meshb=meshball(mit)

  if meshdr(mit)=1 or donenos(meshb)>0 then
'Crap lighting stuff
    lt=ltmx3d*(1-mdist(sortit)/camdfr)+ltmx2d*(1-scrd(mit)/scrdmx)
    if lt<-100 lt=-100

    if meshtype(mit)=3 then
      gosub fillcirc
    elseif meshtype(mit)<>8 then  
    for i=1 to fnr
      f=f(znrst(mit),i)
      x1=screenx(mit,face(f,1))
      y1=screeny(mit,face(f,1))
      x2=screenx(mit,face(f,2))
      y2=screeny(mit,face(f,2))
      x3=screenx(mit,face(f,3))
      y3=screeny(mit,face(f,3))
      x4=screenx(mit,face(f,4))
      y4=screeny(mit,face(f,4))

      if (((x2-x1)*(y3-y1)-(y2-y1)*(x3-x1)) < 0) then
        setrgb 1,facer(mit,f)+lt,faceg(mit,f)+lt,faceb(mit,f)+lt
          fill triangle x1,y1 to x2,y2 to x3,y3
          fill triangle x1,y1 to x4,y4 to x3,y3
      fi

    next i
  fi
  fi :rem if draw
  next sortit

return

label rendersort
done=0
while (done=0)
done=1
for p=1 to num_mesh
 if (mdist(p)<mdist(p+1)) then 
  tmpd=mdist(p)
  mdist(p)=mdist(p+1)
  mdist(p+1)=tmpd

'changing render order

  tempr=sortz(p)
  sortz(p)=sortz(p+1)
  sortz(p+1)=tempr
  done=0
 fi
next p
wend

return


label initmnodes

  for mit=1 to num_mesh
    alp(mit)=360
    bet(mit)=360
    gam(mit)=360

rem    for mnit=1 to meshnodemax
rem      meshnx(mit,mnit)=meshnodex(mit,mnit)
rem      meshny(mit,mnit)=meshnodey(mit,mnit)
rem      meshnz(mit,mnit)=meshnodez(mit,mnit)
rem    next mnit
  next mit
return

label setdims

meshmax=70              :rem nos. objects
meshnodemax=30          :rem nos. nodes for each object
meshface=6             :rem for cube object
trimax=100             :rem num of 2D tris on the screen

midx=winx/2
midy=winy/2
FOV=200
zoomr=90
camrad=2300

frpln=10000
frpln=frpln*frpln*frpln


camx=1500
camy=1000
camz=-1500
croty=1
crotx=20

'Cam Lighting sphere
camdnr=20
camdfr=1100
camdnr=camdnr*camdnr
camdfr=camdfr*camdfr
camdfn=camdfr-camdnr

'Camera field of view degrees (room wall clipping)
cfov=40

ltmx=70
ltratio2d=0.8
ltratio3d=2-ltratio2d
ltmx2d=ltmx*ltratio2d
ltmx3d=ltmx*ltratio3d

'Compass Init...
decsz=30
decalx=570
decaly=70

'Altimeter Init...
l1ytop=130
l1yinit=100
l2yinit=70
l3yinit=40

l123x=510
lsz=20
l1y=l1yinit
l2y=l2yinit
l3y=l3yinit

camyl=camy

twopi=2*pi
nominalfps=10
FPS=10
 
dim tri1x(trimax)
dim tri1y(trimax)

dim tri2x(trimax)
dim tri2y(trimax)

dim tri3x(trimax)
dim tri3y(trimax)
 
dim tri1r(trimax)
dim tri1g(trimax)
dim tri1b(trimax)

dim tri2r(trimax)
dim tri2g(trimax)
dim tri2b(trimax)

dim tri3r(trimax)
dim tri3g(trimax)
dim tri3b(trimax)

dim meshdr(meshmax)

dim meshnx(meshmax,meshnodemax)
dim meshny(meshmax,meshnodemax)
dim meshnz(meshmax,meshnodemax)

dim screenx(meshmax,meshnodemax)
dim screeny(meshmax,meshnodemax)
dim zbuf(meshmax,meshnodemax)

'not sure if this will work on other than cuboid
cuban=8          :rem num cube nodes
fnr=3            :rem num faces shown at one time
dim f(cuban,fnr) :rem list of faces associated with node
dim znrst(meshmax)
dim sortz(meshmax)
for i=1 to meshmax
 sortz(i)=i
next i


dim meshtype(meshmax)
dim meshmov(meshmax)
dim meshnmx(meshmax)
dim meshev(meshmax)
dim meshact(meshmax)

dim meshcgx(meshmax)
dim meshcgy(meshmax)
dim meshcgz(meshmax)
dim meshsz(meshmax)
dim meshball(meshmax)

dim meshrotx(meshmax)
dim meshroty(meshmax)
dim meshrotz(meshmax)
dim mdist(meshmax)
dim meshball(meshmax)

'ROOM DRAWING RAY-CASTING STUFF
flrnos=4

dim flx(flrnos)
dim flz(flrnos)
dim frx(flrnos)
dim frz(flrnos)

'THE ROOM MESH FINALLLY CLIPPED BY CAMERA RAY
dim fmx(8)
dim fmz(8)

'THE TWO NEAREST INTERSECTED POINTS ON WALL(S)
dim flnr(2)

dim scrd(meshmax)
scrdmx=180
scrdmx=scrdmx*scrdmx
scrmx=600
scrmx=scrmx*scrmx

tdrt=450
tundmx=tdrt*tdrt

dim face(meshface,4)   :rem Four nodes on each face
dim facer(meshmax,meshface)
dim faceg(meshmax,meshface)
dim faceb(meshmax,meshface)

dim lnum(meshmax)
dim lx1(meshmax,4*meshface) :rem store drawability  here
dim ly1(meshmax,4*meshface) :rem store drawability  here
dim lx2(meshmax,4*meshface) :rem store drawability  here
dim ly2(meshmax,4*meshface) :rem store drawability  here
dim lz(meshmax,4*meshface) :rem store drawability  here

dim alp(meshmax)
dim bet(meshmax)
dim gam(meshmax)
dim viewz(meshmax)

'****EVENT HANDLER STUFF*******
evmax=8
dim blkkill(evmax) :REM cant blow up more blocks than evts
dim evtaken(evmax)
dim evtype(evmax)
dim evtimer(evmax)
dim evset(evmax)
dim evgoing(evmax)
dim evnum(evmax)
dim evobjnos(evmax)

'KILL BLOCK TRI'S RELATED TO BLK 
kbmx=4
kbtime=10
kbtrsz=8

kbtrmax=kbtrsz*kbmx  :rem kbmx kill block events are poss.
dim kbtr1x(kbtrmax)
dim kbtr1y(kbtrmax)
dim kbtr2x(kbtrmax)
dim kbtr2y(kbtrmax)
dim kbtr3x(kbtrmax)
dim kbtr3y(kbtrmax)

dim kpos(kbmx)
dim kbtrset(kbmx)
dim kbr(kbmx)
dim kbg(kbmx)
dim kbb(kbmx)
dim kbl(kbmx)

ksz=0
for kbit=1 to kbmx
  kpos(kbit)=ksz
  ksz=ksz+kbtrsz
next kbit

dim mvkbtrx(kbtrsz)
dim mvkbtry(kbtrsz)

dim blktimer(kbmx)

starmax=300
stardist=100000
dim starx(starmax)
dim stary(starmax)
dim starz(starmax)

dim starr(starmax)
dim starg(starmax)
dim starb(starmax)

tuno=8
tunv=8
dim tunx(tuno,tunv)
dim tuny(tuno,tunv)
dim tunz(tuno,tunv)

dim tscrx(tuno,tunv)
dim tscry(tuno,tunv)
dim tzbuf(tuno,tunv)

dim tunvr(tunv)
dim tunvg(tunv)
dim tunvb(tunv)
tunw=19000
tnlgth=9000
tcam=tunw*0.9

tcinc=tnlgth*0.05
tcirmx=tuno-1
dim tcirx(tcirmx,tunv)
dim tciry(tcirmx,tunv)
dim tcirz(tcirmx,tunv)
dim tczbuf(tcirmx)
dim tp(tcirmx)

tblvmx=4
tblr=40
tblg=70
tblb=40
dim tblvrtx(tblvmx)
dim tblvrty(tblvmx)
dim tblvrtz(tblvmx)
dim tblscrx(tblvmx)
dim tblscry(tblvmx)

bcnt=3
ballmx=8
ballmov=90
bdecay=ballmov/90
ballmin=2*bdecay
dim ballmit(ballmx)
dim ballmovx(ballmx)
dim ballmovz(ballmx)
dim ballrad(ballmx)
dim ballmov(ballmx)
dim ballcoll(ballmx)
dim bcnt(ballmx)
dim ballsize(ballmx)
dim tmp2dx(ballmx)
dim tmp2dz(ballmx)
dim tmp3dx(ballmx)
dim tmp3dz(ballmx)
dim tmp4dx(ballmx)
dim tmp4dz(ballmx)
dim ballid(ballmx)
dim doneflag(ballmx)
dim donex(ballmx+1)
dim doney(ballmx+1)
dim dnx(ballmx)
dim dny(ballmx)
dim donenos(ballmx)
dim doscore(ballmx)
dim ballinitx(ballmx)
dim ballinitz(ballmx)
dim bolap(ballmx)

'REPLAY STUFF
repmx=250
repstate=0
dim reppad(repmx)

dsz=8
bid=1
for bit=1 to ballmx+1
  donex(bit)=19*bit
  doney(bit)=490
  if bit<=ballmx then
    ballid(bit)=bid
    bid=bid*2
  fi
next bit

dim sinD(360),cosD(360)
for i=1 to 360
  cosD(i)=cos(i*pi/180)
  sinD(i)=sin(i*pi/180)
next i
coscroty=cosD(croty)
sincroty=sinD(croty)
coscrotx=cosD(crotx)
sincrotx=sinD(crotx)

kbspeed=14
mvkbtrx(1)=-0.4*kbspeed
mvkbtry(1)=-0.6*kbspeed

mvkbtrx(2)=-0.6*kbspeed
mvkbtry(2)=-0.4*kbspeed

mvkbtrx(3)=-0.6*kbspeed
mvkbtry(3)=0.4*kbspeed

mvkbtrx(4)=-0.4*kbspeed
mvkbtry(4)=0.6*kbspeed

mvkbtrx(5)=0.4*kbspeed
mvkbtry(5)=0.6*kbspeed

mvkbtrx(6)=0.6*kbspeed
mvkbtry(6)=0.4*kbspeed

mvkbtrx(7)=0.6*kbspeed
mvkbtry(7)=-0.4*kbspeed

mvkbtrx(8)=0.4*kbspeed
mvkbtry(8)=-0.6*kbspeed

gosub readmeshs
 croty= croty-2
 if croty <1 croty=360-abs(croty)
 coscroty=cosD(croty)
 sincroty=sinD(croty)
 camrad=sqrt(camx*camx+camz*camz)
 camx=-camrad*sincroty
 camz=-camrad*coscroty
 crotx=atan(camy,sqrt(camx*camx+camz*camz))

return

label readmeshs
  ballcnt=1
  restore meshtypedata
  read num_mesh
  rmesh=num_mesh+1
  for mit=1 to num_mesh
    read meshtype(mit)
    read meshnmx(mit)
    read meshsz(mit)
    read meshcgx(mit)
    read meshcgy(mit)
    read meshcgz(mit)
    meshdr(mit)=1   
    read meshmov(mit)
    if meshtype(mit)=3 then
      read facer(mit,1)
      read faceg(mit,1)
      read faceb(mit,1)
      meshnx(mit,1)=0
      meshny(mit,1)=0
      meshnz(mit,1)=0
      meshact(mit)=1
      ballmit(ballcnt)=mit
      meshball(mit)=ballcnt 
      ballinitx(ballcnt)=meshcgx(mit)
      ballinitz(ballcnt)=meshcgz(mit)
      tmp2dx(ballcnt)=meshcgx(mit)
      tmp2dz(ballcnt)=meshcgz(mit)
      tmp3dx(ballcnt)=meshcgx(mit)
      tmp3dz(ballcnt)=meshcgz(mit)

      if ballcnt=1 then 
         cuerad=atan(meshcgx(mit),meshcgz(mit))
         cuemit=mit
         ballsz= meshsz(mit)+meshsz(mit)
         ballrng=ballsz*ballsz
      fi

      ballcnt=ballcnt+1
    fi
  next mit
  ballcnt=ballcnt-1 :rem so we know how many for later!

  for mit=1 to num_mesh
    if meshtype(mit)=1 then
      restore meshtype1
    elseif meshtype(mit)=2 then
      restore meshtype2
    elseif meshtype(mit)=8 then
      restore meshtypesky
    else
      goto jump
    fi

    for mnit=1 to meshnmx(mit)
      read meshnx(mit,mnit)
      read meshny(mit,mnit)
      read meshnz(mit,mnit)
    next mnit

    for fit=1 to meshface
      read facer(mit,fit)
      read faceg(mit,fit)
      read faceb(mit,fit)
    next fit
label jump
  next mit

'AND FINALLY....
  restore linkface
  for fit=1 to meshface  
    for i= 1 to 4
      read face(fit,i)
    next i
  next fit

  for mnit=1 to cuban
  countha=1
    for fit=1 to meshface
      for i= 1 to 4
        if mnit= face(fit,i) then
          f(mnit,countha)=fit
          countha=countha+1
        fi
      next i
    next fit
  next mnit
return


label ranmesh
frommesh=num_mesh+1
num_mesh=frommesh-1

  for mit=frommesh to num_mesh
     meshtype(mit)=1
     meshnmx(mit)=8
     meshsz(mit)=100
     meshdr(mit)=1
     meshcgx(mit)=300+int(900*ran())
     meshcgy(mit)=140
     meshcgz(mit)=300+int(900*ran())
  next mit

  for mit=frommesh to num_mesh
    restore meshtype1

    for mnit=1 to meshnmx(mit)
      read meshnx(mit,mnit)
      read meshny(mit,mnit)
      read meshnz(mit,mnit)
    next mnit

    for fit=1 to meshface
      read facer(mit,fit)
      read faceg(mit,fit)
      read faceb(mit,fit)
    next fit
  next mit

return

label getpad

deltax1=0
deltay1=0

  pad=peek("port1")

 if and(pad,32)>0 then  :rem  R   
   deltax1=0.2
 elseif and(pad,128)>0 then :rem L
   deltax1=-0.2
 fi

 if and(pad,16)>0 then :rem U 
   deltay1=0.2
 elseif and(pad,64)>0 then  :rem D 
   deltay1=-0.2
 fi

return

label fire

'***** REPLAY STUFF ******
  pad=peek("port1")


camch=45
camx=camx-camoffx
camz=camz-camoffz
'!!!deb
zoomr=100

' Up rotate Up
if (and(pad,16)>0) then
 camx=camx+zoomr*sinD(croty)
 camz=camz+zoomr*cosD(croty)
 crotx=atan(camy,sqrt(camx*camx+camz*camz))

fi

' Down-rot down
if (and(pad,64)>0) then
 camx=camx-zoomr*sinD(croty)
 camz=camz-zoomr*cosD(croty)
 crotx=atan(camy,sqrt(camx*camx+camz*camz))

fi

' R-rot R
if (and(pad,32)>0) then
 croty= croty+1
 if croty >360 croty=croty-360
 coscroty=cosD(croty)
 sincroty=sinD(croty)

'FIELD OF VIEW STUFF
 crotyr=croty+cfov
 if crotyr >360 crotyr=crotyr-360
 crotyl=croty-cfov
 if crotyl <1 crotyl=360-abs(crotyl)
 cgradr=cosD(crotyr)/sinD(crotyr)
 cgradl=cosD(crotyl)/sinD(crotyl)

 camoffx=meshcgx(ballmit(1))
 camoffz=meshcgz(ballmit(1))
 camrad=sqrt(camx*camx+camz*camz)
 camx=-camrad*sincroty
 camz=-camrad*coscroty
 crotx=atan(camy,sqrt(camx*camx+camz*camz))

fi

' left-rot left
if (and(pad,128)>0) then
 croty= croty-1
 if croty <1 croty=360-abs(croty)
 coscroty=cosD(croty)
 sincroty=sinD(croty)

'FIELD OF VIEW STUFF
 crotyr=croty+cfov
 if crotyr >360 crotyr=crotyr-360
 crotyl=croty-cfov
 if crotyl <1 crotyl=360-abs(crotyl)
 cgradr=cosD(crotyr)/sinD(crotyr)
 cgradl=cosD(crotyl)/sinD(crotyl)

 camoffx=meshcgx(ballmit(1))
 camoffz=meshcgz(ballmit(1))
 camrad=sqrt(camx*camx+camz*camz)
 camx=-camrad*sincroty
 camz=-camrad*coscroty
 crotx=atan(camy,sqrt(camx*camx+camz*camz))
fi


' r2- zoom in
if (and(pad,512)>0) then
 camz= camz-100
 crotx=atan(camy,sqrt(camx*camx+camz*camz))
fi

' l2 zoom out
if (and(pad,256)>0) then
 camz= camz+100
 crotx=atan(camy,sqrt(camx*camx+camz*camz))
fi

' triangle -drawtype1
if (and(pad,4096)>0) then
 camy=camy+camch
 crotx=atan(camy,sqrt(camx*camx+camz*camz))
fi

' O drawtype 2
if pad=8192 and lastp<>8192 then
  if ballmov(1)=0 then
    btncnt=btncnt+1
  else
    btncnt=0
  fi
fi

if btncnt=0 then
  ballmv1=ballmov(1)
elseif btncnt=1 then
  if ballmv1< ballmov then
     ballmv1=ballmv1+1
  else
     btncnt=2
  fi
elseif btncnt=3 then
   btncnt=0
     ballrad(1)=croty            
     ballmov(1)=ballmv1
     evobjnos=1
     evtype=5 :rem START IMPULSE EVENT
     gosub grabev
fi

' X
if (and(pad,16384)>0) then
 camy=camy-camch
 crotx=atan(camy,sqrt(camx*camx+camz*camz))
 
fi

' square
if (and(pad,32768)>0) then
 camx=camx-10
 crotx=atan(camy,sqrt(camx*camx+camz*camz))
 donenos=ballcnt 

fi

' change object
if (and(pad,1)>0) and lastp<>1 then
 camx=1500
 camy=1000
 camz=-1500
 croty= croty-90
 if croty <1 croty=360-abs(croty)

'FIELD OF VIEW STUFF
 crotyr=croty+cfov
 if crotyr >360 crotyr=crotyr-360
 crotyl=croty-cfov
 if crotyl <1 crotyl=360-abs(crotyl)
 cgradr=cosD(crotyr)/sinD(crotyr)
 cgradl=cosD(crotyl)/sinD(crotyl)

 coscroty=cosD(croty)
 sincroty=sinD(croty)


 camrad=2000 :rem sqrt(camx*camx+camz*camz)
 camx=-camrad*sincroty
 camz=-camrad*coscroty
 crotx=atan(camy,sqrt(camx*camx+camz*camz))

fi

 if crotx<>lcrotx then
   sincrotx=sin(crotx)
   coscrotx=cos(crotx)
   lcrotx=crotx
 fi
camx=camx+camoffx
camz=camz+camoffz

lastp=pad
return

'*******FRAMER RATER!!!!!!!!*********
label frate

setdispbuf draw
draw = 1 - draw
setdrawbuf draw

return
'*****SORT EVENTS*******
label eventhdl

for iter=1 to evmax

   if evtaken(iter)>0 and evgoing(iter)=0 then     
      
        evgoing(iter)=1
  on evtype(iter) gosub eventdo,eventdo,eventdo,ballgutinit,ballimp
      
   fi

next iter
return

'*****DO EVENT*****
'*****They're all the same for now.

label eventdo

for iter=1 to evmax

   if evtaken(iter)>0 and evgoing(iter)>0 then     
      
  on evtype(iter) gosub eventdo,eventdo,eventdo,ballguthdl,ballhdl
     
   fi
next iter

return

label grabev
  evok=0
  for evit=1 to evmax    :REM Grab an event!*^&%$@
     if evtaken(evit)=0 then
       evtype(evit)=evtype :rem Hooray! 
       evtaken(evit)=1
       evgoing(evit)=0
       evobjnos(evit)=evobjnos
       evok=evit
       evit=evmax
     fi
  next evit

return

label killblkinit
'EV5
ok=0
if zbuf(evobjnos,1)>0 then

for kbit2=1 to kbmx

if kbtrset(kbit2)<1 then
 evobjnos=evobjnos(iter)

 ok=1

 kbtrset(kbit2)=evobjnos
 meshev(evobjnos)=iter
 drbtrx=FOV*meshsz(evobjnos)/zbuf(evobjnos,1)
 drbblx=-FOV*meshsz(evobjnos)/zbuf(evobjnos,1)
 drbtry=FOV*meshsz(evobjnos)/zbuf(evobjnos,1)
 drbbly=-FOV*meshsz(evobjnos)/zbuf(evobjnos,1)
 lt=ltmx2d*(1-scrd(evobjnos)/scrdmx)
 if lt<-100 lt=-100
 kbr(kbit2)=facer(evobjnos,1)+lt
 kbg(kbit2)=faceg(evobjnos,1)+lt
 kbb(kbit2)=faceb(evobjnos,1)+lt

 meshdr(evobjnos)=0   
 meshnmx(evobjnos)=1
 evobjnos(iter)=kbit2 :rem swap what it saves
 kbwd=(drbtrx-drbblx)/2
 kbht=(drbtry-drbbly)/2
 
 blktimer(kbit2)=miligone+kbtime

 kpos=kpos(kbit2)

'MIDDLE
 for kbit=1 to kbtrsz
   kbtr1x(kbit+kpos)=drbblx+kbwd
   kbtr1y(kbit+kpos)=drbbly+kbht
 next kbit

'A
 kbtr2x(1+kpos)=drbblx+kbwd
 kbtr2y(1+kpos)=drbbly
 kbtr3x(8+kpos)=drbblx+kbwd
 kbtr3y(8+kpos)=drbbly

'B
 kbtr2x(2+kpos)=drbblx
 kbtr2y(2+kpos)=drbbly
 kbtr3x(1+kpos)=drbblx
 kbtr3y(1+kpos)=drbbly
'C
 kbtr2x(3+kpos)=drbblx
 kbtr2y(3+kpos)=drbbly+kbht
 kbtr3x(2+kpos)=drbblx
 kbtr3y(2+kpos)=drbbly+kbht
'D
 kbtr2x(4+kpos)=drbblx
 kbtr2y(4+kpos)=drbtry
 kbtr3x(3+kpos)=drbblx
 kbtr3y(3+kpos)=drbtry
'E
 kbtr2x(5+kpos)=drbblx+kbwd
 kbtr2y(5+kpos)=drbtry
 kbtr3x(4+kpos)=drbblx+kbwd
 kbtr3y(4+kpos)=drbtry
'F
 kbtr2x(6+kpos)=drbtrx
 kbtr2y(6+kpos)=drbtry
 kbtr3x(5+kpos)=drbtrx
 kbtr3y(5+kpos)=drbtry
'G
 kbtr2x(7+kpos)=drbtrx
 kbtr2y(7+kpos)=drbbly+kbht
 kbtr3x(6+kpos)=drbtrx
 kbtr3y(6+kpos)=drbbly+kbht
'H
 kbtr2x(8+kpos)=drbtrx
 kbtr2y(8+kpos)=drbbly
 kbtr3x(7+kpos)=drbtrx
 kbtr3y(7+kpos)=drbbly

 kbit2=kbmx

fi :rem if set free

next kbit2
fi :rem if z +ve

if ok=0 then
  evgoing(iter)=0
  evtaken(iter)=0
fi

return

label killblkhdl
'EV5
kbit2=evobjnos(iter)

if kbtrset(kbit2)>0 then
mit=kbtrset(kbit2)

setrgb 1,kbr(kbit2),kbr(kbit2),kbr(kbit2)

for kbit =1 to kbtrsz

kpos=kbit+kpos(kbit2)

kbtr1x(kpos)=kbtr1x(kpos)+mvkbtrx(kbit)
kbtr1y(kpos)=kbtr1y(kpos)+mvkbtry(kbit)

kbtr2x(kpos)=kbtr2x(kpos)+mvkbtrx(kbit)
kbtr2y(kpos)=kbtr2y(kpos)+mvkbtry(kbit)

kbtr3x(kpos)=kbtr3x(kpos)+mvkbtrx(kbit)
kbtr3y(kpos)=kbtr3y(kpos)+mvkbtry(kbit)
fill triangle screenx(mit,1)+kbtr1x(kpos),screeny(mit,1)+kbtr1y(kpos) to screenx(mit,1)+kbtr2x(kpos),screeny(mit,1)+kbtr2y(kpos) to screenx(mit,1)+kbtr3x(kpos),screeny(mit,1)+kbtr3y(kpos)

next kbit

if blktimer(kbit2)<miligone then
   evgoing(iter)=0
   evtaken(iter)=0
   kbtrset(kbit2)=0
   blkkill(iter)=0
   meshev(evobjnos)=0
fi

fi

return
label starsinit
 cnt=0
 for stit= 1 to starmax
   cnt=cnt+1
   if cnt>3 cnt=1

   if cnt=1 then
      xran=ran(2)
      yran=ran(2-xran)
      zran=ran(2-yran)
   elseif cnt=2 then
      yran=ran(2)
      zran=ran(2-yran)
      xran=ran(2-zran)
   else
      zran=ran(2)
      xran=ran(2-zran)
      yran=ran(2-xran)
   fi
   starx(stit)=stardist*(xran-1)
   stary(stit)=stardist*(yran-1)
   starz(stit)=stardist*(zran-1)

 next stit
return

label drawstars
setrgb 1,255,255,255

    for stit=1 to starmax
      newx=starx(stit)
      newy=stary(stit)
      newz=starz(stit)

'#### CAM TRANSFORM!!! ####

      ctnx=newx*coscroty-newz*sincroty
      ctny=newy
      ctnz=newx*sincroty+newz*coscroty

      ctny=newy*coscrotx+ctnz*sincrotx
      ctnz=ctnz*coscrotx-newy*sincrotx

        ctnz=ctnz*0.25
        dot midx+FOV*(ctnx/ctnz),midy+FOV*(ctny/ctnz)
  next stit
return



label fillcirc
if donenos(meshb)=0 then
  x=screenx(mit,1)
  y=screeny(mit,1)
  z=FOV*meshsz(mit)/zbuf(mit,1)
  zbl=z*0.2
  ztr=z*0.4
  setrgb 1,facer(mit,1)+lt,faceg(mit,1)+lt,faceb(mit,1)+lt
  fill  circle x,y,z
  setrgb 1,255,255,255
  fill rectangle x+zbl,y+zbl to x+ztr,y+ztr
 
fi
return
label doscore
setrgb 1,10,30,10
fill rectangle 5,470 to 125,510 
setrgb 1,9,5,5
fill rectangle 15,480 to 125,500 
for bit=1 to ballcnt
if doscore(bit)>0 then
  mit=ballmit(bit)
  setrgb 1,facer(mit,1),faceg(mit,1),faceb(mit,1)

  fill  circle dnx(bit),dny(bit),dsz
fi
next bit
return

label tblinit
mt=1

label again
gam(mt)=90
meshmov(mt)=1
gosub align
meshmov(mt)=0
gam(mt)=360
if mt=1 then
 mt=5
 goto again
fi

gam=90
alp(3)=gam
alp(4)=gam
bet(5)=270
meshmov(3)=1
meshmov(4)=1
meshmov(5)=1
gosub align
meshmov(3)=0
meshmov(4)=0
meshmov(5)=0


return
label ballgutinit
 bit=evobjnos(iter)

 dnx(bit)=donex(ballcnt+1)
 dny(bit)=doney(ballcnt+1)
 doscore(bit)=1
return

label ballguthdl
 bit=evobjnos(iter)

if dnx(bit)>donex(donenos(bit)) then
   dnx(bit)=dnx(bit)-2
else
   dnx(bit)=donex(donenos(bit))
   if donenos =ballcnt-1 donenos=ballcnt
   evgoing(iter)=0
   evtaken(iter)=0
fi
return

label ballimp
 bit=evobjnos(iter)
 if ballrad(bit)=0 ballrad(bit)=1+int(ran(360))
 ballmovx(bit)=ballmov(bit)*sinD(ballrad(bit))
 ballmovz(bit)=ballmov(bit)*cosD(ballrad(bit))
return

label ballhdl
 bit=evobjnos(iter)
 bmit=ballmit(bit)
 meshcgx=meshcgx(bmit)+ballmovx(bit)
 meshcgz=meshcgz(bmit)+ballmovz(bit)
 tmp2dx(bit)=meshcgx(bmit)+ballmovx(bit)*0.33
 tmp2dz(bit)=meshcgz(bmit)+ballmovz(bit)*0.33
 tmp3dx(bit)=meshcgx(bmit)+ballmovx(bit)*0.66
 tmp3dz(bit)=meshcgz(bmit)+ballmovz(bit)*0.66

 gosub collwll
 if collwall=550 then
   ballmovx(bit)=ballmov(bit)*sinD(ballrad(bit))
   ballmovz(bit)=ballmov(bit)*cosD(ballrad(bit))
   goto getout2
 fi

 if abs(meshcgx)>458 then

   if (abs(meshcgz)>944 or abs(meshcgz)<23) then
    if bit<>1 then   
     donenos=donenos+1
     donenos(bit)=donenos
     evobjnos=bit
     evtype=4 :rem show roll in gutter
     gosub grabev

     ballmov(bit)=0
     ballmovx(bit)=0
     ballmovz(bit)=0

     ballrad(bit)=0
     evgoing(iter)=0
     evtaken(iter)=0
    else
     gosub resetwhite
     goto getout2

    fi
   else
     meshcgx=458*meshcgx/abs(meshcgx)
     ballrad(bit)=181+int(180*atan(sinD(ballrad(bit)),-cosD(ballrad(bit)) )/pi)

   fi

 fi

 if  abs(meshcgz)>968 then

   if abs(meshcgx)>434 and donenos(bit)=0  then
    if bit<>1 then   
     donenos=donenos+1
     donenos(bit)=donenos
     evobjnos=bit
     evtype=4 :rem show roll in gutter
     gosub grabev

     ballmov(bit)=0
     ballmovx(bit)=0
     ballmovz(bit)=0

     ballrad(bit)=0
     evgoing(iter)=0
     evtaken(iter)=0
    else
     gosub resetwhite
     goto getout2
    fi
   else
     meshcgz=968*meshcgz/abs(meshcgz)
     ballrad(bit)=181+int(180*atan(-sinD(ballrad(bit)),cosD(ballrad(bit)))/pi)
   fi

 fi
if donenos(bit)=0 then

 meshcgx(bmit)=meshcgx
 meshcgz(bmit)=meshcgz

 ballmov(bit)=ballmov(bit)-bdecay
 ballmovx(bit)=ballmov(bit)*sinD(ballrad(bit))
 ballmovz(bit)=ballmov(bit)*cosD(ballrad(bit))

 if ballmov(bit)<bdecay then
   gosub overlap
   if olap=0 then
     ballmov(bit)=0
     bolap(bit)=0
     ballmovx(bit)=0
     ballmovz(bit)=0
     ballrad(bit)=0
     evgoing(iter)=0
     evtaken(iter)=0
     tmp2dx(bit)=meshcgx
     tmp2dz(bit)=meshcgz   
     tmp3dx(bit)=meshcgx
     tmp3dz(bit)=meshcgz
    fi   
 fi
fi
label getout2

return

'COLLISION HANDLE WHEN BALL HAS HIT WALL
label collwll
collwall=0
 for i=1 to  ballcnt
    
   if i<>bit and and(ballcoll(bit),ballid(i))=0 and donenos(i)=0 then
     collnr=sqr(tmp2dz(bit)-tmp2dz(i)) + sqr(tmp2dx(bit)-tmp2dx(i))
     collmd=sqr(tmp3dz(bit)-tmp3dz(i)) + sqr(tmp3dx(bit)-tmp3dx(i))

     collfr=sqr(meshcgz-meshcgz(ballmit(i))) + sqr(meshcgx-meshcgx(ballmit(i)))

     if (collnr<ballrng) or (collfr<ballrng) or (collmd<ballrng) then
           collwall=1
           if (collnr<ballrng) then
            meshcgx(ballmit(i))=meshcgx(ballmit(i))-ballmovx(i)
            meshcgz(ballmit(i))=meshcgz(ballmit(i))-ballmovz(i)
            meshcgx=meshcgx-ballmovx(bit)
            meshcgz=meshcgz-ballmovz(bit)
           elseif (collmd<ballrng) then

            meshcgx=tmp2dx(bit)
            meshcgz=tmp2dz(bit)
            meshcgx(ballmit(i))=tmp2dx(i)
            meshcgz(ballmit(i))=tmp2dz(i)
            collwall=2
           else
            meshcgx=tmp3dx(bit)
            meshcgz=tmp3dz(bit)
            meshcgx(ballmit(i))=tmp3dx(i)
            meshcgz(ballmit(i))=tmp3dz(i)
            collwall=3
           fi
           bitst=bit
           if ballmov(i)>ballmov(bit) then
             bit=i
             i=bitst
           fi

           bbitmov=ballmov(bit)
           bbitrad=ballrad(bit)
           bimov=ballmov(i)
           birad=ballrad(i)

           mez=meshcgz(ballmit(bit))
           mex=meshcgx(ballmit(bit))
           youz=meshcgz(ballmit(i))
           youx=meshcgx(ballmit(i))
           hitang=int(180*atan(youx-mex,youz-mez)/pi)

           ballrad(i)=hitang 
           if ballrad(i)<=0 ballrad(i)=360+ballrad(i)
           if ballrad(i)>360 ballrad(i)=ballrad(i)-360

           fctr=abs(bbitrad-ballrad(i))
           if fctr>90 fctr=360-fctr
           
           fctr=fctr/90
           if fctr >1 fctr=1
           fctr=1-fctr

           flag=0
           bbitrad=abs(bbitrad-ballrad(i))
           if bbitrad>180 then
             bbitrad=360-bbitrad
             flag=1
           fi
           if flag=0 then
             if ballrad(bit)<ballrad(i) then
               ballrad(bit)=ballrad(i)-90
             else
               ballrad(bit)=ballrad(i)+90
             fi
           else             
             if ballrad(bit)>ballrad(i) then
               ballrad(bit)=ballrad(i)-90
             else
               ballrad(bit)=ballrad(i)+90
             fi
           fi

           if ballrad(bit)<=0 ballrad(bit)=360+ballrad(bit)
           if ballrad(bit)>360 ballrad(bit)=ballrad(bit)-360
'WHY TWICE?????
rem           if ballrad(bit)<=0 ballrad(bit)=360+ballrad(bit)
rem           if ballrad(bit)>360 ballrad(bit)=ballrad(bit)-360

           ballmov(bit)= abs((1-fctr)*bbitmov)
            
           if ballmov(i)=0 then
             ballmov(i)=abs(fctr*bbitmov)
             evobjnos=i
             evtype=5 :rem START IMPULSE EVENT
             gosub grabev
           else
             ballmov(i)=abs(fctr*bbitmov)
           fi
           ballcoll(bit)=or(ballcoll(bit),ballid(i))
           ballcoll(i)=or(ballcoll(i),ballid(bit))
           bcnt(bit)=bcnt
           bcnt(i)=bcnt
           i=ballcnt+1 :rem jump out loop
           bit=bitst
     fi
   fi   
 next i
return
'COLLWLL^

'IF BALL OVERLAPS JUST BEFORE IT STOPS MOVING DO THIS
label overlap
olap=0
 for i=1 to  ballcnt
   if i<>bit  and ballmov(i)=0 and donenos(i)=0 then
     yuk=sqr(meshcgz(ballmit(bit))-meshcgz(ballmit(i))) + sqr(meshcgx(ballmit(bit))-meshcgx(ballmit(i)))
     if  yuk< ballrng then
           olap=1

           mez=meshcgz(ballmit(bit))
           mex=meshcgx(ballmit(bit))
           youz=meshcgz(ballmit(i))
           youx=meshcgx(ballmit(i))
           hitang=int(180*atan(youx-mex,youz-mez)/pi)
           if bolap(bit)<>i then
             ballrad(bit)=hitang+180
             if ballrad(bit)<=0 ballrad(bit)=360+ballrad(bit)
             if ballrad(bit)>360 ballrad(bit)=ballrad(bit)-360
           fi
           if bolap(i)<>bit then 
             ballrad(i)=hitang
             if ballrad(i)<=0 ballrad(i)=360+ballrad(i)
             if ballrad(i)>360 ballrad(i)=ballrad(i)-360
           fi
           bolap(i)=bit
           bolap(bit)=i
           ballmov(bit)=sqrt(ballrng-yuk)/3 :rem was /5
           if ballmov(bit)<2 ballmov(bit)=2
           ballmov(i)=ballmov(bit)/2
           evobjnos=i
           evtype=5 :rem START IMPULSE EVENT
           gosub grabev
            
     fi
   fi
 next i
return

label drawcue
if ballmov(1)=0 then
      newx=-700*sincroty+meshcgx(cuemit)
      newz=-700*coscroty+meshcgz(cuemit)

      newy=meshcgy(cuemit)
      newx=newx-camx
      newy=newy-camy
      newz=newz-camz

      ctnx=newx*coscroty-newz*sincroty     
      ctnz=newx*sincroty+newz*coscroty

      ctny=newy*coscrotx+ctnz*sincrotx
      ctnz=ctnz*coscrotx-newy*sincrotx

      ctnz=ctnz*0.25

      if ctnz<0 nzc=nzc+1

      cuex=midx+FOV*ctnx/ctnz
      cuey=midy+FOV*ctny/ctnz
      setrgb 1,255,255,255
      line screenx(cuemit,1),screeny(cuemit,1) to cuex,cuey
 fi

return

label resetwhite
  meshcgx(ballmit(1))=ballinitx(1)
  meshcgz(ballmit(1))=ballinitz(1)
return


'THIS WHOLE MESS DRAWS THE CONTROLLER INSTRUCTIONS @ START
label showcontroller
pad=0
testx=250
testy=250
 if and(pad,16)>0 then
   testy=testy+1
 elseif and(pad,64)>0 then
   testy=testy-1
 fi
 if and(pad,32)>0 then
   testx=testx+1
 elseif and(pad,128)>0 then
   testx=testx-1
 fi

 setrgb 0,20,50,20
 clear window

 pad=peek("port1")

 setrgb 1,10,10,10
 fill circle 195,250,95
 fill circle 420,250,95

 clear fill rectangle 360,300 to 400,348
 clear fill rectangle 440,300 to 490,348

 clear fill rectangle 135,300 to 175,348
 clear fill rectangle 215,300 to 320,348

 
 setrgb 1,30,30,30
 fill circle 195,250,90
 fill circle 420,250,90

 clear fill rectangle 0,0 to 640,300
 clear fill triangle 220,345 to 300,325 to 240,250
 clear fill triangle 395,345 to 320,310 to 375,240
 
 clear fill triangle 60,290 to 170,345 to 160,290
 clear fill triangle 555,290 to 445,345 to 455,290

 fill triangle 135,250 to 115,140 to 195,125
 fill triangle 135,250 to 195,125 to 255,250

 fill triangle 360,250 to 420,125 to 500,140
 fill triangle 360,250 to 480,250 to 500,140
 fill circle 155,135,40
 fill circle 460,135,40

 setrgb 1,30,30,30
 fill rectangle 195,190 to 415,300

 setrgb 1,30,30,40
 fill circle 195,250,60
 fill circle 420,250,60
 setrgb 1,0,0,0
 circle 195,250,60
 circle 420,250,60

 setrgb 1,30,30,40
 fill circle 255,190,40
 fill circle 360,190,40
 setrgb 1,3,3,3
 fill circle 255,190,30
 fill circle 360,190,30
 setrgb 1,10,10,10
 fill circle 255,190,27
 fill circle 360,190,27
 setrgb 1,0,0,0
 circle 255,190,40
 circle 360,190,40
 circle 255,190,27
 circle 360,190,27

cx=195
cy=250
Xsz=17
W=45
check=0
LABEL drcross
setrgb 1,27,27,37

fill rectangle cx-Xsz,cy-W to cx+Xsz,cy+W
fill rectangle cx-W,cy-Xsz to cx+W,cy+Xsz

setrgb 1,0,0,0

line cx-Xsz,cy+W to cx+Xsz,cy+W
line cx-Xsz,cy-W to cx+Xsz,cy-W

line cx-W,cy+Xsz to cx-W,cy-Xsz
line cx+W,cy+Xsz to cx+W,cy-Xsz

line cx-Xsz,cy+Xsz to cx-Xsz,cy+W
line cx+Xsz,cy+Xsz to cx+Xsz,cy+W

line cx-Xsz,cy-Xsz to cx-Xsz,cy-W
line cx+Xsz,cy-Xsz to cx+Xsz,cy-W

line cx-Xsz,cy+Xsz to cx-W,cy+Xsz
line cx-Xsz,cy-Xsz to cx-W,cy-Xsz

line cx+Xsz,cy+Xsz to cx+W,cy+Xsz
line cx+Xsz,cy-Xsz to cx+W,cy-Xsz

if check=0 then
 check=1
 cx=420
 goto drcross
fi

setrgb 1,14,14,14

fill circle 390,250,12
fill circle 450,250,12

fill circle 420,280,12
fill circle 420,220,12
setrgb 1,0,0,0

 circle 390,250,13
 circle 450,250,13

 circle 420,280,13
 circle 420,220,13

setrgb 1,20,180,20
triangle 420,288 to 412,275 to 428,275

setrgb 1,190,20,20
circle 450,250,9

setrgb 1,120,48,24
rectangle 383,243 to 397,257

setrgb 1,100,100,180
line 413,213 to 427,227
line 413,227 to 427,213
 

setrgb 1,0,0,0
check=0
W=1.1*W
dsz=9
tbeg=W*0.15
rbeg=W/3
rend=2*W/3

label dbuttons

cx=195
cy=250


fill rectangle cx-dsz,cy+rbeg to cx+dsz,cy+rend
fill rectangle cx-dsz,cy-rbeg to cx+dsz,cy-rend

fill rectangle cx-rend,cy-dsz to cx-rbeg,cy+dsz
fill rectangle cx+rend,cy-dsz to cx+rbeg,cy+dsz

fill triangle cx-dsz,cy+rbeg to cx+dsz,cy+rbeg to cx,cy+tbeg
fill triangle cx-dsz,cy-rbeg to cx+dsz,cy-rbeg to cx,cy-tbeg
fill triangle cx-rbeg,cy+dsz to cx-rbeg,cy-dsz to cx-tbeg,cy
fill triangle cx+rbeg,cy+dsz to cx+rbeg,cy-dsz to cx+tbeg,cy
 
if check=0 then
  check=1
  setrgb 1,12,12,12
  tbeg=tbeg+2
  rbeg=rbeg+2
  rend=rend-2
  dsz=7
  goto dbuttons
fi

setrgb 1,95,0,0
fill rectangle 298,200 to 318,208
setrgb 1,0,0,0
rectangle 298,200 to 318,208
setrgb 1,175,170,170
dot 315,206
dot 315,206

setrgb 1,59,0,0
line 301,201 to 312,201

setrgb 1,0,0,0
fill rectangle 263,243 to 282,257
fill triangle 333,242 to 333,258 to 352,250

setrgb 1,12,12,12
fill rectangle 265,245 to 280,255
fill triangle 335,244 to 335,256 to 350,250

setrgb 1,0,0,0
fill rectangle 297,212 to 319,224
setrgb 1,12,12,12
fill rectangle 299,213 to 317,223

setrgb 1,50,70,150
text 287,274,"SONY"
 
setrgb 1,255,255,255
line 195,300 to 195,370
text 140,380,"Zoom in out"

line 115,250 to 145,250
text 10,250,"Turn view"

line 445,295 to 480,340
text 490,340,"Raise view"

line 445,205 to 515,155
text 525,155,"Lower view"

line 272,265 to 272,315
text 210,325,"Rotate view by 90'"

line 472,250 to 480,250
text 485,290,"Push 3 times"
text 485,270,"to take shot:"
text 485,250,"1.Power rise"
text 485,230,"2.Power stop"
text 485,210,"3.Take shot"

setrgb 1,10,30,10
fill rectangle 180,59 to 432,86

setrgb 1,255,250,250
text 185,70,"Press select to continue"

rem setrgb 1,200,200,200
rem text 20,80,"testy:-> "+str$(testy)
rem text 20,60,"testx:-> "+str$(testx)
rem setrgb 1,255,255,255
rem dot testx,testy

gosub frate

while( pad<>1 )
 pad=peek("port1")
wend
pad=0
return

label drawsky
    nrest=frpln*frpln  :rem oh tooo big.....!
    flnr=nrest
    flnl=nrest

    nzc=0
    mit=rmesh
    for i=1 to flrnos
'TODO Optimise!
      if i<4 then
        z=meshnz(mit,i)-meshnz(mit,i+1)
        x=meshnx(mit,i)-meshnx(mit,i+1)
        if x=0 then
          flx(i)=meshnx(mit,i)
          flz(i)=cgradl*(flx(i)-camx)+camz
          frx(i)=meshnx(mit,i)
          frz(i)=cgradr*(frx(i)-camx)+camz
        fi
        if z=0 then
          flz(i)=meshnz(mit,i)
          flx(i)=(flz(i)-camz)/cgradl+camx
          frz(i)=meshnz(mit,i)
          frx(i)=(frz(i)-camz)/cgradr+camx
        fi
      else
        z=meshnz(mit,i)-meshnz(mit,1)
        x=meshnx(mit,i)-meshnx(mit,1)
        if x=0 then
          flx(i)=meshnx(mit,i)
          flz(i)=cgradl*(flx(i)-camx)+camz
          frx(i)=meshnx(mit,i)
          frz(i)=cgradr*(frx(i)-camx)+camz
        fi
        if z=0 then
          flz(i)=meshnz(mit,i)
          flx(i)=(flz(i)-camz)/cgradl+camx
          frz(i)=meshnz(mit,i)
          frx(i)=(frz(i)-camz)/cgradr+camx
        fi
      fi
'Find nearest intersected walls in front

      newx=flx(i)-camx
      newz=flz(i)-camz

      ctnx=newx*coscroty-newz*sincroty
      ctnz=newx*sincroty+newz*coscroty

      if ctnz>0 then
        dist=ctnx*ctnx+ctnz*ctnz
        if dist<flnl then
          flt=i
          flnl=dist
        fi
      fi
      newx=frx(i)-camx
      newz=frz(i)-camz

      ctnx=newx*coscroty-newz*sincroty
      ctnz=newx*sincroty+newz*coscroty

      if ctnz>0 then
        dist=ctnx*ctnx+ctnz*ctnz
        if dist<flnr then
          frt=i
          flnr=dist
        fi
      fi

    next i

    for i=1 to meshnmx(mit)

      fmx(i)=meshnx(mit,i)
      fmz(i)=meshnz(mit,i)
    next i

      fleft=flt+1
      if fleft=5 fleft=1

      fmx(fleft)=flx(flt)
      fmz(fleft)=flz(flt)
      fmx(fleft+4)=flx(flt)
      fmz(fleft+4)=flz(flt)

      fmx(frt)=frx(frt)
      fmz(frt)=frz(frt)
      fmx(frt+4)=frx(frt)
      fmz(frt+4)=frz(frt)
      if abs(flt-frt)<>2  then
          fleft=fleft+1
          if fleft=5 fleft=1

        while( fleft<>frt)
          fmx(fleft)=camx
          fmz(fleft)=camz
          fmx(fleft+4)=camx
          fmz(fleft+4)=camz
          fleft=fleft+1
          if fleft=5 fleft=1
        wend
      fi
'debug
    camcgx=meshcgx(mit)-camx
    camcgy=meshcgy(mit)-camy
    camcgz=meshcgz(mit)-camz

    for mnit=1 to meshnmx(mit)
      newx=fmx(mnit)
      newy=meshny(mit,mnit)
      newz=fmz(mnit)

      newx=newx+camcgx
      newy=newy+camcgy
      newz=newz+camcgz

      ctnx=newx*coscroty-newz*sincroty
     
      ctnz=newx*sincroty+newz*coscroty

      ctny=newy*coscrotx+ctnz*sincrotx
      ctnz=ctnz*coscrotx-newy*sincrotx

      ctnz=ctnz*0.25
      zbuf(mit,mnit)=ctnz

      if ctnz<=0 nzc=nzc+1

      xoff=FOV*ctnx/ctnz
      yoff=FOV*ctny/ctnz

      screenx(mit,mnit)=midx+xoff
      screeny(mit,mnit)=midy+yoff
      dist=newx*newx+newy*newy+newz*newz

      if nrest>dist and ctnz>0 then
          znrst=mnit
          nrest=dist 
          scrd=xoff*xoff+yoff*yoff
      fi
    next mnit

    for i=1 to 6
      f=i
      x1=screenx(mit,face(f,1))
      y1=screeny(mit,face(f,1))
      x2=screenx(mit,face(f,2))
      y2=screeny(mit,face(f,2))
      x3=screenx(mit,face(f,3))
      y3=screeny(mit,face(f,3))
      x4=screenx(mit,face(f,4))
      y4=screeny(mit,face(f,4))

      if (((x2-x1)*(y3-y1)-(y2-y1)*(x3-x1)) > 0) then
        setrgb 1,facer(mit,f),faceg(mit,f),faceb(mit,f)
          fill triangle x1,y1 to x2,y2 to x3,y3
          fill triangle x1,y1 to x4,y4 to x3,y3
      fi

    next i

'DEBUG RAY !!!!!!!!!!!!!!!!!!!!!!!
      newx=flx(flt)+camcgx
      newy=camcgy
      newz=flz(flt)+camcgz

      ctnx=newx*coscroty-newz*sincroty
     
      ctnz=newx*sincroty+newz*coscroty

      ctny=newy*coscrotx+ctnz*sincrotx
      ctnz=ctnz*coscrotx-newy*sincrotx

      ctnz=ctnz*0.25

      if ctnz>0 then

        xoff=FOV*ctnx/ctnz
        yoff=FOV*ctny/ctnz


        screenx=midx+xoff
        screeny=midy+yoff
  x=screenx
  y=screeny
  z=FOV*2000/ctnz
  setrgb 1,50,50,50
  fill  circle x,y,z
        setrgb 1,255,255,255

        text x,y,str$(flt)+"L"
      fi
'STILL DEBUG RAY !!!!!!!!!!!!!!!!!!!!!!!
      newx=frx(frt)+camcgx
      newy=camcgy
      newz=frz(frt)+camcgz

      ctnx=newx*coscroty-newz*sincroty
     
      ctnz=newx*sincroty+newz*coscroty

      ctny=newy*coscrotx+ctnz*sincrotx
      ctnz=ctnz*coscrotx-newy*sincrotx

      ctnz=ctnz*0.25

      if ctnz>0 then

        xoff=FOV*ctnx/ctnz
        yoff=FOV*ctny/ctnz


        screenx=midx+xoff
        screeny=midy+yoff
  x=screenx
  y=screeny
  z=FOV*2000/ctnz
  setrgb 1,50,50,50
  fill  circle x,y,z
        setrgb 1,255,255,255

        text x,y,str$(frt)+"R"
      fi

return

label resettable
   for i =1 to ballcnt
    meshcgx(ballmit(i))=ballinitx(i)
    meshcgz(ballmit(i))=ballinitz(i)
    tmp2dx(i)=ballinitx(i)
    tmp2dz(i)=ballinitz(i)
    tmp3dx(i)=ballinitx(i)
    tmp3dz(i)=ballinitz(i)
    donenos(i)=0 
    doscore(i)=0
    ballmov(i)=0
   next i
   donenos=0
return

label roominit
    restore meshtyperoom
    mit=rmesh
    
    read meshtype(mit)
    read meshnmx(mit)
    read meshsz(mit)
    read meshcgx(mit)
    read meshcgy(mit)
    read meshcgz(mit)
    meshdr(mit)=1   
    read meshmov(mit)

    for mnit=1 to meshnmx(mit)
      read meshnx(mit,mnit)
      read meshny(mit,mnit)
      read meshnz(mit,mnit)
    next mnit

    for fit=1 to meshface
      read facer(mit,fit)
      read faceg(mit,fit)
      read faceb(mit,fit)
    next fit

'AND FINALLY....
  restore linkface
  for fit=1 to meshface  
    for i= 1 to 4
      read face(fit,i)
    next i
  next fit

  for mnit=1 to cuban
  countha=1
    for fit=1 to meshface
      for i= 1 to 4
        if mnit= face(fit,i) then
          f(mnit,countha)=fit
          countha=countha+1
        fi
      next i
    next fit
  next mnit

return

label drawroom
return

label choreo
  if donenos=ballcnt gosub resettable

  if choret>miligone then
    evobjnos=1
    ballmov(1)=ballmov/2
    evtype=5 :rem drop medic pack
    gosub grabev
    choret=miligone+25 :rem +int(ran(5))  
  fi

return

'DATA
label meshtypedata
data 14            :rem Num of meshes defined below:

data 1             :rem type
data 8             :rem node nos
data 100           :rem size
data 0,20,1010    :rem initial x,y,z co-ords
data 0             :rem movable

data 2             :rem type
data 8             :rem node nos
data 100           :rem size
data 0,0,0    :rem initial x,y,z co-ords
data 0             :rem movable

data 1             :rem type
data 8             :rem node nos
data 100           :rem size
data 500,20,480    :rem initial x,y,z co-ords
data 0             :rem movable

data 1             :rem type
data 8             :rem node nos
data 100           :rem size
data 500,20,-480    :rem initial x,y,z co-ords
data 0             :rem movable

data 1             :rem type
data 8             :rem node nos
data 100           :rem size
data 0,20,-1010    :rem initial x,y,z co-ords
data 0             :rem movable

data 1             :rem type
data 8             :rem node nos
data 100           :rem size
data -500,20,-480    :rem initial x,y,z co-ords
data 0             :rem movable

data 1             :rem type
data 8             :rem node nos
data 100           :rem size
data -500,20,480    :rem initial x,y,z co-ords
data 0             :rem movable

data 3             :rem type
data 1             :rem node nos
data 24           :rem size
data 0,24,450    :rem initial x,y,z co-ords
data 0             :rem movable
data 135,135,135    :rem initial rgb

data 3             :rem type
data 1             :rem node nos
data 24           :rem size
data 0,24,-448    :rem initial x,y,z co-ords
data 0             :rem movable
data 20,20,180    :rem initial rgb

data 3             :rem type
data 1             :rem node nos
data 24            :rem size
data 27,24,-500    :rem initial x,y,z co-ords
data 0             :rem movable
data 20,20,180    :rem initial rgb

data 3             :rem type
data 1             :rem node nos
data 24            :rem size
data -54,24,-552    :rem initial x,y,z co-ords
data 0             :rem movable
data 20,20,180    :rem initial rgb

data 3             :rem type
data 1             :rem node nos
data 24            :rem size
data -27,24,-500    :rem initial x,y,z co-ords
data 0             :rem movable
data 180,20,20    :rem initial rgb

data 3             :rem type
data 1             :rem node nos
data 24           :rem size
data 0,24,-552    :rem initial x,y,z co-ords
data 0             :rem movable
data 180,20,20    :rem initial rgb

data 3             :rem type
data 1             :rem node nos
data 24            :rem size
data 54,24,-552    :rem initial x,y,z co-ords
data 0             :rem movable
data 180,20,20    :rem initial rgb


label meshtype1
'RELATIVE 8 NODE X,Y,Z
data -20,20,446 
data -20,20,-446
data 20,20,-446
data 20,20,446
data -20,-20,446
data -20,-20,-446
data 20,-20,-446
data 20,-20,446

'FACE COLOURS R,G,B - 6 FACES
data 120,40,40
data 40,130,40
data 110,110,150
data 110,110,150
data 130,40,40
data 40,130,40

label meshtype2
'RELATIVE 4 NODE X,Y,Z
data -500,0,-1000
data 500,0,-1000
data 500,0,1000
data -500,0,1000 
data -500,-300,-1000
data 500,-300,-1000
data 500,-300,1000
data -500,-300,1000 

'FACE COLOURS R,G,B - 6 FACES
data 145,175,145
data 80,80,80
data 150,150,150
data 100,100,100
data 135,135,135
data 100,100,100

label meshtyperoom
data 8             :rem type
data 8             :rem node nos
data 100           :rem size
data 0,0,0    :rem initial x,y,z co-ords
data 0             :rem movable

'RELATIVE 4 NODE X,Y,Z
data -50000,50000,-50000
data 50000,50000,-50000
data 50000,50000,50000
data -50000,50000,50000 

data -50000,-50000,-50000
data 50000,-50000,-50000
data 50000,-50000,50000
data -50000,-50000,50000 

'FACE COLOURS R,G,B - 6 FACES
data 155,0,0
data 0,155,0
data 0,0,135
data 0,150,135
data 145,0,235
data 140,140,0

label linkface
'CHECK THESE!
data 2,1,4,3
data 5,6,7,8
data 1,5,8,4
data 6,2,3,7
data 5,1,2,6
data 8,7,3,4

label meshtypexxxxx
'Just color of circle
data 200,20,20 

label meshtype5
'Just color of Kill block (AKA square)
data 255,0,0 

label meshtypeyyyyyyyyy
'RELATIVE 8 NODE X,Y,Z for a random spline
data -60900,100,-50500
data -6900,100,-500
data -4900,100,-500
data -3900,100,-500
data -2900,100,-500
data -1900,100,-50
data -900,100,1000
data 0,120,1300  
data 0,130,1400 
data 50,140,1600
data 80,110,1400
data 300,100,1200
data 500,90,1100
data 1050,100,800
data 1300,110,500
data 1200,120,-100
data 1900,130,-500
data 2800,130,-500
data 3800,130,-500
data 4800,130,-500
data 5800,130,-500
data 6800,130,-500
data 60800,130,-50500

'SPLINE COLOUR R,G,B 
data 30,30,130

label meshtype4
'RELATIVE 8 NODE X,Y,Z for a random spline
data -900000,200,900000 
data -900000,200,300000
data -900000,200,-300000
data -900000,200,-900000
data -300000,200,-900000
data 300000,200,-900000
data 900000,200,-900000
data 900000,200,-300000
data 900000,200,300000
data 900000,200,900000
data 300000,200,900000
data -300000,200,900000
data -900000,200,900000

'SPLINE COLOUR R,G,B 
data 100,30,100