'              -= TeleVisual By Shockwave =-
'                 ~~~~~~~~~~~~~~~~~~~~~~~
'               A 3D Demo with a novel twist.
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'    PLEASE TAKE THE TIME TO WATCH THIS DEMO UNTIL THE
' SECOND SCROLL STARTS OTHERWISE YOU'LL MISS OUT ON MOST
' OF THE EFFECTS... AND THERE ARE SOME CRAZY ONES ON HERE.
' OH YES.
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'%%     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)|
'               +---------------------------+
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'=========================================================
'LETS GO!! ;
'=========================================================

debug=0:rem                   Set this to 1 for info mode.

gosub initialise
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'=========================================================
'MAIN LOOP STARTS ;
'=========================================================
count=0

repeat
gons=2
'---------------------------------------------------------
'DOUBLE BUFFER;
'---------------------------------------------------------

  setdrawbuf dw
  dw=1-dw
  setdispbuf dw

'---------------------------------------------------------
'EVENT TIMING;
'---------------------------------------------------------

  if count<2500 count=count+1
  if count=2500 size=size+.3*sin(mm)

'---------------------------------------------------------
'BACKGROUND COLOURS;
'---------------------------------------------------------

     rd=30*sin(mm/4)
     bl=30*sin(mm/3)
     gr=30*sin(mm/2)

     setrgb 1,40+(rd),30,20
     setrgb 2,0,20+(bl),40
     setrgb 3,80,20,gr

     gtriangle 0,0 to 640,512 to 0,512
     setrgb 3,40,30,20
     gtriangle 0,0 to 640,512 to 640,0

     mm=mm+.05

'---------------------------------------------------------
'MOVE STARS; 
'---------------------------------------------------------

  for a=polys+1 to polys+stars
    x(a)=x(a)+s(a)
    if x(a)>13 x(a)=-13
  next a

'---------------------------------------------------------
'ROTATE CUBE AND TELLY;
'---------------------------------------------------------

    gosub rotate2
    gosub rotate

'---------------------------------------------------------
'DRAW TELEVISION BODY;
'---------------------------------------------------------

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

'---------------------------------------------------------
'DRAW TELEVISION SCREEN;
'---------------------------------------------------------

    scrn=1
    r=-50 : g=-50 : b=-50
    f1=12 : f2=11 : f3=10 : f4=9
    gosub draw
    scrn=0

'---------------------------------------------------------
'SCROLLTEXT;
'---------------------------------------------------------

   setrgb 1,0,0,0
   text scx+2,258,mid$(s$,p,67)
   setrgb 1,255,255,255
   text scx,256,mid$(s$,p,67)

   scx=scx-2
   if scx<-10 then
     scx=scx+10
     p=p+1
     if p>len(s$) p=0
   fi
'---------------------------------------------------------
'Debug Mode;
'---------------------------------------------------------

if debug=1 then
text 320,20,"POLYGONS DRAWN THIS FRAME:"+str$(gons),"cc"
fi

until (and(peek("port1"),16384)<>0)
'=========================================================
'MAIN LOOP HAS ENDED ;
'=========================================================

exit

'=========================================================
'DRAW ONE FACE OF THE TELEVISION ;
'=========================================================

label draw

'---------------------------------------------------------
'DRAW A FACE OF THE TELLY;
'---------------------------------------------------------

'---------------------------------------------------------
'HIDDEN SURFACE 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

'---------------------------------------------------------
'DETERMINE COLOUR;
'---------------------------------------------------------

   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))*5
   setrgb 1,r+light,g+light,b+light

'---------------------------------------------------------
'DRAW THE RECTANGLE (FROM TWO TRIANGLES);
'---------------------------------------------------------

fill triangle tx(f1),ty(f1) to tx(f2),ty(f2) to tx(f3),ty(f3)
fill triangle tx(f1),ty(f1) to tx(f4),ty(f4) to tx(f3),ty(f3)

 gons=gons+2
'---------------------------------------------------------
'IF SCREEN IS VISIBLE DRAW THE CUBE+STARS;
'---------------------------------------------------------

  if scrn=1 then
    gosub starfield
    r=120 : g=60 : b=60
    f1=13 : f2=14 : f3=15 : f4=16
    gosub cube
    r=120 : g=60 : b=60
    f1=20 : f2=19 : f3=18 : f4=17
    gosub cube
    r=60 : g=120 : b=60
    f1=14 : f2=13 : f3=17 : f4=18
    gosub cube
    r=60 : g=120 : b=60
    f1=19 : f2=20 : f3=16 : f4=15
    gosub cube
    r=60 : g=60 : b=120
    f1=20 : f2=17 : f3=13 : f4=16
    gosub cube
    r=60 : g=60 : b=120
    f1=14 : f2=18 : f3=19 : f4=15
    gosub cube
  fi
fi
return

'=========================================================
'CALCULATE RAW STAR POSITIONS ;
'=========================================================

label starfield
setrgb 1,255,255,255
for a=polys+1 to polys+stars
  fill rect tx(a),ty(a) to tx(a)+2,ty(a)+1
next a

gons=gons+17

return

'=========================================================
'DRAW THE CUBE!! ;
'=========================================================

label cube

'---------------------------------------------------------
'DRAWS ONE FACE OF THE CUBE;
'---------------------------------------------------------

'---------------------------------------------------------
'HIDEN LINE 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

'---------------------------------------------------------
'DRAW THE FACE;
'---------------------------------------------------------

setrgb 1,r,g,b
fill triangle tx(f1),ty(f1) to tx(f2),ty(f2) to tx(f3),ty(f3)
fill triangle tx(f1),ty(f1) to tx(f4),ty(f4) to tx(f3),ty(f3)

gons=gons+2

fi
return

'=========================================================
'ROTATE AND SCALE IT ALL ;
'=========================================================

label rotate
'###############################################
'## Rotate And Scale Each Point! Store Result ##
'###############################################
 for a=1 to polys+stars
 
  x1=x(a)
  y1=y(a)
  z1=z(a)
'##################
'## Flaten Cube; ##
'##################
if a>12 and a<=20 then
  x1=tx(a)
  y1=ty(a)
  z1=-4
fi
  
'######################
'## 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
if count>600 and count<700 size=size-.15
if peek("port1")=0 then
if count>1000 xr=xr+3
if count>1500 yr=yr+2
if count>1750 zr=zr+1
fi
if count=2499 then s$=t$: t$="" : p=0: fi
if xr>720 xr=xr-720
if yr>720 yr=yr-720
if zr>720 zr=zr-720
return


'=========================================================
'ROTATE AND SCALE THE CUBE ;
'=========================================================

label rotate2
'###############################################
'## Rotate And Scale Each Point! Store Result ##
'###############################################
 for a=13 to 20
  x1=x(a)
  y1=y(a)
  z1=z(a)
  
'######################
'## X,Y,Z rotations! ##
'######################
  xx=x1
  yy=y1*cs(xr2)+z1*sn(xr2)
  zz=z1*cs(xr2)-y1*sn(xr2)
  y1=yy
  x1=xx*cs(yr2)-zz*sn(yr2)
  z1=xx*sn(yr2)+zz*cs(yr2)
  zz=z1
  xx=x1*cs(zr2)-y1*sn(zr2)
  yy=x1*sn(zr2)+y1*cs(zr2)


'########################
'## Apply Perspective! ##
'########################
  xx=(xx/((zz/50)+1))
  yy=(yy/((zz/50)+1))
  tx(a)=xx
  ty(a)=yy
  tz(a)=zz
 next a
 xr2=xr2+5
 yr2=yr2+4
 zr2=zr2+3
if xr2>720 xr2=xr2-720
if yr2>720 yr2=yr2-720
if zr2>720 zr2=zr2-720
return

'=========================================================
'SET EVERYTHING UP! ;
'=========================================================

label initialise
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' This Sub-Routine Initialises The Program.
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

'---------------------------------------------------------
'INTRODUCTION SCROLL;
'---------------------------------------------------------
s$="                                                                      "
'---------------------------------------------------------
s$=s$+"WHAT'S THIS LAME PIECE OF CRAP? A SHAKY STARFIELD "
s$=s$+"AND A ROPEY 3D VECTOR CUBE?                    "
s$=s$+"   HANG ON, THIS IS SUPOSED TO BE A SHOCKWAVE DEMO"
s$=s$+"...  AND THINGS ARE ABOUT TO GET SERIOUS!!!!!     "
s$=s$+"                                             "
s$=s$+"... *VERY* SERIOUS IN FACT!!!             "
s$=s$+"        HAHA!  HOW D'YA "
s$=s$+"LIKE IT NOW THEN EH???         "
S$=S$+"          WELL, WHAT ABOUT THIS??????            "
s$=s$+"ONLY SHOCKWAVE MAKES IT POSSIBLE IN YABASIC!!!!  "
s$=s$+"                                             "
'---------------------------------------------------------
'MAIN SCROLL;
'---------------------------------------------------------
t$="                                                                      "
'---------------------------------------------------------
t$=t$+"THIS IS A NICE LITTLE BIT OF CODE, DID I FOOL YOU "
t$=t$+" FOR A MOMENT???   OH COME ON, GET REAL, I STOPPED"
t$=t$+" RELEASING SIMPLE 3D STUFF LAST YEAR, WELCOME TO "
t$=t$+"THE NEW ERA OF SHOCKWAVE DEMOS!        THINGS ARE "
t$=t$+"LOOKING UP... I GOT THE IDEA FOR THIS BY LOOKING "
t$=t$+"AT MY TELEVISION FROM DIFFERENT ANGLES SO I "
t$=t$+"THOUGHT, WHAT THE HELL, LETS MODEL IT AND SPIN IT!"
t$=t$+"     THIS IS THE RESULT... THE ONLY TRICKY BIT "
t$=t$+"WAS WRAPPING THE CUBE AND STARFIELD ONTO THE FRONT"
t$=t$+" OF THE 'TELEVISION'....   A COUPLE OF QUICK HELLO"
t$=t$+"S GO OUT TO THESE TOP PEOPLE:      "
t$=t$+"XALTHORN... DOCTOR... DOUGAL... JIM SHAW... "
t$=t$+"JINX... MASTER TONBERRY... JACOB BUSBY... "
t$=t$+"DEMONEYE... ASIV... LIQUID PIA... IAN... "
t$=t$+"STATIC GERBIL... VERYBASIC... SNAKEDOGG... "
t$=t$+"JOMORROW... DREW... ELL... AND ALL THE REST OF "
t$=t$+"THE BUNCH AT THE YABASIC FORUMS...        "
t$=t$+"CHECK OUT THESE LINKS IF YOU'RE INTERESTED IN "
t$=t$+"YABASIC PROGRAMING:   WWW.PS2-YABASIC.CO.UK   "
t$=t$+"WWW.YABASIC.CO.UK   WWW.EVILSOFT.S5.COM   "
t$=t$+"EMAIL ME AT :   SHOCKWAVE@PS2-YABASIC.CO.UK   "
t$=t$+"AND BY THE WAY, IF YOU THINK THIS IS PRECALCULATED"
t$=t$+" PRESS ANY BUTTON EXCEPT (X) ON THE DPAD AND YOU'L"
t$=t$+"L SEE IT ISN'T...    SEE YOU NEXT TIME..."
p=0

'######################
'## Open Gfx Screen! ##
'######################
open window 640,512
'#####################################
'## Define the necessary variables! ##
'#####################################

stars=17

size=25: rem how big do you want it?
dw=1 : Rem            Double buffering Variable
polys=20 : Rem        The amount of polygons in the object
dim x(polys+stars) : Rem  Original X co-ordinate store
dim y(polys+stars) : Rem  Original Y co-ordinate store
dim z(polys+stars) : Rem  Original Z co-ordinate store
dim s(polys+stars)
dim tx(polys+stars) : Rem Transformed  X co-ordinate store
dim ty(polys+stars) : Rem Transformed Y co-ordinate store
dim tz(polys+stars) : 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)
next a

'---------------------------------------------------------
'GENERATE STARFIELD;
'---------------------------------------------------------

for a=polys+1 to polys+stars
 x(a)=-13+ran(26)
 y(a)=-10+ran(20)
 z(a)=-4
 s(a)=.1 +ran(.4)
next a

'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'   The Object Description As Data!
'   The Data Below Describes A Television and a Cube.
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
data -10,12,4,10,12,4,10,-10,4,-10,-10,4
data -15,12,-4,15,12,-4,15,-12,-4,-15,-12,-4
data -13,10,-4,13,10,-4,13,-10,-4,-13,-10,-4

data -5,5,5,5,5,5,5,-5,5,-5,-5,5
data -5,5,-5,5,5,-5,5,-5,-5,-5,-5,-5


return














