'                %%%%%%%%%%%%%%%%%%%%%%%%%%
'                %% The Paracetamol Demo %%
'                %%%%%%%%%%%%%%%%%%%%%%%%%%
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'%%     Programmed In May 2002 (c) By Mr. Shockwave     %%
'%%     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~     %%
'%%           You can Contact Me Via Email On:          %%
'%%             SHOCKWAVE@PS2-YABASIC.CO.UK             %%
'%%                Or On The Forums At:                 %%
'%%                 WWW.Yabasic.co.uk                   %%
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'            My Back Catalogue Is Available On:
'            ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'               +---------------------------+
'               |WWW.PS2-YABASIC.CO.UK (all)|
'               |WWW.YABASIC.CO.UK    (most)|
'               |WWW.EVILSOFT.S5.COM  (some)|
'               |WWW.CODEJUNKIES.COM  (some)|
'               +---------------------------+
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'Program Notes:     This demo started life as a wire frame
'3D routine that I developed to model a simple 3D cube....
'My previous 3D had depth sorted faces, this one uses a
'hidden line algorithm that checks if the points of a 
'given face are in clockwise or anticlockwise order to see
'if they should be drawn....   I Added some light sourcing
'to the cube, and borrowed an idea from one of my other 
'demos (the dotcube demo) to calculate extra vertices from
'the original points.. This routine creates an extra 12
'vertices per face in real time from the original data of
'8 vertices.. This means that I can have a more detailed
'object (although not 100% accurate) without having to
'rotate the extra data.. To define it in the conventional
'way would mean that the object would have a total of
'40 vertices which would be 100% accurate but slow.
'I found that because of the speed savings I have made, it
'was possible to add lots of visual glitz.
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'#########################################################

gosub initialise:rem                     Set Everything Up
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'=========================================================
'                     Main Loop Begins
'=========================================================
repeat

setdrawbuf dw:rem                            Double Buffer
dw=1-dw
setdispbuf dw
   setrgb 1,40,130,20 :rem          Set Background Colours
   setrgb 2,80,20,140
   setrgb 3,130,20,30

    gtriangle 0,0 to 640,512 to 0,512:rem   Draw Backround
    setrgb 3,40,30,20
    gtriangle 0,0 to 640,512 to 640,0

    gosub rotate: rem                Call Rotation Routine
'---------------------------------------------------------
'                    Draw Inside Faces
'---------------------------------------------------------
setrgb 2,10,30,10
setrgb 3,10,30,10

    f1=1 : f2=2 : f3=3 : f4=4:rem                   Face 1
    gosub draw:rem                             Draw Face 1
    f1=5 : f2=8 : f3=7 : f4=6:rem                   Face 2
    gosub draw:rem                             Draw Face 2
    f1=6 : f2=2 : f3=1 : f4=5:rem                   Face 3
    gosub draw:rem                             Draw Face 3
    f1=8 : f2=4 : f3=3 : f4=7:rem                   Face 4
    gosub draw:rem                             Draw Face 4
    f1=2 : f2=6 : f3=7 : f4=3:rem                   Face 5
    gosub draw:rem                             Draw Face 5
    f1=8 : f2=5 : f3=1 : f4=4:rem                   Face 6
    gosub draw:rem Draw                             Face 6
'---------------------------------------------------------
'                   Draw Outside Faces
'---------------------------------------------------------

    f1=1 : f2=2 : f3=3 : f4=4:rem                   Face 1
    gosub draw2:rem                            Draw Face 1
    f1=5 : f2=8 : f3=7 : f4=6:rem                   Face 2
    gosub draw2:rem                            Draw Face 2
    f1=6 : f2=2 : f3=1 : f4=5:rem                   Face 3
    gosub draw2:rem                            Draw Face 3
    f1=8 : f2=4 : f3=3 : f4=7:rem                   Face 4
    gosub draw2:rem                            Draw Face 4
    f1=2 : f2=6 : f3=7 : f4=3:rem                   Face 5
    gosub draw2:rem                            Draw Face 5
    f1=8 : f2=5 : f3=1 : f4=4:rem                   Face 6
    gosub draw2:rem                            Draw Face 6
'---------------------------------------------------------
'                     Display Text
'---------------------------------------------------------
  setrgb 1,0,0,0
  text 322,62,"THE PARACETAMOL DEMO BY SHOCKWAVE","cc"
  text scx+2,257,mid$(s$,p,67)
   setrgb 1,255,255,255
   text 320,60,"THE PARACETAMOL DEMO BY SHOCKWAVE","cc"
   text scx,255,mid$(s$,p,67)
'---------------------------------------------------------
'                     Scroller Code
'---------------------------------------------------------
  scx=scx-1
   if scx<-10 then
    scx=scx+10
    p=p+1
    if p>len(s$) p=0
   fi

gosub writer

until (and(peek("port1"),16384)<>0)
'=========================================================
'                     Main Loop Ends
'=========================================================

exit :rem                                     Exit Program

'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'                      Subroutines;
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

'=========================================================
'     This Subroutine Does The Bouncy Greetings Thing;
'=========================================================

label writer
  mm=mm+.05
  if mm>7 then
   mm=0
   mc=mc+1
   if mc>messages mc=1
  fi
  setrgb 1,255,255,255
  text 320,522+70*sin(mm),m$(mc),"cc"
return

'=========================================================
'Subroutine To Draw One Inner Face From 4 Passed Points
'This Will Only Draw The Face If It Is Behind.
'=========================================================
label draw
'#########################################################
'  Calculate Poly Positions And Draw One Complete Face;
'#########################################################

'---------------------------------------------------------
'            Hidden Line Removal Algorithm;
'---------------------------------------------------------
  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
    
'---------------------------------------------------------
'                   Lightsource Colour;
'---------------------------------------------------------
  light=(tz(1)+tz(f2)+tz(f3)+tz(f4)*3)
'  light=light+50
  setrgb 1,0,0,light
'---------------------------------------------------------
'            Draw Background of face (blue);
'---------------------------------------------------------
  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)
'---------------------------------------------------------
'         Calculate Non Defined Co-Ordinates.
'---------------------------------------------------------
  xt=(tx(f1)+tx(f2))/2:rem            Find Top Centre X
  yt=(ty(f1)+ty(f2))/2:rem            Find Top Centre y
  cx(1)=(xt+tx(f1))/2:rem             Calculate xpos 1
  cy(1)=(yt+ty(f1))/2:rem             Calculate Ypos 1
  cx(2)=(xt+tx(f2))/2:rem             Calculate xpos 2 
  cy(2)=(yt+ty(f2))/2:rem             Calculate Ypos 2
   xt=(tx(f2)+tx(f3))/2:rem           Find side Centre X
   yt=(ty(f2)+ty(f3))/2:rem           Find side Centre y
   cx(3)=(xt+tx(f2))/2:rem            Calculate xpos 3
   cy(3)=(yt+ty(f2))/2:rem            Calculate Ypos 3
   cx(4)=(xt+tx(f3))/2:rem            Calculate xpos 4
   cy(4)=(yt+ty(f3))/2:rem            Calculate Ypos 4
    xt=(tx(f3)+tx(f4))/2:rem          Find bottom Centre X
    yt=(ty(f3)+ty(f4))/2:rem          Find bottom Centre y
    cx(5)=(xt+tx(f3))/2:rem           Calculate xpos 5
    cy(5)=(yt+ty(f3))/2:rem           Calculate Ypos 5
    cx(6)=(xt+tx(f4))/2:rem           Calculate xpos 6
    cy(6)=(yt+ty(f4))/2:rem           Calculate Ypos 6
     xt=(tx(f4)+tx(f1))/2:rem         Find side Centre X
     yt=(ty(f4)+ty(f1))/2:rem         Find side Centre y
     cx(7)=(xt+tx(f4))/2:rem          Calculate xpos 7
     cy(7)=(yt+ty(f4))/2:rem          Calculate Ypos 7
     cx(8)=(xt+tx(f1))/2:rem          Calculate xpos 8
     cy(8)=(yt+ty(f1))/2:rem          Calculate Ypos 8
   xt=(cx(1)+cx(6))/2:rem        Find side offset Centre 1
   yt=(cy(1)+cy(6))/2:rem        Find side offset Centre 1
   cx(9)=(xt+cx(1))/2:rem             Calculate xpos 9
   cy(9)=(yt+cy(1))/2:rem             Calculate Ypos 9
   cx(10)=(xt+cx(6))/2:rem            Calculate xpos 10
   cy(10)=(yt+cy(6))/2:rem            Calculate Ypos 10
     xt=(cx(2)+cx(5))/2:rem      Find side offset Centre 2
     yt=(cy(2)+cy(5))/2:rem      Find side offset Centre 2
     cx(11)=(xt+cx(2))/2:rem          Calculate xpos 11
     cy(11)=(yt+cy(2))/2:rem          Calculate Ypos 11
     cx(12)=(xt+cx(5))/2:rem          Calculate xpos 12
     cy(12)=(yt+cy(5))/2:rem          Calculate Ypos 12
'---------------------------------------------------------
'                  Draw Red Polygons;
'---------------------------------------------------------
 setrgb 1,light,0,0
gtriangle tx(f1),ty(f1) to cx(1),cy(1) to cx(9),cy(9)
gtriangle tx(f1),ty(f1) to cx(9),cy(9) to cx(8),cy(8)
gtriangle tx(f2),ty(f2) to cx(2),cy(2) to cx(11),cy(11)
gtriangle tx(f2),ty(f2) to cx(11),cy(11) to cx(3),cy(3)
gtriangle tx(f3),ty(f3) to cx(4),cy(4) to cx(12),cy(12)
gtriangle tx(f3),ty(f3) to cx(12),cy(12) to cx(5),cy(5)
gtriangle tx(f4),ty(f4) to cx(6),cy(6) to cx(10),cy(10)
gtriangle tx(f4),ty(f4) to cx(10),cy(10) to cx(7),cy(7)

'---------------------------------------------------------
'               Draw The Green Polygons;
'---------------------------------------------------------
 setrgb 1,0,light,0
gtriangle cx(9),cy(9) to cx(10),cy(10) to cx(11),cy(11)
gtriangle cx(12),cy(12) to cx(11),cy(11) to cx(10),cy(10)
'---------------------------------------------------------
'                   Draw Black Lines
'---------------------------------------------------------
  setrgb 1,0,0,0
   line tx(f1),ty(f1) to tx(f2),ty(f2)
   line tx(f2),ty(f2) to tx(f3),ty(f3)
   line tx(f3),ty(f3) to tx(f4),ty(f4)
   line tx(f4),ty(f4) to tx(f1),ty(f1)
   line cx(1),cy(1) to cx(6),cy(6)
   line cx(2),cy(2) to cx(5),cy(5)
   line cx(3),cy(3) to cx(8),cy(8)
   line cx(4),cy(4) to cx(7),cy(7)
fi
return

'=========================================================
'Subroutine To Draw One Outer Face From 4 Passed Points
'This Wil Only Draw The Face If It Is In Front.
'=========================================================

label draw2

'#########################################################
'  Calculate Poly Positions And Draw One Complete Face;
'#########################################################

'---------------------------------------------------------
'            Hidden Line Removal Algorithm;
'---------------------------------------------------------
  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
    
'---------------------------------------------------------
'                   Lightsource Colour;
'---------------------------------------------------------
  light=-(tz(1)+tz(f2)+tz(f3)+tz(f4))*5
  light=light+50
  setrgb 1,0,0,light
'---------------------------------------------------------
'            Draw Background of face (blue);
'---------------------------------------------------------
'  fill triangle tx(f1),ty(f1) to tx(f2),ty(f2) to tx(f3),ty(f3)
'  triangle tx(f1),ty(f1) to tx(f4),ty(f4) to tx(f3),ty(f3)
'---------------------------------------------------------
'         Calculate Non Defined Co-Ordinates.
'---------------------------------------------------------
  xt=(tx(f1)+tx(f2))/2:rem           Find Top Centre X
  yt=(ty(f1)+ty(f2))/2:rem           Find Top Centre y
  cx(1)=(xt+tx(f1))/2:rem            Calculate xpos 1
  cy(1)=(yt+ty(f1))/2:rem            Calculate Ypos 1
  cx(2)=(xt+tx(f2))/2:rem            Calculate xpos 2 
  cy(2)=(yt+ty(f2))/2:rem            Calculate Ypos 2
   xt=(tx(f2)+tx(f3))/2:rem          Find side Centre X
   yt=(ty(f2)+ty(f3))/2:rem          Find side Centre y
   cx(3)=(xt+tx(f2))/2:rem           Calculate xpos 3
   cy(3)=(yt+ty(f2))/2:rem           Calculate Ypos 3
   cx(4)=(xt+tx(f3))/2:rem           Calculate xpos 4
   cy(4)=(yt+ty(f3))/2:rem           Calculate Ypos 4
    xt=(tx(f3)+tx(f4))/2:rem         Find bottom Centre X
    yt=(ty(f3)+ty(f4))/2:rem         Find bottom Centre y
    cx(5)=(xt+tx(f3))/2:rem          Calculate xpos 5
    cy(5)=(yt+ty(f3))/2:rem          Calculate Ypos 5
    cx(6)=(xt+tx(f4))/2:rem          Calculate xpos 6
    cy(6)=(yt+ty(f4))/2:rem          Calculate Ypos 6
     xt=(tx(f4)+tx(f1))/2:rem        Find side Centre X
     yt=(ty(f4)+ty(f1))/2:rem        Find side Centre y
     cx(7)=(xt+tx(f4))/2:rem         Calculate xpos 7
     cy(7)=(yt+ty(f4))/2:rem         Calculate Ypos 7
     cx(8)=(xt+tx(f1))/2:rem         Calculate xpos 8
     cy(8)=(yt+ty(f1))/2:rem         Calculate Ypos 8
   xt=(cx(1)+cx(6))/2:rem        Find side offset Centre 1
   yt=(cy(1)+cy(6))/2:rem        Find side offset Centre 1
   cx(9)=(xt+cx(1))/2:rem            Calculate xpos 9
   cy(9)=(yt+cy(1))/2:rem            Calculate Ypos 9
   cx(10)=(xt+cx(6))/2:rem           Calculate xpos 10
   cy(10)=(yt+cy(6))/2:rem           Calculate Ypos 10
     xt=(cx(2)+cx(5))/2:rem      Find side offset Centre 2
     yt=(cy(2)+cy(5))/2:rem      Find side offset Centre 2
     cx(11)=(xt+cx(2))/2:rem         Calculate xpos 11
     cy(11)=(yt+cy(2))/2:rem         Calculate Ypos 11
     cx(12)=(xt+cx(5))/2:rem         Calculate xpos 12
     cy(12)=(yt+cy(5))/2:rem         Calculate Ypos 12
'---------------------------------------------------------
'                  Draw Red Polygons;
'---------------------------------------------------------
 setrgb 1,light,0,0
gtriangle tx(f1),ty(f1) to cx(1),cy(1) to cx(9),cy(9)
gtriangle tx(f1),ty(f1) to cx(9),cy(9) to cx(8),cy(8)
gtriangle tx(f2),ty(f2) to cx(2),cy(2) to cx(11),cy(11)
gtriangle tx(f2),ty(f2) to cx(11),cy(11) to cx(3),cy(3)
gtriangle tx(f3),ty(f3) to cx(4),cy(4) to cx(12),cy(12)
gtriangle tx(f3),ty(f3) to cx(12),cy(12) to cx(5),cy(5)
gtriangle tx(f4),ty(f4) to cx(6),cy(6) to cx(10),cy(10)
gtriangle tx(f4),ty(f4) to cx(10),cy(10) to cx(7),cy(7)

'---------------------------------------------------------
'                 Draw The Green Polygons;
'---------------------------------------------------------
 setrgb 1,0,light,0
gtriangle cx(9),cy(9) to cx(11),cy(11) to cx(10),cy(10)
gtriangle cx(12),cy(12) to cx(11),cy(11) to cx(10),cy(10)
'---------------------------------------------------------
'                      Black Lines
'---------------------------------------------------------
  setrgb 1,40,110,150
   line tx(f1),ty(f1) to tx(f2),ty(f2)
   line tx(f2),ty(f2) to tx(f3),ty(f3)
   line tx(f3),ty(f3) to tx(f4),ty(f4)
   line tx(f4),ty(f4) to tx(f1),ty(f1)
   line cx(1),cy(1) to cx(6),cy(6)
   line cx(2),cy(2) to cx(5),cy(5)
   line cx(3),cy(3) to cx(8),cy(8)
   line cx(4),cy(4) to cx(7),cy(7)
fi

return

'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'This Subroutine Rotates The Eight Corner Points About
'Thier X,Y and Z Axis Using Matrices And Applys A
'Perspective Formula To The Transformed Points.
'All Logical Points are derived from these 8.
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
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/50)+1))+320
  yy=size*(yy/((zz/50)+1))+256
  tx(a)=xx
  ty(a)=yy
  tz(a)=zz
 next a
'##########################
'## Incriment Rotations! ##
'##########################
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.
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'---------------------------------------------------------
'                    Scroll Variables;
'---------------------------------------------------------
s$="                                                                       "
'---------------------------------------------------------
s$=s$+"CAN YOU GUESS WHY THIS IS CALLED THE PARACETAMOL "
s$=s$+"DEMO???    NO???  WELL WATCH IT FOR HALF AN HOUR "
s$=s$+"AND YOU'LL FIND OUT THE HARD WAY....    GUARANTEED"
s$=s$+" TO CAUSE A BLINDING HEADACHE... I TRIED TO MAKE "
s$=s$+"SOMETHING COLOURFUL. I THINK THAT I HAVE SUCCEEDED"
s$=s$+" IN THIS DEMO....   GREETINGS TO ALL THE PEEPS "
s$=s$+"WHO KNOW ME, I HAVE TO GO NOW.....  SEE YOU AGAIN "
s$=s$+"IN MY NEXT INSANE DEMO.....  CHECK OUT: "
s$=s$+"WWW.PS2-YABASIC.CO.UK..."
p=0
scx=0

'---------------------------------------------------------
'                   Writer Variables;
'---------------------------------------------------------
  messages=24:REM                      How Many Greetings?
  mc=1
  dim m$(messages):REM                  Set Space For Them
   for a=1 to messages:REM                    Read Them In
    read m$(a)
   next a

'######################
'## Open Gfx Screen! ##
'######################
open window 640,512
'#####################################
'## Define the necessary variables! ##
'#####################################
size=20: rem                       how big do you want it?
dw=1 : Rem                       Double buffering Variable
polys=8 : Rem         The amount of vertices 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
dim cx(12): Rem                   Storage For Calculated X
dim cy(12): Rem                   Storage For Calculated Y

'##########################
'## 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)
next a

data "GREETINGS TO:","XALTHORN"
data "DOCTOR","DOUGAL"
data "JINX","JOMORROW"
data "SNAKEDOGG","JIM SHAW"
data "ASIV","LIQUID"
data "DEMONEYE","ELL"
data "YALUPINE","YABASIC GURUS"
data "VERYBASIC","MR FURIOUS"
data "STATIC GERBIL","DREW"
data "JACOB BUSBY","MASTER TONBERRY"
data "BALROQ","DAYWALKER"
data "SORRY IF I FORGOT YOU!"," "
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'   The Object Description As Data!
'   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
return





