( menu routine 9/27/83 )
forget it
: it ;

4 mode
17 0 3 color
10 vtab 10 htab
print " One moment, please ... "

1 variable noise
0 variable size
0 variable fill.size
0 variable x
0 variable y
0 variable char.seg
0 variable char.addr
0 variable char.offset
0 variable rot.val
0 variable key.pressed
0 variable timeout
500 string cube
500 string pyramid
500 string tetrahedron
500 string xyz
2000 string tune

: not 0 = ;

: clrkey begin getkey 0 = until ;

: locate.end 0 tune begin
  dup peek 0 <> while
  3 + repeat ;

: set.repeat
  0 tune ( address of beginning )
  locate.end 1 + ( address of end )
  pokew ; ( put address of beginning at end of music )

: setup.music
  0 tune 1999 memory read " invent8.mus "
  set.repeat ;

: load.image
  object
  dup objadr
  pad concat " .img "
  499 memory pad -> read 
  15 xrot 15 yrot 
  56 ypos 
  100 scale ;

: setup.images
  objerase
  pad assign " cube "
  0 cube 0 load.image
  40 xpos 1 objcolor
  pad assign " pyram "
  0 pyramid 1 load.image
  120 xpos 2 objcolor
  pad assign " tetra "
  0 tetrahedron 2 load.image
  200 xpos 3 objcolor 
  pad assign " xyz "
  0 xyz 3 load.image 
  280 xpos ;

: spin.images
  rot.val 15 - dup -> rot.val
  0 object dup yrot
  1 object dup xrot
  2 object dup zrot 
  3 object yrot draw ;

: charprint
  8 * char.offset + -> char.addr
  char.seg segment
  y dup size 8 * + swap do
    char.addr peek
    x dup size 8 * + swap do
    dup 128 and
    if
      i j move
      i fill.size + j fill.size + fill
    then
    2 * size +loop drop
    char.addr 1 + -> char.addr
    size +loop
    local segment 
    x size 8 * + -> x ;

: gr.print
  61440 -> char.seg
  64110 -> char.offset
  begin
  dup peek 13 <> while
  dup peek charprint
  1 + repeat
  drop y size 8 * + -> y ;

: title pad assign " GraFORTH PC "
  pad gr.print ;

: start.music
  noise if
  0 tune -> play
  else 0 -> play then ;

: do.desc read " desc " ;
: do.microworld read " face " ;
: do.bridge read " bridge " ;
: do.life read " life " ;
: do.happy read " happy " ;
: do.fledermaus read " flederm " ;
: do.graforth
  0 pad 127 + poke
  0 pad 126 + poke
  forget it abort ;

: do.flip.noise
  noise not dup -> noise
  if 0 126 pad + poke ( music )
  else 78 126 pad + poke then ( "N"o music )
  start.music ;

: main clrkey
  pad 126 + peek 78 =
  if 0 else 1 then -> noise
  0 autorun
  0 -> key.pressed
  1 sequence
  68 pad 127 + poke ( uppercase "D" )
  3 dup -> size
  1 - -> fill.size
  setup.images
  setup.music
  4 mode
  17 0 3 color
  start.music
  3 -> y 20 -> x
  2 gcolor ormode title
  0 -> y 23 -> x
  3 gcolor ormode title
  3 10 grfix.rows
  12 vtab
  print " (C) P. Lutus 1983 " cr cr
  print " Press a [F]unction Key: " cr cr
  print " [F1] GraFORTH PC System Description " cr
  print " [F2] Talking Head " cr
  print " [F3] The Bridge " cr
  print " [F4] Happiness " cr
  print " [F5] Game of Life " cr
  print " [F6] Die Fledermaus " cr
  print " [F7] Enter GraFORTH PC " cr
  print " [F8] Sound On/Off "
  begin
  0 -> timeout
  0 begin
  spin.images
  1 + dup 500 >=
  dup -> timeout
  getkey dup -> key.pressed
  or until 
  drop
  timeout 
    if do.desc 1 ( valid )
    else
      key.pressed 
      dup 128 <
      if 49 -
      else 187 -
      then
      dup 7 <
      over -1 > and
        if
          case:
            do.desc
            do.microworld
            do.bridge
            do.happy
            do.life
            do.fledermaus
            do.graforth
          then 1 ( valid )
        else 
          7 = if
            do.flip.noise
          else
            24 vtab 0 htab
            print " A FUNCTION KEY! (you're only human ...) "
          then 0
        then
    then
  until 
  0 -> play ; ( key or timeout )
