'            ** No Precalculation Here!!! **
'   @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'   @ This Demo Was Coded By Mr. Shockwave (C) 2002!! @
'   @-===============================================-@
'   @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'                         Notes:
'
'     This technical demo was inspired by Xalthorn.
' I took the object from my magnetic mayhem, he made me
' wonder if it was possible to depth sort my magnet and
' keep it running smoothly.. Well, I found a way but it's
' not a depth sort, I've used the hidden line algorithm 
' and a bit of lateral thought.
'
' The Object Has 30 faces made from 60 triangles.
'
' I've included a debug mode, set it by changing the db 
' variable to 1. The program will display the vertices,
' vertice numbers, filled object and surface normals.
'
' Have fun with it!
'
' Greetings to all 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
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'=========================================================
'     Set The db variable to 1 to see the debug mode.
'=========================================================

db=0

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
gosub rotate
setrgb 2,0,0,0
setrgb 3,0,0,0
gosub magnet
if db=1 gosub debug
setrgb 1,0,0,0
text 323,259,"NO PRECALCULATION HERE.. BY SHOCKWAVE!","cc"
setrgb 1,255,255,255
text 320,256,"NO PRECALCULATION HERE.. BY SHOCKWAVE!","cc"


'#######################################################
'## The Main Loop. These Calls Are Repeated Until (X) ##
'#######################################################
until (and(peek("port1"),16384)<>0)
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
exit
label debug
'########################
'## Draw The Magnet!!! ##
'########################
setrgb 1,255,200,200
  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)
    
  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)
for a=1 to polys
setrgb 1,255,255,255
 rect tx(a)-2,ty(a)-2 to tx(a)+2,ty(a)+2
 text tx(a),ty(a),"V"+str$(a),"cc"

next a

return


label magnet
'inner curves
     r=255 : g=0 : b=0
     f1=29 : f2=30 : f3=34 : f4=33
    gosub draw
    f1=36 : f2=35 : f3=31 : f4=32
    gosub draw

if tz(1)>tz(9) gosub leg1
if tz(1)<=tz(9) gosub leg2

    r=255 : g=0 : b=0
    f1=30 : f2=31 : f3=35 : f4=34
    gosub draw
    f1=19 : f2=25 : f3=26 : f4=20
    gosub draw
    f1=25 : f2=19 : f3=18 : f4=24
    gosub draw
    f1=26 : f2=25 : f3=34 : f4=35
    gosub draw
    f1=18 : f2=19 : f3=30 : f4=29
    gosub draw
    f1=25 : f2=24 : f3=33 : f4=34
    gosub draw
    f1=20 : f2=26 : f3=27: f4=21
    gosub draw
    f1=27 : f2=26 : f3=35 : f4=36
    gosub draw
    f1=30 : f2=19 : f3=20 : f4=31
    gosub draw
    f1=32 : f2=31 : f3=20 : f4=21
    gosub draw




if tz(1)<=tz(9) gosub leg1
if tz(1)>tz(9) gosub leg2

return

label leg1
    r=100 : g=100 : b=100
    f1=1 : f2=2 : f3=6 : f4=5
    gosub draw
    f1=3 : f2=7 : f3=6 : f4=2
    gosub draw
    f1=5 : f2=6 : f3=7 : f4=8
    gosub draw
    f1=1 : f2=4 : f3=3 : f4=2
    gosub draw
    f1=8 : f2=4 : f3=1 : f4=5
    gosub draw

    r=255 : g=0 : b=0
    f1=24 : f2=18 : f3=4 : f4=8
    gosub draw
    f1=7 : f2=3 : f3=29 : f4=33
    gosub draw
    f1=8 : f2=7 : f3=33 : f4=24
    gosub draw
    f1=18 : f2=29 : f3=3 : f4=4
    gosub draw



return

label leg2
'leg 2


    r=255 : g=0 : b=0
    f1=15 : f2=16 : f3=27 : f4=36
    gosub draw
    f1=36 : f2=32 : f3=11 : f4=15
    gosub draw
    f1=12 : f2=11 : f3=32 : f4=21
    gosub draw
    f1=16 : f2=12 : f3=21 : f4=27
    gosub draw


    r=100 : g=100 : b=100
    f1=15 : f2=11 : f3=10 : f4=14
    gosub draw
    f1=14 : f2=13 : f3=16 : f4=15
    gosub draw
    f1=9 : f2=10 : f3=11 : f4=12
    gosub draw
    f1=10 : f2=9 : f3=13 : f4=14
    gosub draw
    f1=13 : f2=9 : f3=12 : f4=16
    gosub draw

 
return


label draw

'################################
'## Draw A Face Of The Magnet! ##
'################################

  vx1= tx(f1)-tx(f2)
  vy1= ty(f1)-ty(f2)
  vx2= tx(f3)-tx(f2)
  vy2= ty(f3)-ty(f2)
  if  (vx1*vy2-vx2*vy1)<0 then
xc=(tx(f1)+tx(f2)+tx(f3)+tx(f4))/4
yc=(ty(f1)+ty(f2)+ty(f3)+ty(f4))/4
light=-(tz(f1)+tz(f2)+tz(f3)+tz(f4))*1.2
setrgb 1,r+light,g+light,b+light
gtriangle tx(f1),ty(f1) to tx(f2),ty(f2) to tx(f3),ty(f3)
gtriangle tx(f1),ty(f1) to tx(f4),ty(f4) to tx(f3),ty(f3)
if db=1 then
setrgb 1,100,255,100
text xc,yc,"N"+str$(int(light)),"cc"
fi
fi
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+3
yr=yr+1
zr=zr+1
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=6: rem how big do you want it?
dw=1 : Rem            Double buffering Variable
polys=36 : 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)*5
z(a)=z(a)*8
y(a)=y(a)*4
next a
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'   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

return







