Double Trouble v2

[DrChip]

Code:
Rem Double Trouble v2 with sound and working grid!
rem v1.0 - fixed bugs and added filled cubes
rem Wrote this on an iphone 6 plus.
rem Sorry for the mess. Enjoy!
rem Thanks Mr. K for the tips!

gosub initialize
deltax=1
title$="DOUBLE TROUBLE"
titlex=csw
notes stop
notes load "/Examples/10. Music & Sound/files/test6.mid"
notes play

loop:
refresh off
graphics clear 0,0,0
draw color .10,.200,.10
draw size 4
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 1,1,1
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
gosub grid

if titlex>sw-len(title$)*11 or titlex<-10 then
deltax=-deltax
end if
titlex=titlex+deltax

draw color 0,0,0
draw text title$ at titlex+2,2
draw color 1,1,1
draw text title$ at titlex,0
gosub scroll
refresh on
Goto loop
End

grid:
fill color .10,.10,.10
for a=0 to sw step 8
fill rect a,0 to a+3,sh
next a
for a=0 to sh step 8
draw line 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:
ls=len(s$)-1
texty=csh+220*sn(xr)
draw color 55/255,55/255,255/255
text$=substr$(s$,p,ls)
draw text text$ at scx+2,texty+2
draw color 1,1,1

draw text substr$(s$,p,ls) at scx,texty
scx-=1
if scx<-50 then
scx+=10
p+=1
if p>ls then p=1
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

[Mr. Kibernetik]

Although your REFRESH commands give you the result you need, you are not using them in a proper way.

REFRESH ON command turns on automatic screen refreshing. REFRESH OFF turns automatic refreshing off. If automatic refresh is off, then you can make manual refresh by REFRESH command.

So, in the case you want refreshing only and exactly when you need it to refresh, your approach should be:

1. Turn off automatic refreshing by REFRESH OFF
2. Preform refresh exacty when you need by REFRESH.

[Mr. Kibernetik]

When you draw rectangles, you can do it more efficiently. Instead of

Code: Select all

DRAW RECT X,Y TO X+S,Y+S

you can draw it like

Code: Select all

DRAW RECT X,Y SIZE S

if S is the size of your square. In the second command S will be half of rectangle size and X,Y will be center of the square.