( K E Y B O A R D )
57 const ^SPACE
75 const ^LEFT
77 const ^RIGHT
51 const ^<
52 const ^>
31 const ^S
59 const ^F1

0 const BLACK
1 const BLUE
2 const GREEN
3 const CYAN
4 const RED
5 const MAGENTA
6 const BROWN
7 const LGRAY
8 const DGRAY
9 const LBLUE
10 const LGREEN
11 const LCYAN
12 const PINK
13 const LMAGENTA
14 const YELLOW
15 const WHITE

: rungame
  0 player.state DRIVING f!
  1 showmouse !
  [ MODE-MOVE @ lit ] dup MODE-MOVE ! ' tick redefine
  ' full-draw ' draw redefine
  12 11 tile>world player entity.pos!
  bgi-off 320x200 loadportraits
  s" pete.jor" loadfile
  begin suspend again ;

( S L I D E )
var skip
var autoslide
: pause
  skip @ not if
    begin
      suspend 0
      ^< key-pressed if drop 1 1 skip ! -1 autoslide ! then
      ^> key-pressed if drop 1 1 skip ! 1 autoslide ! then
      ^S key-pressed if drop 1 1 skip ! then
      ^RIGHT key-pressed ^SPACE key-pressed or if drop 1 then
      ^F1 key-pressed if rungame then
    until
  then ;

defer write
: y pos swap drop ;
: nexty ( dy -- y ) y + ;
: writeline ( s x dy ) nexty <rot outtext moveto ;

: header :| 320 50 writeline |; ' write redefine
    wipe BLUE bg! 1 5 font 1 justify WHITE color! 320 10 moveto ;

: bullet :| 30 30 writeline |; ' write redefine
    3 3 font 0 justify LCYAN color! 30 y 30 + moveto ;

: goof :| 320 60 writeline |; ' write redefine
    wipe 4 7 font 1 justify CYAN color! 320 100 moveto ;

( S L I D E S )

' noop
:noname 12 11 tile>world player entity.pos!
	s" pete.jor" loadfile ;
:noname :| player yield 0 |; ' entities redefine
	0 player.state DRIVING f!
	1 showmouse ! MODE-MOVE @ ' tick redefine
	12 11 tile>world player entity.pos!
	loadportraits ;
:noname s" hide-footer" REPL send ;
:noname s" show-footer" REPL send ;
:noname :| player yield 0 |; ' entities redefine
	1 player.state DRIVING f! E player entity.dir ! ;
:noname :| 0 |; ' entities redefine 0 showmouse ! ;
array demostates , , , , , , ,
var demostate

: enterdemostate
  demostate @ cells demostates + @ execute ;

: tick-nextslide
  ^SPACE key-pressed if 1 demostate +! enterdemostate then ;

: demotick
  tick-nextslide
  0 ^LEFT key-down if 3 - then
    ^RIGHT key-down if 3 + then
  0 ^UP key-down if 3 - then
    ^DOWN key-down if 3 + then
  player entity.y +!
  player entity.x +!
  tick-mapedit
  tick-debounce ;

: autoadvance autoslide @ not if 1 autoslide ! then ;
: demo ( endstate startstate -- )
  bgi-off 320x200
  ' full-draw ' draw redefine
  ' demotick ' tick redefine
  demostate ! enterdemostate
  begin suspend dup demostate @ <= until drop
  ' noop ' draw redefine
  ' noop ' tick redefine
  bgi-on autoadvance ;

var demorepldone
: quit 1 demorepldone ! ;
: start-demorepl activate ' putc task-emit !
  s" .:: J O R T H ( jean forth) ::." type cr
  begin receive loadstring s" ok" type cr again ;
task const DEMOREPL
array replbuf 256 allot

: demorepl
  bgi-off key-end 0 demorepldone !
  DEMOREPL start-demorepl suspend
  begin replbuf gets DEMOREPL send suspend
  demorepldone @ until
  bgi-on key-start autoadvance ;

array filenamebuf 13 allot
var filenameindex
: store-fn-char filenamebuf filenameindex @ + b! ;
: filename-emit
  dup [ key   lit ] != if
    store-fn-char
    1 filenameindex +!
    0 store-fn-char
  else drop then ;

: slidefilename ( i -- s )
  task-emit @
    ' filename-emit task-emit !
    0 filenameindex !
    s" slide" type
    swap .
    s" .jor" type
  task-emit !
  filenamebuf ;

var slidecount
var slideindex

: skipto ( i -- )
  slideindex @ - autoslide ! 1 skip ! ;

: fixindex
  slideindex @ 0 < if slidecount @ 1 - slideindex ! else
  slideindex @ slidecount @ >= if 0 slideindex ! then then ;

: show ( i -- ) 0 skip ! 0 autoslide ! slidefilename loadjor ;
: nextslide
  autoslide @ if
    autoslide @ slideindex +!
  else
    begin
      suspend
      ^LEFT key-pressed ^< key-pressed or
	if -1 else
      ^RIGHT key-pressed ^SPACE key-pressed or ^> key-pressed or
	if 1 else 0 then then
      dup if dup slideindex +! then
    until
  then fixindex ;

: slideshow activate blah
  bgi-on ' noop ' draw redefine ' noop ' tick redefine
  begin slideindex @ show nextslide again ;
task const SLIDESHOW
SLIDESHOW slideshow

:noname
  0 begin dup slidefilename exists while 1 + repeat slidecount !
  :| tick-nextslide [ MODE-MOVE @ , ] |; MODE-MOVE !
; ' onload redefine