( ணࠬ  9/27/83 )
forget it
: it ;

4 mode
17 0 3 color
10 vtab 10 htab
print "  ... "

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         (  砫 )
  locate.end 1 + (   )
  pokew ; (   砫   모 )

: 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 
  ( local segment 1 autorun 0 autodraw ormode 1 sequence )
  0 autorun 1 sequence 0 -> key.pressed
  clrkey pad 126 + peek 78 = if 0 else 1 then -> noise
  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, . 1987 " cr
  print "  F-: " cr
  print " [F1] ᠭ ⥬ ࠔ/87 " cr
  print " [F2]   " cr
  print " [F3]  " cr
  print " [F4]  " cr
  print " [F5]   " cr
  print " [F6]   " cr
  print " [F7] 室  ࠔ/87 " cr
  print " [F8]  /몫 "
  begin 
   0 -> timeout
   0 begin spin.images 1 + dup 500 >= dup -> timeout
     getkey dup -> key.pressed 
   or until drop

   3000 0 do loop ( delay )

    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 " F-! ( ⮫쪮 祫 ...) " )
          then 0
    then
  until
  0 -> play ; (   timeout )
close run
