'#########################################################
'##
'##  PSYCHE SPIRAL Demo
'##  By Franck Chevassu (aka. Parabellum) --- August 2002
'##
'##  This code runs at 50 FPS on a PS2.
'##  Feel free to use any part of this code.
'##
'##  You  can  create new  patterns just by  adding new
'##  entries at the end of the data block ( but be sure
'##  that the data sections ends with the "data 0" line).
'##
'#########################################################

s$=   "        Welcome to the\n"
s$=s$+"     PSYCHE SPIRALS demo!\n"
s$=s$+"______________________________\n\n"
s$=s$+"  Hit the \"cross\" button to\n"
s$=s$+"  cycle through the effects\n"
s$=s$+"  and \"start\" to freeze...\n\n"
s$=s$+"  Warning : Maybe you'll have\n"
s$=s$+"  to buy new eyes afterwards!\n"
s$=s$+"______________________________\n\n"
s$=s$+"              ParaBelLum, 2002"

t$="Before the mandatory greetings list, a bit of advice "
t$=t$+": people suffering epilepsy MUST *NOT* watch this "
t$=t$+"demo (it is not a joke) . . . Well, I must admit t"
t$=t$+"his demo is best seen on a PS2, since it somewhat "
t$=t$+"\"hides\" visual glitches (damn, the emulator is w"
t$=t$+"ay too accurate, Jim! :) . . . OK, so Parabellum s"
t$=t$+"ends his greetings to the following people (alphab"
t$=t$+"etical order)  ###  DemonEye  -- Do you really wan"
t$=t$+"t to destroy us all? :)  ###  Doctor  -- Cool prog"
t$=t$+"rams! Thanks for your comments on my demos.  ###  "
t$=t$+"Jim Shaw  -- The last version of your emulator roc"
t$=t$+"ks! Thanks for the optimisation tips.  ###  Jinx  "
t$=t$+"-- Hold on to the 3D mate, you're getting quite go"
t$=t$+"od at it :)  ###  Jo Morrow  -- I really enjoy you"
t$=t$+"r games. Please post more of them!  ###  KyataAvl "
t$=t$+" -- No flames this time, but beware! OK, I'm just "
t$=t$+"kidding :) Did you start your 3D pool game project"
t$=t$+"?  ###  Shockwave  -- You make me cry each time I "
t$=t$+"see your latest releases :) And TankZone almost ki"
t$=t$+"lled me! You sure rule the YAB scene mate!  ###  X"
t$=t$+"althorn  -- Thanks for your help with the XPort. I"
t$=t$+" love your demos, carry on!  ### . . . I also send"
t$=t$+" greetings to all the other aficionados on the YAB"
t$=t$+"asic boards - See you soon on WWW.YABASIC.CO.UK . "
t$=t$+". . . . . . . . . . . . . . . . . . . . . . . . . "
t$=t$+". . . I really think it's time for you to press th"
t$=t$+"e X button of your gamepad . . . Enjoy the show !"

for i=1 to 3 t$=t$+"           " next
TL=len(t$)
TI=1
TX=900

open window 640,512 : window origin "cc"
gosub BLABLA

LABEL PATTERNS
data 1300.60, 1659.94, 1714.23, 1735.51, 1749.91, 1751.09
data 1751.87, 1752.77, 1760.00, 1781.14, 1795.88, 1797.88
data 1809.82, 1812.50, 1821.80, 1857.51, 1871.41, 1880.69
data 1899.00, 1907.30, 1942.34, 1946.54, 1950.21, 1973.64
data 1977.74, 1996.01, 2000.13, 2034.35, 2094.65, 2145.85
data 2188.85
data 0

dim S(7200), C(7200), Sa(7200), Ca(7200)
for i=0 to 7200
  I     = i * PI / 720
  S(i)  = sin(I)
  C(i)  = cos(I)
  Sa(i) = 255 * abs(S(i))
  Ca(i) = 255 * abs(C(i))
next

I=1 : IS=2
intro=1
mode=1

xrs=10
yr=-230-100   rem -- set to "-230" to see the FPS checker

LABEL LOOP rem ===========================================

'>>> This is some FPS checker code. But if commented out,
'>>> the framerate drops when X is pressed !!!  :/
'
     clear fill rect xr,yr to xr+20,yr+20
     setrgb 1,200,200,200
     fill rect xr+2,yr+2 to xr+18,yr+18
     xr=xr+xrs
     if xr>295  xrs=-10
     if xr<-295 xrs=10
'
'<<< End of FPS checker code

setdispbuf DB
DB=1-DB
setdrawbuf DB

A = mod( A+35, 1440)
R = mod( R+4,  1440)
G = mod( G+3,  1440)
B = mod( B+5,  1440)

if intro=1 goto INTRO

r=R : g=G : b=B : x=0 : y=0

if mode=14 goto M6
on mode gosub M1,M1,M2,M3,M4,M3,M4,M5,M5,M4,M4,M5,M5

LABEL RETURN_M6

if peek("port1")<>0 goto GAMEPAD
key=0

GOTO LOOP

LABEL M1 rem =============================================

  if mode<>1 then setrgb 1,0,0,0
             else setrgb 1,255,255,255 : A=A+21
  fi
  for a=5640 to 41 step -41
    k=a+A
    x1=a/10*C(k)
    y1=a/11*S(k)
    setrgb 3,Ca(r),Sa(g),Ca(b)
    r=r+1.125
    g=g+1.250
    b=b+1.000
    setrgb 2,Ca(r),Sa(g),Ca(b)
    gtriangle 0,0 to x,y to x1,y1
    x=x1 : y=y1
  next

RETURN

LABEL M2 rem =============================================

  setrgb 1,0,0,0
  for a=5640 to 50 step -50
    x1 = a/10*C(a+A)
    y1 = a/11*S(a+A)
    setrgb 2,255*C(A+45),255*S(A+45),255*C(A+595)
    setrgb 3,255*C(A),255*S(A),255*C(A+550)
    gtriangle 0,0 to x,y to x1,y1
    x=x1 : y=y1
  next
    
RETURN

LABEL M3 rem =============================================

  if mode=4 then
    clear window
    I=-41
  else
    setrgb 1,Sa(B),Sa(R),Ca(G)
    fill rect -320,-256 to 320,256
    I=-41.15
  fi
  for a=5640 to 41 step I
    x1=a/10*C(a+A)
    y1=a/11*S(a+A)
    setrgb 3,Ca(r),Sa(g),Ca(b)
    r=r+3.5
    g=g+4
    b=b+3
    setrgb 2,Ca(r),Sa(g),Ca(b)
    k=1-k
    if k=0 gtriangle 0,0 to x,y to x1,y1
    x=x1 : y=y1
  next

RETURN

LABEL M4 rem =============================================

  if mode=5 then
    o=1 : m=1 : gosub BACKGROUND
    setrgb 1,0,0,0
    m=0 : o=-37
  else
    m=40
    if mode=7 then 
      setrgb 1,250,200,0
      o=-48.92
    else
      setrgb 1,Sa(R),Sa(B),0
      o=-39.92
    fi
  fi
  for a=5640 to m step o
    x1=a/10*C(a+A)
    y1=a/11*S(a+A)
    r1=r+1.125
    g1=g+1.250
    b1=b+1.000
    k=1-k
    if k=1 then
      setrgb 2,Ca(r1),Sa(g1),Ca(b1)
      setrgb 3,Ca(r),Sa(g),Ca(b)
      gtriangle 0,0 to x,y to x1,y1
    fi
    r=r1 : g=g1 : b=b1
    x=x1 : y=y1
  next
  if mode=11 A=A+3
  o=0 : m=0

RETURN

LABEL M5 rem =============================================

  if mode=8 then
    A=A-3
    setrgb 1,250,200,0
    m=1440.1175
  elsif mode=9 then
    A=A-3
    setrgb 1,Sa(R),Sa(B),0
    m=1440.1175
  else
    if mode=12 then
      setrgb 1,0,0,0
    else
      setrgb 1,Sa(R),Sa(B),Ca(G)
    fi
    m=1450.4
  fi
  for a=5640 to 41 step -44.968
    x1=a/10*C(a+A)
    y1=a/11*S(a+A)
    A=mod(A+m,1440)
    r1=r+1.125
    g1=g+1.250
    b1=b+1.000
    k=1-k
    if k=0 then 
      setrgb 2,Ca(r1),Sa(g1),Ca(b1)
      setrgb 3,Ca(r),Sa(g),Ca(b)
      gtriangle 0,0 to x,y to x1,y1
    fi
    r=r1 : g=g1 : b=b1
    x=x1 : y=y1
  next
  m=0

RETURN

LABEL M6 rem =============================================

  setrgb 1,0,0,0
  for a=5640 to 41 step -44.968
    x1=a/10*C(a+A)
    y1=a/11*S(a+A)
    A=mod(A+m,1440)
    setrgb 3,Ca(r),Sa(g),Ca(b)
    r=r+1.125
    g=g+1.250
    b=b+1.000
    setrgb 2,Ca(r),Sa(g),Ca(b)
    gtriangle 0,0 to x,y to x1,y1
    x=x1 : y=y1
  next

GOTO RETURN_M6

LABEL INTRO rem ==========================================

  o=1    : m=1   : gosub BACKGROUND
  o=0.75 : m=0.5 : gosub BACKGROUND
  clear rect -160,-128 to 160,128
  
  setrgb 1,0,0,0
  ts$ = mid$(t$,TI,65)
  text TX,240,ts$
  TX=TX-3
  if TX<-330 then
    TI=TI+1
    TX=TX+10
    if TI=TL then TI=1 : TX=320 fi
  fi
  
  if I<>0 and IS>0 gosub FADE
  gosub BLABLA
  
  if I=0 and peek("port1")=16384 then I=400 : IS=-4 fi
  if I<>0 and IS<0 then
    gosub FADE
    if I=0 then 
      s$="" :t$="":ts$="": intro=0:o=0:m=0: TX=0:TI=0:TL=0
    fi
  fi
  
GOTO LOOP

LABEL GAMEPAD rem ========================================

  x = AND( peek( "port1"), 16392)
  if x<>key then
    if AND(x,8)=8 then
'     --- Freeze anim. until PAUSE is pressed once more
      clear fill rect -310,223 to -280,250
      setrgb 1,255,255,255
      rect -310,223 to -280,250
      if mode>9 then s$="" else s$="0" fi
      text -305,241,s$+str$(mode+max(0,subm-1))
      s$="" : setdispbuf DB
      for key=2 to 0 step -1
        repeat until(AND(peek("port1"),8)=8*AND(key,1))
      next
    else
'     --- Advance to the next pattern
      key=x : k=0
      if key<>0 then
        if mode<13 then
          mode=mode+1
        else
          mode=14 : read m : subm=subm+1
          if m=0 then subm=0: mode=1: restore PATTERNS fi
        fi
      fi
    fi
  fi
  
GOTO LOOP

LABEL BACKGROUND rem =====================================

  setrgb 1,o*Ca(B),o*Ca(R),o*Sa(G)
  setrgb 2,o*Ca(R),o*Sa(G),o*Sa(B)
  setrgb 3,o*Ca(G),o*Sa(B),o*Sa(R)
  gtriangle 320*m,256*m to 320*m,-256*m to -320*m,256*m
  setrgb 1,o*Sa(B),o*Sa(R),o*Ca(G)
  gtriangle -320*m,-256*m to 320*m,-256*m to -320*m,256*m

RETURN

LABEL BLABLA rem =========================================

  setrgb 1,0,0,0       : text -149,117,s$
  setrgb 1,255,255,255 : text -151,115,s$

RETURN

LABEL FADE rem ===========================================

  i=I
  setrgb 1,0,0,0
  fill rect -320,-256 to 320,-i
  fill rect -320, 256 to 320, i
  fill rect -320,-256 to -i,256
  fill rect  320,-256 to  i,256
  x1=i : y1=0
  for a=10 to 360 step 10
    x2=i*C(a)
    y2=i*S(a)
    fill triangle -i,-i to -x1,-y1 to -x2,-y2
    fill triangle  i, i to  x1, y1 to  x2, y2
    fill triangle -i, i to -x1, y1 to -x2, y2
    fill triangle  i,-i to  x1,-y1 to  x2,-y2
    x1=x2 : y1=y2
  next
  if (i>400) then I=0 else I=I+IS fi

RETURN



