REM The tunnel by Christopher Rankine
 
gosub initialise
gosub mainloop
exit
 
label mainloop
gosub prompt
repeat
c=peek("port1")
if (and(c,16384)>0) then
gosub bar
pause 0.02
fi
 
if (and(c,32768)>0) then
gosub square
pause 0.02
fi
 
if (and(c,8192)>0) then
gosub rectanglex
pause 0.02
fi
 
until (and(c,1)>0)
return
 
label prompt 
setrgb 1, 0, 100, 225
text$="Press and hold X to see a bar form and go down a tunnel."
text sw/65, sh/2, text$
 
setrgb 1, 250, 0, 200
text$="Press and hold square to see a square form and go down a tunnel."
text sw/65, sh/1.8, text$
 
setrgb 1, 225, 0, 0
text$="Press and hold O to see a rectangle form and go down a tunnel."
text sw/65, sh/1.65  , text$
 
setrgb 1, 225, 225, 225
text$="Press select to end."
text sw/65, sh/1.5, text$
 
text$="The tunnel by Christopher."
text sw/65, sh/3, text$
return
 
label bar
clear window
mm=mm+0.2
sx=ran(5)*cos(mm/5)
sy=ran(5)*cos(mm/5)
sz=ran(5)*cos(mm/1000)
for a = 1 to cube
setrgb 1, ran(255), ran(255), ran(255)
xx=x(a)*5
yy=y(a)40
xx=xx/z(a)*3
yy=yy/z(a)*3
xx=xx+sw/2
yy=yy+sh/2
zz=10+z(a)/100
 
fill rectangle xx, yy to xx+zz, yy+zz
z(a)=z(a)+sz
x(a)=x(a)+sx
y(a)=y(a)+sy
 
if and y(a)<-25 y(a)=y(a)+50
if and y(a)>25 y(a)=y(a)-50
if and x(a)<-25 x(a)=x(a)+50
if and x(a)>25 x(a)=x(a)-50
if and z(a)<-100 z(a)=z(a)+100
if and z(a)>100 z(a)=z(a)-100
next a
gosub tunnel
gosub flip_screen
return
 
label square
clear window
mm=mm+0.2
sx=ran(5)*cos(mm/5)
sy=ran(5)*cos(mm/5)
sz=ran(5)*cos(mm/1000)
for a = 1 to cube
setrgb 1, ran(255), ran(255), ran(255)
xx=x(a)*5
yy=y(a)*7
xx=xx/z(a)*5
yy=yy/z(a)*3
xx=xx+sw/2
yy=yy+sh/2
zz=10+z(a)/100
 
fill rectangle xx, yy to xx+zz, yy+zz
z(a)=z(a)+sz
x(a)=x(a)+sx
y(a)=y(a)+sy
 
if and y(a)<-25 y(a)=y(a)+50
if and y(a)>25 y(a)=y(a)-50
if and x(a)<-25 x(a)=x(a)+50
if and x(a)>25 x(a)=x(a)-50
if and z(a)<-100 z(a)=z(a)+100
if and z(a)>100 z(a)=z(a)-100
next a
gosub tunnel
gosub flip_screen
return
 
label rectanglex
clear window
mm=mm+0.2
sx=ran(5)*cos(mm/5)
sy=ran(5)*cos(mm/5)
sz=ran(5)*cos(mm/1000)
for a = 1 to cube
setrgb 1, ran(255), ran(255), ran(255)
xx=x(a)*40
yy=y(a)*10
xx=xx/z(a)*3
yy=yy/z(a)*3
xx=xx+sw/2
yy=yy+sh/2
zz=10+z(a)/100
 
fill rectangle xx, yy to xx+zz, yy+zz
z(a)=z(a)+sz
x(a)=x(a)+sx
y(a)=y(a)+sy
 
if and y(a)<-25 y(a)=y(a)+50
if and y(a)>25 y(a)=y(a)-50
if and x(a)<-25 x(a)=x(a)+50
if and x(a)>25 x(a)=x(a)-50
if and z(a)<-100 z(a)=z(a)+100
if and z(a)>100 z(a)=z(a)-100
next a
gosub tunnel
gosub flip_screen
return
 
label flip_screen
setdispbuf d
d=1-d
setdrawbuf d
return
 
label tunnel
circle sw/2, sh/2, 250
circle sw/1.975, sh/2, 45
return
 
label initialise
cube=100
dim x(cube)
dim y(cube)
dim z(cube)
di=50
t=200
for a = 1 to cube
x(a)=-5+ran(50)
y(a)=-5+ran(50)
z(a)=t
next a
sw=640
sh=512
d=1
open window sw,sh
return