'                      "Retro Style"
'  Coded by Shockwave As An Example For The 300 Line Demo
'        competition. Read The Scroll For Greetings!
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
gosub setup:REM                       SET UP ALL VARIABLES
'                       Start Loop;
'---------------------------------------------------------
repeat
  fd=fad/10 : setrgb 0,0,0,fd
    setdrawbuf dw : dw=1-dw
    setdispbuf dw : clear window
     setrgb 1,0,0,fad:REM                        BLUE BARS
     setrgb 2,0,0,fad
     setrgb 3,0,0,fd
     gtriangle 0,0 to 640,0 to 640,50
     gtriangle 0,512 to 640,512 to 640,462
     setrgb 2,0,0,fd
     gtriangle 0,0 to 0,50 to 640,50
     gtriangle 0,512 to 0,462 to 640,462
     if fad<255 fad=fad+.5
  gosub stars:REM                              DO 3D STARS
  gosub rotate:REM                           ROTATE OBJECT
  gosub construct:REM                          DRAW OBJECT
  gosub logo1:REM                   DRAW LOGO BACK LETTERS
  gosub scroll:REM                             DO SCROLLER
  gosub logo2: REM                 DRAW LOGO FRONT LETTERS
until (1=2)
'                      ^ End Loop OO
'---------------------------------------------------------

'                        Scroller;
'---------------------------------------------------------
label scroll
yp=100*sin(mm/3)
setrgb 1,fad,fad,fad : text scx,256+yp,mid$(s$,p,67)
setrgb 1,0,0,0 : text scx+1,257+yp,mid$(s$,p,67)
scx=scx-1
if scx<-10 then:rem               RESET POS ADD NEW LETTER
scx=scx+10 : p=p+1
if p>len(s$) p=0
fi
return
'              Control sub to Draw The Object;
'---------------------------------------------------------
label construct
for a=1 to faces:REM                  DO EACH FACE IN TURN
gosub draw
next a
return
'              Draw A Face Of The Object;
'---------------------------------------------------------
label draw:REM                       CROSS PRODUCT CALC \/
  vx1 = tx(f1(a))-tx(f2(a)) :  vy1= ty(f1(a))-ty(f2(a))
  vx2 = tx(f3(a))-tx(f2(a)) :  vy2= ty(f3(a))-ty(f2(a))
    n =  vx1*vy2-vx2*vy1
 if n<0 then:REM               IF NEGATIVE SURVACE VISIBLE
 n=-(n/200)
if n>220 n=220:REM                        LIMIT MAX COLOUR
 n=n-250+fad : setrgb 1,r(a)+n,g(a)+n,b(a)+n
 fill triangle tx(f1(a)),ty(f1(a)) to tx(f2(a)),ty(f2(a)) to tx(f3(a)),ty(f3(a))
 if cls(a)=1 then:REM          DRAW BORDER IF CELL SHAD ON
   setrgb 1,0,0,0
   line tx(f1(a)),ty(f1(a)) to tx(f2(a)),ty(f2(a))
   line tx(f2(a)),ty(f2(a)) to tx(f3(a)),ty(f3(a))
   line tx(f3(a)),ty(f3(a)) to tx(f4(a)),ty(f4(a))
   line tx(f4(a)),ty(f4(a)) to tx(f1(a)),ty(f1(a))
 fi
fi
return
'                Object Rotation and offset;
'---------------------------------------------------------
label rotate
 mm=mm+.1: zo=11*sin(mm/2)
'###############################################
'## Rotate And Scale Each Point! Store Result ##
'###############################################
 for a=1 to points
  x1=x(a) : y1=y(a)
  z1=z(a)+zo
'######################
'## 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! ##
'########################
  dv=(zz/20)+1
  xx=size*(xx/dv)+320
  yy=size*(yy/dv)+256
  tx(a)=xx
  ty(a)=yy
  tz(a)=zz
 next a
xr=xr+3 : 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
'                         Starfield;
'---------------------------------------------------------
label stars
setrgb 1,fad/2,fad/2,fad/2
for a=1 to ns
fill rect ox(a),oy(a) to ox(a)+os(a),oy(a)+os(a)
next a
setrgb 1,fad,fad,fad
for a=1 to ns
tx=320+(sx(a)/sz(a)) : ty=256+(sy(a)/sz(a))
s=6-sz(a) : sz(a)=sz(a)-.1
if tx<0 or tx>640 or ty<0 or ty>512 then
  sx(a)=-2000+ran(4000) : sy(a)=-2000+ran(4000)
  sz(a)=5
fi
ox(a)=tx : oy(a)=ty
os(a)=s  : fill rect tx,ty to tx+s,ty+s
next a
return
'                     Logo Back Letters;
'---------------------------------------------------------
label logo1
setrgb 1,0,0,fad/1.8
's
   fill rect 10,210 to 70,220
   fill rect 10,290 to 70,280
   fill rect 10,245 to 70,255
   fill rect 10,210 to 20,255
   fill rect 70,255 to 60,290
   fill rect 70,245 to 50,290
'o
   fill rect 150,210 to 210,220
   fill rect 150,290 to 210,280
   fill rect 150,210 to 160,290
   fill rect 210,210 to 200,290
   fill rect 150,245 to 170,290
'k
   fill rect 290,210 to 300,290
   fill rect 290,245 to 350,255
   fill rect 350,245 to 330,290
   fill rect 320,210 to 330,245
'a
   fill rect 430,210 to 440,290
   fill rect 490,210 to 480,290
   fill rect 430,210 to 490,220
   fill rect 430,245 to 490,255
   fill rect 430,245 to 450,290
'e
   fill rect 570,210 to 580,290
   fill rect 570,210 to 630,220
   fill rect 570,280 to 630,290
   fill rect 570,245 to 610,255
   fill rect 570,245 to 590,290 
return
'                    Logo Front Letters;
'---------------------------------------------------------
label logo2
setrgb 1,0,0,fad
'h
   fill rect 80,210 to 90,290
   fill rect 140,210 to 130,290
   fill rect 140,245 to 80,255
   fill rect 80,245 to 100,290
'c
   fill rect 220,210 to 280,220
   fill rect 220,290 to 280,280
   fill rect 220,210 to 230,290
   fill rect 220,245 to 240,290
'w
   fill rect 360,210 to 370,290
   fill rect 360,245 to 380,290
   fill rect 360,290 to 420,280
   fill rect 420,290 to 410,210
   fill rect 390,290 to 400,245
'v
   fill rect 500,210 to 510,290
   fill rect 510,245 to 520,290
   fill rect 560,210 to 550,245
   fill rect 500,280 to 545,290
   fill triangle 545,290 to 540,280 to 550,245
   fill triangle 560,245 to 550,245 to 545,290
   rect 5,204 to 635,296
return

label setup
open window 640,512
'                   Scroller Definition;
'---------------------------------------------------------
s$="                                                      "
s$=s$+"                 RETRO STYLE    BY SHOCKWAVE   "
s$=s$+"WELL, THIS ONE CERTAINLY DOESN'T DO ANYTHING NEW "
s$=s$+"BUT I TRIED TO MAKE THE DESIGN NICE!    IT'S SORT "
s$=s$+"Of OLDSKOOL BUT NICE AND IT WAS WRITTEN IN SEPT"
s$=s$+"EMBER 2002... IT PAYS HOMAGE TO THE GREAT AMIGA "
s$=s$+"DEMOS OF THE PAST... NOT TOO MANY YEARS AGO THIS "
s$=s$+"WOULD HAVE BEEN CONSIDERED GROUNDBREAKING STUFF. "
s$=s$+"  AH WELL, NEVER MIND.    ALTHOUGH THIS DEMO IS "
s$=s$+"FAIRLY BEREFT OF NEW IDEAS I LIKE IT BECAUSE IT "
s$=s$+"DOES EVERYTHING WELL.   I TRIED TO SPEND A LITTLE "
s$=s$+"TIME ON THE DESIGN THIS TIME AND I THINK IT PAID "
s$=s$+"OFF.    I SCALED IT DOWN TO EXACTLY 300 LINES SO "
s$=s$+"I COULD INCLUDE IT AS AN EXAMPLE FOR THE NEW DEMO "
s$=s$+"COMPETITION ON THE FORUMS.   THIS MEANS THAT I AM "
s$=s$+"A BIT STUCK FOR SPACE SO WITHOUT FURTHER ADO, HERE"
s$=s$+" ARE THE ADS AND THEN I'LL DO THE GREETS!    "
s$=s$+"WWW.PS2-YABASIC.CO.UK FOR YABASIC PROGRAMS.   "
s$=s$+"WWW.YABASIC.CO.UK FOR THE YABASIC FORUMS.    "
s$=s$+"WWW.GAMEVINE.NET FOR GAMES RELATED STUFF.    "
s$=s$+"SHOCKWAVE@PS2-YABASIC.CO.UK TO EMAIL ME.    "
s$=s$+"GREETINGS TO THESE PEOPLE (IN RANDOM ORDER)    "
s$=s$+"XALTHORN (HIYA M8!), DOCTOR (POST MORE! I MISS U),"
s$=s$+"JIM SHAW (THE EMULATOR IS COOL.. MORE PLEASE!!!!),"
s$=s$+"PARABELLUM (GREAT DEMOS!), JINX (LIKEWISE!), "
s$=s$+"RAFRYER (F1 WILL BE COOL!), JOMORROW (HAMSTERS!!),"
s$=s$+"DEMONEYE (GUITAR GENIUS), KYATAAVL (HELLO DUDE!)," 
s$=s$+"AZ (NICE DEMOS!), BALROQ (WHERE ARE U?),"
s$=s$+"BONGOTRUMMOR (GOOD LUCK IN THE COMP!), SEPHIROTH, "
s$=s$+"DREW (GOOD 2 HAVE U BACK!), ZINGSTER+PYRO (HIYA!),"
s$=s$+" SNAKEDOGG (HI PETE!), TONBERRY (COME BACK!), " 
s$=s$+"JACOB BUSBY (WHEN IS CATAN READY?), ELL, BRUASET, "
s$=s$+"YALOOPY (HIYA! U R STRNGE), COMBATKING (4 IN 1?) "
s$=s$+"AND EVERYONE ELSE AT THE FORUMS! "
s$=s$+"SORRY IF I MISSED YOU OUT..     TEXT RESTARTS NOW."
scx=0:p=0
'                        Starfield;
'---------------------------------------------------------
ns=44
dim ox(ns),oy(ns),os(ns),sx(ns),sy(ns),sz(ns)
for a=1 to ns
   sx(a)=-2000+ran(4000) : sy(a)=-2000+ran(4000)
   sz(a)=ran(5)
next a
'                  3D Object Variables;
'---------------------------------------------------------
size=17: rem                      how big do you want it?
points=14 : Rem         The amount of points in the object
faces=24 : Rem          The Amount of faces in the object
dim x(points): Rem            Original X co-ordinate store
dim y(points): Rem            Original Y co-ordinate store
dim z(points): Rem            Original Z co-ordinate store
dim tx(points): Rem       Transformed  X co-ordinate store
dim ty(points): Rem        Transformed Y co-ordinate store
dim tz(points): Rem        Transformed Z co-ordinate store
dim f1(faces):rem                   Connections definition
dim f2(faces):rem                   Connections definition
dim f3(faces):rem                   Connections definition
dim f4(faces):rem                   Connections definition
dim r(faces):rem                             Red Component
dim g(faces):rem                           Green Component
dim b(faces):rem                            Blue Component
dim cls(faces):rem                        Cell Shade Face?
'   Define Sine Tables for faster matrix calculations;
'---------------------------------------------------------
 dim cs(720),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's points;
'---------------------------------------------------------
for a=1 to points
 read x(a),y(a),z(a)
next a
'         Read In Connections and face parameters;
'---------------------------------------------------------
for a=1 to faces
    read f1(a),f2(a),f3(a),f4(a),r(a),g(a),b(a),cls(a)
next a
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'   The Object Description As Data!
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
data 5,-5,-5,5,5,-5,-5,5,-5,-5,-5,-5,0,0,-8,8,0,0,0
data 8,0,-8,0,0,0,-8,0,5,-5,5,5,5,5,-5,5,5,-5,-5,5,0,0,8
data 10,9,13,13,50,0,0,1
data 14,10,13,13,0,50,0,1
data 14,13,12,12,0,50,0,1
data 8,12,13,13,0,0,50,1
data 4,8,13,13,0,0,50,1
data 10,14,11,11,0,50,0,1
data 10,11,6,6,50,0,50,1
data 4,13,9,9,50,0,0,1
data 1,4,9,9,50,0,0,1
data 1,9,10,10,50,0,0,1
data 6,1,10,10,50,0,50,1
data 5,4,1,1,0,50,50,1
data 8,4,3,3,0,0,50,1
data 3,12,8,8,0,0,50,0
data 3,4,5,5,0,50,50,1
data 7,12,3,3,50,50,0,1
data 14,12,11,11,0,50,0,0
data 11,12,7,7,50,50,0,1
data 6,11,2,2,50,0,50,1
data 11,7,2,2,50,50,0,0
data 1,6,2,2,50,0,50,1
data 2,5,1,1,0,50,50,1
data 2,7,3,3,50,50,0,0
data 2,3,5,5,0,50,50,1
return


