Code: Select all
rem Snakebox Demo
rem iPhone 6 Plus / 8.3
rem Enjoy...
gosub initialize
dtime=100000
main:
refresh off
graphics clear 50/255,50/255,50/255
qq=(qq+6)%360 ! br=si(qq)*64+96
gosub drawobject 'Draw the object
draw color 200/255,200/255,1
'Draw the scroller
mx=mx-2
if mx>-330 then goto write
mx=mx+10
mpos=(mpos+1)%mlen
write:
mm$=mid$(m$,mpos,65)
draw text mm$ at mx,sh-20
draw color 0,0,0
xr=(xr+2)%360 'Change the rotation values
yr=(yr+1)%360
zr=(zr+0)%360
if dtime>0 then
dtime=dtime-200
if dtime=0 then clearrit=1
refresh on
goto main
end if
if clearrit=1 then
gosub clearsnake
refresh on
goto main
end if
snm=(snm+1)%2
if snm=0 then gosub movesnake
refresh on
goto main 'Go back and start again
'SETOBJ ROUTINE
setobj:
'Prepare an object
convex=objects(obj,1) '0=Concave 1=Convex
np=objects(obj,2)
nf=objects(obj,3)
for a=1 to np 'Copy the points across
px(a)=points(obj,a,1) 'from the object store
py(a)=points(obj,a,2)
pz(a)=points(obj,a,3)
next a
for a=1 to nf
'Copy the faces across
f1(a)=faces(obj,a,1)
f2(a)=faces(obj,a,2)
f3(a)=faces(obj,a,3)
f4(a)=faces(obj,a,4)
f5(a)=faces(obj,a,8)
f6(a)=faces(obj,a,9)
f7(a)=faces(obj,a,10)
red(a)=faces(obj,a,5)
green(a)=faces(obj,a,6)
blue(a)=faces(obj,a,7)
next a
return
'DRAWOBJECT ROUTINE
drawobject: 'Draw the actual object
CX=co(xr) ! SX=si(xr)
CY=co(yr) ! SY=si(yr)
CZ=co(zr) ! SZ=si(zr)
SXY=SX*SY ! CXSY=CX*SY
m00 = CY*CZ ! m01 = -CY*SZ
m02 = SY ! m10 = CX*SZ + SXY*CZ
m11 = CX*CZ - SXY*SZ ! m12 = -SX*CY
m20 = SX*SZ - CXSY*CZ ! m21 = SX*CZ + CXSY*SZ
m22 = CX*CY 'End of the matrix prep
for p=1 to np
'Calculate the points
x=px(p) ! y=py(p)
z=pz(p) ! xx=m00*x+m10*y+m20*z
yy=m01*x+m11*y+m21*z ! zz=m02*x+m12*y+m22*z
zz=zz+dtime
z=((zz*0.001)+1)
asx(p)=xx/z
'Store the points
asy(p)=yy/z
asz(p)=zz/z
next p
fp=0
for f=1 to nf
'Process the faces
x=f5(f)
y=f6(f)
z=f7(f)
zz=m02*x+m12*y+m22*z
f10(f)=zz
fv(f)=999
if zz>=0 then goto skipcalc
REM - if normal is away, ignore
p1=f1(f) ! p2=f2(f)
p3=f3(f) ! p4=f4(f)
x1=asx(p1) ! y1=asy(p1)
x2=asx(p2) ! y2=asy(p2)
x3=asx(p3) ! y3=asy(p3)
v1x=x1-x2 ! v1y=y1-y2
v2x=x3-x2 ! v2y=y3-y2
vi=v1x*v2y-v2x*v1y ! fv(f)=vi
if vi<=0 then goto notvis
'if invisible, ignore it
fp=fp+1 ! fl(fp)=f
z1=asz(p1) ! z2=asz(p2)
z3=asz(p3) ! z4=asz(p4)
if p4=0 then fz(f)=(z1+z2+z3)*0.333
if p4>0 then fz(f)=(z1+z2+z3+z4)*0.25
notvis:
'We came here if invisible
skipcalc:
'We came here to skip calc
next f
'End of face calculations
if convex=1 then goto nosort
'No need to sort convex
for f=1 to fp-1
'Bubble sort the faces
for a=f to fp
if fz(fl(f))<fz(fl(a)) then
t=fl(f) ! fl(f)=fl(a)
fl(a)=t
end if
next a
next f
nosort: 'We came here if no sort
for o=1 to fp
'Draw the actual faces
f=fl(o)
if fv(f)<=0 then goto skipdraw
p1=f1(f) ! p2=f2(f)
p3=f3(f) ! p4=f4(f)
x1=asx(p1)+sw/2 ! y1=asy(p1)+sh/2
x2=asx(p2)+sw/2 ! y2=asy(p2)+sh/2
x3=asx(p3)+sw/2 ! y3=asy(p3)+sh/2
x4=asx(p4)+sw/2 ! y4=asy(p4)+sh/2
br=f10(f)*-200
fill color br/255,br/255,br/255
if clearrit=1 then fill color (br+csn)/255,csn/255,csn/255
'fill triangle x1,y1 to x2,y2 to x3,y3
trix(0)=x1
triy(0)=y1
trix(1)=x2
triy(1)=y2
trix(2)=x3
triy(2)=y3
fill poly trix,triy count 3
'fill triangle x1,y1 to x3,y3 to x4,y4
trix(0)=x1
triy(0)=y1
trix(1)=x3
triy(1)=y3
trix(2)=x4
triy(2)=y4
fill poly trix,triy count 3
xd12=x1-x2
yd12=y1-y2
x12=xd12 * 0.2
y12=yd12 * 0.2
xd43=x4-x3
yd43=y4-y3
x43=xd43 * 0.2
y43=yd43 * 0.2
p=1
xs=x1 ! ys=y1
xe=x4 ! ye=y4
for b=1 to 6
xst=(xe-xs) * 0.2
yst=(ye-ys) * 0.2
xt=xs ! yt=ys
for a=1 to 6
gx(p)=xt
gy(p)=yt
xt=xt+xst
yt=yt+yst
p=p+1
next a
xs=xs-x12 ! ys=ys-y12
xe=xe-x43 ! ye=ye-y43
next b
block=(f-1)*25+1
for a=1 to 30
if (a)%6=0 or clearrit=1 then goto skip
col=blocks(block)
if col=0 then goto nodraw
rr=coloursr(col)
gg=coloursg(col)
bb=coloursb(col)
fill color (br*rr)/255,(br*gg)/255,(br*bb)/255
gx1=gx(a) ! gy1=gy(a)
gx4=gx(a+1) ! gy4=gy(a+1)
gx2=gx(a+6) ! gy2=gy(a+6)
gx3=gx(a+7) ! gy3=gy(a+7)
'fill triangle gx1,gy1 to gx2,gy2 to gx3,gy3
trix(0)=gx1
triy(0)=gy1
trix(1)=gx2
triy(1)=gy2
trix(2)=gx3
triy(2)=gy3
fill poly trix,triy count 3
'fill triangle gx1,gy1 to gx3,gy3 to gx4,gy4
trix(0)=gx1
triy(0)=gy1
trix(1)=gx3
triy(1)=gy3
trix(2)=gx4
triy(2)=gy4
fill poly trix,triy count 3
nodraw:
block=block+1
skip:
next a
draw color 0,0,0
draw line x1,y1 to x2,y2
draw line to x3,y3
draw line to x4,y4
draw line to x1,y1
skipdraw:
'No drawing, come here
next o 'Next face in the list
return
'INITIALISE ROUTINE
initialize:
graphics
sw=screen_width()
sh=screen_height()
pi=3.1415
graphics clear 0,0,80/255
dim gx(37),gy(37)
colim=3000
dim co(colim+1),si(colim+1)
'Setup Cos and Sin Arrays
for a=0 to colim
co(a)=cos(a*(pi/180))
si(a)=sin(a*(pi/180))
next a
'restore objectdata
read mo,mp,mf
dim objects(mo+1,4),points(mo+1,mp+1,4),faces(mo+1,mf+1,11),px(mp+1)
dim py(mp+1),pz(mp+1),f1(mf+1),f2(mf+1),f3(mf+1),f4(mf+1),f5(mf+1)
dim f6(mf+1),f7(mf+1),f8(mf+1),f9(mf+1),f10(mf+1),red(mf+1),green(mf+1)
dim blue(mf+1),fv(mf+1),pv(mp+1),pc(mp+1),asx(mp+1),asy(mp+1),asz(mp+1)
dim fz(mf+1),fl(mf+1)
for o=1 to mo
'From 1 to Max Objects
read convex,scale,np
'Convex=1 Concave=0
objects(o,1)=convex
objects(o,2)=np
for a=1 to np
'Read the objects points
read x,y,z
points(o,a,1)=x*scale
points(o,a,2)=y*scale
points(o,a,3)=z*scale
next a 'Next point
read nf
objects(o,3)=nf
for a=1 to nf 'Read the objects faces
for b=1 to 4
read faces(o,a,b)
next b
read b 'Grab the color value
faces(o,a,5)=and(b,4)/4 'Extract the red part
faces(o,a,6)=and(b,2)/2 'Extract the green part
faces(o,a,7)=and(b,1) 'Extract the blue part
x1=points(o,faces(o,a,1),1)
y1=points(o,faces(o,a,1),2)
z1=points(o,faces(o,a,1),3)
x2=points(o,faces(o,a,2),1)
y2=points(o,faces(o,a,2),2)
z2=points(o,faces(o,a,2),3)
x3=points(o,faces(o,a,3),1)
y3=points(o,faces(o,a,3),2)
z3=points(o,faces(o,a,3),3)
x4=points(o,faces(o,a,4),1)
y4=points(o,faces(o,a,4),2)
z4=points(o,faces(o,a,4),3)
'CALCULATE SURFACE NORMAL
xa=x1-x2 ! ya=y1-y2
za=z1-z2 ! xb=x3-x2
yb=y3-y2 ! zb=z3-z2
xx=yb*za - zb*ya + x2 ! yy=xa*zb - xb*za + y2
zz=xb*ya - xa*yb + z2 ! l1=xx-x2
l2=yy-y2 ! l3=zz-z2
ul=sqr(l1*l1 + l2*l2 + l3*l3) ! xn=l1/ul
yn=l2/ul ! zn=l3/ul
faces(o,a,8)=xn 'Store face normal
faces(o,a,9)=yn
faces(o,a,10)=zn
next a 'Next face
next o 'Next Object
obj=1 ! od=800
gosub setobj 'Setup the first object
for a=1 to 65 'Setup the scroller
m$=m$+" "
next a
m$=m$&"Another cube demo. It might not look like much "
m$=m$&"to start off with, but bear with it, it should "
m$=m$&"get more impressive. I've used my dads good "
m$=m$&"old snake and cube routines, but this time "
m$=m$&"it moves around the outside of a cube. When the "
m$=m$&"snake hits it's own tail, the cube goes red and "
m$=m$&"clears the old snake away making room for a new "
m$=m$&"one. "
mx=-300
mlen=len(m$)
dim blocks(6*26)
for a=1 to 6*25
blocks(a)=0
next a
dim dirs(5)
dirs(1)=1
dirs(2)=-1
dirs(3)=5
dirs(4)=-5
dim coloursr(8),coloursg(8),coloursb(8)
for a=0 to 7
coloursr(a)=(and(a,4)/4)
coloursg(a)=(and(a,2)/2)
coloursb(a)=and(a,1)
next a
coloursr(0)=1
coloursg(0)=1
coloursb(0)=1
coloursr(7)=0
coloursg(7)=0
coloursb(7)=0
dim area(6*26)
dim flink(7*5*4)
' 6 faces, 4 directions
' 0=face
' 1=edge
' 1=left
' 2=right
' 3=top
' 4=bottom
' 2=direction
' 1=right
' -1=left
' 5=up
' -5=down
for f=1 to 6
for d=1 to 4
for a=0 to 2
p=(f*12)+(d*3)+a
read flink(p)
next a
next d
next f
return
clearsnake:
blocks(csn)=0
area(csn)=0
csn=csn+1
if csn<6*25+1 then return
clearrit=0
csn=0
snakeheadx=int(rnd(5))+1
snakeheady=int(rnd(5))+1
snakeheadf=int(rnd(6))+1
snaketailx=snakeheadx
snaketaily=snakeheady
snaketailf=snakeheadf
snakedelay=int(rnd(10))+10
snakecolour=int(rnd(7))+1
shf=snakeheadf
shs=(snakeheady-1)*5+snakeheadx
p=(shf-1)*25+shs
area(p)=-5
blocks(p)=snakecolour
return
movepart:
d=area(p)
nx=x ! ny=y ! newf=f ! nd=d
if d=1 then nx=x+1
if nx=6 then
pp=(f*12)+(2*3)+0
newf=flink(pp)
edge=flink(pp+1)
nd=flink(pp+2)
if edge=1 then
nx=1
end if
if edge=3 then
nx=y
ny=5
end if
if edge=4 then
nx=6-y
ny=1
end if
else
if int(ran(5))=1 then
do
nd=dirs(int(rnd(4))+1)
until nd<>-1
end if
end if
'end if
if d=-1 then nx=x-1
if nx=0 then
pp=(f*12)+(1*3)+0
newf=flink(pp)
edge=flink(pp+1)
nd=flink(pp+2)
if edge=2 then
nx=5
end if
if edge=3 then
nx=6-y
ny=5
end if
if edge=4 then
nx=y
ny=1
end if
else
if int(rnd(5))=1 then
do
nd=dirs(int(rnd(4))+1)
until nd<>1
end if
end if
if d=5 then ny=y+1
if ny=6 then
pp=(f*12)+(3*3)+0
newf=flink(pp)
edge=flink(pp+1)
nd=flink(pp+2)
if edge=1 then
ny=6-x
nx=1
end if
if edge=2 then
nx=5
ny=x
end if
if edge=3 then
nx=6-x
ny=5
end if
if edge=4 then
ny=1
end if
else
if int(rnd(5))=1 then
do
nd=dirs(int(rnd(4))+1)
until nd<>-5
end if
end if
if d=-5 then ny=y-1
if ny=0 then
pp=(f*12)+(4*3)+0
newf=flink(pp)
edge=flink(pp+1)
nd=flink(pp+2)
if edge=1 then
ny=x
nx=1
end if
if edge=2 then
nx=5
ny=6-x
end if
if edge=3 then
nx=x
ny=5
end if
if edge=4 then
nx=6-x
ny=1
end if
else
if int(rnd(5))=1 then
do
nd=dirs(int(rnd(4))+1)
until nd<>5
end if
end if
x=nx ! y=ny ! f=newf ! d=nd
return
movesnake:
x=snakeheadx
y=snakeheady
f=snakeheadf
shs=(y-1)*5+x
p=(f-1)*25+shs
gosub movepart
shs=(y-1)*5+x
p=(f-1)*25+shs
if area(p)<>0 then
clearrit=1
return
end if
snakeheadx=x
snakeheady=y
snakeheadf=f
shs=(y-1)*5+x
p=(f-1)*25+shs
area(p)=d
blocks(p)=blocks(p)+snakecolour
if snakedelay>0 then
snakedelay=snakedelay-1
return
end if
x=snaketailx
y=snaketaily
f=snaketailf
shs=(y-1)*5+x
p=(f-1)*25+shs
gosub movepart
area(p)=0
blocks(p)=blocks(p)-snakecolour
snaketailx=x
snaketaily=y
snaketailf=f
return
objectdata:
data 1,31,35
' cube
data 1,110,8,-1,-1,-1,-1,1,-1,1,1,-1,1,-1,-1,-1,-1,1,-1,1
data 1,1,1,1,1,-1,1,6,1,2,3,4,1,8,7,6,5,2,5,6,2,1,3,2,6,7
data 3,4,4,3,7,8,5,5,1,4,8,6
data 3,2,-1
data 5,1,1
data 4,4,5
data 6,3,-5
data 5,2,-1
data 3,1,1
data 4,3,-5
data 6,4,5
data 2,2,-1
data 1,1,1
data 4,1,1
data 6,1,1
data 3,3,-5
data 5,3,-5
data 2,3,-5
data 1,3,-5
data 1,2,-1
data 2,1,1
data 4,2,-1
data 6,2,-1
data 3,4,5
data 5,4,5
data 1,4,5
data 2,4,5