Support Forum / Форум поддержки

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

Code: Select all

Rem Double Trouble v1 with sound
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 "/Examples/10. Music & Sound/files/test6.mid"
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:
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<-10 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