REM =====================================================================
REM
REM     A K L A B S   M E G A D E M O   ' 8 5
REM
REM     CODE AND FX ............. TACHIKOMA
REM     DEDICATED TO ............ GAMECUBE
REM     MEGAGREETZ .............. STARFORT
REM
REM  A demoscene production for the akbasic interpreter, written as if
REM  it were 1985 and this dialect were the machine under the tree.
REM  It leans on every corner of the interpreter on purpose:
REM
REM    - it carries chapter 17's LCG rather than the native RND, and seeds it
REM      from the jiffy clock
REM    - the palette cannot be rewritten, so every "colour cycle" is an
REM      honest redraw of the same strokes in the next colour
REM    - there are eight sprites, so the lettering IS the sprite bank:
REM      each letter of GAMECUBE is drawn with the stroke font, captured
REM      with SSHAPE and installed with SPRSAV
REM    - SOLID walls and COLLISION 2 bounce that lettering around the
REM      screen with RCOLLISION(n, 7) saying which axis to reverse
REM    - the PLAY queue is one queue -- monophonic, one instrument per
REM      batch (TODO.md 4) -- so the soundtrack is beeper-style: one
REM      interleaved line that is its own kick, bass and arpeggio,
REM      with a noise drum break every third batch. Voice 1 is music,
REM      voice 2 the collision blips, voice 3 the scene sweeps
REM    - 3D wireframes with no matrices: two composed rotations and a
REM      perspective divide per vertex, floats kept on the left the
REM      whole way because the left operand decides the arithmetic
REM
REM  It probes for its hardware like a proper boot loader. No audio
REM  device mutes it. No text grid drops the status row. A host with no
REM  clock -- tools/screenshot.c -- gets each scene as a still and the
REM  finale as the picture, because every animation loop is gated on
REM  TI# actually moving.
REM
REM  Q or ESC quits. TODO.md section 4 records what this program wanted
REM  and could not have.
REM
REM =====================================================================

REM ---- every pool up front: the DIM pool never frees (chapter 13) ----
DIM FNC#(41)
DIM FNI#(41)
DIM FNS#(280)
DIM RBW#(7)
DIM STC#(4)
DIM BARC#(20)
DIM SBG#(9)
DIM BYO%(4)
DIM WVX%(14)
DIM WVY%(14)
DIM WVZ%(14)
DIM WPX#(14)
DIM WPY#(14)
DIM WQX#(14)
DIM WQY#(14)
DIM WE1#(24)
DIM WE2#(24)
DIM PBRD#(63)

ALPHA$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 :-.!"
GC$ = "GAMECUBE"
REM  The picture decoder's alphabets: a run is two characters, colour
REM  then length, and INSTR turns each back into a number.
CPAL$ = "ABCDEFGHIJKLMNOP"
LTAB$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
SEED# = 314159
QF# = 0
RB# = 0
PH% = 0
MT# = 0
W# = 320
H# = 200

REM  A scalar FIRST assigned inside a GOSUB lives in that call's scope
REM  and dies at RETURN, so a subroutine's OUTPUT must be assigned here
REM  first to make it a global -- that is why chapter 18 predeclares.
REM  But only the outputs: there are 128 variable slots in the whole
REM  machine and a predeclared scratch variable occupies one forever,
REM  where a scoped one gives its slot back. The first cut of this
REM  program predeclared everything and ran the pool dry.
RMAX# = 0
ROLL# = 0
TX% = 0
TB# = 0

REM =====================================================================
REM  Probe the machine. Graphics is mandatory; everything else degrades.
REM =====================================================================
GFX# = 1
TRAP NOGFX
W# = RGR(1)
H# = RGR(2)
TRAP
IF GFX# = 1 THEN GOTO HAVEGFX
PRINT "THIS DEMO NEEDS THE SDL BUILD (-DAKBASIC_WITH_AKGL=ON)."
END
LABEL HAVEGFX

SND# = 1
TRAP NOSID
SOUND 1, 17175, 4
VOL 12
TRAP

TXT# = 1
TRAP NOGRID
WINDOW 0, 0, 39, 0
TRAP

KEYS# = 1
K# = 0
TRAP NOKEYS
GET K#
TRAP

REM  A host that never sets the clock is the screenshot tool. TI# stays
REM  zero there, so every wait would spin forever: render stills instead.
HL# = 0
SLEEP 0.3
IF TI# = 0 THEN HL# = 1
SEED# = SEED# + TI#

GOSUB LOADTABLES
GOSUB LOADWIRE
GOSUB LOADFONT
GOSUB LOADBIRD
IF SND# = 1 THEN GOSUB SIDINIT
GOSUB TUNE
IF TXT# = 1 THEN CHAR 1, 0, 0, "AKLABS MEGADEMO 85 - PRESS Q TO EXIT"

REM =====================================================================
REM  SCENE 1 : TITLE.  Starfield from the LCG, the logo in rainbow,
REM  and the "palette cycle" that is really a redraw.
REM =====================================================================
GRAPHIC 1, 1
WIDTH 1
NS# = 120
GOSUB STARS
WIDTH 2
T$ = "AKLABS"
SZ% = 0.025 * W#
GOSUB CENTERX
TY% = 0.12 * H#
CM# = 1
GOSUB DRAWTEXT
CM# = 0
COLOR 1, 2
T$ = "PRESENTS"
SZ% = 0.008 * W#
GOSUB CENTERX
TY% = 0.45 * H#
GOSUB DRAWTEXT
COLOR 1, 4
T$ = "A 1985 DEMO FOR GAMECUBE"
SZ% = 0.006 * W#
GOSUB CENTERX
TY% = 0.58 * H#
GOSUB DRAWTEXT
GOSUB SWEEP
IF HL# = 1 THEN GOTO S1DONE
T$ = "AKLABS"
SZ% = 0.025 * W#
GOSUB CENTERX
TY% = 0.12 * H#
DL# = TI# + 420
DO WHILE TI# < DL#
  RB# = RB# + 1
  CM# = 1
  GOSUB DRAWTEXT
  CM# = 0
  GOSUB POLLKEY
  IF QF# = 1 THEN EXIT
  SLEEP 0.12
LOOP
LABEL S1DONE
IF QF# = 1 THEN GOTO BYE

REM =====================================================================
REM  SCENE 2 : LISSAJOUS BRAID.  Twelve phase-shifted 3:2 curves, drawn
REM  once each -- the drawing layer persists, so the braid accumulates.
REM =====================================================================
GRAPHIC 1, 1
WIDTH 1
CX% = 0.5 * W#
CY% = 0.5 * H#
R1% = 0.3 * W#
R2% = 0.38 * H#
PN# = 0
DO WHILE PN# < 12
  COLOR 1, RBW#(MOD(PN#, 7))
  GOSUB SPIRO1
  IF HL# = 0 THEN SLEEP 0.25
  GOSUB POLLKEY
  IF QF# = 1 THEN EXIT
  PN# = PN# + 1
LOOP
WIDTH 2
COLOR 1, 2
T$ = "TACHIKOMA FX"
SZ% = 0.007 * W#
GOSUB CENTERX
TY% = 0.88 * H#
GOSUB DRAWTEXT
IF HL# = 0 THEN SLEEP 1.5
IF QF# = 1 THEN GOTO BYE

REM =====================================================================
REM  SCENE 3 : WIREFRAMES.  A cube and an octahedron out of one pooled
REM  vertex and edge table -- two composed rotations and a perspective
REM  divide per vertex, no matrices anywhere.  Each frame erases the
REM  previous edges in black and draws the new ones, the raster bars'
REM  trick applied to twenty-four lines.  A clockless host gets five
REM  exposures without the erase: a tumble, as a still.
REM
REM  The way out is the way in: the solids drift together, the point
REM  they share ignites -- pulsing through the bar ramp table, because
REM  it is the origin of the next scene -- the camera dives through
REM  the frames as the perspective scale outgrows the window, and the
REM  origin splits in two, rides the Y axis to the bars' band, and
REM  stretches into the first two raster bars itself.
REM =====================================================================
GRAPHIC 1, 1
WIDTH 1
NS# = 90
GOSUB STARS
WIDTH 2
COLOR 1, 2
T$ = "TWO SOLIDS - NO MATRICES - PURE SIN"
SZ% = 0.0045 * W#
GOSUB CENTERX
TY% = 0.06 * H#
GOSUB DRAWTEXT
SF% = 0.24 * H#
CY% = 0.55 * H#
A1% = 0.4
B1% = 0.9
A2% = 1.1
B2% = 0.3
FC# = 0
IF HL# = 0 THEN GOTO WIRELIVE
PN# = 0
DO WHILE PN# < 5
  RA% = A1%
  RB% = B1%
  CX% = 0.3 * W#
  VS# = 0
  VE# = 8
  ES# = 0
  EE# = 12
  GOSUB WIRESPIN
  COLOR 1, RBW#(PN#)
  GOSUB WIREDRAW
  RA% = A2%
  RB% = B2%
  CX% = 0.7 * W#
  VS# = 8
  VE# = 14
  ES# = 12
  EE# = 24
  GOSUB WIRESPIN
  GOSUB WIREDRAW
  A1% = A1% + 0.3
  B1% = B1% + 0.19
  A2% = A2% - 0.26
  B2% = B2% + 0.17
  PN# = PN# + 1
LOOP
GOTO WIREDONE
LABEL WIRELIVE
C1X% = 0.3 * W#
C2X% = 0.7 * W#
DL# = TI# + 360
DO WHILE TI# < DL#
  GOSUB SPINSTEP
  IF TI# > MT# THEN GOSUB TUNE
  GOSUB POLLKEY
  IF QF# = 1 THEN EXIT
  GOSUB VSYNC
LOOP
IF QF# = 1 THEN GOTO WIREDONE
REM  Converge: the two solids drift to the shared centre, spinning
REM  the whole way in.
XS1% = (0.2 * W#) / 36
GF# = 0
DO WHILE GF# < 36
  C1X% = C1X% + XS1%
  C2X% = C2X% - XS1%
  GOSUB SPINSTEP
  IF TI# > MT# THEN GOSUB TUNE
  GOSUB POLLKEY
  GOSUB VSYNC
  GF# = GF# + 1
LOOP
C1X% = 0.5 * W#
C2X% = 0.5 * W#
REM  The origin point ignites inside them.
BF# = 0
PB% = 0
BBR% = 22.0
GF# = 0
DO WHILE GF# < 40
  GOSUB SPINSTEP
  GOSUB BALLFX
  IF TI# > MT# THEN GOSUB TUNE
  GOSUB POLLKEY
  GOSUB VSYNC
  GF# = GF# + 1
LOOP
REM  The camera goes in: the perspective scale grows past the window
REM  and the solids pass out of view around us. The drawing verbs
REM  clip silently, so the coordinates are allowed to leave.
GOSUB ZOOMSND
GF# = 0
DO WHILE GF# < 26
  SF% = 1.14 * SF%
  BBR% = BBR% + 1.2
  GOSUB SPINSTEP
  GOSUB BALLFX
  IF TI# > MT# THEN GOSUB TUNE
  GOSUB POLLKEY
  GOSUB VSYNC
  GF# = GF# + 1
LOOP
ES# = 0
EE# = 24
GOSUB WIRERASE
REM  The origin splits; each half rides the Y axis out to where the
REM  bars are about to be born.
IF SND# = 1 THEN SOUND 2, 30000, 4
YO% = 0
GF# = 0
DO WHILE GF# < 18
  DCI# = 1
  DR% = PB%
  DCX% = C1X%
  DCY% = CY% - YO%
  GOSUB DISC
  DCY% = CY% + YO%
  GOSUB DISC
  YO% = YO% + 4.4
  IF YO% > 70 THEN YO% = 70
  BF# = BF# + 1
  DR% = 16.0 + (6.0 * SIN(1.1 * BF#))
  DCI# = BARC#(MOD(BF#, 20))
  DCY% = CY% - YO%
  GOSUB DISC
  DCI# = BARC#(MOD(BF# + 10, 20))
  DCY% = CY% + YO%
  GOSUB DISC
  PB% = DR%
  GOSUB POLLKEY
  GOSUB VSYNC
  GF# = GF# + 1
LOOP
DCI# = 1
DR% = PB%
DCY% = CY% - YO%
GOSUB DISC
DCY% = CY% + YO%
GOSUB DISC
REM  Each ball shoots out to the full width of the screen and is a
REM  raster bar by the time it gets there.
XR% = 4.0
DO WHILE XR% < (0.5 * W#)
  BY% = (CY% - YO%) - 9
  BR# = 0
  GOSUB PROTOBAR
  BY% = (CY% + YO%) - 9
  BR# = 5
  GOSUB PROTOBAR
  XR% = XR% + (0.045 * W#)
  GOSUB POLLKEY
  GOSUB VSYNC
LOOP
SLEEP 0.3
LABEL WIREDONE
IF QF# = 1 THEN GOTO BYE

REM =====================================================================
REM  SCENE 4 : RASTER BARS.  The palette is not writable, so these are
REM  not palette tricks: every frame erases four bars in black and
REM  redraws them two scanlines at a time.  Racing TI# is the beam.
REM =====================================================================
GRAPHIC 1, 1
WIDTH 1
NS# = 90
GOSUB STARS
WIDTH 2
COLOR 1, 2
T$ = "NO PALETTE WRITES - EVERY CYCLE REDRAWN"
SZ% = 0.0045 * W#
GOSUB CENTERX
TY% = 0.06 * H#
GOSUB DRAWTEXT
CY3% = 0.55 * H#
IF HL# = 0 THEN GOTO BARLIVE
BI# = 0
DO WHILE BI# < 4
  BY% = CY3% + (70.0 * SIN(1.5 * BI#))
  BR# = BI# * 5
  EB# = 0
  GOSUB DRAWBAR
  BI# = BI# + 1
LOOP
GOTO BARDONE
LABEL BARLIVE
DL# = TI# + 480
DO WHILE TI# < DL#
  BI# = 0
  DO WHILE BI# < 4
    BY% = BYO%(BI#)
    BR# = BI# * 5
    EB# = 1
    GOSUB DRAWBAR
    BI# = BI# + 1
  LOOP
  PH% = PH% + 0.13
  BI# = 0
  DO WHILE BI# < 4
    BY% = CY3% + (70.0 * SIN(PH% + (1.5 * BI#)))
    BR# = BI# * 5
    EB# = 0
    GOSUB DRAWBAR
    BYO%(BI#) = BY%
    BI# = BI# + 1
  LOOP
  IF TI# > MT# THEN GOSUB TUNE
  GOSUB POLLKEY
  IF QF# = 1 THEN EXIT
  GOSUB VSYNC
LOOP
LABEL BARDONE
IF QF# = 1 THEN GOTO BYE

REM =====================================================================
REM  SCENE 5 : THE PICTURE, AND THEN IT MOVES.  A full 800x600
REM  vaporwave sunset carried inside the listing, then six delta
REM  frames of full motion video in a loop. DATA could never hold any
REM  of it -- the pool is 512 items and the font owns most of them
REM  (TODO.md section 4) -- so it all rides in string literals:
REM  run-length encoded, two characters a run, decoded with INSTR and
REM  painted as 5x5 blocks. A video frame re-encodes only the rows
REM  that changed ('R' records jump the cursor), 'Q' skips what stayed
REM  and black draws over what moved, so a frame of grid-scroll and
REM  sun-shimmer is about two hundred bytes and paints in a few
REM  presents. The rays are not encoded at all: they are struck live
REM  over every frame, which is what keeps the floor rows cheap. The
REM  loop is exact -- the grid advances one geometric step over six
REM  frames and the slice pattern's period is six. The paint is the
REM  reveal; the exit is a stride-63 column dissolve. The bird is the
REM  one thing DATA does hold: a real 24x21 SPRSAV sprite, 63 bytes,
REM  gliding across its own sunset. vaporwave.py draws the picture,
REM  proves base plus deltas reproduce every frame, and owns the
REM  generated block.
REM =====================================================================
GRAPHIC 1, 1
WIDTH 2
BS% = W# / 160
IF BS% < 1 THEN BS% = 1
REM  ---- PICTURE-BEGIN (generated by vaporwave.py; do not
REM  ---- hand-edit -- rerun the script to change the picture)
DIM IM$(56)
DIM VA#(6)
DIM VB#(6)
NS# = 32
VA#(0) = 32
VB#(0) = 35
VA#(1) = 36
VB#(1) = 39
VA#(2) = 40
VB#(2) = 43
VA#(3) = 44
VB#(3) = 47
VA#(4) = 48
VB#(4) = 51
VA#(5) = 52
VB#(5) = 55
IM$(0) = "G9G9G9G9GPGHEHG9GTEHG9GTEHGPGPEHG9GTEHG9GTEHGHGXEHGTBAG8EHG9GTEH"
IM$(1) = "G5EHGPEHG5EHGPEHG5EHGAPAG3EHGPEHG5EHGPEHGXGHEHG5EHGPEHG5EHGFBAGI"
IM$(2) = "EHGPGPEHGPEHGHEHGPEHGPEHGHEHGPEHGHEHGPEHGPEHGHEHGBPAGMEHGPEHGHEH"
IM$(3) = "GPEHGHEHGPEHGPEHGHEHGPEHGPEHGHEHGPEHGHEPGHEHGPEHGHEPGHEHGPEHGHEP"
IM$(4) = "GHEHGHEGBAEHGHEHGPEHGHEPGHEHGPEHGHEHGPEHGHEPGHEHGPEHGHEPGHEHGPEC"
IM$(5) = "PAEDGHEPGHEHGHEPGHEPGHEHGHEPGHEPGHEHGHEPGHEHGHEPGHEPGHECBAEDGHEP"
IM$(6) = "GHEPGHEHGHEPGHEHGHEPGHEPGHEHGHEPGHEPEPGHEPGHE5GHEPGHE5GHEHEXGHEP"
IM$(7) = "GHEEPAEZGHEPGHE5GHE5GHEPGHE5GHEPGHE5GHE9ETGHE9ETGHEXEHGHE9ETGHHA"
IM$(8) = "E9ESGHEPEPGBBAGEE9EMHOE9ETGHEHE9E7HUE9E6E9E4H0E9E3E9E3H2E9EHBAET"
IM$(9) = "EHKHE9ELH6E9ECKHEPEPKHE9EBH9HAE9EIKHEHEXKHE2H9HCE9EPKHE5KHEPKDH9"
IM$(10) = "HEKCEPKHE5KHE5KHEKH9HGEBKHEPKHEXEHKHE5KHEBH9HIEIKHEPKHEPEPKHEPKH"
IM$(11) = "EHKAH9HKKHEHKHEPKHEHKHEPKHEPKHH9HMEGKHEHKHEPKHEHKHEPKHEPH9HMEOKH"
IM$(12) = "EHKHEPKHEHKPEHKHEGH9HOKFEPKHEHKPEHKHEHKPEHKGH9HOEFKHEPKHEHKHEPKH"
IM$(13) = "EHKPEFH9HQKEEHKHEPKHEHKHEPKHEHKMH9HSKLEHKHEPKHEHKPEHKHEHKEH9HSED"
IM$(14) = "KPEHKPEHKHEHKPEHKHEEH9HSKDEHKPEHKPKPEHKPEHKDH9HUECKHEHKPEHKHKXEH"
IM$(15) = "KPEDH9HUKCEHK5EHK5EHKLH9HUKKEHK5EHK5EHKCH9HWEBKPEHKXKHEHK8I9IWKZ"
IM$(16) = "EHKPKPEHK0I9IWK7EHKHKXEHKSI9IWK9KFEHK9KOI9IWK9KNK9KOI9IWK9KNK9KO"
IM$(17) = "I9IWK9KNKPIHKZI9IYK6IHKHKXIHKSI9IWK9KFIHK5IHKKI9IWK9KNIHK5IHKCI9"
IM$(18) = "IYKPIHKXKHIHK5IHKPIHK5IHKPIHKPKPIHK0I9IWKJIHKPIHKHIHKPIHKPI9IZKB"
IM$(19) = "IHKHIHKPIHKHIHKPIHKKI9IWKJIHKHIHKPIHKHIHKPIHKDI9IXKPIHKHIHKHKHIH"
IM$(20) = "KHIPKHI9IYKCIHKPIHKHIHKPIHKHIPKHIHKPIHKHIPKHIHKPIHKHIHKPIHKHI9I9"
IM$(21) = "IHKHIHKPIHKHIPKHIHKHIEC9CSKDIPKHIPKHIHKHIPKHIHKEC9CSIDKHIPKHIPIP"
IM$(22) = "KHIPKHIFC9CQKEIHKHIPKHIHIXKHIPKGC9COIFKHI5KHI5KHIPKHI5KHIPKHI5KH"
IM$(23) = "I5KHIPKHI5KHIPKHIXIHKHI9IDC9CMI4KHIPIPKHI6C9CKI9IDKHIHIXKHIZC9CI"
IM$(24) = "I9IMKHI9IWC9CGI9IVI9I9I9I9IPI9I9I9I9IPQ9Q9Q9Q9QPE9E9E9E9EPE9E9E9"
IM$(25) = "E9EPQ9Q9Q9Q9QPE9E9E9E9EPQ9Q9Q9Q9QPE9E9E9E9EPQ9Q9Q9Q9QPQ9Q9Q9Q9QP"
IM$(26) = "Q9Q9Q9Q9QPQ9Q9Q9Q9QPE9E9E9E9EPQ9Q9Q9Q9QPQ9Q9Q9Q9QPQ9Q9Q9Q9QPQ9Q9"
IM$(27) = "Q9Q9QPQ9Q9Q9Q9QPQ9Q9Q9Q9QPE9E9E9E9EPQ9Q9Q9Q9QPQ9Q9Q9Q9QPQ9Q9Q9Q9"
IM$(28) = "QPQ9Q9Q9Q9QPQ9Q9Q9Q9QPQ9Q9Q9Q9QPQ9Q9Q9Q9QPQ9Q9Q9Q9QPQ9Q9Q9Q9QPQ9"
IM$(29) = "Q9Q9Q9QPE9E9E9E9EPQ9Q9Q9Q9QPQ9Q9Q9Q9QPQ9Q9Q9Q9QPQ9Q9Q9Q9QPQ9Q9Q9"
IM$(30) = "Q9QPQ9Q9Q9Q9QPQ9Q9Q9Q9QPQ9Q9Q9Q9QPQ9Q9Q9Q9QPQ9Q9Q9Q9QPQ9Q9Q9Q9QP"
IM$(31) = "Q9Q9Q9Q9QPQ9Q9Q9Q9QPQ9Q9Q9Q9QPQ9Q9Q9Q9QPQ9Q9Q9Q9QP"
IM$(32) = "RBRQ9QOKMQHK5RBSQ9QTI9IRRBXQ9QTKPQHKHQPKERBYQ9QPI9IHRB3Q9QSKAI5"
IM$(33) = "KHIJRB5Q9QTC9CMRB9Q9QWI9IGRCBQ9QYC9CCRCIA9A9A9A9APRCJE9E9E9E9EP"
IM$(34) = "RCNA9A9A9A9APRCOE9E9E9E9EPRCUA9A9A9A9APRCVE9E9E9E9EPRC5A9A9A9A9"
IM$(35) = "APRC7E9E9E9E9EP"
IM$(36) = "RBQQ9QOK9KIQHKFRBRQ9QOI9IQRBWQ9QPKLQHKHQHKPRBXQ9QTI9QLIERB2Q9QR"
IM$(37) = "IBKHIPKHIPKCRB4Q9QSC9CORB8Q9QVI3KHIGRCAQ9QXC9CERCJA9A9A9A9APRCK"
IM$(38) = "E9E9E9E9EPRCOA9A9A9A9APRCPE9E9E9E9EPRCVA9A9A9A9APRCXE9E9E9E9EP"
IM$(39) = "RC7A9A9A9A9APRDAE9E9E9E9EP"
IM$(40) = "RBPQ9QOK9KAQHKNRBQQ9QOI9IWRBVQ9QOKEQHKHQHKPQHKFRBWQ9QPI9IPRB1Q9"
IM$(41) = "QQKCIPKHIPKHIDRB3Q9QSC9CORB7Q9QUIWKHIPRB9Q9QWC9CGRCEA9A9A9A9AP"
IM$(42) = "RCFE9E9E9E9EPRCGA9A9A9A9APRCHE9E9E9E9EPRCPA9A9A9A9APRCQE9E9E9E9"
IM$(43) = "EPRCXA9A9A9A9APRCZE9E9E9E9EPRDAA9A9A9A9APRDCE9E9E9E9EP"
IM$(44) = "RBOQ9QNK3QHKWRBPQ9QOI9IWRBUQ9QTKHQHKPQHKNRBVQ9QOI9IWRB0Q9QQIKKH"
IM$(45) = "IPKHIHKDRB1Q9QQC9CSRB2Q9QRC9CQRB6Q9QTIPKHIYRB8Q9QVC9CIRCKA9A9A9"
IM$(46) = "A9APRCLE9E9E9E9EPRCQA9A9A9A9APRCRE9E9E9E9EPRCZA9A9A9A9APRC1E9E9"
IM$(47) = "E9E9EPRDCA9A9A9A9APRDFE9E9E9E9EP"
IM$(48) = "RBOQ9QNI9IYRBTQ9QOKEQHKPQHKVRBUQ9QTI9IRRBZQ9QTKHQHKPQHKHRB0Q9QQ"
IM$(49) = "C9CSRB5Q9QTIHKHI5KARB7Q9QUC9CKRCBQ9QYI9ICRCHA9A9A9A9APRCIE9E9E9"
IM$(50) = "E9EPRCLA9A9A9A9APRCME9E9E9E9EPRCRA9A9A9A9APRCTE9E9E9E9EPRC1A9A9"
IM$(51) = "A9A9APRC3E9E9E9E9EPRDFA9A9A9A9APRDIE9E9E9E9EP"
IM$(52) = "RBSQ9QTKPQHK3RBTQ9QOI9IWRBYQ9QPKDQHKPQHKHRBZQ9QTI9ILRB4Q9QSIAKH"
IM$(53) = "I5KHIBRB6Q9QTC9CMRCAQ9QXI9IERCEE9E9E9E9EPRCFA9A9A9A9APRCGE9E9E9"
IM$(54) = "E9EPRCMA9A9A9A9APRCNE9E9E9E9EPRCTA9A9A9A9APRCUE9E9E9E9EPRC3A9A9"
IM$(55) = "A9A9APRC5E9E9E9E9EPRDIA9A9A9A9AP"
REM  ---- PICTURE-END
SS# = 0
SE# = NS# - 1
GOSUB DRAWSTREAM
GOSUB RAYS
SPRSAV PBRD#, 1
SPRITE 1, 1, 1, 0, 1, 1
MOVSPR 1, 0.16 * W#, 0.14 * H#
IF HL# = 0 THEN MOVSPR 1, 96 # 1
COLOR 1, 2
T$ = "THE PICTURE IS STRINGS - THE BIRD IS DATA"
SZ% = 0.0038 * W#
GOSUB CENTERX
TY% = 0.02 * H#
GOSUB DRAWTEXT
IF HL# = 1 THEN GOTO PICDONE
REM  Six delta frames in a loop: the grid rolls toward you and the
REM  sun's slices crawl. Each frame repaints only the rows that
REM  changed, and the rays are struck over the top again.
VI# = 0
DL# = TI# + 480
DO WHILE TI# < DL#
  SS# = VA#(VI#)
  SE# = VB#(VI#)
  GOSUB DRAWSTREAM
  GOSUB RAYS
  VI# = VI# + 1
  IF VI# >= 6 THEN VI# = 0
  IF TI# > MT# THEN GOSUB TUNE
  GOSUB POLLKEY
  IF QF# = 1 THEN EXIT
LOOP
REM  The dissolve: black out the 160 columns in stride-63 order.
COLOR 1, 1
K2# = 0
DO WHILE K2# < 160
  CO# = MOD(K2# * 63, 160)
  X3% = CO# * BS%
  DRAW 1, X3%, 0 TO X3%, H# - 1
  X3% = X3% + 2
  DRAW 1, X3%, 0 TO X3%, H# - 1
  X3% = X3% + 2
  DRAW 1, X3%, 0 TO X3%, H# - 1
  IF MOD(K2#, 5) = 0 THEN GOSUB VSYNC
  K2# = K2# + 1
LOOP
MOVSPR 1, 0 # 0
SPRITE 1, 0
LABEL PICDONE
IF QF# = 1 THEN GOTO BYE

REM =====================================================================
REM  SCENE 6 : THE SPRITE BANK IS THE SCROLLTEXT, AND THEN IT EXPLODES.
REM  Eight letters, eight sprites: draw each with the stroke font,
REM  SSHAPE it, SPRSAV it, surf it on a sine. Then the letters fall
REM  into the middle, a supernova throws them at the walls -- SOLID
REM  and COLLISION 2 do the physics while BASIC reverses a bearing --
REM  and a black hole drags everything back to the centre as the
REM  transition out. A clockless host gets the wave over a frozen
REM  fireball as its still.
REM =====================================================================
WIDTH 2
SZ% = 7
L# = 1
DO WHILE L# < 9
  GRAPHIC 1, 1
  WIDTH 2
  COLOR 1, 2
  C$ = MID(GC$, L# - 1, 1)
  GI# = INSTR(ALPHA$, C$)
  GX2% = 10
  GY2% = 10
  GOSUB DRAWGLYPH
  SSHAPE SH$, 6, 6, 42, 56
  SPRSAV SH$, L#
  SPRITE L#, 1, RBW#(MOD(L# - 1, 7))
  L# = L# + 1
LOOP
GRAPHIC 1, 1
WIDTH 1
NS# = 100
GOSUB STARS
WIDTH 2
SPX% = 0.055 * W#
WX0% = 0.5 * (W# - (SPX% * 8))
WCY% = 0.5 * H#
AMP% = 60.0
GOSUB WAVE
CX0% = 0.5 * W#
CY0% = 0.5 * H#
PR% = 0
IF HL# = 0 THEN GOTO SNLIVE
ER% = 130
GOSUB BOOMFX
GOTO WAVEDONE
LABEL SNLIVE
DL# = TI# + 420
DO WHILE TI# < DL#
  PH% = PH% + 0.15
  GOSUB WAVE
  IF TI# > MT# THEN GOSUB TUNE
  GOSUB POLLKEY
  IF QF# = 1 THEN EXIT
  GOSUB VSYNC
LOOP
IF QF# = 1 THEN GOTO BYE
COLOR 1, 2
T$ = "EIGHT SPRITES - ONE SUPERNOVA - ZERO MATHS"
SZ% = 0.0045 * W#
GOSUB CENTERX
TY% = 0.03 * H#
GOSUB DRAWTEXT
REM  Wind-up: the letters fall into the middle on a slow spiral.
VC% = COS(0.1)
VS2% = SIN(0.1)
VF% = 0.78
GF# = 0
DO WHILE GF# < 14
  GOSUB VORTEX
  GOSUB VSYNC
  GF# = GF# + 1
LOOP
REM  The supernova. Every letter leaves the centre on its own bearing,
REM  eight of them fanned evenly around the compass, fast, while the
REM  fireball expands around them and the walls wait to ring.
GOSUB BOOMSND
SOLID 61, 0, 0, W# - 1, 12
SOLID 62, 0, H# - 13, W# - 1, H# - 1
SOLID 63, 0, 0, 12, H# - 1
SOLID 64, W# - 13, 0, W# - 1, H# - 1
COLLISION 2, BOUNCE
L# = 1
DO WHILE L# < 9
  SBG#(L#) = MOD((L# * 45) + 23, 360)
  MOVSPR L#, CX0%, CY0%
  MOVSPR L#, SBG#(L#) # 14
  L# = L# + 1
LOOP
ER% = 16
DO WHILE ER% < 430
  GOSUB BOOMFX
  ER% = (1.18 * ER%) + 6
  GOSUB POLLKEY
  IF QF# = 1 THEN EXIT
  GOSUB VSYNC
LOOP
BCF# = 1
BR2% = PR%
GOSUB BOOMPASS
REM  Debris. Let them ricochet for a while.
DL# = TI# + 300
DO WHILE TI# < DL#
  GOSUB SHEPHERD
  IF TI# > MT# THEN GOSUB TUNE
  GOSUB POLLKEY
  IF QF# = 1 THEN EXIT
  SLEEP 0.05
LOOP
COLLISION 2
SOLID
L# = 1
DO WHILE L# < 9
  MOVSPR L#, 0 # 0
  L# = L# + 1
LOOP
IF QF# = 1 THEN GOTO WAVEDONE
REM  The black hole. An iris of collapsing black circles swallows the
REM  screen from the outside in, the accretion arcs spin over the top,
REM  and the vortex drags every letter into the middle. The clear at
REM  the end is the event horizon closing over the corners.
GOSUB HOLESND
VC% = COS(0.26)
VS2% = SIN(0.26)
VF% = 0.86
HA0# = 0
IR% = 470
HF# = 0
DO WHILE HF# < 34
  GOSUB HOLEFX
  IR% = IR% - 14
  IF IR% < 24 THEN IR% = 24
  HAC# = 0
  GOSUB HOLEARC
  HA0# = MOD(HA0# + 26, 360)
  IF IR% > 70 THEN HAC# = 1
  IF IR% > 70 THEN GOSUB HOLEARC
  GOSUB VORTEX
  GOSUB POLLKEY
  GOSUB VSYNC
  HF# = HF# + 1
LOOP
GRAPHIC 1, 1
LABEL WAVEDONE
IF QF# = 1 THEN GOTO BYE

REM =====================================================================
REM  SCENE 7 : THE FINALE CARD.  Everything at once: stars, bars, the
REM  logo, the greetz, and the sprite bank surfing a sine.  This is the
REM  frame a clockless host leaves on the screen.
REM =====================================================================
GRAPHIC 1, 1
WIDTH 1
NS# = 150
GOSUB STARS
WIDTH 2
EB# = 0
BY% = 26
BR# = 10
GOSUB DRAWBAR
BY% = H# - 24
BR# = 5
GOSUB DRAWBAR
T$ = "AKLABS"
SZ% = 0.02 * W#
GOSUB CENTERX
TY% = 0.07 * H#
CM# = 1
GOSUB DRAWTEXT
CM# = 0
COLOR 1, 2
T$ = "MEGADEMO 85"
SZ% = 0.009 * W#
GOSUB CENTERX
TY% = 0.32 * H#
GOSUB DRAWTEXT
COLOR 1, 4
T$ = "CODE AND FX : TACHIKOMA"
SZ% = 0.004 * W#
GOSUB CENTERX
TY% = 0.72 * H#
GOSUB DRAWTEXT
COLOR 1, 14
T$ = "DEDICATED TO GAMECUBE"
GOSUB CENTERX
TY% = 0.77 * H#
GOSUB DRAWTEXT
COLOR 1, 8
T$ = "MEGAGREETZ TO STARFORT - KEEP THE FORGE LIT"
GOSUB CENTERX
TY% = 0.82 * H#
GOSUB DRAWTEXT
COLOR 1, 16
T$ = "100 PCT BASIC - NO MACHINE CODE"
GOSUB CENTERX
TY% = 0.88 * H#
GOSUB DRAWTEXT
WCY% = 0.55 * H#
AMP% = 40.0
PH% = 1.0
GOSUB WAVE
IF HL# = 1 THEN GOTO BYE
T$ = "AKLABS"
SZ% = 0.02 * W#
GOSUB CENTERX
TY% = 0.07 * H#
DO WHILE QF# = 0
  RB# = RB# + 1
  CM# = 1
  GOSUB DRAWTEXT
  CM# = 0
  PH% = PH% + 0.1
  GOSUB WAVE
  IF TI# > MT# THEN GOSUB TUNE
  GOSUB POLLKEY
  SLEEP 0.1
LOOP
GOTO BYE

REM =====================================================================
REM  Shutdown: disarm the handler, retire the rectangles, mute the SID.
REM  The picture stays -- that is what END is for.
REM =====================================================================
LABEL BYE
COLLISION 2
SOLID
IF SND# = 1 THEN VOL 0
IF TXT# = 1 THEN CHAR 1, 0, 0, "AKLABS 85 - KEEP THE SCENE ALIVE    "
END

REM =====================================================================
REM  Subroutines.
REM =====================================================================

REM  Chapter 17's historical generator, verbatim. RND(n) is built in now;
REM  this stays so the demo runs identically on every machine.
REM  Answers 0 to RMAX#-1 in ROLL#, from the middle bits of the seed.
LABEL RANDOM
SEED# = MOD(((SEED# * 1103515245) + 12345), 2147483648)
ROLL# = MOD((SEED# / 65536), RMAX#)
RETURN

REM  NS# stars in four brightnesses. Two LCG pulls a star, and the
REM  brightness rides the low bits of the seed for free.
LABEL STARS
SI# = 0
DO WHILE SI# < NS#
  RMAX# = W#
  GOSUB RANDOM
  X# = ROLL#
  RMAX# = H#
  GOSUB RANDOM
  Y# = ROLL#
  B# = MOD(SEED#, 4)
  COLOR 1, STC#(B#)
  DRAW 1, X#, Y#
  SI# = SI# + 1
LOOP
RETURN

REM  One Lissajous pass: 3:2, phase-shifted 25 degrees per PN#. The
REM  first point is plotted bare, the rest chain with TO.
LABEL SPIRO1
PX% = CX% + (R1% * SIN(RAD(25 * PN#)))
PY% = CY% + R2%
DRAW 1, PX%, PY%
FOR T# = 8 TO 360 STEP 8
  X% = CX% + (R1% * SIN(RAD((3 * T#) + (25 * PN#))))
  Y% = CY% + (R2% * COS(RAD(2 * T#)))
  DRAW 1, PX%, PY% TO X%, Y%
  PX% = X%
  PY% = Y%
NEXT T#
RETURN

REM  Centre T$ at scale SZ%: a glyph cell is five units wide.
LABEL CENTERX
LW% = SZ% * 5
TW% = LW% * LEN(T$)
TX% = 0.5 * (W# - TW%)
RETURN

REM  Draw T$ at TX%, TY%, scale SZ%. CM# = 1 paints each letter from
REM  the rainbow table, offset by RB# -- the redraw that stands in for
REM  the palette cycle this machine does not have.
LABEL DRAWTEXT
TL# = LEN(T$)
TC# = 0
DO WHILE TC# < TL#
  C$ = MID(T$, TC#, 1)
  GI# = INSTR(ALPHA$, C$)
  IF CM# = 1 THEN COLOR 1, RBW#(MOD(TC# + RB#, 7))
  LW% = SZ% * 5
  GX2% = TX% + (LW% * TC#)
  GY2% = TY%
  IF GI# >= 0 THEN GOSUB DRAWGLYPH
  TC# = TC# + 1
LOOP
RETURN

REM  One glyph. A DO rather than a FOR: single-stroke glyphs exist and
REM  FOR 1 TO 1 never runs its body (TODO.md section 6).
LABEL DRAWGLYPH
GN# = FNC#(GI#)
IF GN# = 0 THEN RETURN
GP# = FNI#(GI#)
GK# = 0
DO WHILE GK# < GN#
  P1# = FNS#(GP#)
  P2# = FNS#(GP# + 1)
  GP# = GP# + 2
  X1% = GX2% + (SZ% * (P1# / 10))
  Y1% = GY2% + (SZ% * MOD(P1#, 10))
  X2% = GX2% + (SZ% * (P2# / 10))
  Y2% = GY2% + (SZ% * MOD(P2#, 10))
  DRAW 1, X1%, Y1% TO X2%, Y2%
  GK# = GK# + 1
LOOP
RETURN

REM  One raster bar: a five-step ramp, two double-width lines per step
REM  for a twenty-pixel bar -- or all black when EB# says erase.
LABEL DRAWBAR
BL# = 0
DO WHILE BL# < 5
  CI# = BARC#(BR# + BL#)
  IF EB# = 1 THEN CI# = 1
  COLOR 1, CI#
  BLY% = BY% + (BL# * 4)
  DRAW 1, 0, BLY% TO W# - 1, BLY%
  BLY% = BLY% + 2
  DRAW 1, 0, BLY% TO W# - 1, BLY%
  BL# = BL# + 1
LOOP
RETURN

REM =====================================================================
REM  The wireframe engine. One pooled model: cube vertices 0-7 and
REM  octahedron vertices 8-13, edge list indexing into the pool.
REM  VS#/VE# and ES#/EE# select the object, CX%/CY% place it, SF%
REM  scales it, RA%/RB% are its two rotation angles.
REM =====================================================================

REM  Rotate the selected vertices about X then Y and project them.
REM  Every product keeps the float on the left -- the left operand
REM  decides the arithmetic, and one integer would floor the trig.
LABEL WIRESPIN
CS1% = COS(RA%)
SN1% = SIN(RA%)
CS2% = COS(RB%)
SN2% = SIN(RB%)
V# = VS#
DO WHILE V# < VE#
  RY% = (WVY%(V#) * CS1%) - (WVZ%(V#) * SN1%)
  RZ% = (WVY%(V#) * SN1%) + (WVZ%(V#) * CS1%)
  RX% = (WVX%(V#) * CS2%) + (RZ% * SN2%)
  RZ% = (RZ% * CS2%) - (WVX%(V#) * SN2%)
  PJ% = SF% / (3.2 + RZ%)
  WPX#(V#) = CX% + (RX% * PJ%)
  WPY#(V#) = CY% + (RY% * PJ%)
  V# = V# + 1
LOOP
RETURN

REM  Draw the selected edges from the projected points. The caller has
REM  already bound COLOR 1, so a rainbow costs nothing extra.
LABEL WIREDRAW
E# = ES#
DO WHILE E# < EE#
  V1# = WE1#(E#)
  V2# = WE2#(E#)
  DRAW 1, WPX#(V1#), WPY#(V1#) TO WPX#(V2#), WPY#(V2#)
  E# = E# + 1
LOOP
RETURN

REM  Draw the previous frame's edges in black. The first frame erases
REM  a degenerate point at the origin, which costs one black pixel.
LABEL WIRERASE
COLOR 1, 1
E# = ES#
DO WHILE E# < EE#
  V1# = WE1#(E#)
  V2# = WE2#(E#)
  DRAW 1, WQX#(V1#), WQY#(V1#) TO WQX#(V2#), WQY#(V2#)
  E# = E# + 1
LOOP
RETURN

REM  Remember this frame's points so the next frame can erase them.
LABEL WIRESAVE
V# = VS#
DO WHILE V# < VE#
  WQX#(V#) = WPX#(V#)
  WQY#(V#) = WPY#(V#)
  V# = V# + 1
LOOP
RETURN

LABEL CUBETICK
VS# = 0
VE# = 8
ES# = 0
EE# = 12
GOSUB WIRERASE
RA% = A1%
RB% = B1%
CX% = C1X%
GOSUB WIRESPIN
COLOR 1, RBW#(MOD(FC# / 8, 7))
GOSUB WIREDRAW
GOSUB WIRESAVE
RETURN

LABEL OCTATICK
VS# = 8
VE# = 14
ES# = 12
EE# = 24
GOSUB WIRERASE
RA% = A2%
RB% = B2%
CX% = C2X%
GOSUB WIRESPIN
COLOR 1, RBW#(MOD((FC# / 8) + 3, 7))
GOSUB WIREDRAW
GOSUB WIRESAVE
RETURN

REM  One frame of both solids: advance the four angles, tick each.
LABEL SPINSTEP
FC# = FC# + 1
A1% = A1% + 0.061
B1% = B1% + 0.043
A2% = A2% - 0.053
B2% = B2% + 0.037
GOSUB CUBETICK
GOSUB OCTATICK
RETURN

REM  A ball of light: concentric circles three pixels apart, solid at
REM  WIDTH 2. DCX%/DCY% centre it, DR% sizes it, DCI# colours it --
REM  DCI# = 1 is the eraser.
LABEL DISC
IF DR% < 1 THEN RETURN
COLOR 1, DCI#
R3% = DR%
DO WHILE R3% > 1
  CIRCLE 1, DCX%, DCY%, R3%, R3%
  R3% = R3% - 3
LOOP
RETURN

REM  The origin point: erase it where it was, redraw it pulsing on
REM  SIN(BF#) and strobing through the bar ramp table -- the colours
REM  of the next scene, because this is where its bars come from.
LABEL BALLFX
DCI# = 1
DR% = PB%
DCX% = C1X%
DCY% = CY%
GOSUB DISC
DR% = BBR% + ((0.45 * BBR%) * SIN(1.1 * BF#))
DCI# = BARC#(MOD(BF#, 20))
DCX% = C1X%
DCY% = CY%
GOSUB DISC
PB% = DR%
BF# = BF# + 1
RETURN

REM  A raster bar being born: the same five-step ramp as DRAWBAR, but
REM  spanning only C1X% plus and minus XR%. Each frame's lines cover
REM  the last frame's, so the stretch needs no eraser.
LABEL PROTOBAR
BL# = 0
DO WHILE BL# < 5
  COLOR 1, BARC#(BR# + BL#)
  PX1% = C1X% - XR%
  PX2% = C1X% + XR%
  BLY% = BY% + (BL# * 4)
  DRAW 1, PX1%, BLY% TO PX2%, BLY%
  BLY% = BLY% + 2
  DRAW 1, PX1%, BLY% TO PX2%, BLY%
  BL# = BL# + 1
LOOP
RETURN

REM  The approach: one long sweep rising as the camera goes in.
LABEL ZOOMSND
IF SND# = 0 THEN RETURN
SOUND 3, 4000, 40, 1, 52000, 800
RETURN

REM  Decode picture strings IM$(SS#) through IM$(SE#) and paint them
REM  as 5x5 blocks. A run is colour-char then length-char. 'Q' misses
REM  the colour table, so it advances without drawing -- the skip. 'A'
REM  is black and DOES draw, which is how a video delta erases. 'R'
REM  opens a row record: two base-36 digits of row, cursor to column
REM  zero -- how a delta jumps between the rows that changed.
LABEL DRAWSTREAM
X# = 0
Y# = 0
S# = SS#
DO WHILE S# <= SE#
  T2$ = IM$(S#)
  TL2# = LEN(T2$)
  P# = 0
  DO WHILE P# < TL2#
    C2$ = MID(T2$, P#, 1)
    IF C2$ = "R" THEN GOSUB PICROW ELSE GOSUB PICRUN2
  LOOP
  GOSUB POLLKEY
  S# = S# + 1
LOOP
RETURN

LABEL PICROW
Y# = INSTR(LTAB$, MID(T2$, P# + 1, 1)) * 36
Y# = Y# + INSTR(LTAB$, MID(T2$, P# + 2, 1))
X# = 0
P# = P# + 3
RETURN

LABEL PICRUN2
CI# = INSTR(CPAL$, C2$) + 1
LN# = INSTR(LTAB$, MID(T2$, P# + 1, 1)) + 1
IF CI# > 0 THEN GOSUB PICRUN
X# = X# + LN#
IF X# >= 160 THEN X# = 0
IF X# = 0 THEN Y# = Y# + 1
P# = P# + 2
RETURN

REM  One run: LN# cells of colour CI# at cell (X#, Y#), scaled by BS%.
LABEL PICRUN
X3% = X# * BS%
X4% = ((X# + LN#) * BS%) - 1
Y3% = Y# * BS%
COLOR 1, CI#
DRAW 1, X3%, Y3% TO X4%, Y3%
Y3% = Y3% + 2
DRAW 1, X3%, Y3% TO X4%, Y3%
Y3% = Y3% + 2
DRAW 1, X3%, Y3% TO X4%, Y3%
RETURN

REM  The rays live outside the encoding, redrawn over every video
REM  frame: nineteen lines instead of thirty runs a grid row, and they
REM  are what makes the encoded floor nearly free.
LABEL RAYS
COLOR 1, 4
RI# = 0 - 9
DO WHILE RI# < 10
  X3% = (0.5 * W#) + (RI# * 26 * BS%)
  DRAW 1, 0.5 * W#, (74 * BS%) + 2 TO X3%, H# + 99
  RI# = RI# + 1
LOOP
RETURN

REM  Park the eight letter sprites on a sine.
LABEL WAVE
L# = 1
DO WHILE L# < 9
  WX% = WX0% + (SPX% * (L# - 1))
  WY% = WCY% + (AMP% * SIN(PH% + (0.8 * L#)))
  MOVSPR L#, WX%, WY%
  L# = L# + 1
LOOP
RETURN

REM =====================================================================
REM  The supernova and the black hole.
REM =====================================================================

REM  Pull every letter one step around and toward (CX0%, CY0%): read
REM  its position back, rotate the offset by the angle in VC%/VS2%,
REM  shrink it by VF%, put it there. Fourteen frames of 0.78 is a
REM  wind-up; thirty-four of 0.86 is an event horizon.
LABEL VORTEX
L# = 1
DO WHILE L# < 9
  SX% = RSPPOS(L#, 0) - CX0%
  SY% = RSPPOS(L#, 1) - CY0%
  NX% = ((SX% * VC%) - (SY% * VS2%)) * VF%
  NY% = ((SX% * VS2%) + (SY% * VC%)) * VF%
  MOVSPR L#, CX0% + NX%, CY0% + NY%
  L# = L# + 1
LOOP
RETURN

REM  One frame of fireball: erase the previous radius, draw the new
REM  one. PR% carries the radius to erase between calls.
LABEL BOOMFX
BCF# = 1
BR2% = PR%
GOSUB BOOMPASS
BCF# = 0
BR2% = ER%
GOSUB BOOMPASS
PR% = ER%
RETURN

REM  The fireball at radius BR2%: three rings, white heart to orange
REM  rim, and twelve red spokes thrown past the outer ring. BCF# = 1
REM  draws the whole thing in black, which is the eraser.
LABEL BOOMPASS
IF BR2% < 1 THEN RETURN
R3% = BR2%
IF BCF# = 1 THEN COLOR 1, 1 ELSE COLOR 1, 2
CIRCLE 1, CX0%, CY0%, R3%, R3%
R4% = 0.72 * R3%
IF BCF# = 1 THEN COLOR 1, 1 ELSE COLOR 1, 8
CIRCLE 1, CX0%, CY0%, R4%, R4%
R4% = 0.45 * R3%
IF BCF# = 1 THEN COLOR 1, 1 ELSE COLOR 1, 9
CIRCLE 1, CX0%, CY0%, R4%, R4%
IF BCF# = 1 THEN COLOR 1, 1 ELSE COLOR 1, 3
SK# = 0
DO WHILE SK# < 12
  SA% = RAD((SK# * 30) + 15)
  X1B% = CX0% + ((0.55 * R3%) * SIN(SA%))
  Y1B% = CY0% - ((0.55 * R3%) * COS(SA%))
  X2B% = CX0% + ((1.14 * R3%) * SIN(SA%))
  Y2B% = CY0% - ((1.14 * R3%) * COS(SA%))
  DRAW 1, X1B%, Y1B% TO X2B%, Y2B%
  SK# = SK# + 1
LOOP
RETURN

REM  One frame of iris: ten black circles two pixels apart, WIDTH 2,
REM  a closed band from IR% outward that the loop walks inward.
LABEL HOLEFX
COLOR 1, 1
HC# = 0
R3% = IR%
DO WHILE HC# < 10
  CIRCLE 1, CX0%, CY0%, R3%, R3%
  R3% = R3% + 2
  HC# = HC# + 1
LOOP
RETURN

REM  The accretion disc: three arcs at three radii, rotated to HA0#.
REM  HAC# = 0 is the eraser, drawn at the angle before the turn.
LABEL HOLEARC
IF HAC# = 1 THEN COLOR 1, 5 ELSE COLOR 1, 1
CIRCLE 1, CX0%, CY0%, 58, 58, HA0#, HA0# + 130
IF HAC# = 1 THEN COLOR 1, 13 ELSE COLOR 1, 1
CIRCLE 1, CX0%, CY0%, 40, 40, HA0# + 120, HA0# + 250
IF HAC# = 1 THEN COLOR 1, 7 ELSE COLOR 1, 1
CIRCLE 1, CX0%, CY0%, 25, 25, HA0# + 240, HA0# + 370
RETURN

REM  The bang: a long rumble falling to the floor on voice 2 and a
REM  crack sweeping down over it on voice 3.
LABEL BOOMSND
IF SND# = 0 THEN RETURN
SOUND 2, 9000, 45, 2, 150, 350
SOUND 3, 52000, 30, 2, 900, 1400
RETURN

REM  The suck: one long sweep rising off the top of the register.
LABEL HOLESND
IF SND# = 0 THEN RETURN
SOUND 3, 1500, 55, 1, 58000, 950
RETURN

REM  COLLISION 2 lands here between lines. BUMP(2) says who, and
REM  RCOLLISION(n, 7) says which axis -- reflecting a bearing is one
REM  subtraction per axis, done in BOUNCE1.
LABEL BOUNCE
BM# = BUMP(2)
BS# = 1
DO WHILE BS# < 9
  BB# = SHL(1, BS# - 1)
  IF (BM# AND BB#) <> 0 THEN GOSUB BOUNCE1
  BS# = BS# + 1
LOOP
RETURN

LABEL BOUNCE1
AX# = RCOLLISION(BS#, 7)
IF AX# = 1 THEN SBG#(BS#) = MOD(720 - SBG#(BS#), 360)
IF AX# = 2 THEN SBG#(BS#) = MOD(540 - SBG#(BS#), 360)
MOVSPR BS#, SBG#(BS#) # 5
IF SND# = 1 THEN SOUND 2, 38000, 2
RETURN

REM  A continuous mover can tunnel a thin wall between handler entries.
REM  Anyone who escapes is rehomed to the centre with a fresh bearing.
LABEL SHEPHERD
L2# = 1
DO WHILE L2# < 9
  SX% = RSPPOS(L2#, 0)
  SY% = RSPPOS(L2#, 1)
  OUT# = 0
  IF SX% < 2 THEN OUT# = 1
  IF SX% > W# - 40 THEN OUT# = 1
  IF SY% < 2 THEN OUT# = 1
  IF SY% > H# - 55 THEN OUT# = 1
  IF OUT# = 1 THEN GOSUB REHOME
  L2# = L2# + 1
LOOP
RETURN

LABEL REHOME
MOVSPR L2#, 0.5 * W#, 0.5 * H#
RMAX# = 360
GOSUB RANDOM
SBG#(L2#) = ROLL#
MOVSPR L2#, SBG#(L2#) # 5
RETURN

REM  Hold for about a frame. The first cut spun on TI# -- the closest
REM  thing this machine has to a raster wait -- and the spin starved
REM  the music: the host releases at most ONE queued PLAY note per
REM  frame, and a frame is 256 *executed* statements, so a busy-wait
REM  makes frames slow enough to drop the release rate under the
REM  tune's fifteen notes a second. The queue backed up and overflowed
REM  two scenes later. SLEEP holds the program at no per-step cost, so
REM  the frames stay fast and the music drains on time. TODO.md
REM  section 4 carries the measurement.
LABEL VSYNC
IF HL# = 1 THEN RETURN
SLEEP 0.02
RETURN

LABEL POLLKEY
IF KEYS# = 0 THEN RETURN
GET K#
IF K# = 113 THEN QF# = 1
IF K# = 27 THEN QF# = 1
RETURN

LABEL SWEEP
IF SND# = 0 THEN RETURN
SOUND 3, 62000, 16, 2, 5000, 700
RETURN

REM  ENVELOPE's sixth argument is a waveform -- 0 triangle, 1 sawtooth,
REM  2 square, 3 noise -- which Chapter 7 does not mention. Preset 3 is
REM  the sawtooth lead and preset 4 the noise drum kit.
LABEL SIDINIT
ENVELOPE 3, 0, 5, 9, 1, 1
ENVELOPE 4, 0, 6, 3, 1, 3
VOL 12
TEMPO 15
RETURN

REM  The PLAY queue is one queue: each note holds it for its length,
REM  and the envelope applied when a note sounds is whatever the last
REM  T parsed selected -- so naming three voices plays three tracks
REM  end to end with one instrument, not a chord (TODO.md section 4).
REM  So this is beeper music, the way single-channel tracker tunes
REM  were written: sixteenths that take turns being the kick (the O1
REM  root), the pumping bass (O2/O3) and the rolling arpeggio (O4 up).
REM  Batch A walks Am F C G, batch B turns Am F Dm E with the G sharp,
REM  and every third batch is a bar of noise drums on preset 4.
REM
REM  There is no way to ask whether the queue has drained, so each
REM  batch stamps MT# with its own length plus a breath, and the scene
REM  loops requeue when TI# passes it. A batch is 64 notes and the
REM  queue holds 128, so a slightly early requeue appends safely.
LABEL TUNE
MT# = TI# + 300
IF SND# = 0 THEN RETURN
TRAP QFULL
IF TB# = 0 THEN GOSUB TUNEA
IF TB# = 1 THEN GOSUB TUNEB
IF TB# = 2 THEN GOSUB TUNED
TRAP
TB# = TB# + 1
IF TB# > 2 THEN TB# = 0
RETURN

REM  A batch is four PLAY statements, one bar each: the parser's V, T,
REM  U and duration state persists across statements and every PLAY
REM  appends to the same queue, so four bars queue exactly as one long
REM  string would -- which the 80-column line limit no longer allows.
REM  Each bar restates the prefix anyway, so a bar dropped by QFULL
REM  never leaves the next one playing with drum-kit state.
LABEL TUNEA
PLAY "V1T3U9S O1AO2AO3AO2AO3AO4CEAO1AO2AO4CEAO5CO4AE"
PLAY "V1T3U9S O1FO2FO3FO2FO3FAO4CFO1FO2FO3AO4CFAO5CO4A"
PLAY "V1T3U9S O1CO2CO3CO2CO3CEGO4CO1CO2CO3EGO4CEGO5C"
PLAY "V1T3U9S O1GO2GO3GO2GO3GBO4DGO1GO2GO3BO4DGBO5DO4B"
MT# = TI# + 270
RETURN

LABEL TUNEB
PLAY "V1T3U9S O1AO2AO3AO2AO3AO4CEAO1AO2AO4CEAO5CEO4A"
PLAY "V1T3U9S O1FO2FO3FO2FO3FAO4CFO1FO2FO3AO4CFAO5CO4A"
PLAY "V1T3U9S O1DO2DO3DO2DO3DFAO4DO1DO2DO3FAO4DFAO5D"
PLAY "V1T3U9S O1EO2EO3EO2EO3E#GBO4EO1EO2EO3#GBO4E#GBO5E"
MT# = TI# + 270
RETURN

LABEL TUNED
PLAY "V1T4U9S O1ARO5ARO1AAO5ARO1ARO5ARO1AO5AAA"
MT# = TI# + 80
RETURN

REM  Table loaders. READ walks every DATA line in file order, so these
REM  run before LOADFONT and their DATA sits above the glyphs.
LABEL LOADTABLES
I# = 0
DO WHILE I# < 7
  READ D#
  RBW#(I#) = D#
  I# = I# + 1
LOOP
I# = 0
DO WHILE I# < 4
  READ D#
  STC#(I#) = D#
  I# = I# + 1
LOOP
I# = 0
DO WHILE I# < 20
  READ D#
  BARC#(I#) = D#
  I# = I# + 1
LOOP
RETURN

REM  The wireframe models: fourteen vertices, then twenty-four edges
REM  as pairs of vertex indices. DM% because the octahedron's reach is
REM  a float and READ types by the variable it lands in.
LABEL LOADWIRE
I# = 0
DO WHILE I# < 14
  READ DM%
  WVX%(I#) = DM%
  READ DM%
  WVY%(I#) = DM%
  READ DM%
  WVZ%(I#) = DM%
  I# = I# + 1
LOOP
I# = 0
DO WHILE I# < 24
  READ D#
  WE1#(I#) = D#
  READ D#
  WE2#(I#) = D#
  I# = I# + 1
LOOP
RETURN

REM  The stroke font, shared with examples/breakout: one glyph per DATA
REM  line, stroke count then point pairs, a point coded X*10+Y on a
REM  grid four wide and seven tall. INSTR into ALPHA$ finds the glyph.
LABEL LOADFONT
GX# = 0
FOR I# = 0 TO 40
  READ N#
  FNC#(I#) = N#
  FNI#(I#) = GX#
  IF N# > 0 THEN GOSUB READGLYPH
NEXT I#
RETURN

LABEL READGLYPH
FOR K# = 1 TO N# * 2
  READ D#
  FNS#(GX#) = D#
  GX# = GX# + 1
NEXT K#
RETURN

REM  The bird: SPRSAV's type-in form, sixty-three bytes, three per row,
REM  most significant bit leftmost.
LABEL LOADBIRD
FOR I# = 0 TO 62
  READ D#
  PBRD#(I#) = D#
NEXT I#
RETURN

REM =====================================================================
REM  Trap handlers for the hardware probes. Each marks its device gone
REM  and lets the probe fall through to the next line.
REM =====================================================================
LABEL NOGFX
GFX# = 0
RESUME NEXT

LABEL NOSID
SND# = 0
RESUME NEXT

LABEL NOGRID
TXT# = 0
RESUME NEXT

LABEL NOKEYS
KEYS# = 0
RESUME NEXT

REM  A host slow enough to fall behind the tune finds the note queue
REM  full. Dropping the rest of the batch is a skipped bar, not a
REM  crash -- MT# is already stamped, so the music picks itself up.
LABEL QFULL
RESUME NEXT

REM =====================================================================
REM  Data.  The rainbow, the star brightnesses, four raster-bar ramps,
REM  then the stroke font.
REM =====================================================================
REM rainbow: red orange yellow green lt-green cyan lt-blue
DATA 3, 9, 8, 6, 14, 4, 15
REM star brightnesses: dark grey, mid grey, light grey, white
DATA 12, 13, 16, 2
REM bar ramps, five entries each: red, green, blue, yellow
DATA 3, 11, 2, 11, 3
DATA 6, 14, 2, 14, 6
DATA 7, 15, 2, 15, 7
DATA 9, 8, 2, 8, 9

REM cube vertices 0-7, one per line, x y z
DATA -1, -1, -1
DATA  1, -1, -1
DATA  1,  1, -1
DATA -1,  1, -1
DATA -1, -1,  1
DATA  1, -1,  1
DATA  1,  1,  1
DATA -1,  1,  1
REM octahedron vertices 8-13; 1.4 so its reach matches the cube's
DATA  1.4,  0,    0
DATA -1.4,  0,    0
DATA  0,    1.4,  0
DATA  0,   -1.4,  0
DATA  0,    0,    1.4
DATA  0,    0,   -1.4
REM cube edges: bottom ring, top ring, four pillars
DATA 0, 1, 1, 2, 2, 3, 3, 0
DATA 4, 5, 5, 6, 6, 7, 7, 4
DATA 0, 4, 1, 5, 2, 6, 3, 7
REM octahedron edges: every equator vertex to every pole
DATA 8, 10, 8, 11, 8, 12, 8, 13
DATA 9, 10, 9, 11, 9, 12, 9, 13
DATA 10, 12, 10, 13, 11, 12, 11, 13

REM A
DATA 4, 0,30, 0,6, 30,36, 3,33
REM B
DATA 6, 0,6, 0,30, 3,33, 6,36, 30,33, 33,36
REM C
DATA 3, 0,30, 0,6, 6,36
REM D
DATA 6, 0,6, 0,20, 20,31, 31,35, 35,26, 26,6
REM E
DATA 4, 0,6, 0,30, 3,33, 6,36
REM F
DATA 3, 0,6, 0,30, 3,33
REM G
DATA 5, 0,30, 0,6, 6,36, 33,36, 13,33
REM H
DATA 3, 0,6, 30,36, 3,33
REM I
DATA 1, 10,16
REM J
DATA 3, 30,36, 6,36, 3,6
REM K
DATA 3, 0,6, 30,3, 3,36
REM L
DATA 2, 0,6, 6,36
REM M
DATA 4, 0,6, 30,36, 0,13, 13,30
REM N
DATA 3, 0,6, 30,36, 0,36
REM O
DATA 4, 0,30, 6,36, 0,6, 30,36
REM P
DATA 4, 0,6, 0,30, 3,33, 30,33
REM Q
DATA 5, 0,30, 6,36, 0,6, 30,36, 24,36
REM R
DATA 5, 0,6, 0,30, 3,33, 30,33, 13,36
REM S
DATA 5, 0,30, 0,3, 3,33, 33,36, 6,36
REM T
DATA 2, 0,30, 10,16
REM U
DATA 3, 0,6, 30,36, 6,36
REM V
DATA 2, 0,16, 16,30
REM W
DATA 4, 0,6, 30,36, 6,13, 13,36
REM X
DATA 2, 0,36, 30,6
REM Y
DATA 3, 0,13, 30,13, 13,16
REM Z
DATA 3, 0,30, 30,6, 6,36
REM 0
DATA 5, 0,30, 6,36, 0,6, 30,36, 30,6
REM 1
DATA 2, 10,16, 1,10
REM 2
DATA 5, 0,30, 30,33, 3,33, 3,6, 6,36
REM 3
DATA 4, 0,30, 30,36, 3,33, 6,36
REM 4
DATA 3, 0,3, 3,33, 30,36
REM 5
DATA 5, 0,30, 0,3, 3,33, 33,36, 6,36
REM 6
DATA 5, 0,30, 0,6, 3,33, 33,36, 6,36
REM 7
DATA 2, 0,30, 30,36
REM 8
DATA 5, 0,30, 6,36, 0,6, 30,36, 3,33
REM 9
DATA 5, 0,30, 0,3, 3,33, 30,36, 6,36
REM space
DATA 0
REM colon
DATA 2, 12,13, 14,15
REM dash
DATA 1, 3,33
REM full stop
DATA 1, 15,16
REM exclamation mark
DATA 2, 10,14, 15,16

REM  The bird, 24 by 21, one bit a pixel:
REM    ..XXX...........XXX.....
REM    .X...XX.......XX...X....
REM    X.....XXX...XXX.....X...
REM    .......XXXXXX...........
REM    .........XX.............
REM  and sixteen empty rows of sky.
DATA 0, 0, 0, 56, 0, 224, 70, 3, 16
DATA 131, 142, 8, 1, 248, 0, 0, 96, 0
DATA 0, 0, 0, 0, 0, 0, 0, 0, 0
DATA 0, 0, 0, 0, 0, 0, 0, 0, 0
DATA 0, 0, 0, 0, 0, 0, 0, 0, 0
DATA 0, 0, 0, 0, 0, 0, 0, 0, 0
DATA 0, 0, 0, 0, 0, 0, 0, 0, 0
