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

Rem Double Trouble v.2
Rem I'm still working on it. I'm porting it from my old misoft code.
Rem is there a triangle command?

pi=3.1416
gosub initialize

tx(1)=tx(2)+1


loop:
refresh on
graphics clear 0,0,0
draw color .10,.40,.10
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 to x4,y4
draw line x1,y1 to x3,y3
draw line to x2,y2
draw color .130,.255,.130
for a=0 to str-1
itx=sx(a)
itx=itx/sz(a)
itx=itx+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+1

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
draw color 0,0,0
draw text "DOUBLE TROUBLE" at 1,1
draw color .255,.255,.255
draw text "DOUBLE TROUBLE" at 0,0

refresh off
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=3 ! 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
draw color .r+light,.g+light,.b+light
'fill triangle tx(f1),ty(f1) to tx(f2),ty(f2) to tx(f3),ty(f3)
draw line tx(f1),ty(f1) to tx(f2),ty(f2)
draw line tx(f2),ty(f2) to tx(f3),ty(f3)

'fill triangle tx(f1),ty(f1) to tx(f4),ty(f4) to tx(f3),ty(f3)
draw line tx(f1),ty(f1) to tx(f4),ty(f4)
draw line tx(f4),ty(f4) to tx(f3),ty(f3)
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

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!
'#####################################
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

'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)+1
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

Rem is there a triangle command?

Yes, somewhat "hidden" in the versatile "draw poly" statement.

"Draw poly x,y" will draw a triangle if x and y are arrays of size 3, containing the coordinates of the 3 points.
Also see the "fill poly" statement.

Rem Double Trouble v.3
rem v.3 - fixed bugs and added filled cubes
rem I'm still learning thus basic. Sorry for the mess!
rem enjoy!

gosub initialize


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

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

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
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