Inside out demo
Posted: Tue Mar 24, 2015 10:35 am
Code: Select all
rem The Inside out demo
rem iPhone 6 Plus / 8.3 beta 3
rem Enjoy...
gosub initialize
loop:
refresh off
graphics clear 5/255,100/255,155/255
gosub rotate
gosub construct
gosub dstars
fill color 0,0,0
for a=0 to sw step 12
fill rect a,0 to a+2,sh
next a
for a=0 to sh step 12
fill rect 0,a to sw,a+2
next a
fill color 155/255,1,1
fill rect 0,0 to sw,18
draw color 0,0,0
draw text "Inside out demo" at 0,0
fill rect 0,sh-18 to sw,sh
gosub logo
gosub scroll
refresh on
goto loop
scroll:
draw color 1,1,1
draw text mid$(s$,p,67) at scx,sh-18
draw color 0,0,0
draw text mid$(s$,p,67) at scx,sh-17
scx=scx-2
if scx<-10 then
scx=scx+10
p=p+1
if p>len(s$)-1 then p=0
end if
return
logo:
ls=ls+.1
lc=lc+.12
for a=1 to 5
lx=90*sin(ls+(a/23))+sw
ly=30*cos(lc+(a/20))+sh
draw color 0,(25*a)/255,(34*a)/255
draw line 290+lx,50+ly to 350+lx,50+ly
draw line 290+lx,50+ly to 290+lx,200+ly
draw line 350+lx,50+ly to 350+lx,200+ly
draw line 290+lx,125+ly to 350+lx,125+ly
draw rect 220+lx,50+ly to 280+lx,200+ly
draw line 220+lx,125+ly to 280+lx,125+ly
draw line 150+lx,50+ly to 180+lx,125+ly
draw line 210+lx,50+ly to 180+lx,125+ly
draw line 210+lx,50+ly to 210+lx,200+ly
draw line 150+lx,50+ly to 150+lx,200+ly
draw line 80+lx,50+ly to 80+lx,125+ly
draw line 80+lx,50+ly to 140+lx,50+ly
draw line 80+lx,125+ly to 140+lx,125+ly
draw line 140+lx,125+ly to 140+lx,200+ly
draw line 140+lx,200+ly to 80+lx,200+ly
draw line 420+lx,50+ly to 360+lx,50+ly
draw line 360+lx,50+ly to 360+lx,125+ly
draw line 360+lx,125+ly to 420+lx,125+ly
draw line 420+lx,125+ly to 420+lx,200+ly
draw line 420+lx,200+ly to 360+lx,200+ly
draw line 430+lx,50+ly to 490+lx,50+ly
draw line 430+lx,200+ly to 490+lx,200+ly
draw line 460+lx,50+ly to 460+lx,200+ly
draw line 560+lx,50+ly to 500+lx,50+ly
draw line 500+lx,50+ly to 500+lx,200+ly
draw line 500+lx,200+ly to 560+lx,200+ly
next a
return
dstars:
fill color 5/255,100/255,155/255
for a=1 to ds
sz(a)=sz(a)-.05
itx=(sx(a)/sz(a))+sw/2
ity=(sy(a)/sz(a))+sh/2
ts=6-sz(a)
fill rect itx,ity to itx+ts,ity+ts
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
return
'Draw The Inner Ball Object
construct:
f1=8!f2=4!f3=3
gosub draw
f1=12!f2=8!f3=3
gosub draw
f1=12!f2=13!f3=8
gosub draw
f1=13!f2=4!f3=8
gosub draw
f1=12!f2=3!f3=7
gosub draw
f1=3!f2=4!f3=5
gosub draw
f1=13!f2=9!f3=4
gosub draw
f1=4!f2=9!f3=1
gosub draw
f1=4!f2=1!f3=5
gosub draw
f1=3!f2=5!f3=2
gosub draw
f1=5!f2=1!f3=2
gosub draw
f1=7!f2=3!f3=2
gosub draw
f1=6!f2=2!f3=1
gosub draw
f1=11!f2=7!f3=2
gosub draw
f1=11!f2=2!f3=6
gosub draw
f1=10!f2=11!f3=6
gosub draw
f1=10!f2=6!f3=1
gosub draw
f1=9!f2=10!f3=1
gosub draw
f1=13!f2=10!f3=9
gosub draw
f1=12!f2=7!f3=11
gosub draw
f1=12!f2=11!f3=14
gosub draw
f1=13!f2=12!f3=14
gosub draw
f1=13!f2=14!f3=10
gosub draw
f1=14!f2=11!f3=10
gosub draw
return
'Calculate Cross product and draw face
draw:
'Draw A Face Of The Ball If Cross product Positive
vx1= tx(f1)-tx(f2) 'Calculate Cross product
vy1= ty(f1)-ty(f2)
vx2= tx(f3)-tx(f2)
vy2= ty(f3)-ty(f2)
n=(vx1*vy2-vx2*vy1)
if n>0 then 'Cross product positive?
l=abs(n/2500)
fill color (r+l)/255,(g+l)/255,(b+l)/255 ' Set colour for face
'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
draw color l,l,(l*2)/255
'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)
draw poly trix, triy count 3
end if
return
'Rotation and perspective transformations For Inner Object
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 matrix 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;
zv=(zz/10)+1
xx=size*(xx/zv)+sw/2
yy=size*(yy/zv)+sh/2
tx(a)=xx
ty(a)=yy
tz(a)=zz
next a
xr=xr+1 'Rotation Offset Additions
yr=yr+2
zr=zr+3
if xr>720 then xr=xr-720 'Offset Resets
if yr>720 then yr=yr-720
if zr>720 then zr=zr-720
return
'Initialize Program
initialize:
graphics
sw=screen_width()
sh=screen_height()
size=16 'Size and color values for inside ball
r=0!g=0!b=40
pi=3.1415 'pi
polys=14 'The amount of points in the object
dim trix(4),triy(4)
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
s$=" "
p=0
scx=0
s$=s$&" This demo is like watching the inside of a bag "
s$=s$&"with stars inside. It is very quickly coded "
s$=s$&"so don't hold it against me, I was trying to "
s$=s$&"have some fun teaching my son, Digit... "
ds=40
dim sx(ds+1),sy(ds+1),sz(ds+1)
for a=1 to ds
sx(a)=-900+rnd(1800)
sy(a)=-900+rnd(1800)
sz(a)=ran(5)
next a
dim cs(721) 'Sin/Cos Table Precalc;
dim sn(721)
for ang=0 to 720
cs(ang)=cos(ang*(pi/360))
sn(ang)=sin(ang*(pi/360))
next ang
for a=1 to polys 'Get Object from Data
read x(a),y(a),z(a)
next a
'Ball Object (14 Points)
data 5,-5,-5,5,5,-5,-5,5,-5,-5,-5,-5,0,0,-8,8,0,0,0,8,0
data -8,0,0,0,-8,0,5,-5,5,5,5,5,-5,5,5,-5,-5,5,0,0,8
return