'              *** Magnetic Mayhem Demo ***
'   @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'   @ This Demo Was Coded By Mr. Shockwave (C) 2002!! @
'   @-===============================================-@
'   @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' Greetings to al my friends and acquaintences on the
' Yabasic forums, especially these (In Random Order):
'
'  Xalthorn, Doctor, Jinx, Master Tonberry, Jacob Busby,
'    Dougal The Dogg, Demoneye, Asiv, Liquid Pia, Ian,
'     Static Gerbil, Verybasic, Snakedogg, Jomorrow.
'   And To All The Rest Of You Too :o) Enjoy The Demo!
'#########################################################

gosub initialise
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
l=37
repeat
l=l+1
if l>38 l=37
fl=100*sin(mm)
mm=mm+.1
setdrawbuf dw
dw=1-dw
setdispbuf dw
setrgb 1,40,30,20
setrgb 2,0,20,40
setrgb 3,80,20,0
gtriangle 0,0 to 640,512 to 0,512
setrgb 3,40,30,20
gtriangle 0,0 to 640,512 to 640,0
setrgb 1,0,0,0
text 322+ran(2),258+ran(2),"MAGNETIC MAYHEM BY SHOCKWAVE 2002","cc"
setrgb 1,55,55,155+fl
text 320+ran(2),256+ran(2),"MAGNETIC MAYHEM BY SHOCKWAVE 2002","cc"

gosub rotate
gosub draw
gosub fieldcheck
gosub drawballs

'#######################################################
'## The Main Loop. These Calls Are Repeated Until (X) ##
'#######################################################
until (and(peek("port1"),16384)<>0)
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
exit

'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'    Check balls to see if they are in magnetic field
'    Calculate positions if they are.
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

label 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:rem               CHECK BALLS ONE AT A TIME
 if ballx(a)>mgx-55 and ballx(a)<mgx+55 then:rem   IN X?
  if bally(a)>mgy-70 and bally(a)<mgy+70 then:rem  IN Y?
  
   ballx(a)=ballx(a)-((ballx(a)-mgx)*.25):rem       MOVE X
   balls(a)=-4+ran(8):rem           GENERATE RANDOM SPEED
   bally(a)=bally(a)-((bally(a)-mgy)*.25):rem       MOVE Y
   ballg(a)=0:rem                        STOP 'EM FALLING
  fi:rem                         END OF ABOVE Y CONDITIONS
 fi:rem                          END OF ABOVE X CONDITIONS
 if bally(a)<507 then:rem            IS IT OFF THE GROUND?
  ballg(a)=ballg(a)+.1+(a/100):rem             ADD GRAVITY
  bally(a)=bally(a)+ballg(a):rem              MAKE IT FALL
  if bally(a)>507 then:rem          HAS IT HIT THE GROUND?
   bally(a)=507:rem                    LINE UP WITH GROUND
   if ballg(a)>1 then :rem                MAKE THEM BOUNCE
       ballg(a)=-(ballg(a)/1.3):rem   SLOW THE BOUNCE DOWN
       bally(a)=506:rem          PUT BALL ABOVE LINE AGAIN
   fi
  fi:rem                           END OF GROUND CONDITION
 fi:rem                              END OF FALL CONDITION
next a:rem                     DO NEXT BALL UNTIL ALL DONE
return


label drawballs
b=0
setrgb 1,0,0,0
setrgb 2,0,0,0
setrgb 3,155,155,255
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)
gtriangle ballx(a)+7,bally(a) to ballx(a),bally(a)-7 to ballx(a),bally(a)
gtriangle ballx(a)-7,bally(a) to ballx(a),bally(a)+7 to ballx(a),bally(a)
gtriangle ballx(a)+7,bally(a) to ballx(a),bally(a)+7 to ballx(a),bally(a)



 ballx(a)=ballx(a)+balls(a):rem        MOVE LEFT AND RIGHT
                            rem       AND REVERSE AT SIDES
 if ballx(a)>640 or ballx(a)<0 balls(a)=-balls(a)
next a:rem                               MOVE TO NEXT BALL
return



label draw
'########################
'## Draw The Magnet!!! ##
'########################
b=1
setrgb 1,255,200+fl,200+fl
  line tx(1),ty(1) to tx(2),ty(2)
   line tx(2),ty(2) to tx(3),ty(3)
    line tx(3),ty(3) to tx(4),ty(4)
     line tx(1),ty(1) to tx(4),ty(4)
      line tx(5),ty(5) to tx(6),ty(6)
       line tx(6),ty(6) to tx(7),ty(7)
  line tx(7),ty(7) to tx(8),ty(8)
   line tx(5),ty(5) to tx(8),ty(8)
    line tx(1),ty(1) to tx(5),ty(5)
     line tx(2),ty(2) to tx(6),ty(6)
      line tx(3),ty(3) to tx(7),ty(7)
       line tx(4),ty(4) to tx(8),ty(8)
  line tx(9),ty(9) to tx(10),ty(10)
   line tx(10),ty(10) to tx(11),ty(11)
    line tx(11),ty(11) to tx(12),ty(12)
     line tx(12),ty(12) to tx(9),ty(9)
      line tx(13),ty(13) to tx(14),ty(14)
       line tx(14),ty(14) to tx(15),ty(15)
  line tx(15),ty(15) to tx(16),ty(16)
   line tx(16),ty(16) to tx(13),ty(13)
    line tx(9),ty(9) to tx(13),ty(13)
     line tx(10),ty(10) to tx(14),ty(14)
      line tx(11),ty(11) to tx(15),ty(15)
       line tx(12),ty(12) to tx(16),ty(16)
       setrgb 1,255+fl,50,50

  line tx(17),ty(17) to tx(18),ty(18)
   line tx(18),ty(18) to tx(19),ty(19)
    line tx(19),ty(19) to tx(20),ty(20)
     line tx(20),ty(20) to tx(21),ty(21)
      line tx(21),ty(21) to tx(22),ty(22)
       line tx(23),ty(23) to tx(24),ty(24)
  line tx(24),ty(24) to tx(25),ty(25)
   line tx(25),ty(25) to tx(26),ty(26)
    line tx(26),ty(26) to tx(27),ty(27)
     line tx(27),ty(27) to tx(28),ty(28)
      line tx(18),ty(18) to tx(24),ty(24)
       line tx(19),ty(19) to tx(25),ty(25)
  line tx(20),ty(20) to tx(26),ty(26)
   line tx(21),ty(21) to tx(27),ty(27)
    line tx(3),ty(3) to tx(29),ty(29)
     line tx(29),ty(29) to tx(30),ty(30)
      line tx(30),ty(30) to tx(31),ty(31)
       line tx(31),ty(31) to tx(32),ty(32)
  line tx(32),ty(32) to tx(11),ty(11)
   line tx(7),ty(7) to tx(33),ty(33)
    line tx(33),ty(33) to tx(34),ty(34)
     line tx(34),ty(34) to tx(35),ty(35)
      line tx(35),ty(35) to tx(36),ty(36)
       line tx(36),ty(36) to tx(15),ty(15)
  line tx(33),ty(33) to tx(29),ty(29)
   line tx(34),ty(34) to tx(30),ty(30)
    line tx(35),ty(35) to tx(31),ty(31)
     line tx(36),ty(36) to tx(32),ty(32)
return

label 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))+320
  yy=size*(yy/((zz/70)+1))+256
  tx(a)=xx
  ty(a)=yy
  tz(a)=zz
 next a
xr=xr+5
yr=yr+1
zr=zr+3
if xr>720 xr=xr-720
if yr>720 yr=yr-720
if zr>720 zr=zr-720
return


label initialise
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' This Sub-Routine Initialises The Program.
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'######################
'## Open Gfx Screen! ##
'######################
open window 640,512
'#####################################
'## Define the necessary variables! ##
'#####################################
size=10: rem how big do you want it?
dw=1 : Rem            Double buffering Variable
polys=38 : Rem        The amount of polygons in the object
dim x(polys) : Rem  Original X co-ordinate store
dim y(polys) : Rem  Original Y co-ordinate store
dim z(polys) : Rem  Original Z co-ordinate store
dim tx(polys) : Rem Transformed  X co-ordinate store
dim ty(polys) : Rem Transformed Y co-ordinate store
dim tz(polys) : Rem Transformed Z co-ordinate store
'##########################
'## Define Sine Tables!! ##
'##########################
 dim cs(720)
 dim sn(720)
 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:rem                      MAXIMUM BALLS TO HAVE
 dim ballx(bbs):rem              DEFINE BALL X POS()
 dim bally(bbs):rem              DEFINE BALL Y POS()
 dim balls(bbs):rem              DEFINE BALL SPEED()
 dim ballg(bbs):rem              DEFINE BALL GRAVITY()
'----------Define Ball Positions, Speed + Gravity---------
 for a=1 to bbs:rem              DO ALL BALLS ONE BY ONE
   bally(a)=507:rem              BALL Y POS AT BOTTOM
   ballx(a)=ran(640):rem         SET RANDOM BALL X POS
   balls(a)=int(ran(4))+1:rem    SET RANDOM BALL SPEED
   ballg(a)=0:rem                BALL GRAVITY 0
 next a:rem                      MOVE TO NEXT BALL



'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'   The Object Description As Data!
'   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




