'         CONFUSION CODED BY SHOCKWAVE (C) 2002 !
'         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'           EMAIL: SHOCKWAVE@PS2-YABASIC.CO.UK
'                    TRY THESE SITES;
'
'                  WWW.PS2-YABASIC.CO.UK
'                  WWW.YABASIC.CO.UK
'                  WWW.GAMEVINE.NET
'
'     Thanks to Parabellum for inspiring this demo.
'
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

gosub initialise
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'                        Main Loop;
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
repeat

   setdrawbuf dw
   dw=1-dw
   setdispbuf dw
   gosub fram
   gosub stars
     g=10*sin((c/2)*pi/180)
     r=10*sin((c/3)*pi/180)
     setrgb 1,0,0,10
     fill rect 10,60 to 380,440     
     gosub rotate
     gosub construct
     gosub grid
     gosub logo
     gosub scroll
if start>-185 then
setrgb 1,0,0,0
fill rect 11-start,61-start to 380+start,440+start
start=start-3
fi
until (1=2)
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'            Main loop restarts (infinate) /\
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

'---------------------------------------------------------
'            Masked Scrolling Message Routine;
'---------------------------------------------------------
label scroll
  setrgb 1,255,255,255
  text scx+20,276,mid$(s$,p,36)
  setrgb 1,0,0,0
  text scx+21,277,mid$(s$,p,36)
   setrgb 1,0,0,10
   fill rect 11,266 to 21,279
   fill rect 370,266 to 380,279
   scx=scx-1
if scx<-10 then
   p=p+1
   scx=scx+10
   if p>len(s$) p=0
fi
return

'---------------------------------------------------------
'               Draw The Shockwave Logo;
'---------------------------------------------------------
label logo
setrgb 1,30,30,100+40*sin(c*pi/180)
       fill rect 530,20 to 580,30
       fill rect 530,20 to 540,50
       fill rect 540,50 to 580,40
       fill rect 580,40 to 570,60
       fill rect 580,60 to 530,70
       fill rect 530,80 to 540,120
       fill rect 570,80 to 580,120
       fill rect 570,95 to 530,105
       fill rect 530,130 to 580,140
       fill rect 530,160 to 580,170
       fill rect 530,130 to 540,170
       fill rect 580,130 to 570,170
       fill rect 530,180 to 580,190
       fill rect 530,210 to 580,220
       fill rect 530,180 to 540,210
       fill rect 530,230 to 540,270
       fill rect 570,230 to 560,250
       fill rect 580,250 to 570,270
       fill rect 530,245 to 580,255
       fill rect 530,280 to 540,320
       fill rect 580,320 to 570,280
       fill rect 550,295 to 560,320
       fill rect 530,320 to 580,310
       fill rect 530,330 to 540,370
       fill rect 580,330 to 570,370
       fill rect 530,330 to 580,340
       fill rect 530,345 to 580,355
       fill rect 530,380 to 540,420
       fill rect 580,380 to 570,420
       fill rect 580,420 to 530,410
       fill rect 530,430 to 540,480
       fill rect 530,430 to 580,440
       fill rect 530,480 to 580,470
       fill rect 530,450 to 570,460
         setrgb 1,50,50,90
         rect 520,10 to 590,490
return

'---------------------------------------------------------
'                Do Reflective 3D Stars;
'---------------------------------------------------------
label stars
for a=1 to ns
 tsx(a)=(sx(a)/sz(a))+320
 tsy(a)=(sy(a)/sz(a))+206
 sz(a)=sz(a)-.05
 if tsx(a)>640 or tsx(a)<0 or tsy(a)<0 or tsy(a)>412 then
 sx(a)=-2000+ran(4000)
 sy(a)=-2000+ran(3000)
 sz(a)=5
 fi
next a
setrgb 1,255,255,255
for a=1 to ns
 fill rect tsx(a),tsy(a) to tsx(a)+6-sz(a),tsy(a)+6-sz(a)
if -tsy(a)+840>412 and -tsy(a)<512 and tsx(a)>0 then
 fill rect tsx(a),(-tsy(a))+840 to tsx(a)+5-sz(a),(-tsy(a)+5-sz(a))+840
fi
next a
setrgb 1,0,0,0
for a=1 to 640 step 17
line a,3 to a,509
next a
for a=3 to 509 step 17
line 0,a to 640,a
next a
return

'---------------------------------------------------------
'        Display Morphing Grid Over Vector Object;
'---------------------------------------------------------
label grid
setrgb 1,0,0,10
s=0
c=c+6
if c>360 c=c-360
d=d+8
if d>360 d=d-360
for a=20 to 360 step 15
fill rect a,60 to a+gs(s+c),440
s=s+9
next a
s=0
for a=70 to 430 step 15
fill rect 10,a to 380,a+gc(b+d)
s=s+7
next a
setrgb 1,155,155,255
rect 10,60 to 380,440
return

'---------------------------------------------------------
'                Cosmetics (background);
'---------------------------------------------------------
label fram
setrgb 1,0,0,20
setrgb 2,0,0,20
setrgb 3,0,0,10
gtriangle 0,0 to 640,412 to 0,412
gtriangle 0,0 to 640,412 to 640,0
setrgb 1,0,0,25
setrgb 2,0,0,40
setrgb 3,0,0,40
gtriangle 0,412 to 640,512 to 0,512
setrgb 3,0,0,25
gtriangle 0,412 to 640,512 to 640,412
setrgb 1,1,1,5
line 0,412 to 640,412
setrgb 1,255,255,255
fill rect 0,0 to 640,3
fill rect 0,510 to 640,512
return

'---------------------------------------------------------
'                     Draw The Object;
'---------------------------------------------------------
label construct
 f1=8:f2=4:f3=3
 gosub draw
  f1=12:f2=8:f3=3
  gosub draw
   f1=12:f2=13:f3=8
   gosub draw
    f1=13:f2=4:f3=8
    gosub draw
     f1=12:f2=3:f3=7
     gosub draw
      f1=3:f2=4:f3=5
      gosub draw
       f1=13:f2=9:f3=4
       gosub draw
      f1=4:f2=9:f3=1
      gosub draw
     f1=4:f2=1:f3=5
     gosub draw
    f1=3:f2=5:f3=2
    gosub draw
   f1=5:f2=1:f3=2
   gosub draw
  f1=7:f2=3:f3=2
  gosub draw
 f1=6:f2=2:f3=1
 gosub draw
f1=11:f2=7:f3=2
gosub draw
 f1=11:f2=2:f3=6
 gosub draw
  f1=10:f2=11:f3=6
  gosub draw
   f1=10:f2=6:f3=1
   gosub draw
    f1=9:f2=10:f3=1
    gosub draw
     f1=13:f2=10:f3=9
     gosub draw
     f1=12:f2=7:f3=11
     gosub draw
      f1=12:f2=11:f3=14
      gosub draw
       f1=13:f2=12:f3=14
       gosub draw
        f1=13:f2=14:f3=10
        gosub draw
          f1=14:f2=11:f3=10
          gosub draw
return

'---------------------------------------------------------
'         Calculate Cross product and draw face;
'---------------------------------------------------------

label draw
'##############################
'## Draw A Face Of The Ball! ##
'##############################
l=l+1
if l>5 l=4
  vx1= tx(f1)-tx(f2)
  vy1= ty(f1)-ty(f2)
  vx2= tx(f3)-tx(f2)
  vy2= ty(f3)-ty(f2)
  n=(vx1*vy2-vx2*vy1)
if n<0 then
light=abs(n/400)

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

fi
return

'---------------------------------------------------------
'      Rotation and perspective transformations;
'---------------------------------------------------------
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/30)+1))+195
  yy=size*(yy/((zz/30)+1))+256
  tx(a)=xx
  ty(a)=yy
  tz(a)=zz
 next a
xr=xr+1
yr=yr+2
zr=zr+3
if xr>720 xr=xr-720
if yr>720 yr=yr-720
if zr>720 zr=zr-720
return

'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'                    Set Everything up;
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

label initialise
size=20
r=0:g=0:b=40
open window 640,512
setrgb 0,40,40,40

polys=14 : Rem      The amount of points 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 cs(720)
 dim sn(720)
 dim gs(720)
 dim gc(720)
ns=27
start=400
 dim sx(ns),sy(ns),sz(ns),tsx(ns),tsy(ns)
ang=0
 for a=1 to ns
 sx(a)=-2000+ran(4000)
 sy(a)=-2000+ran(4000)
 sz(a)=ang
ang=ang+.005
 next a

 for ang=0 to 720
  cs(ang)=cos(ang*(pi/360))
  sn(ang)=sin(ang*(pi/360))
  gs(ang)=9*sin(ang*pi/180)
  gc(ang)=9*cos(ang*pi/180)
 next ang
for a=1 to polys
 read x(a),y(a),z(a)
next a
p=0
scx=0
s$="                                                   "
s$=s$+"WELCOME TO THE LATEST DEMO FROM SHOCKWAVE....  "
s$=s$+"IT IS CALLED 'CONFUSION' FOR OBVIOUS REASONS.. "
s$=s$+"THIS SCROLL IS JUST HERE FOR A FEW GREETINGS "
s$=s$+"BECAUSE I KNOW THAT IT'S A BIT HARD TO READ... "
s$=s$+"BIG HANDSHAKES TO THESE PEOPLE (IN RANDOM ORDER)  "
s$=s$+"XALTHORN   DOCTOR   JIM SHAW   DEMONEYE   JOMORROW"
s$=s$+"   PARABELLUM   SNAKEDOGG   DREW   BONGOTRUMMOR   "
s$=s$+"KYATAAVL   ZINGSTER   PYRO   YALOOPY   FRYER   "
s$=s$+"SEPHIROTH   BIGYABASIC   TONBERRY   ELLTHEMAN   "
s$=s$+"JACOB BUSBY   JINX   AND ALL THE REST OF THE "
s$=s$+"PEOPLE WHO I KNOW I HAVE FORGOTTEN! (SORRY).   "
s$=s$+"TO PARABELLUM, THIS IS A DEVELOPMENT OF THE GRID "
s$=s$+"IDEA YOU USED IN YOUR SINE SCROLL AND IT'S QUITE "
s$=s$+"EFFECTIVE I THINK.. HOPE YOU LIKE IT... "
s$=s$+"YOUR CUBE DEMO WAS INCREDIBLE BY THE WAY..   "
s$=s$+"I'M GOING TO START WORK ON SOMETHING SPECIAL NOW.."
s$=s$+" WATCH THIS SPACE...    "
s$=s$+"THAT'S ALL FOR NOW, SCROLL RESTARTS....    "

data 5,-5,-5,5,5,-5,-5,5,-5,-5,-5,-5,0,0,-8,8,0,0,0,8,0,-8,0,0,0,-8,0,5,-5,5,5,5,5,-5,5,5,-5,-5,5,0,0,8
return