'The Box Clever Demo, Coded By SHOCKWAVE (C) 2002.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Contact me at:
'
'Shockwave@ps2-yabasic.co.uk
'www.yabasic.co.uk
'www.ps2-yabasic.co.uk
'
'Enjoy the demo. :o)
'#########################################################
gosub initialise
gosub slapemin
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
repeat
setdrawbuf dw
dw=1-dw
setdispbuf dw
   setrgb 1,6,23,3
   setrgb 2,3,33,7
   setrgb 3,3,48,3
    gtriangle 0,0 to 640,512 to 0,512
    gtriangle 0,0 to 640,512 to 640,0
    setrgb 2,10,10,30
    setrgb 3,10,10,40

mm=mm+.02
size=30+25*sin(mm)

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

setrgb 1,50,50,120

f1=8:f2=4:f3=3
gosub draw2
f1=12:f2=8:f3=3
gosub draw2
f1=12:f2=13:f3=8
gosub draw2
f1=13:f2=4:f3=8
gosub draw2
f1=12:f2=3:f3=7
gosub draw2
f1=3:f2=4:f3=5
gosub draw2
f1=13:f2=9:f3=4
gosub draw2
f1=4:f2=9:f3=1
gosub draw2
f1=4:f2=1:f3=5
gosub draw2
f1=3:f2=5:f3=2
gosub draw2
f1=5:f2=1:f3=2
gosub draw2
f1=7:f2=3:f3=2
gosub draw2
f1=6:f2=2:f3=1
gosub draw2
f1=11:f2=7:f3=2
gosub draw2
f1=11:f2=2:f3=6
gosub draw2
f1=10:f2=11:f3=6
gosub draw2
f1=10:f2=6:f3=1
gosub draw2
f1=9:f2=10:f3=1
gosub draw2
f1=13:f2=10:f3=9
gosub draw2
f1=12:f2=7:f3=11
gosub draw2
f1=12:f2=11:f3=14
gosub draw2
f1=13:f2=12:f3=14
gosub draw2
f1=13:f2=14:f3=10
gosub draw2
f1=14:f2=11:f3=10
gosub draw2
setrgb 1,30,155,155
for a=1 to str
 tx=(sx(a)/sz(a))+320
 ty=(sy(a)/sz(a))+256
 siz=6-sz(a)
sz(a)=sz(a)-.04
 fill rect tx,ty to tx+siz,ty+siz
if (tx<0) or (tx>640) or (ty<0) or (ty>512) then
 sx(a)=-1500+ran(3000)
 sy(a)=-1500+ran(3000)
 sz(a)=5
fi
next a
    gosub rotate
gosub scroller
until (and(peek("port1"),16384)<>0)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
exit

label slapemin
setrgb 1,150,250,150
text 320,226,"CONVERTING SCROLL TO ASCII FORMAT","cc"
text 320,400,"BOX CLEVER (C) SHOCKWAVE 2002","cc"
   mmm=0
target=len(s$)+1
   for a=1 to len(s$)
   letter=asc(mid$(s$,a,1))-48
   ostore(mmm)=(letter*10)
   if ostore(mmm)<0 ostore(mmm)=-1
   mmm=mmm+1
   width=(int((target-a)/len(s$)*100))*2
   rect 420,240 to 420-width,260

   next a
   p=p+1
   if p>len(s$)-5 p=0
clear window
'---------------------------------------------------------
'Take the offsets and build the connection data from them
'--------------------------------------------------------
setrgb 1,150,250,150
text 320,226,"CALCULATING SCROLL CONNECTIONS","cc"
text 320,400,"EMAIL: SHOCKWAVE@PS2-YABASIC.CO.UK","cc"

   os=1
   l=0
   for a=1 to len(s$) 
     for b=1 to 10
     connects(os)=fnt(ostore(a)+b)
     if ostore(a)<0 connects(os)=(1)
     os=os+1
     next b
 width=(int((target-a)/len(s$)*100))*2
 rect 420,240 to 420-width,260

   next a
flag=0
l=0
p=0
return

label scroller
   scrl=scrl-8
   if scrl<-164 then
    scrl=scrl+164
    p=p+10
    if (p/10)>(len(s$)-6) p=0
   fi
f=100+100*sin(mm)

setrgb 1,155+f,155+f,255
 lf=0
 l=0
for a=1 to 50 step 2
line txx(connects(p+a)+l)+scrl,tyy(connects(p+a)+l) to txx(connects(p+a+1)+l)+scrl,tyy(connects(p+a+1)+l)
lf=lf+1
if lf=5 then lf=0:l=l+9:fi
next a

return


label draw
'##############################
'## Draw A Face Of The Cube! ##
'##############################
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)
  if  (vx1*vy2-vx2*vy1)<0 then
light=-(tz(f1)+tz(f2)+tz(f3))*l
setrgb 1,r+light,g+light,b+light
gtriangle tx(f1),ty(f1) to tx(f2),ty(f2) to tx(f3),ty(f3)
setrgb 1,r+30+light,g+30+light,b+30+light
triangle tx(f1),ty(f1) to tx(f2),ty(f2) to tx(f3),ty(f3)
fi
return

label draw2
'##############################
'## Draw A Face Of The Cube! ##
'##############################
  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
triangle tx(f1),ty(f1) to tx(f2),ty(f2) to tx(f3),ty(f3)
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/50)+1))+320
  yy=size*(yy/((zz/50)+1))+256
  tx(a)=xx
  ty(a)=yy
  tz(a)=zz
 next a
xr=xr+3
yr=yr+2
zr=zr+4
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=29: rem how big do you want it?
dw=1 : Rem            Double buffering Variable
polys=14 : 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
str=65
dim sx(str),sy(str),sz(str)

for a=1 to str
 sx(a)=-1000+ran(2000)
 sy(a)=-1000+ran(2000)
 sz(a)=ran(5)
next a

r=10
g=10
b=40
'##########################
'## 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
s$="      "
s$=s$+"WHAT YOU ARE LOOKING AT SHOULD NOT BE POSSIBLE IN "
s$=s$+"YABASIC  ::  ;SHOCKWAVE;  PRESENTS THE BOX CLEVER"
s$=s$+" DEMONSTRATION CODED IN JULY 2002  ;  YOU ARE NOW "
s$=s$+"LOOKING AT A VECTOR SCROLL TEXT AND 70 3D STARS "
s$=s$+"WITH A NEW GLASS TYPE OBJECT THAT I BASED ON A "
s$=s$+"BOX AND STRETCHED OUT THE MIDDLES  ;  HENCE THE "
s$=s$+"NAME OF THE DEMO  ;  INCIDENTALLY I CREATED THE "
s$=s$+"OBJECT WITH MY VECTOR EDITOR ;;  DO YOU CODE 3D "
s$=s$+"STUFF??  DOWNLOAD IT FROM  WWW PS2:YABASIC CO UK "
s$=s$+"AND SEE WHAT YOU CAN COME UP WITH    YOU CAN "
s$=s$+"EMAIL ME AT   SHOCKWAVE@PS2-YABASIC CO UK     "
s$=s$+"OR VISIT THE FORUMS AT WWW YABASIC CO UK AND LEAVE"
s$=s$+"ME A MESSAGE ;:;:;:; ANYWAY ALL THATS LEFT NOW ARE"
s$=s$+" THE OBLIGATORY GREETINGS SO IN NO ORDER GREETS TO"
s$=s$+" :XALTHORN:DOCTOR:RAFRYER:JIM SHAW:SNAKEDOGG:"
s$=s$+"JOMORROW:DEMONEYE:ZINGSTER:JINX:KYATAAVL:ELL:"
s$=s$+"BIGYABASIC:BRUASSET:SEPHIROTH:MASTER TONBERRY:"
s$=s$+"BONGOTRUMMOR:PARABELLUM:JACOB BUSBY:STATIC GERBIL:"
s$=s$+"COMBATKING:AND EVERYONE WHO I HAVE FORGOTTEN ;THER"
s$=s$+"E ARE SO MANY OF YOU NOW; "
s$=s$+"   I HOPE THAT YOULL ALL ENJOY THE LATEST BATCH  "
s$=s$+"OF DEMOS I HAVE RELEASED AND ID JUST LIKE TO SAY "
s$=s$+"A SPECIAL BIG THANK YOU TO XALTHORN FOR UPLOADING "
s$=s$+"THEM   <CHEERS MATE> "
s$=s$+"   FUNNILY ENOUGH THIS TEXT DOESNT SEEM TO BE "
s$=s$+"SLOWING THE DEMO DOWN AT ALL : NORMALY THE BIGGER "
s$=s$+"THE STRING THE SLOWER THE CODE    "
s$=s$+"IT ISNT ACCESSING THE STRING AT ALL THOUGH AS I "
s$=s$+"HAD TO PRECALCULATE THE SCROLL TEXT TO A FAIRLY "
s$=s$+"LARGE DEGREE AND THERE IS NO REAL TIME STRING "
s$=s$+"HANDLING IN THIS DEMO    ;    THE REST OF IT IS "
s$=s$+"IN REAL TIME THOUGH AND I SUPPOSE THAT THE SCROLL "
s$=s$+"IS ONLY 2 THIRDS PRECALCULATED IN ALL  ;   "
s$=s$+"ANYWAY I WANTED TO DO SOMETHING DIFFERENT   I WAS "
s$=s$+"GETTING IRED OF USING THE BUILT IN FONT ALL THE "
s$=s$+"TIME ;;;; EVERYTHING WAS BEGINNING TO LOOK THE SAM"
s$=s$+"E ;   WELL I GUESS THAT THIS TEXT IS NOW LONG "
s$=s$+"ENOUGH BECAUSE I HAVE RUN OUT OF THINGS TO SAY "
s$=s$+"TO YOU    SCROLL RESTARTS IN A FEW MOMENTS "
s$=s$+";;10;;      "
s$=s$+";;9;;      "
s$=s$+";;8;;      "
s$=s$+";;7;;      "
s$=s$+";;6;;      "
s$=s$+";;5;;      "
s$=s$+";;4;;      "
s$=s$+";;3;;      "
s$=s$+";;2;;      "
s$=s$+";;1;;      "
s$=s$+";;0;;      "


s$=s$+"      "

dim ostore(len(s$))
dim scx(45),scy(45),txx(45),tyy(45):rem   scroll template.
dim connects(10*len(s$)):Rem    This stores display lines.
dim fnt (430) :Rem   storage space for letter connections.

for a=1 to 45
read scx(a),scy(a)
next a
for a=1 to 45
  txx(a)=(55*scx(a))+540
  tyy(a)=(55*scy(a))+256
next a

for a=1 to 430
read fnt(a)
next a
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'   The Object Description As Data!
'   The Data Below Describes A Special Cube/Sphere.
'   Designed with Shockwave's vector editor.
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
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
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'The Scroling message template;
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
data -10,-1,-9,-1,-8,-1,-10,0,-9,0,-8,0,-10,1,-9,1,-8,1
data  -7,-1,-6,-1,-5,-1,-7,0,-6,0,-5,0,-7,1,-6,1,-5,1
data -4,-1,-3,-1,-2,-1,-4,0,-3,0,-2,0,-4,1,-3,1,-2,1
data -1,-1,0,-1,1,-1,-1,0,0,0,1,0,-1,1,0,1,1,1
data 2,-1,3,-1,4,-1,2,0,3,0,4,0,2,1,3,1,4,1
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'The Font. (Each letter has five lines).
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'AscII map;
'48=0:49=1:50=2:51=3:52=4:53=5:54=6:55=7:56=8:57=9:58=:
'59=;:60=<:61==:62=>:63=?:64=@:65=A: to 90= Z:
'
'Font designed by shockwave. DO NOT RIP without credit!
'
'0 to 3
data 1,3,3,9,9,7,7,1,1,9
data 4,2,2,5,5,8,8,7,8,9
data 2,3,3,6,6,4,4,7,7,9
data 1,2,2,6,6,4,6,9,9,7
'4 to 7
data 1,4,4,5,5,2,5,8,5,6
data 2,1,1,4,4,6,6,9,9,7
data 3,1,1,7,7,9,9,6,6,4
data 1,3,3,6,6,4,6,8,8,6
'8 to 9,:,;
data 1,3,3,9,9,7,7,1,4,6
data 1,3,3,6,6,4,4,1,6,8
data 4,6,6,4,4,6,6,4,4,6 :rem colon gives -
data 2,8,4,6,1,9,3,7,4,6 :rem semicolon gives *
'< = > ? @
data 3,4,4,9,9,5,5,3,3,4
data 1,3,3,1,7,9,9,7,7,9
data 1,6,6,7,7,5,5,1,1,6
data 1,3,3,6,6,5,5,4,7,8
data 3,1,1,7,7,9,9,6,6,8
'A to D;
data 7,4,4,2,2,6,6,9,4,6
data 1,7,7,9,9,4,4,6,6,1
data 6,3,3,2,2,4,4,7,7,9
data 1,2,2,6,6,9,9,7,7,1
'E to H
data 3,2,2,4,4,6,4,7,7,9
data 3,2,2,4,4,6,4,7,4,7
data 3,4,4,7,7,9,9,6,6,5
data 1,7,4,6,3,9,4,6,4,6
'I to L
data 1,2,2,3,2,8,7,8,8,9
data 1,3,3,6,6,8,8,7,7,4
data 1,7,4,2,9,5,5,4,4,5
data 1,4,4,7,7,8,8,9,8,9
'M to P
data 1,3,3,9,1,7,2,5,5,2
data 7,4,4,1,1,5,5,9,9,3
data 1,3,3,9,9,7,7,1,1,3
data 7,4,4,1,1,3,3,6,6,4
'Q to T
data 1,3,3,9,9,7,7,1,9,5
data 1,2,2,6,6,4,4,9,1,7
data 3,1,1,4,4,6,6,9,9,7
data 1,3,3,1,2,5,5,8,8,2
'U to X
data 1,7,7,8,8,9,9,6,6,3
data 1,4,4,8,8,6,6,3,3,6
data 1,7,7,9,9,3,8,5,5,8
data 1,5,5,9,3,5,5,7,7,5
'Y to Z
data 1,4,4,6,6,3,6,9,9,7
data 1,2,2,3,3,7,7,8,8,9
return