Magnetic Demo
Posted: Mon Mar 23, 2015 8:15 am
Code: Select all
rem Magnetic Demo
rem iPhone 6 Plus / 8.3 b3
rem Enjoy...
gosub initialize
l=37
loop:
refresh off
l=l+1
if l>38 then l=37
fl=100*sin(mm)
mm=mm+.1
graphics clear 40/255,30/255,20/255
draw color 0,0,0
draw text "MAGNETIC DEMO" at 2+rnd(2),2+rnd(2)
draw color 55/255,55/255,(155+fl)/255
draw text "MAGNETIC DEMO" at 0+rnd(2),0+rnd(2)
gosub rotate
gosub draw
gosub fieldcheck
gosub drawballs
refresh on
goto loop
end
'Check balls to see if they are in magnetic field
'Calculate positions if they are.
fieldcheck:
'mgx=(tx(l)+tx(l+1)+tx(l+4)+tx(l+5))/4
mgx=tx(l)
mgy=ty(l)
'mgy=(ty(l)+ty(l+1)+ty(l+4)+ty(l+5))/4
for a=1 to bbs 'CHECK BALLS ONE AT A TIME
if ballx(a)>mgx-55 and ballx(a)<mgx+55 then 'IN X?
if bally(a)>mgy-70 and bally(a)<mgy+70 then 'IN Y?
ballx(a)=ballx(a)-((ballx(a)-mgx)*.25) 'MOVE X
balls(a)=-4+rnd(8) 'GENERATE RANDOM SPEED
bally(a)=bally(a)-((bally(a)-mgy)*.25) 'MOVE Y
ballg(a)=0 'STOP 'EM FALLING
end if 'END OF ABOVE Y CONDITIONS
end if 'END OF ABOVE X CONDITIONS
if bally(a)<sh-4 then 'IS IT OFF THE GROUND?
ballg(a)=ballg(a)+.1+(a/100) 'ADD GRAVITY
bally(a)=bally(a)+ballg(a) 'MAKE IT FALL
if bally(a)>sh-4 then 'HAS IT HIT THE GROUND?
bally(a)=sh-4 'LINE UP WITH GROUND
if ballg(a)>1 then 'MAKE THEM BOUNCE
ballg(a)=-(ballg(a)/1.3) 'SLOW THE BOUNCE DOWN
bally(a)=sh-5 'PUT BALL ABOVE LINE AGAIN
end if
end if 'END OF GROUND CONDITION
end if 'END OF FALL CONDITION
next a 'DO NEXT BALL UNTIL ALL DONE
return
drawballs:
b=0
fill color 0,0,0
for a=1 to bbs
rem DRAW THEM WITHIN LOOP
'gtriangle ballx(a)-7,bally(a) to ballx(a),bally(a)-7 to ballx(a),bally(a)
trix(0)=ballx(a)-7
triy(0)=bally(a)
trix(1)=ballx(a)
triy(1)=bally(a)-7
trix(2)=ballx(a)
triy(2)=bally(a)
fill poly trix, triy count 3
'gtriangle ballx(a)+7,bally(a) to ballx(a),bally(a)-7 to ballx(a),bally(a)
trix(0)=ballx(a)+7
triy(0)=bally(a)
trix(1)=ballx(a)
triy(1)=bally(a)-7
trix(2)=ballx(a)
triy(2)=bally(a)
fill poly trix, triy count 3
'gtriangle ballx(a)-7,bally(a) to ballx(a),bally(a)+7 to ballx(a),bally(a)
trix(0)=ballx(a)-7
triy(0)=bally(a)
trix(1)=ballx(a)
triy(1)=bally(a)+7
trix(2)=ballx(a)
triy(2)=bally(a)
fill poly trix, triy count 3
'gtriangle ballx(a)+7,bally(a) to ballx(a),bally(a)+7 to ballx(a),bally(a)
trix(0)=ballx(a)+7
triy(0)=bally(a)
trix(1)=ballx(a)
triy(1)=bally(a)+7
trix(2)=ballx(a)
triy(2)=bally(a)
fill poly trix, triy count 3
ballx(a)=ballx(a)+balls(a) 'MOVE LEFT AND RIGHT AND REVERSE AT SIDES
if ballx(a)>sw or ballx(a)<0 then balls(a)=-balls(a)
next a 'MOVE TO NEXT BALL
return
draw:
'Draw The Magnet
b=1
draw color 1,(200+fl)/255,(200+fl)/255
draw line tx(1),ty(1) to tx(2),ty(2)
draw line tx(2),ty(2) to tx(3),ty(3)
draw line tx(3),ty(3) to tx(4),ty(4)
draw line tx(1),ty(1) to tx(4),ty(4)
draw line tx(5),ty(5) to tx(6),ty(6)
draw line tx(6),ty(6) to tx(7),ty(7)
draw line tx(7),ty(7) to tx(8),ty(8)
draw line tx(5),ty(5) to tx(8),ty(8)
draw line tx(1),ty(1) to tx(5),ty(5)
draw line tx(2),ty(2) to tx(6),ty(6)
draw line tx(3),ty(3) to tx(7),ty(7)
draw line tx(4),ty(4) to tx(8),ty(8)
draw line tx(9),ty(9) to tx(10),ty(10)
draw line tx(10),ty(10) to tx(11),ty(11)
draw line tx(11),ty(11) to tx(12),ty(12)
draw line tx(12),ty(12) to tx(9),ty(9)
draw line tx(13),ty(13) to tx(14),ty(14)
draw line tx(14),ty(14) to tx(15),ty(15)
draw line tx(15),ty(15) to tx(16),ty(16)
draw line tx(16),ty(16) to tx(13),ty(13)
draw line tx(9),ty(9) to tx(13),ty(13)
draw line tx(10),ty(10) to tx(14),ty(14)
draw line tx(11),ty(11) to tx(15),ty(15)
draw line tx(12),ty(12) to tx(16),ty(16)
draw color (255+fl)/255,50/255,50/255
draw line tx(17),ty(17) to tx(18),ty(18)
draw line tx(18),ty(18) to tx(19),ty(19)
draw line tx(19),ty(19) to tx(20),ty(20)
draw line tx(20),ty(20) to tx(21),ty(21)
draw line tx(21),ty(21) to tx(22),ty(22)
draw line tx(23),ty(23) to tx(24),ty(24)
draw line tx(24),ty(24) to tx(25),ty(25)
draw line tx(25),ty(25) to tx(26),ty(26)
draw line tx(26),ty(26) to tx(27),ty(27)
draw line tx(27),ty(27) to tx(28),ty(28)
draw line tx(18),ty(18) to tx(24),ty(24)
draw line tx(19),ty(19) to tx(25),ty(25)
draw line tx(20),ty(20) to tx(26),ty(26)
draw line tx(21),ty(21) to tx(27),ty(27)
draw line tx(3),ty(3) to tx(29),ty(29)
draw line tx(29),ty(29) to tx(30),ty(30)
draw line tx(30),ty(30) to tx(31),ty(31)
draw line tx(31),ty(31) to tx(32),ty(32)
draw line tx(32),ty(32) to tx(11),ty(11)
draw line tx(7),ty(7) to tx(33),ty(33)
draw line tx(33),ty(33) to tx(34),ty(34)
draw line tx(34),ty(34) to tx(35),ty(35)
draw line tx(35),ty(35) to tx(36),ty(36)
draw line tx(36),ty(36) to tx(15),ty(15)
draw line tx(33),ty(33) to tx(29),ty(29)
draw line tx(34),ty(34) to tx(30),ty(30)
draw line tx(35),ty(35) to tx(31),ty(31)
draw line tx(36),ty(36) to tx(32),ty(32)
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
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+5
yr=yr+1
zr=zr+3
if xr>720 then xr=xr-720
if yr>720 then yr=yr-720
if zr>720 then zr=zr-720
return
initialize:
graphics
sw=screen_width()
sh=screen_height()
pi=3.1415
size=8 'how big do you want it?
polys=38 'The amount of polygons 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
'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)
x(a)=x(a)*3
z(a)=z(a)*3
y(a)=y(a)*2
next a
'Storage Space For Balls
bbs=17 'MAXIMUM BALLS TO HAVE
dim ballx(bbs+1) 'DEFINE BALL X POS()
dim bally(bbs+1) 'DEFINE BALL Y POS()
dim balls(bbs+1) 'DEFINE BALL SPEED()
dim ballg(bbs+1) 'DEFINE BALL GRAVITY()
'Define Ball Positions, Speed + Gravity
for a=1 to bbs 'DO ALL BALLS ONE BY ONE
bally(a)=sh-5 'BALL Y POS AT BOTTOM
ballx(a)=rnd(sw) 'SET RANDOM BALL X POS
balls(a)=int(rnd(4))+1 'SET RANDOM BALL SPEED
ballg(a)=0 'BALL GRAVITY 0
next a 'MOVE TO NEXT BALL
'The Data Below Describes A Magnet.
data -5,-10,1,-3,-10,1,-3,-8,1,-5,-8,1
data -5,-10,-1,-3,-10,-1,-3,-8,-1,-5,-8,-1
data 5,-10,1,3,-10,1,3,-8,1,5,-8,1
data 5,-10,-1,3,-10,-1,3,-8,-1,5,-8,-1
data -5,-8,1,-5,8,1,-2,10,1,2,10,1,5,8,1,5,-8,1
data -5,-8,-1,-5,8,-1,-2,10,-1,2,10,-1,5,8,-1,5,-8,-1
data -3,7,1,-1,8,1,1,8,1,3,7,1
data -3,7,-1,-1,8,-1,1,8,-1,3,7,-1
data -4,-10,0 , 4,-10,0
return
