> ls
A:/3D
15:07 16-04-2022        184  memtest.BAS
[snip]
22:26 29-04-2022       5116  SBSGHZv01.bas
20:52 10-04-2022        892  test.bas
20:51 10-04-2022        883  test.bas.bak
0 directories, 14 files

option angle degrees
option default integer
mode 1,8:cls
B=6E4:BR=5E4:AC=20:A=360:E=300:F=400:G=200
dim di(AC),o(AC,6),c(8)=(&hA52A2A,&hFF00,&hAF00,&h6000,2^14,0,&hC0FF,&hFF00C0,&h404040)
dim dw(AC),l(18)=(0,3,7,2,9,3,6,2,8,12,9,1,6,2,9,3,6,1,0),fv(64),fn(20),ec(20),fc(20),s(G),t(9)
dim float h,fu,sd,ct,st,q(4),v(2,32)
LA "EEDDDDHAAAHAAA>CAAHADCAAEJJLABCCBDBADACDIFEEEEEEEEEEDDDDD8A8JA8JAJ8AJ@S@BS@BSB@SBNTAEFBBFGCCGH"
LA "DDHEAHGFEIF!!!=A=EA=EAE=AE=I=EI=EIE=IEZANKEEEEEEDDDDEEEEEEBBBBAAAAACBBBB<A<FA<FAF<AF?B?CB?CBC?"
LA "BC>G>DG>DGD>GDAIAUdAEFBBFGCCGHDDHEAHGFEIJKLIMJJMKKMLLMINK!EEEEEEGGGGGGGGBBDDDD@A@BA@BAB@AB?M?C"
LA "M?CMC?MCAM7GMAAMK;MAAQAKALIDDDDEEEDEEEEEEEEBBBBCCCEDA9DAI>AI>A9AF:BD@BEJ@EJ@D@AE=AFJU[AEBBECCE"
LA "DADEFGHIFJKGIHKJGKHPNEEEEEDDDDEEEDEEEEEEEEEEEEEEDDDDCCCCBBBEDA9DAJ>AJ>A9ED8EDK=DK=D8AH;BFCBGK@"
LA "GK@FCAG?AHKPoABCDAEFBBFGCCGHDADHEEIFFIGGIHHIEJKLMJNOKMLONKOL  "
j=1:u=0:do:nv=NB():if nv<-32 then exit do
nf=NB():RC fn():RC ec():RC fc():for i=0to nv-1:for k=0 to 2:v(k,i)=NB():next k,i
sc=NB():math scale v(),sc,v():n=NB():if n then for i=0to n:fv(i)=NB():next
draw3d create j,nv,nf,1,v(),fn(),fv(),c(),ec(),fc():inc j:loop
for i=1to 8:read o(i,6):next:data 1,1,1,1,4,5,6,7
P 3
cls
circle F,E,21,,4,c(2),c(2)
circle F,E,15,,4,0,0
blit read 9,370,E,60,30
circle F,E,30,,,c(3),c(3)
blit write 9,370,E,4
image rotate E,G,G,G,E,G,15
blit read 1,315,268,170,64
h=0:fu=100:sd=100:se=0:lv=1
draw3d camera 1,500,0,75
M
settick 25,MM,1
w=0
np=1
do
if keydown(0)then
SK keydown(1)
SK keydown(2)
endif
if keydown(7)then
if np then
np=0
for i=1to 2
if o(i,0)=0 then v2=25:NS i,,,-h:i=3
next
endif
else
np=1
endif
for i=1to 4
if o(i,0)then
inc o(i,0),-sgn(o(i,0))
k=MB(i,7,o(i,4),o(i,5))
if k>6 then
o(i,0)=-o(i,0)
if k<9 then
v1=75
o(k,1)=B/2
o(k,2)=B/k
o(k,3)=rnd*A
inc se
if se>lv*9 and o(6,0)=0 then v4=99:o(6,0)=1
endif
endif
endif
next
inc o(6,3)
TY 7
TY 8
if sd<0 then
P 0:for i=0to 999:line 0,600*rnd,800,600*rnd,,c(0):pause 2:next
text F,E,"GAME OVER",CT,3,,c(0)
do while inkey$<>"":loop:do:loop until inkey$<>"":run
endif
DS
if qx+qy then sprite scroll qx,qy:qx=0:qy=0
do:loop until timer>25
timer=0
page copy w+1,0,D
w=w=0
loop
end
sub SK k
if k=128 then MF 50
if k=129 then MF -50
if k=130 then h=(h+359)mod A
if k=131 then h=(h+361)mod A
end sub
sub NS n,x,y,h:o(n,0)=90:o(n,1)=x:o(n,2)=y:o(n,3)=h:o(n,4)=-sin(h)*151:o(n,5)=cos(h)*151:end sub
sub C2 c,n:c=(c+n+1.5*B)mod B-B/2:end sub
function MB(n,f,dx,dy)
MB=1
x=o(n,1):C2 x,dx
y=o(n,2):C2 y,dy
if n>6 and x^2+y^2<BR then exit function
for j=f to 20
j=j+(j=n)+(n+4=j)
if (o(j,1)-x)^2+(o(j,2)-y)^2<BR then MB=j:exit function
next
MB=0
if n then o(n,1)=x:o(n,2)=y
end function
sub MF r
if fu<0 then exit sub
fu=fu-(fu>0)/G
dx=sin(h)*r
dy=cos(h)*r
i=MB(0,5,dx,dy)
if i<6 then
for i=1to AC:C2 o(i,1),-dx:C2 o(i,2),-dy:next
elseif i=6 then
P 0
for i=1to 999:n=rnd*A:line F,E,F+sin(n)*500,E+cos(n)*500,,c(6):pause 1:next
h=(h+180)mod A
inc lv
M
DS
P 0:for i=1to F:blit F-i,E-i,F-i,E-i,i*2,i*2,w+1:pause 1/i:next
else
v3=2:sd=sd-1
endif
end sub
sub TY n
if t(n)then inc t(n),-sgn(t(n)):o(n,3)=(o(n,3)+sgn(t(n))*2)mod A:exit sub
j=atan2(o(n,1),-o(n,2)):inc j,A*(j<0):i=(o(n,3)-j)mod A
if i=0 and o(n-4,0)=0 then NS n-4,o(n,1),o(n,2),o(n,3)
j=-sgn(i):if abs(i)>180 then j=-j
o(n,3)=(o(n,3)+j)mod A:if MB(n,5,-sin(o(n,3))*o(n,4),cos(o(n,3))*o(n,4))then t(n)=60*sgn(rnd-.5)
end sub
sub M
for i=1to 4:o(i,0)=0:PM i+4:next:o(7,4)=30+lv:o(8,4)=15+lv
for i=9to AC:PM i:o(i,6)=2+(rnd<.5):next
end sub
sub PM n
o(n,0)=(n<>6)
do:x=rnd*B-B/2:y=rnd*B-B/2:loop while x^2+y^2<BR
o(n,1)=x:o(n,2)=y:o(n,3)=rnd*A
end sub
sub DS
for i=1to AC:dw(i)=o(i,1)^2+o(i,2)^2:next
for i=3to 4:if dw(i)<BR and o(i,0)>0 then o(i,0)=-o(i,0):inc sd,-10:qx=rnd*9-5:qy=rnd*9-5:v3=3
next
fu=fu-(fu>0)/G
if dw(5)<BR then fu=100:sd=min(100,sd+sr/500):sr=0
sort dw(),di(),1
ct=cos(h):st=sin(h)
P w+1:cls:line 0,E,800,E,1,c(3)
if h>239 and h<340 then blit write 1,3100-h*9.6,60
circle 800-h*9.6,G,20,0,,,c(3)
circle 800-h*9.6-9,203,20,0,,,0
circle 1440-h*9.6,120,30,0,,,&h80FF00
ix=h\20:n=-(h mod 20)*10
for i=0to 5:j=(ix+i+15)mod 18:line n,E-l(j)*10,n+G,E-l(j+1)*10,,c(3):n=n+G:next
P 3
box 0,0,102,102,1,c(8),0
for i=1to AC
n=di(i)
if o(n,0)>0 then
P 3
x=o(n,1)*ct-o(n,2)*st
y=o(n,1)*st+o(n,2)*ct
pixel 51+x*140/B,51-y*140/B,c(0+6*(o(n,6)=5)+(o(n,6)=4))  
pixel 51,51,&hFFFF00
if y>150 and abs(x)<y then
P w+1:math q_euler o(n,3)+h,0,0,q():draw3d rotate q(),o(n,6):draw3d write o(n,6),x,0,y
endif
endif
next
P w+1
blit 0,0,369,497,102,102,3
box 369,497,102,102,1,c(8)
text F,6,"LEVEL:"+str$(lv,2)+"  SCORE:"+str$(se,3),CT,,,c(1)
text F,495,"S F  HEADING: "+str$(h,3,0),CB,,,c(1)
DG 331,sd
DG 346,fu
end sub
sub P n:page write n:end sub
sub DG x,g:box x,497,10,102,1,c(8),0:if g>0 then box x+1,598-g,8,g,4,c(g>25)
end sub
sub RC c():k=NB():if k<>-32 then c(0)=k:for i=1to nf-1:c(i)=NB():next
end sub:function NB():NB=lgetbyte(s(),u)-65:inc u:end function
sub LA z$:longstring append s(),z$:end sub
sub MM
play sound 1,b,n,99,v1/3:D v1
play sound 2,b,p,99-v2,v2:D v2
play sound 3,b,n,G,20*(v3<>0):D v3
play sound 4,b,t,499-99*sin(v4),v4/4:D v4
inc sr
end sub
sub D n:n=n-(n>0):end sub