Code: Select all
rem v1.0 - fixed bugs and added filled cubes
rem Wrote this on an iphone 6 plus.
rem Sorry for the mess. Enjoy!
gosub initialize
notes stop
notes load "test6.mid" ' copy from examples/music and sound
notes play
loop:
refresh off
graphics clear 0,0,0
draw color .10,.40,.10
'gosub grid
wsv=wsv+3
x1=(560*sin(wsv*pi/180))+csw
y1=(560*cos(wsv*pi/180))+csh
x2=(560*sin((wsv+90)*pi/180))+csw
y2=(560*cos((wsv+90)*pi/180))+csh
x3=(560*sin((wsv+180)*pi/180))+csw
y3=(560*cos((wsv+180)*pi/180))+csh
x4=(560*sin((wsv+270)*pi/180))+csw
y4=(560*cos((wsv+270)*pi/180))+csh
draw line x1,y1 to x3,y3
draw line x3,y3 to x4,y4
draw line x1,y1 to x3,y3
draw line x3,y3 to x2,y2
'stars
fill color .255,.255,.255
for a=0 to str-1
itx=(sx(a)/sz(a))+csw
ity=(sy(a)/sz(a))+csh
siz=6-sz(a)
sz(a)=sz(a)-.04
fill rect itx,ity to itx+siz,ity+siz
if (itx<0) or (itx>sw) or (ity<0) or (ity>sh) then
sx(a)=-1500+rnd(3000)
sy(a)=-1500+rnd(3000)
sz(a)=5
end if
next a
mm=mm+.5 ' speed
zo1=18*sin((mm*pi/180))
zo2=18*sin(((mm+180)*pi/180))
if zo1>=zo2 then
gosub one
gosub two
end if
if zo2>zo1 then
gosub two
gosub one
end if
size=5+4*sin(mm/52)
xr=xr+2
yr=yr+4
zr=zr+1
if xr>720 then xr=xr-720
if yr>720 then yr=yr-720
if zr>720 then zr=zr-720
draw color 0,0,0
draw text "DOUBLE TROUBLE" at 2,2
draw color 1,1,1
draw text "DOUBLE TROUBLE" at 0,0
gosub scroll
refresh on
Goto loop
End
grid:
for a=0 to sw step 8
fill rect a,0 to a+3,sh
next a
for a=0 to sh step 8
fill rect 0,a to sw,a+3
next a
return
one:
xo=24*sin(mm*pi/180)
yo=24*sin(mm*pi/180)
zo=28*sin(mm*pi/180)
r=0!g=0!b=50
gosub rotate
f1=0 ! f2=1 ! f3=2 ! f4=3
gosub draw
f1=4 ! f2=7 ! f3=6 ! f4=5
gosub draw
f1=5 ! f2=1 ! f3=0 ! f4=4
gosub draw
f1=7 ! f2=3 ! f3=2 ! f4=6
gosub draw
f1=1 ! f2=5 ! f3=6 ! f4=2
gosub draw
f1=7 ! f2=4 ! f3=0 ! f4=3
gosub draw
return
two:
xo=24*cos(mm*pi/180)
yo=24*cos(mm*pi/180)
zo=28*sin((mm+180)*pi/180)
r=50!g=0!b=0
gosub rotate
f1=0 ! f2=1 ! f3=2 ! f4=3
gosub draw
f1=4 ! f2=7 ! f3=6 ! f4=5
gosub draw
f1=5 ! f2=1 ! f3=0 ! f4=4
gosub draw
f1=7 ! f2=3 ! f3=2 ! f4=6
gosub draw
f1=1 ! f2=5 ! f3=6 ! f4=2
gosub draw
f1=7 ! f2=4 ! f3=0 ! f4=3
gosub draw
return
draw: 'Draw A Face Of The Cube
vx1 = tx(f1)-tx(f2)
vy1 = ty(f1)-ty(f2)
vx2 = tx(f3)-tx(f2)
vy2 = ty(f3)-ty(f2)
normal=(vx1*vy2-vx2*vy1)
if normal<0 then
normal=normal/200
'light=((abs(normal))/100)+100
light=abs(normal)
xc=(tx(f1)+tx(f2)+tx(f3)+tx(f4))/4
yc=(ty(f1)+ty(f2)+ty(f3)+ty(f4))/4
fill color r+light/1000,g+light/1000,b+light/1000
'fill triangle tx(f1),ty(f1) to tx(f2),ty(f2) to tx(f3),ty(f3)
trix(0)=tx(f1)
triy(0)=ty(f1)
trix(1)=tx(f2)
triy(1)=ty(f2)
trix(2)=tx(f3)
triy(2)=ty(f3)
fill poly trix,triy count 3
'fill triangle tx(f1),ty(f1) to tx(f4),ty(f4) to tx(f3),ty(f3)
trix(0)=tx(f1)
triy(0)=ty(f1)
trix(1)=tx(f4)
triy(1)=ty(f4)
trix(2)=tx(f3)
triy(2)=ty(f3)
fill poly trix,triy count 3
fill color 1,1,1
draw color 0,0,0
draw line tx(f1),ty(f1) to tx(f2),ty(f2)
draw line tx(f2),ty(f2) to tx(f3),ty(f3)
draw line tx(f3),ty(f3) to tx(f4),ty(f4)
draw line tx(f4),ty(f4) to tx(f1),ty(f1)
end if
return
rotate:
'Rotate And Scale Each Point - Store Result
for a=0 to polys-1
x1=x(a)
y1=y(a)
z1=z(a)
'X,Y,Z rotations
xx=x1
yy=y1*cs(xr)+z1*sn(xr)
zz=z1*cs(xr)-y1*sn(xr)
y1=yy
x1=xx*cs(yr)-zz*sn(yr)
z1=xx*sn(yr)+zz*cs(yr)
zz=z1
xx=x1*cs(zr)-y1*sn(zr)
yy=x1*sn(zr)+y1*cs(zr)
'Apply Perspective
xx=xx+xo
yy=yy+yo
zz=zz+zo
xx=size*(xx/((zz/50)+1))+csw
yy=size*(yy/((zz/50)+1))+csh
tx(a)=xx
ty(a)=yy
tz(a)=zz
next a
return
scroll:
texty=csh+220*sn(xr)
draw color 55/255,55/255,255/255
text$=substr$(s$,p,100)
draw text text$ at scx+2,texty+2
draw color 1,1,1
draw text substr$(s$,p,100) at scx,texty
scx=scx-1
if scx<-10 then
scx=scx+10
p=p+1
if p> 100 then 'len(s$) then
p=1
end if
end if
return
initialize:
'This Sub-Routine Initializes The Program.
'Open Gfx Screen
graphics
graphics clear 0,0,0
sw=screen_width()
sh=screen_height()
csw=sw/2
csh=sh/2
'Define the necessary variables
s$ = " DEMO BY DRCHIP (C)2014. GREETINGS TO MY RED SECTOR INC PALS. "
pi=3.1416 ' Pi
size=4 ' how big do you want it?
polys=8 ' The amount of polygons in the object
dim x(polys) ' Original X co-ordinate store
dim y(polys) ' Original Y co-ordinate store
dim z(polys) ' Original Z co-ordinate store
dim tx(polys+10) ' Transformed X co-ordinate store
dim ty(polys+10) ' Transformed Y co-ordinate store
dim tz(polys+10) ' Transformed Z co-ordinate store
dim trix(5),triy(5) ' triangle array
'Define Sine Tables
dim cs(722)
dim sn(722)
for ang=0 to 720
cs(ang)=cos(ang*(pi/360))
sn(ang)=sin(ang*(pi/360))
next ang
'Read in the object
for a=0 to polys-1
read x(a)
read y(a)
read z(a)
next a
str=45
dim sx(200),sy(str),sz(str)
for a=0 to str-1
sx(a)=-1000+rnd(2000)
sy(a)=-1000+rnd(2000)
sz(a)=rnd(5)+.01
next a
'The Object Description As Data
'The Data Below Describes A Cube
data -10,10,10,10,10,10,10,-10,10,-10,-10,10
data -10,10,-10,10,10,-10,10,-10,-10,-10,-10,-10
return
