rem BALL AND BOX DEMO
rem
rem enjoy
gosub initialize
dim trix(4),triy(4)
sw=screen_width()
sh=screen_height()
Do
Refresh off
'graphics clear 0,0,0
fill color (40+(rd/5))/255,30/255,20/255
'triangle 0,0 to sw,sh to 0,sh
trix(0)=0
triy(0)=0
trix(1)=sw
triy(1)=sh
trix(2)=0
triy(2)=sh
fill poly trix,triy count 3
'triangle 0,0 to sw,sh to sw,0
trix(0)=0
triy(0)=0
trix(1)=sw
triy(1)=sh
trix(2)=sw
triy(2)=0
fill poly trix,triy count 3
mm=mm+.05
gosub rotatelights
gosub drawback
gosub rotate
gosub draw
gosub drawfront
draw color 0,0,0
draw text "BALL AND BOX DEMO" at 2,2
draw text mid$(s$,p,67) at scx,258
draw color 1,1,1
draw text "BALL AND BOX DEMO" at 0,0
draw text mid$(s$,p,67) at scx,sh/2
scx=scx-2
if scx<-10 then
scx=scx+10
p=p+1
if p>len(s$)-1 then p=1
end if
refresh on
until 1=2
drawback:
for a=1 to 3
if a=1 then fill color 1,0,0
if a=2 then fill color 0,1,0
if a=3 then fill color 0,0,1
if ltz(a)<0 then
sz=(ltz(a)/2)+30
fill circle ltx(a),lty(a) size sz
end if
next a
return
drawfront:
for a=1 to 3
if a=1 then fill color 1,0,0
if a=2 then fill color 0,1,0
if a=3 then fill color 0,0,1
if ltz(a)>=0 then
sz=(ltz(a)/2)+30
fill circle ltx(a),lty(a) size sz
end if
next a
return
draw:
'Draw The Cube
b=1
fill color 1,200+fl/255,200+fl/255
vx1= tx(1)-tx(2)
vy1= ty(1)-ty(2)
vx2= tx(3)-tx(2)
vy2= ty(3)-ty(2)
if (vx1*vy2-vx2*vy1)<0 then
xp=(tx(1)+tx(2)+tx(3)+tx(4))/4
yp=(ty(1)+ty(2)+ty(3)+ty(4))/4
zp=(tz(1)+tz(2)+tz(3)+tz(4))/4
red=((ltz(1)-zp)*10)
grn=((ltz(2)-zp)*10)
blu=((ltz(3)-zp)*10)
fill color red/255,grn/255,blu/255
'fill triangle tx(1),ty(1) to tx(2),ty(2) to tx(3),ty(3)
trix(0)=tx(1)
triy(0)=ty(1)
trix(1)=tx(2)
triy(1)=ty(2)
trix(2)=tx(3)
triy(2)=ty(3)
fill poly trix,triy count 3
'fill triangle tx(1),ty(1) to tx(4),ty(4) to tx(3),ty(3)
trix(0)=tx(1)
triy(0)=ty(1)
trix(1)=tx(4)
triy(1)=ty(4)
trix(2)=tx(3)
triy(2)=ty(3)
fill poly trix,triy count 3
end if
vx1= tx(5)-tx(6)
vy1= ty(5)-ty(6)
vx2= tx(7)-tx(6)
vy2= ty(7)-ty(6)
if (vx1*vy2-vx2*vy1)>0 then
xp=(tx(5)+tx(6)+tx(7)+tx(8))/4
yp=(ty(5)+ty(6)+ty(7)+ty(8))/4
zp=(tz(5)+tz(6)+tz(7)+tz(8))/4
red=((ltz(1)-zp)*10)
grn=((ltz(2)-zp)*10)
blu=((ltz(3)-zp)*10)
fill color red/255,grn/255,blu/255
'fill triangle tx(5),ty(5) to tx(6),ty(6) to tx(7),ty(7)
trix(0)=tx(5)
triy(0)=ty(5)
trix(1)=tx(6)
triy(1)=ty(6)
trix(2)=tx(7)
triy(2)=ty(7)
fill poly trix,triy count 3
'fill triangle tx(5),ty(5) to tx(8),ty(8) to tx(7),ty(7)
trix(0)=tx(5)
triy(0)=ty(5)
trix(1)=tx(8)
triy(1)=ty(8)
trix(2)=tx(7)
triy(2)=ty(7)
fill poly trix,triy count 3
end if
vx1= tx(5)-tx(1)
vy1= ty(5)-ty(1)
vx2= tx(8)-tx(1)
vy2= ty(8)-ty(1)
if (vx1*vy2-vx2*vy1)<0 then
xp=(tx(1)+tx(4)+tx(8)+tx(5))/4
yp=(ty(1)+ty(4)+ty(8)+ty(5))/4
zp=(tz(1)+tz(4)+tz(8)+tz(5))/4
red=((ltz(1)-zp)*10)
grn=((ltz(2)-zp)*10)
blu=((ltz(3)-zp)*10)
fill color red/255,grn/255,blu/255
'fill triangle tx(5),ty(5) to tx(1),ty(1) to tx(8),ty(8)
trix(0)=tx(5)
triy(0)=ty(5)
trix(1)=tx(1)
triy(1)=ty(1)
trix(2)=tx(8)
triy(2)=ty(8)
fill poly trix,triy count 3
'fill triangle tx(8),ty(8) to tx(1),ty(1) to tx(4),ty(4)
trix(0)=tx(8)
triy(0)=ty(8)
trix(1)=tx(1)
triy(1)=ty(1)
trix(2)=tx(4)
triy(2)=ty(4)
fill poly trix,triy count 3
end if
vx1= tx(5)-tx(1)
vy1= ty(5)-ty(1)
vx2= tx(2)-tx(1)
vy2= ty(2)-ty(1)
if (vx1*vy2-vx2*vy1)>0 then
xp=(tx(1)+tx(2)+tx(5)+tx(6))/4
yp=(ty(1)+ty(2)+ty(5)+ty(6))/4
zp=(tz(1)+tz(2)+tz(5)+tz(6))/4
red=((ltz(1)-zp)*10)
grn=((ltz(2)-zp)*10)
blu=((ltz(3)-zp)*10)
fill color red/255,grn/255,blu/255
'fill triangle tx(5),ty(5) to tx(1),ty(1) to tx(2),ty(2)
trix(0)=tx(5)
triy(0)=ty(5)
trix(1)=tx(1)
triy(1)=ty(1)
trix(2)=tx(2)
triy(2)=ty(2)
fill poly trix,triy count 3
'fill triangle tx(2),ty(2) to tx(5),ty(5) to tx(6),ty(6)
trix(0)=tx(2)
triy(0)=ty(2)
trix(1)=tx(5)
triy(1)=ty(5)
trix(2)=tx(6)
triy(2)=ty(6)
fill poly trix,triy count 3
end if
vx1= tx(7)-tx(3)
vy1= ty(7)-ty(3)
vx2= tx(2)-tx(3)
vy2= ty(2)-ty(3)
if (vx1*vy2-vx2*vy1)<0 then
xp=(tx(7)+tx(2)+tx(3)+tx(6))/4
yp=(ty(7)+ty(2)+ty(3)+ty(6))/4
zp=(tz(7)+tz(2)+tz(3)+tz(6))/4
red=((ltz(1)-zp)*10)
grn=((ltz(2)-zp)*10)
blu=((ltz(3)-zp)*10)
fill color red/255,grn/255,blu/255
'fill triangle tx(7),ty(7) to tx(3),ty(3) to tx(2),ty(2)
trix(0)=tx(7)
triy(0)=ty(7)
trix(1)=tx(3)
triy(1)=ty(3)
trix(2)=tx(2)
triy(2)=ty(2)
fill poly trix,triy count 3
'fill triangle tx(2),ty(2) to tx(6),ty(6) to tx(7),ty(7)
trix(0)=tx(2)
triy(0)=ty(2)
trix(1)=tx(6)
triy(1)=ty(6)
trix(2)=tx(7)
triy(2)=ty(7)
fill poly trix,triy count 3
end if
vx1= tx(7)-tx(8)
vy1= ty(7)-ty(8)
vx2= tx(4)-tx(8)
vy2= ty(4)-ty(8)
if (vx1*vy2-vx2*vy1)<0 then
xp=(tx(7)+tx(8)+tx(3)+tx(4))/4
yp=(ty(7)+ty(8)+ty(3)+ty(4))/4
zp=(tz(7)+tz(8)+tz(3)+tz(4))/4
red=((ltz(1)-zp)*10)
grn=((ltz(2)-zp)*10)
blu=((ltz(3)-zp)*10)
fill color red/255,grn/255,blu/255
'fill triangle tx(7),ty(7) to tx(8),ty(8) to tx(4),ty(4)
trix(0)=tx(7)
triy(0)=ty(7)
trix(1)=tx(8)
triy(1)=ty(8)
trix(2)=tx(4)
triy(2)=ty(4)
fill poly trix,triy count 3
'fill triangle tx(7),ty(7) to tx(3),ty(3) to tx(4),ty(4)
trix(0)=tx(7)
triy(0)=ty(7)
trix(1)=tx(3)
triy(1)=ty(3)
trix(2)=tx(4)
triy(2)=ty(4)
fill poly trix,triy count 3
end if
return
rotate:
'Rotate And Scale Each Point Store Result
for a=1 to polys
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=size*(xx/((zz/70)+1))+sw/2
yy=size*(yy/((zz/70)+1))+sh/2
tx(a)=xx
ty(a)=yy
tz(a)=zz
next a
xr=xr+3
yr=yr+2
zr=zr+1
if xr>720 then xr=xr-720
if yr>720 then yr=yr-720
if zr>720 then zr=zr-720
return
rotatelights:
'Rotate And Scale Each Point Store Result
for a=1 to 3
x1=lx(a)
y1=ly(a)
z1=lz(a)
'X,Y,Z rotations
xx=x1
yy=y1*cs(lxr(a))+z1*sn(lxr(a))
zz=z1*cs(lxr(a))-y1*sn(lxr(a))
y1=yy
x1=xx*cs(lyr(a))-zz*sn(lyr(a))
z1=xx*sn(lyr(a))+zz*cs(lyr(a))
zz=z1
xx=x1*cs(lzr(a))-y1*sn(lzr(a))
yy=x1*sn(lzr(a))+y1*cs(lzr(a))
'Apply Perspective
xx=size*(xx/((zz/70)+1))+sw/2
yy=size*(yy/((zz/70)+1))+sh/2
ltx(a)=xx
lty(a)=yy
ltz(a)=zz
lxr(a)=lxr(a)+a
lyr(a)=lyr(a)+a+1
lzr(a)=lzr(a)+a
if lxr(a)>720 then lxr(a)=lxr(a)-720
if lyr(a)>720 then lyr(a)=lyr(a)-720
if lzr(a)>720 then lzr(a)=lzr(a)-720
next a
return
initialize:
'Open Gfx Screen
Graphics
pi=3.1415
s$=" "
s$=s$&"THIS IS ALL BEING DONE IN REAL TIME!!! ABSOLUTELY "
s$=s$&"NO PRECALCULATION AT ALL.... ENJOY THE FUN "
s$=s$&"BALL AND BOX DEMO... I WAS BORED OF LOOKING AT MY "
s$=s$&"TIRED OLD IDEAS AND SIMPLE 3D ROUTINES SO I "
s$=s$&"DECIDED TO UP THE ANTE A LITTLE BIT... "
s$=s$&" YOU ARE LOOKING AT A CUBE"
s$=s$&" ROTATED IN REALTIME ABOUT ALL THREE AXIS WITH "
s$=s$&"THREE INDEPENDENT LIGHT SOURCES ALSO ROTATING "
s$=s$&"INDEPENDENTLY AROUND THE OBJECT WHICH REFLECTS "
s$=s$&"THIER LIGHT ACCORDING TO THE PROXIMITY OF THE "
s$=s$&"LIGHT SOURCES AS AN RGB COLOR..... "
s$=s$&"NUFF SAID... TAKE IT EASY.... "
'Define the necessary variables
size=12 ' how big do you want it?
polys=8 ' The amount of points in the object
dim x(polys+1) ' Original X co-ordinate store
dim y(polys+1) ' Original Y co-ordinate store
dim z(polys+1) ' Original Z co-ordinate store
dim tx(polys+1) ' Transformed X co-ordinate store
dim ty(polys+1) ' Transformed Y co-ordinate store
dim tz(polys+1) ' Transformed Z co-ordinate store
dim lx(4),ly(4),lz(4)
dim lxr(4),lyr(4),lzr(4)
dim ltx(4),lty(4),ltz(4)
'Define Sine Tables
dim cs(721)
dim sn(721)
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=1 to polys
read x(a),y(a),z(a)
next a
for a=1 to 3
read lx(a),ly(a),lz(a)
next a
'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
data 0,0,20,0,0,-20,0,20,0
return
ball and Box Demo
-
- Posts: 167
- Joined: Wed Oct 22, 2014 3:26 pm
- My devices: iPhone 4 to 6+,iPad mini to iPad air 2
ball and Box Demo
- Attachments
-
- image.jpg (162.59 KiB) Viewed 1445 times
-
- image.jpg (138.49 KiB) Viewed 1445 times
-
- image.jpg (150.23 KiB) Viewed 1445 times
- Mr. Kibernetik
- Site Admin
- Posts: 4786
- Joined: Mon Nov 19, 2012 10:16 pm
- My devices: iPhone, iPad, MacBook
- Location: Russia
- Flag:
Re: ball and Box Demo
This is very cool!
-
- Posts: 167
- Joined: Wed Oct 22, 2014 3:26 pm
- My devices: iPhone 4 to 6+,iPad mini to iPad air 2
Re: ball and Box Demo
rem BALL AND BOX DEMO v2
rem v2 - sound added, background color
rem if anyone wants to finish / change or
rem add something, please post.
rem enjoy
def reload
notes load "/Examples/10. Music & Sound/files/test1.mid"
notes play
enddef
reload
gosub initialize
dim trix(4),triy(4)
sw=screen_width()
sh=screen_height()
Do
Refresh off
'graphics clear 0,0,0
fill color (red/2)/255,(blu/3)/255,(grn/4)/255
'triangle 0,0 to sw,sh to 0,sh
trix(0)=0
triy(0)=0
trix(1)=sw
triy(1)=sh
trix(2)=0
triy(2)=sh
fill poly trix,triy count 3
'triangle 0,0 to sw,sh to sw,0
trix(0)=0
triy(0)=0
trix(1)=sw
triy(1)=sh
trix(2)=sw
triy(2)=0
fill poly trix,triy count 3
mm=mm+.05
gosub rotatelights
gosub drawback
gosub rotate
gosub draw
gosub drawfront
draw color 0,0,0
draw text "BALL AND BOX DEMO" at 2,2
draw text mid$(s$,p,67) at scx,258
draw color 1,1,1
draw text "BALL AND BOX DEMO" at 0,0
draw text mid$(s$,p,67) at scx,sh/2
scx=scx-2
if scx<-10 then
scx=scx+10
p=p+1
if p>len(s$)-1 then p=1
end if
refresh on
until 1=2
drawback:
for a=1 to 3
if a=1 then fill color 1,0,0
if a=2 then fill color 0,1,0
if a=3 then fill color 0,0,1
if ltz(a)<0 then
sz=(ltz(a)/2)+30
fill circle ltx(a),lty(a) size sz
end if
next a
return
drawfront:
for a=1 to 3
if a=1 then fill color 1,0,0
if a=2 then fill color 0,1,0
if a=3 then fill color 0,0,1
if ltz(a)>=0 then
sz=(ltz(a)/2)+30
fill circle ltx(a),lty(a) size sz
end if
next a
return
draw:
'Draw The Cube
b=1
fill color 1,200+fl/255,200+fl/255
vx1= tx(1)-tx(2)
vy1= ty(1)-ty(2)
vx2= tx(3)-tx(2)
vy2= ty(3)-ty(2)
if (vx1*vy2-vx2*vy1)<0 then
xp=(tx(1)+tx(2)+tx(3)+tx(4))/4
yp=(ty(1)+ty(2)+ty(3)+ty(4))/4
zp=(tz(1)+tz(2)+tz(3)+tz(4))/4
red=((ltz(1)-zp)*10)
grn=((ltz(2)-zp)*10)
blu=((ltz(3)-zp)*10)
fill color red/255,grn/255,blu/255
'fill triangle tx(1),ty(1) to tx(2),ty(2) to tx(3),ty(3)
trix(0)=tx(1)
triy(0)=ty(1)
trix(1)=tx(2)
triy(1)=ty(2)
trix(2)=tx(3)
triy(2)=ty(3)
fill poly trix,triy count 3
'fill triangle tx(1),ty(1) to tx(4),ty(4) to tx(3),ty(3)
trix(0)=tx(1)
triy(0)=ty(1)
trix(1)=tx(4)
triy(1)=ty(4)
trix(2)=tx(3)
triy(2)=ty(3)
fill poly trix,triy count 3
end if
vx1= tx(5)-tx(6)
vy1= ty(5)-ty(6)
vx2= tx(7)-tx(6)
vy2= ty(7)-ty(6)
if (vx1*vy2-vx2*vy1)>0 then
xp=(tx(5)+tx(6)+tx(7)+tx(8))/4
yp=(ty(5)+ty(6)+ty(7)+ty(8))/4
zp=(tz(5)+tz(6)+tz(7)+tz(8))/4
red=((ltz(1)-zp)*10)
grn=((ltz(2)-zp)*10)
blu=((ltz(3)-zp)*10)
fill color red/255,grn/255,blu/255
'fill triangle tx(5),ty(5) to tx(6),ty(6) to tx(7),ty(7)
trix(0)=tx(5)
triy(0)=ty(5)
trix(1)=tx(6)
triy(1)=ty(6)
trix(2)=tx(7)
triy(2)=ty(7)
fill poly trix,triy count 3
'fill triangle tx(5),ty(5) to tx(8),ty(8) to tx(7),ty(7)
trix(0)=tx(5)
triy(0)=ty(5)
trix(1)=tx(8)
triy(1)=ty(8)
trix(2)=tx(7)
triy(2)=ty(7)
fill poly trix,triy count 3
end if
vx1= tx(5)-tx(1)
vy1= ty(5)-ty(1)
vx2= tx(8)-tx(1)
vy2= ty(8)-ty(1)
if (vx1*vy2-vx2*vy1)<0 then
xp=(tx(1)+tx(4)+tx(8)+tx(5))/4
yp=(ty(1)+ty(4)+ty(8)+ty(5))/4
zp=(tz(1)+tz(4)+tz(8)+tz(5))/4
red=((ltz(1)-zp)*10)
grn=((ltz(2)-zp)*10)
blu=((ltz(3)-zp)*10)
fill color red/255,grn/255,blu/255
'fill triangle tx(5),ty(5) to tx(1),ty(1) to tx(8),ty(8)
trix(0)=tx(5)
triy(0)=ty(5)
trix(1)=tx(1)
triy(1)=ty(1)
trix(2)=tx(8)
triy(2)=ty(8)
fill poly trix,triy count 3
'fill triangle tx(8),ty(8) to tx(1),ty(1) to tx(4),ty(4)
trix(0)=tx(8)
triy(0)=ty(8)
trix(1)=tx(1)
triy(1)=ty(1)
trix(2)=tx(4)
triy(2)=ty(4)
fill poly trix,triy count 3
end if
vx1= tx(5)-tx(1)
vy1= ty(5)-ty(1)
vx2= tx(2)-tx(1)
vy2= ty(2)-ty(1)
if (vx1*vy2-vx2*vy1)>0 then
xp=(tx(1)+tx(2)+tx(5)+tx(6))/4
yp=(ty(1)+ty(2)+ty(5)+ty(6))/4
zp=(tz(1)+tz(2)+tz(5)+tz(6))/4
red=((ltz(1)-zp)*10)
grn=((ltz(2)-zp)*10)
blu=((ltz(3)-zp)*10)
fill color red/255,grn/255,blu/255
'fill triangle tx(5),ty(5) to tx(1),ty(1) to tx(2),ty(2)
trix(0)=tx(5)
triy(0)=ty(5)
trix(1)=tx(1)
triy(1)=ty(1)
trix(2)=tx(2)
triy(2)=ty(2)
fill poly trix,triy count 3
'fill triangle tx(2),ty(2) to tx(5),ty(5) to tx(6),ty(6)
trix(0)=tx(2)
triy(0)=ty(2)
trix(1)=tx(5)
triy(1)=ty(5)
trix(2)=tx(6)
triy(2)=ty(6)
fill poly trix,triy count 3
end if
vx1= tx(7)-tx(3)
vy1= ty(7)-ty(3)
vx2= tx(2)-tx(3)
vy2= ty(2)-ty(3)
if (vx1*vy2-vx2*vy1)<0 then
xp=(tx(7)+tx(2)+tx(3)+tx(6))/4
yp=(ty(7)+ty(2)+ty(3)+ty(6))/4
zp=(tz(7)+tz(2)+tz(3)+tz(6))/4
red=((ltz(1)-zp)*10)
grn=((ltz(2)-zp)*10)
blu=((ltz(3)-zp)*10)
fill color red/255,grn/255,blu/255
'fill triangle tx(7),ty(7) to tx(3),ty(3) to tx(2),ty(2)
trix(0)=tx(7)
triy(0)=ty(7)
trix(1)=tx(3)
triy(1)=ty(3)
trix(2)=tx(2)
triy(2)=ty(2)
fill poly trix,triy count 3
'fill triangle tx(2),ty(2) to tx(6),ty(6) to tx(7),ty(7)
trix(0)=tx(2)
triy(0)=ty(2)
trix(1)=tx(6)
triy(1)=ty(6)
trix(2)=tx(7)
triy(2)=ty(7)
fill poly trix,triy count 3
end if
vx1= tx(7)-tx(8)
vy1= ty(7)-ty(8)
vx2= tx(4)-tx(8)
vy2= ty(4)-ty(8)
if (vx1*vy2-vx2*vy1)<0 then
xp=(tx(7)+tx(8)+tx(3)+tx(4))/4
yp=(ty(7)+ty(8)+ty(3)+ty(4))/4
zp=(tz(7)+tz(8)+tz(3)+tz(4))/4
red=((ltz(1)-zp)*10)
grn=((ltz(2)-zp)*10)
blu=((ltz(3)-zp)*10)
fill color red/255,grn/255,blu/255
'fill triangle tx(7),ty(7) to tx(8),ty(8) to tx(4),ty(4)
trix(0)=tx(7)
triy(0)=ty(7)
trix(1)=tx(8)
triy(1)=ty(8)
trix(2)=tx(4)
triy(2)=ty(4)
fill poly trix,triy count 3
'fill triangle tx(7),ty(7) to tx(3),ty(3) to tx(4),ty(4)
trix(0)=tx(7)
triy(0)=ty(7)
trix(1)=tx(3)
triy(1)=ty(3)
trix(2)=tx(4)
triy(2)=ty(4)
fill poly trix,triy count 3
end if
return
rotate:
'Rotate And Scale Each Point Store Result
for a=1 to polys
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=size*(xx/((zz/70)+1))+sw/2
yy=size*(yy/((zz/70)+1))+sh/2
tx(a)=xx
ty(a)=yy
tz(a)=zz
next a
xr=xr+3
yr=yr+2
zr=zr+1
if xr>720 then xr=xr-720
if yr>720 then yr=yr-720
if zr>720 then zr=zr-720
return
rotatelights:
'Rotate And Scale Each Point Store Result
for a=1 to 3
x1=lx(a)
y1=ly(a)
z1=lz(a)
'X,Y,Z rotations
xx=x1
yy=y1*cs(lxr(a))+z1*sn(lxr(a))
zz=z1*cs(lxr(a))-y1*sn(lxr(a))
y1=yy
x1=xx*cs(lyr(a))-zz*sn(lyr(a))
z1=xx*sn(lyr(a))+zz*cs(lyr(a))
zz=z1
xx=x1*cs(lzr(a))-y1*sn(lzr(a))
yy=x1*sn(lzr(a))+y1*cs(lzr(a))
'Apply Perspective
xx=size*(xx/((zz/70)+1))+sw/2
yy=size*(yy/((zz/70)+1))+sh/2
ltx(a)=xx
lty(a)=yy
ltz(a)=zz
lxr(a)=lxr(a)+a
lyr(a)=lyr(a)+a+1
lzr(a)=lzr(a)+a
if lxr(a)>720 then lxr(a)=lxr(a)-720
if lyr(a)>720 then lyr(a)=lyr(a)-720
if lzr(a)>720 then lzr(a)=lzr(a)-720
next a
return
initialize:
'Open Gfx Screen
Graphics
pi=3.1415
s$=" "
s$=s$&"THIS IS ALL BEING DONE IN REAL TIME!!! ABSOLUTELY "
s$=s$&"NO PRECALCULATION AT ALL.... ENJOY THE FUN "
s$=s$&"BALL AND BOX DEMO... I WAS BORED OF LOOKING AT MY "
s$=s$&"TIRED OLD IDEAS AND SIMPLE 3D ROUTINES SO I "
s$=s$&"DECIDED TO UP THE ANTE A LITTLE BIT... "
s$=s$&" YOU ARE LOOKING AT A CUBE"
s$=s$&" ROTATED IN REALTIME ABOUT ALL THREE AXIS WITH "
s$=s$&"THREE INDEPENDENT LIGHT SOURCES ALSO ROTATING "
s$=s$&"INDEPENDENTLY AROUND THE OBJECT WHICH REFLECTS "
s$=s$&"THIER LIGHT ACCORDING TO THE PROXIMITY OF THE "
s$=s$&"LIGHT SOURCES AS AN RGB COLOR..... "
s$=s$&"NUFF SAID... TAKE IT EASY.... "
'Define the necessary variables
size=12 ' how big do you want it?
polys=8 ' The amount of points in the object
dim x(polys+1) ' Original X co-ordinate store
dim y(polys+1) ' Original Y co-ordinate store
dim z(polys+1) ' Original Z co-ordinate store
dim tx(polys+1) ' Transformed X co-ordinate store
dim ty(polys+1) ' Transformed Y co-ordinate store
dim tz(polys+1) ' Transformed Z co-ordinate store
dim lx(4),ly(4),lz(4)
dim lxr(4),lyr(4),lzr(4)
dim ltx(4),lty(4),ltz(4)
'Define Sine Tables
dim cs(721)
dim sn(721)
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=1 to polys
read x(a),y(a),z(a)
next a
for a=1 to 3
read lx(a),ly(a),lz(a)
next a
'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
data 0,0,20,0,0,-20,0,20,0
return
rem v2 - sound added, background color
rem if anyone wants to finish / change or
rem add something, please post.
rem enjoy
def reload
notes load "/Examples/10. Music & Sound/files/test1.mid"
notes play
enddef
reload
gosub initialize
dim trix(4),triy(4)
sw=screen_width()
sh=screen_height()
Do
Refresh off
'graphics clear 0,0,0
fill color (red/2)/255,(blu/3)/255,(grn/4)/255
'triangle 0,0 to sw,sh to 0,sh
trix(0)=0
triy(0)=0
trix(1)=sw
triy(1)=sh
trix(2)=0
triy(2)=sh
fill poly trix,triy count 3
'triangle 0,0 to sw,sh to sw,0
trix(0)=0
triy(0)=0
trix(1)=sw
triy(1)=sh
trix(2)=sw
triy(2)=0
fill poly trix,triy count 3
mm=mm+.05
gosub rotatelights
gosub drawback
gosub rotate
gosub draw
gosub drawfront
draw color 0,0,0
draw text "BALL AND BOX DEMO" at 2,2
draw text mid$(s$,p,67) at scx,258
draw color 1,1,1
draw text "BALL AND BOX DEMO" at 0,0
draw text mid$(s$,p,67) at scx,sh/2
scx=scx-2
if scx<-10 then
scx=scx+10
p=p+1
if p>len(s$)-1 then p=1
end if
refresh on
until 1=2
drawback:
for a=1 to 3
if a=1 then fill color 1,0,0
if a=2 then fill color 0,1,0
if a=3 then fill color 0,0,1
if ltz(a)<0 then
sz=(ltz(a)/2)+30
fill circle ltx(a),lty(a) size sz
end if
next a
return
drawfront:
for a=1 to 3
if a=1 then fill color 1,0,0
if a=2 then fill color 0,1,0
if a=3 then fill color 0,0,1
if ltz(a)>=0 then
sz=(ltz(a)/2)+30
fill circle ltx(a),lty(a) size sz
end if
next a
return
draw:
'Draw The Cube
b=1
fill color 1,200+fl/255,200+fl/255
vx1= tx(1)-tx(2)
vy1= ty(1)-ty(2)
vx2= tx(3)-tx(2)
vy2= ty(3)-ty(2)
if (vx1*vy2-vx2*vy1)<0 then
xp=(tx(1)+tx(2)+tx(3)+tx(4))/4
yp=(ty(1)+ty(2)+ty(3)+ty(4))/4
zp=(tz(1)+tz(2)+tz(3)+tz(4))/4
red=((ltz(1)-zp)*10)
grn=((ltz(2)-zp)*10)
blu=((ltz(3)-zp)*10)
fill color red/255,grn/255,blu/255
'fill triangle tx(1),ty(1) to tx(2),ty(2) to tx(3),ty(3)
trix(0)=tx(1)
triy(0)=ty(1)
trix(1)=tx(2)
triy(1)=ty(2)
trix(2)=tx(3)
triy(2)=ty(3)
fill poly trix,triy count 3
'fill triangle tx(1),ty(1) to tx(4),ty(4) to tx(3),ty(3)
trix(0)=tx(1)
triy(0)=ty(1)
trix(1)=tx(4)
triy(1)=ty(4)
trix(2)=tx(3)
triy(2)=ty(3)
fill poly trix,triy count 3
end if
vx1= tx(5)-tx(6)
vy1= ty(5)-ty(6)
vx2= tx(7)-tx(6)
vy2= ty(7)-ty(6)
if (vx1*vy2-vx2*vy1)>0 then
xp=(tx(5)+tx(6)+tx(7)+tx(8))/4
yp=(ty(5)+ty(6)+ty(7)+ty(8))/4
zp=(tz(5)+tz(6)+tz(7)+tz(8))/4
red=((ltz(1)-zp)*10)
grn=((ltz(2)-zp)*10)
blu=((ltz(3)-zp)*10)
fill color red/255,grn/255,blu/255
'fill triangle tx(5),ty(5) to tx(6),ty(6) to tx(7),ty(7)
trix(0)=tx(5)
triy(0)=ty(5)
trix(1)=tx(6)
triy(1)=ty(6)
trix(2)=tx(7)
triy(2)=ty(7)
fill poly trix,triy count 3
'fill triangle tx(5),ty(5) to tx(8),ty(8) to tx(7),ty(7)
trix(0)=tx(5)
triy(0)=ty(5)
trix(1)=tx(8)
triy(1)=ty(8)
trix(2)=tx(7)
triy(2)=ty(7)
fill poly trix,triy count 3
end if
vx1= tx(5)-tx(1)
vy1= ty(5)-ty(1)
vx2= tx(8)-tx(1)
vy2= ty(8)-ty(1)
if (vx1*vy2-vx2*vy1)<0 then
xp=(tx(1)+tx(4)+tx(8)+tx(5))/4
yp=(ty(1)+ty(4)+ty(8)+ty(5))/4
zp=(tz(1)+tz(4)+tz(8)+tz(5))/4
red=((ltz(1)-zp)*10)
grn=((ltz(2)-zp)*10)
blu=((ltz(3)-zp)*10)
fill color red/255,grn/255,blu/255
'fill triangle tx(5),ty(5) to tx(1),ty(1) to tx(8),ty(8)
trix(0)=tx(5)
triy(0)=ty(5)
trix(1)=tx(1)
triy(1)=ty(1)
trix(2)=tx(8)
triy(2)=ty(8)
fill poly trix,triy count 3
'fill triangle tx(8),ty(8) to tx(1),ty(1) to tx(4),ty(4)
trix(0)=tx(8)
triy(0)=ty(8)
trix(1)=tx(1)
triy(1)=ty(1)
trix(2)=tx(4)
triy(2)=ty(4)
fill poly trix,triy count 3
end if
vx1= tx(5)-tx(1)
vy1= ty(5)-ty(1)
vx2= tx(2)-tx(1)
vy2= ty(2)-ty(1)
if (vx1*vy2-vx2*vy1)>0 then
xp=(tx(1)+tx(2)+tx(5)+tx(6))/4
yp=(ty(1)+ty(2)+ty(5)+ty(6))/4
zp=(tz(1)+tz(2)+tz(5)+tz(6))/4
red=((ltz(1)-zp)*10)
grn=((ltz(2)-zp)*10)
blu=((ltz(3)-zp)*10)
fill color red/255,grn/255,blu/255
'fill triangle tx(5),ty(5) to tx(1),ty(1) to tx(2),ty(2)
trix(0)=tx(5)
triy(0)=ty(5)
trix(1)=tx(1)
triy(1)=ty(1)
trix(2)=tx(2)
triy(2)=ty(2)
fill poly trix,triy count 3
'fill triangle tx(2),ty(2) to tx(5),ty(5) to tx(6),ty(6)
trix(0)=tx(2)
triy(0)=ty(2)
trix(1)=tx(5)
triy(1)=ty(5)
trix(2)=tx(6)
triy(2)=ty(6)
fill poly trix,triy count 3
end if
vx1= tx(7)-tx(3)
vy1= ty(7)-ty(3)
vx2= tx(2)-tx(3)
vy2= ty(2)-ty(3)
if (vx1*vy2-vx2*vy1)<0 then
xp=(tx(7)+tx(2)+tx(3)+tx(6))/4
yp=(ty(7)+ty(2)+ty(3)+ty(6))/4
zp=(tz(7)+tz(2)+tz(3)+tz(6))/4
red=((ltz(1)-zp)*10)
grn=((ltz(2)-zp)*10)
blu=((ltz(3)-zp)*10)
fill color red/255,grn/255,blu/255
'fill triangle tx(7),ty(7) to tx(3),ty(3) to tx(2),ty(2)
trix(0)=tx(7)
triy(0)=ty(7)
trix(1)=tx(3)
triy(1)=ty(3)
trix(2)=tx(2)
triy(2)=ty(2)
fill poly trix,triy count 3
'fill triangle tx(2),ty(2) to tx(6),ty(6) to tx(7),ty(7)
trix(0)=tx(2)
triy(0)=ty(2)
trix(1)=tx(6)
triy(1)=ty(6)
trix(2)=tx(7)
triy(2)=ty(7)
fill poly trix,triy count 3
end if
vx1= tx(7)-tx(8)
vy1= ty(7)-ty(8)
vx2= tx(4)-tx(8)
vy2= ty(4)-ty(8)
if (vx1*vy2-vx2*vy1)<0 then
xp=(tx(7)+tx(8)+tx(3)+tx(4))/4
yp=(ty(7)+ty(8)+ty(3)+ty(4))/4
zp=(tz(7)+tz(8)+tz(3)+tz(4))/4
red=((ltz(1)-zp)*10)
grn=((ltz(2)-zp)*10)
blu=((ltz(3)-zp)*10)
fill color red/255,grn/255,blu/255
'fill triangle tx(7),ty(7) to tx(8),ty(8) to tx(4),ty(4)
trix(0)=tx(7)
triy(0)=ty(7)
trix(1)=tx(8)
triy(1)=ty(8)
trix(2)=tx(4)
triy(2)=ty(4)
fill poly trix,triy count 3
'fill triangle tx(7),ty(7) to tx(3),ty(3) to tx(4),ty(4)
trix(0)=tx(7)
triy(0)=ty(7)
trix(1)=tx(3)
triy(1)=ty(3)
trix(2)=tx(4)
triy(2)=ty(4)
fill poly trix,triy count 3
end if
return
rotate:
'Rotate And Scale Each Point Store Result
for a=1 to polys
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=size*(xx/((zz/70)+1))+sw/2
yy=size*(yy/((zz/70)+1))+sh/2
tx(a)=xx
ty(a)=yy
tz(a)=zz
next a
xr=xr+3
yr=yr+2
zr=zr+1
if xr>720 then xr=xr-720
if yr>720 then yr=yr-720
if zr>720 then zr=zr-720
return
rotatelights:
'Rotate And Scale Each Point Store Result
for a=1 to 3
x1=lx(a)
y1=ly(a)
z1=lz(a)
'X,Y,Z rotations
xx=x1
yy=y1*cs(lxr(a))+z1*sn(lxr(a))
zz=z1*cs(lxr(a))-y1*sn(lxr(a))
y1=yy
x1=xx*cs(lyr(a))-zz*sn(lyr(a))
z1=xx*sn(lyr(a))+zz*cs(lyr(a))
zz=z1
xx=x1*cs(lzr(a))-y1*sn(lzr(a))
yy=x1*sn(lzr(a))+y1*cs(lzr(a))
'Apply Perspective
xx=size*(xx/((zz/70)+1))+sw/2
yy=size*(yy/((zz/70)+1))+sh/2
ltx(a)=xx
lty(a)=yy
ltz(a)=zz
lxr(a)=lxr(a)+a
lyr(a)=lyr(a)+a+1
lzr(a)=lzr(a)+a
if lxr(a)>720 then lxr(a)=lxr(a)-720
if lyr(a)>720 then lyr(a)=lyr(a)-720
if lzr(a)>720 then lzr(a)=lzr(a)-720
next a
return
initialize:
'Open Gfx Screen
Graphics
pi=3.1415
s$=" "
s$=s$&"THIS IS ALL BEING DONE IN REAL TIME!!! ABSOLUTELY "
s$=s$&"NO PRECALCULATION AT ALL.... ENJOY THE FUN "
s$=s$&"BALL AND BOX DEMO... I WAS BORED OF LOOKING AT MY "
s$=s$&"TIRED OLD IDEAS AND SIMPLE 3D ROUTINES SO I "
s$=s$&"DECIDED TO UP THE ANTE A LITTLE BIT... "
s$=s$&" YOU ARE LOOKING AT A CUBE"
s$=s$&" ROTATED IN REALTIME ABOUT ALL THREE AXIS WITH "
s$=s$&"THREE INDEPENDENT LIGHT SOURCES ALSO ROTATING "
s$=s$&"INDEPENDENTLY AROUND THE OBJECT WHICH REFLECTS "
s$=s$&"THIER LIGHT ACCORDING TO THE PROXIMITY OF THE "
s$=s$&"LIGHT SOURCES AS AN RGB COLOR..... "
s$=s$&"NUFF SAID... TAKE IT EASY.... "
'Define the necessary variables
size=12 ' how big do you want it?
polys=8 ' The amount of points in the object
dim x(polys+1) ' Original X co-ordinate store
dim y(polys+1) ' Original Y co-ordinate store
dim z(polys+1) ' Original Z co-ordinate store
dim tx(polys+1) ' Transformed X co-ordinate store
dim ty(polys+1) ' Transformed Y co-ordinate store
dim tz(polys+1) ' Transformed Z co-ordinate store
dim lx(4),ly(4),lz(4)
dim lxr(4),lyr(4),lzr(4)
dim ltx(4),lty(4),ltz(4)
'Define Sine Tables
dim cs(721)
dim sn(721)
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=1 to polys
read x(a),y(a),z(a)
next a
for a=1 to 3
read lx(a),ly(a),lz(a)
next a
'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
data 0,0,20,0,0,-20,0,20,0
return