PS2 Yabasic Pool Code

This is the code for the simple pool game I wrote on the PS2 using the Demo Disk Yabasic game.





'SIX BALL POOL
' 2002
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< nzc="nzc+1" xoff="FOV*ctnx/ctnz" yoff="FOV*ctny/ctnz" dist="newx*newx+newy*newy+newz*newz">dist then
znrst=mnit
nrest=dist
scrd=xoff*xoff+yoff*yoff
fi
next mnit
if nzc<>3 then
if abs(meshnx(mit,znrst)+meshcgx(mit))< nrest="nrest+100000000" nrest="nrest+200000" sortit="1" mit="sortz(sortit)" meshb="meshball(mit)">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)) < done="0" done="0)" done="1" p="1" tmpd="mdist(p)" tempr="sortz(p)" done="0" mit="1" mnit="1" meshmax="70" meshnodemax="30" meshface="6" trimax="100" 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" camdnr="20" camdfr="1100" camdnr="camdnr*camdnr" camdfr="camdfr*camdfr" camdfn="camdfr-camdnr" cfov="40" ltmx="70" ltratio2d="0.8" ltratio3d="2-ltratio2d" ltmx2d="ltmx*ltratio2d" ltmx3d="ltmx*ltratio3d" decsz="30" decalx="570" decaly="70" 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" cuban="8" fnr="3" i="1" flrnos="4" scrdmx="180" scrdmx="scrdmx*scrdmx" scrmx="600" scrmx="scrmx*scrmx" tdrt="450" tundmx="tdrt*tdrt" evmax="8" kbmx="4" kbtime="10" kbtrsz="8" kbtrmax="kbtrsz*kbmx" ksz="0" kbit="1" ksz="ksz+kbtrsz" starmax="300" stardist="100000" tuno="8" tunv="8" tunw="19000" tnlgth="9000" tcam="tunw*0.9" tcinc="tnlgth*0.05" tcirmx="tuno-1" tblvmx="4" tblr="40" tblg="70" tblb="40" bcnt="3" ballmx="8" ballmov="90" bdecay="ballmov/90" ballmin="2*bdecay" repmx="250" repstate="0" dsz="8" bid="1" bit="1" bid="bid*2" i="1" coscroty="cosD(croty)" sincroty="sinD(croty)" coscrotx="cosD(crotx)" sincrotx="sinD(crotx)" kbspeed="14" croty=" croty-2" 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))" ballcnt="1" rmesh="num_mesh+1" mit="1" ballcnt="1" cuerad="atan(meshcgx(mit),meshcgz(mit))" cuemit="mit" ballsz=" meshsz(mit)+meshsz(mit)" ballrng="ballsz*ballsz" ballcnt="ballcnt+1" ballcnt="ballcnt-1" mit="1" mnit="1" fit="1" fit="1" i=" 1" mnit="1" countha="1" fit="1" i=" 1" mnit=" face(fit,i)" countha="countha+1" frommesh="num_mesh+1" num_mesh="frommesh-1" mit="frommesh" mit="frommesh" mnit="1" fit="1" deltax1="0" deltay1="0" pad="peek(">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 < 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))">0) then
croty= croty-1
if croty < croty="360-abs(croty)" coscroty="cosD(croty)" sincroty="sinD(croty)" crotyr="croty+cfov">360 crotyr=crotyr-360
crotyl=croty-cfov
if crotyl < 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))">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< ballmv1="ballmv1+1" btncnt="2" btncnt="3" btncnt="0" evobjnos="1" evtype="5">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 < croty="360-abs(croty)" crotyr="croty+cfov">360 crotyr=crotyr-360
crotyl=croty-cfov
if crotyl < crotyl="360-abs(crotyl)" cgradr="cosD(crotyr)/sinD(crotyr)" cgradl="cosD(crotyl)/sinD(crotyl)" coscroty="cosD(croty)" sincroty="sinD(croty)" camrad="2000" camx="-camrad*sincroty" camz="-camrad*coscroty" crotx="atan(camy,sqrt(camx*camx+camz*camz))">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)< evobjnos="evobjnos(iter)" ok="1" 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)" lt="-100" kbwd="(drbtrx-drbblx)/2" kbht="(drbtry-drbbly)/2" kpos="kpos(kbit2)" kbit="1" kbit2="kbmx" ok="0" kbit2="evobjnos(iter)">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)< cnt="0" stit=" 1" cnt="cnt+1">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)<>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)< olap="0" collwall="0" i="1">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< collwall="1" meshcgx="meshcgx-ballmovx(bit)" meshcgz="meshcgz-ballmovz(bit)" meshcgx="tmp2dx(bit)" meshcgz="tmp2dz(bit)" collwall="2" meshcgx="tmp3dx(bit)" meshcgz="tmp3dz(bit)" collwall="3" bitst="bit">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
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< 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)">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)< evobjnos="i" evtype="5" 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" nzc="nzc+1" cuex="midx+FOV*ctnx/ctnz" cuey="midy+FOV*ctny/ctnz" pad="0" testx="250" testy="250">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< z="meshnz(mit,i)-meshnz(mit,i+1)" x="meshnx(mit,i)-meshnx(mit,i+1)" x="0" z="0" z="meshnz(mit,i)-meshnz(mit,1)" x="meshnx(mit,i)-meshnx(mit,1)" x="0" z="0" newx="flx(i)-camx" newz="flz(i)-camz" ctnx="newx*coscroty-newz*sincroty" ctnz="newx*sincroty+newz*coscroty">0 then
dist=ctnx*ctnx+ctnz*ctnz
if dist< flt="i" flnl="dist" newx="frx(i)-camx" newz="frz(i)-camz" ctnx="newx*coscroty-newz*sincroty" ctnz="newx*sincroty+newz*coscroty">0 then
dist=ctnx*ctnx+ctnz*ctnz
if dist< frt="i" flnr="dist" i="1" fleft="flt+1" fleft="5" fleft="1">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


There is a PS2 Yabasic emulator available on this site:

http://www.softagalleria.net/ps2yabasic.php