Initial commit (forked from pete286)

2020-02-02 18:33:07 -05:00 · 2020-02-02 18:33:07 -05:00 · cd0d0bff8b
commit cd0d0bff8b
68 changed files with 5196 additions and 0 deletions
--- a/.gitignore
+++ b/.gitignore
@ -0,0 +1,7 @@
+*.obj
+*.bak
+*.dsk
+*.swp
+*.log
+*.jim
+game.map
--- a/adlib.c
+++ b/adlib.c
@ -0,0 +1,26 @@
+#include "adlib.h"
+
+static void adlib_wait(int delay) {
+  int i;
+  for (i = 0; i < delay; i ++) adlib_read();
+}
+
+void adlib_write(int reg, int val) {
+  int i;
+  outp(0x388, reg);
+  adlib_wait(6);
+  outp(0x389, val);
+  adlib_wait(35);
+}
+
+void adlib_reset() {
+  int i;
+  for (i = 0; i < 0xff; i ++) {
+    adlib_write(i, 0);
+  }
+}
+
+void adlib_init() {
+  adlib_reset();
+  atexit(adlib_reset);
+}
--- a/adlib.h
+++ b/adlib.h
@ -0,0 +1,6 @@
+#include <dos.h>
+
+void adlib_init();
+#define adlib_read() inp(0x388)
+void adlib_write(int reg, int val);
+void adlib_reset();
--- a/boot.jor
+++ b/boot.jor
@ -0,0 +1,101 @@
+2 const cell
+: cells cell * ;
+
+key ) const ')'
+
+10 const '\n'
+13 const '\r'
+key  const sp
+
+128 const F_IMMEDIATE
+0x100 const F_USERWORD
+
+: cr '\n' emit ;
+: bl sp emit ;
+
+: if ' BZ_ , here 0 , ; immediate
+: else ' GOTO_ , 0 , here swap ! here cell - ; immediate
+: then here swap ! ; immediate
+
+: begin here ; immediate
+: while ' BZ_ , here 0 , ; immediate
+: repeat ' GOTO_ , swap , here swap ! ; immediate
+: again ' GOTO_ , , ; immediate
+: until ' BZ_ , , ; immediate
+
+: ( begin key ')' = until ; immediate
+: lit ' LIT_ , , ;
+
+: inline| ' INLINEDATA_ , here 0 , ;
+: |inline [ ' then , ] ;
+
+' cells @ const $DOCOLON ( get the colon execution token )
+: :| inline| $DOCOLON , ; immediate
+: |; ' ret , |inline ; immediate
+
+key " const '"'
+
+: s" state if inline| else here then
+    begin key dup '"' != over 0 != and while b, repeat drop 0 b,
+    state if |inline else dup here! then ; immediate
+
+: interpretword F_IMMEDIATE & state not or if execute else , then ;
+: interpretnumber state if lit then ;
+: interpretunknown type s" ?" type cr ;
+: compileword lookup dup
+    if interpretword
+    else drop number
+      if interpretnumber
+      else interpretunknown
+      then
+    then ;
+: interpreter
+  begin word dup b@ while compileword repeat drop ;
+: load-input swap-input >r >r interpreter <r <r swap-input ;
+: loadstring ' key-string load-input drop drop ;
+
+( image loading )
+: noop ;
+
+: defer word new-word $DODEFERRED , ' noop , ;
+: redefine ( cp cpdeferred ) cell + ! ;
+: definition ( cpdeferred ) cell + @ ;
+
+defer onload
+: postload ' onload definition ' noop ' onload redefine execute ;
+
+: loadimage ( -- [0 | onload] )
+  imagemagic fget = if
+    fget fget fget fget fget ( onload tasks latest size start )
+    here != if tell + seek drop drop drop 0 else
+    dup here fread here + here! latest! tasks! then
+  else 0 then ;
+
+: saveimage ( herestart -- )
+  imagemagic fput
+  ' onload definition here drop fput
+  tasks fput
+  latest fput
+  dup here swap - fput
+  dup fput
+  dup here swap - swap fwrite ;
+
+( file loading )
+: loadimage-if-uptodate ( filename -- b )
+  dup image-uptodate if imagefilename open loadimage close else drop 0 then
+  dup if execute 1 then ;
+
+: interpretjor ( filename -- )
+  open fdeactivate ' key-file load-input drop factivate close ;
+
+: preservefp ( xt -- ) fdeactivate >r execute <r factivate ;
+
+: loadjor :| interpretjor postload |; preservefp ;
+
+: loadfile ( filename -- )
+  ( active file is preserved for the currently-loading file, but the
+    new file is always loaded with no active files )
+  :| dup loadimage-if-uptodate not if
+    here over >r >r interpretjor
+    <r <r imagefilename overwrite saveimage close postload
+  else drop then |; preservefp ;
--- a/defs.jor
+++ b/defs.jor
@ -0,0 +1,167 @@
+: stdout ' putc task-emit ! ;
+
+: >rot <rot <rot ;
+: 2dup over over ;
+: 3dup >r 2dup r@ >rot <r ;
+: 4dup >r >r 2dup r@ >rot rswap r@ >rot <r <r swap ;
+: nip swap drop ;
+
+: 2= ( a b c d -- a=c&b=d )
+  >r <rot = swap <r = and ;
+
+: 2swap ( a b c d -- c d a b )
+  >r >rot <r >rot ;
+
+: negate 0 swap - ;
+: abs dup 0 < if negate then ;
+
+: ~ -1 ^ ;
+: f! ( b v flag -- )
+  >rot >r r@ @ >rot ( val flag b r: v )
+  if | else ~ & then <r ! ;
+: f@ ( v flag -- b ) swap @ & ;
+: fnot! ( v flag -- ) over @ ^ swap ! ;
+
+: @! ( newval v -- oldval ) dup @ >rot ! ;
+
+: userword 1 latest wordflags F_USERWORD f! ;
+
+: expile state if , else execute then ;
+
+: :noname here $DOCOLON , ] ;
+
+: withfp ( xt fp -- ) :| factivate execute fdeactivate drop |; preservefp ;
+
+: array word new-word $DOVAR , ;
+: create word new-word $DOCREATE , 0 , ;
+
+: finishcreate ( ipfirst -- )
+  ( set cell after codepointer to first instruction of does> )
+  latest codepointer cell + ! ;
+
+: does> here 4 cells + lit ' finishcreate , ' ret , ] ; immediate
+
+: +towards ( from to -- from+-1 )
+  over > if 1 + else 1 - then ;
+
+: for ( from to -- )
+  ' >r , [ ' begin , ] ( from r: to )
+  ' dup , ' r@ , ' != , [ ' while , ]
+  ' >r , ; immediate ( r: to from )
+: i ' r@ , ; immediate
+: next
+  ' <r , ' r@ , ' +towards , ( from+1 r: to )
+  [ ' repeat , ] ' drop , ' rdrop , ; immediate
+: breakfor
+  ' rdrop , ' rdrop , 0 lit ' >r , 1 lit ' >r , ; immediate
+
+: yield rswap ;
+: done rdrop 0 >r rswap ;
+: ;done ' done , ] ; immediate
+: each [ ' begin , ] ' r@ , [ ' while , ] ; immediate
+: more ' yield , [ ' repeat , ] ' rdrop , ; immediate
+: break rswap rdrop :| yield done |; execute rswap ;
+
+: links begin yield @ dup not until drop ;done
+
+: files findfile begin dup while yield nextfile repeat drop ;done
+: .files files each type s"  " type more ;
+
+: min ( x y -- x|y ) 2dup > if swap then drop ;
+: max ( x y -- x|y ) 2dup < if swap then drop ;
+
+: +!pos ( n var -- ) dup @ <rot + 0 max swap ! ;
+: cycle! ( lim var -- )
+  >r dup r@ @ <= if
+    drop 0 r@ !
+  else r@ @ 0 < if
+    r@ !
+  else drop then then rdrop ;
+
+: +!cycle ( n var lim -- )
+  >r >r r@ +! <r <r swap cycle! ;
+
+  over > if drop 0 else dup 0 <
+: checkpoint ( cp -- )
+  create here 4 cells + , latest , tasks , ,
+  does> dup @ here!
+	dup cell + @ latest!
+	dup 2 cells + @ tasks!
+	3 cells + @ execute ;
+
+: intern create latest wordname , does> @ ;
+
+: preserving ( cp 0 vars... -- )
+  0 >r begin dup while dup @ >r >r repeat drop
+  execute
+  begin r@ while <r <r swap ! repeat rdrop ;
+: preserve ( cp var -- ) 0 swap preserves ;
+
+
+: decompile
+  word lookup if 1 begin ( cp i )
+    2dup cells + @ ( cp i @cp+i )
+    dup ' ret != ( cp i @cp+i bool )
+  while
+    dup ` dup if type drop else drop . then bl ( cp i )
+    1 + ( cp i+1 )
+  repeat drop drop then drop ; userword
+
+: words
+  latest links each
+    dup wordflags F_USERWORD f@ if
+      dup wordname type bl
+    then
+  more ;
+
+( tasks )
+: mailbox 2 cells + ;
+: task-ip task-user-size cells + ;
+: task-sp task-user-size 1 + cells + ;
+: task-rsp task-user-size 2 + cells + ;
+: task-stack task-user-size 3 + cells + ;
+: task-rstack task-stack stacksize cells + ;
+
+: .wordin ( ptr -- )
+  latest links each
+    2dup > if wordname type drop 0 break then
+  more dup if . else drop then ; userword
+
+: tasks.s
+  tasks links each
+    dup .wordin s" : " type
+    dup task-sp @ over task-stack ( task stackLim stack )
+    begin 2dup > while dup @ . cell + repeat
+    cr drop drop more ; userword
+
+: doactivate ( task ip -- )
+  over task-ip !
+  dup task-stack over task-sp !
+  dup task-rstack over task-rsp !
+  drop
+;
+
+: activate
+  here 4 cells + lit
+  ' doactivate ,
+  ' ret ,
+; immediate
+
+: >task ( val task -- )
+  task-sp >r r@ @ ! r@ @ cell + r> ! ;
+
+: try-send ( val task -- b )
+  mailbox dup @ if drop drop 0 else ! 1 then ;
+
+: wait-send ( val task -- )
+  mailbox
+  begin dup @ while suspend repeat ( wait for empty mailbox )
+  ! ;
+
+: send ( val task -- ) try-send drop ;
+
+: receive ( -- val )
+  running mailbox
+  begin dup @ not while suspend repeat ( wait for mail )
+  dup @ 0 <rot ! ;
+
--- a/egamap.h
+++ b/egamap.h
@ -0,0 +1,15 @@
+#include "tiles.h"
+
+#define NUM_TILES 64
+#define NUM_PORTRAITS 16
+
+#define SIZE_FOOTER (PAGE_STRIDE * 48)
+#define SIZE_PAGE (PAGE_STRIDE * (PAGE_TILES_H << 4))
+#define SIZE_TILES (NUM_TILES << 5)
+#define SIZE_PORTRAITS (NUM_PORTRAITS << 7)
+
+#define OFF_FOOTER 0
+#define OFF_PAGE1 (OFF_FOOTER + SIZE_FOOTER)
+#define OFF_PAGE2 (OFF_PAGE1 + SIZE_PAGE)
+#define OFF_TILES (OFF_PAGE2 + SIZE_PAGE)
+#define OFF_PORTRAITS (OFF_TILES + SIZE_TILES)
--- a/egavga.bgi
+++ b/egavga.bgi
--- a/entity.jor
+++ b/entity.jor
@ -0,0 +1,114 @@
+0 const EVTICK
+1 const EVTOUCH
+
+: world>tile 4 >> swap 4 >> swap ; userword
+: tile>world 4 << swap 4 << swap ; userword
+
+: +pos ( x1 y1 x2 y2 -- x y )
+  <rot + >rot + swap ; userword
+
+: -pos ( x1 y1 x2 y2 -- x y )
+  negate swap negate swap +pos ; userword
+
+: defentity ( x y dir anim -- ) array ' drop , , , tile>world , , ;
+: entity.x 4 cells + ;
+: entity.y 3 cells + ;
+: entity.dir 2 cells + ;
+: entity>sprite cell + @ execute ;
+: entity>do ( entity event ) swap @ execute ;
+: entity>pos dup entity.x @ swap entity.y @ ; userword
+: entity.pos! ( x y entity ) <rot over entity.x ! entity.y ! ; userword
+
+var entity-defstate
+: entitydo-ev ( [cp ifhere] ev -- )
+  entity-defstate @ if swap [ ' then , ]
+  else 1 entity-defstate ! :noname swap then
+  ' dup , lit ' = , [ ' if , ] ;
+: :touch EVTOUCH entitydo-ev ; immediate
+: :tick EVTICK entitydo-ev ; immediate
+: ;entity ( entity cp ifhere -- )
+  [ ' then , ] ' drop , [ ' ; , ]
+  0 entity-defstate ! swap ! ; immediate
+
+0 const W
+1 const E
+2 const N
+3 const S
+4 const NODIR
+
+: dir>pos ( dir -- dx dy )
+  dup W = if drop -1 0 ret then
+  dup E = if drop 1 0 ret then
+  dup N = if drop 0 -1 ret then
+      S = if 0 1 else 0 0 then ;
+
+: pos>dir ( dx dy -- dir )
+  dup 0 < if drop drop N else
+      0 > if drop S else
+  dup 0 < if drop W else
+      0 > if E else NODIR then then then then ;
+
+: facing ( x1 y1 x2 y2 -- dir ) -pos pos>dir ;
+
+: entity-dst ( e -- x y )
+  >r r@ entity.dir @ dir>pos
+  r@ entity.x @ <r entity.y @ world>tile +pos ;
+
+: move-entity ( e -- )
+  dup entity.dir @ dir>pos ( e dx dy )
+  dup if swap drop swap entity.y
+      else drop swap entity.x then
+  swap 16 * over @ + 4 <rot move-to ;
+
+: frame ( s n e w ) b, b, b, b, ;
+array frames
+( 0: car ) 3 1 0 2 frame
+( 1: pete stand ) 11 9 7 5 frame
+( 2: pete walk ) 12 10 8 6 frame
+( 3: mary stand ) 17 20 22 24 frame
+( 4: mary walk ) 19 21 23 25 frame
+( 5: car lights ) 29 27 26 28 frame
+( 6: jeanne stand ) 30 32 34 36 frame
+( 7: jeanne walk ) 31 33 35 37 frame
+( 8: boat w/ pete ) 42 41 40 39 frame
+( 9: duck ) 44 45 44 45 frame
+
+: sprindex ( dir frame ) 2 << frames + + b@ ;
+: defstatic ( frame -- ) create b, does> b@ sprindex ;
+: defsingle ( sprindex -- ) create b, does> swap drop b@ ;
+: lookup-frame ( anim -- val )
+  dup dup 1 + b@ swap b@ ( a count tpf )
+  ticks swap / swap % ( a index )
+  2 + + b@ ;
+
+: defanim ( frame... framecount ticks-per-frame -- )
+  create b, dup b, 0 for b, next
+  does> ( dir a -- ) lookup-frame sprindex ;
+: defmulti ( sprindex... framecount ticks-per-frame -- )
+  create b, dup b, 0 for b, next
+  does> ( dir a -- ) swap drop lookup-frame ;
+
+0 defstatic {car}
+5 defstatic {car-lit}
+1 defstatic {pete-stand}
+1 2 2 5 defanim {pete-walk}
+13 defsingle {pete-table}
+14 defsingle {chair}
+15 defsingle {pete-bed}
+16 defsingle {horse}
+3 defstatic {mary}
+3 4 2 5 defanim {mary-walk}
+6 defstatic {jeanne}
+6 7 2 5 defanim {jeanne-walk}
+18 defsingle {phone}
+38 defsingle {fridge}
+43 defsingle {boat}
+8 defstatic {boat-pete}
+9 defstatic {duck}
+46 defsingle {aliem}
+13 14 2 5 defmulti {neut}
+
+: sprite-bob ( x y sprindex -- x y sprindex )
+  dup 13 >= over 14 <= and if
+    >rot 2dup + ticks + 40 % 20 < if 1 + then <rot
+  then ;
--- a/footer.jor
+++ b/footer.jor
@ -0,0 +1,116 @@
+( F O O T E R )
+var footer-y
+0 footer-y !
+
+: draw-footer footer-y @ split-screen ;
+
+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
+
+var text-color
+WHITE text-color !
+: textxy ( s x y ) <rot text-color @ text ;
+: portraity 1 swap textxy ;
+: statusy 6 swap textxy ;
+
+var textx
+var texty
+2 const textspeed
+var textleft
+: textleftsay 6 textleft ! ;
+: textleftchoice 8 textleft ! ;
+
+: nltext textleft @ textx ! 10 texty +! ;
+: inctextx
+  textx @ 1 + dup 38 <= if textx !
+  else drop nltext inctextx then ;
+
+key \ const '\'
+: statusc
+  dup dup '\' = swap '\n' = or if drop nltext
+  else dup '\r' = if drop
+  else inctextx textx @ texty @ <rot text-color @ textc then then ;
+
+var texttimer
+: textnextc ( s -- s )
+  dup b@ dup if statusc 1 + else drop then ;
+
+: slowtext ( s -- )
+  texttimer now!
+  begin dup b@ while
+    texttimer advance! textspeed * 0 for textnextc next
+  suspend repeat drop ;
+
+: clear
+  text-color @
+  WHITE text-color !
+  s"                                  " dup dup 10 statusy 20 statusy 30 statusy
+  text-color !
+  textleft @ textx !
+  10 texty ! ; userword
+
+: show-footer 48 10 footer-y move-to ;
+: hide-footer 0 10 footer-y move-to ;
+
+: footer-wait show-footer ^ENTER wait-key ;
+
+: say ( s -- ) textleftsay clear show-footer slowtext footer-wait ; userword
+: say" [ ' s" , ] ' say expile ; immediate
+
+defer choosegen
+var ichoose
+var cchoose
+: countchoosegen ( -- )
+  0 choosegen each drop drop 1 + more cchoose ! ;
+
+: getchoice ( -- s cp )
+  0 choosegen
+  each <rot dup ichoose @ < if 1 + >rot drop drop else drop break then more ;
+
+: canchooseleft ichoose @ 0 > ;
+: canchooseright ichoose @ cchoose @ 1 - < ;
+
+: displaychoice
+  clear
+  canchooseleft if s" <" 6 20 textxy then
+  canchooseright if s" >" 38 20 textxy then
+  getchoice drop slowtext ;
+
+: navchoice ( -- done )
+  0 begin suspend
+    ^LEFT key-pressed canchooseleft and if drop 1 -1 ichoose +! then
+    ^RIGHT key-pressed canchooseright and if drop 1 1 ichoose +! then
+    ^ENTER key-pressed if drop 2 then
+  dup until 1 - ;
+
+: choose ( gen -- )
+  ' choosegen redefine countchoosegen 0 ichoose !
+  textleftchoice clear show-footer
+  begin displaychoice navchoice until
+  getchoice swap drop execute ;
+
+: character ( iportrait color ) create , ,
+  does> dup @ text-color ! cell + @ draw-portrait ;
+
+0 GREEN character pete userword
+1 MAGENTA character mary userword
+2 BROWN character chuck userword
+3 YELLOW character jeanne userword
+4 LGRAY character phone userword
+
+: noone WHITE text-color ! s"     " dup dup dup
+  8 portraity 16 portraity 24 portraity 32 portraity ; userword
--- a/footer.tif
+++ b/footer.tif
--- a/footer2.tif
+++ b/footer2.tif
--- a/game.exe
+++ b/game.exe
--- a/game.jor
+++ b/game.jor
@ -0,0 +1,170 @@
+var MODE-MOVE
+var MODE-WAIT
+
+
+( T I C K )
+defer party
+defer entities
+
+: entity-at ( x y -- entity|0 )
+  0 >rot
+  entities each >r 2dup ( 0 x y x y r:e )
+    r@ entity.x @ r@ entity.y @ world>tile 2= ( 0 x y eq r:e )
+    if <rot drop <r >rot break ( e x y )
+    else rdrop then ( 0 x y )
+  more drop drop ;
+
+( P L A Y E R )
+var player.state userword
+var player.prevdir
+
+1 const MOVING userword
+2 const NOCLIP userword
+4 const ISNEUT userword
+
+: noclip player.state NOCLIP fnot! ; userword
+
+: isneut? player.state ISNEUT f@ ; userword
+
+: {jaye}
+  isneut? not player.state MOVING f@ and
+  if {jeanne-walk} else {jeanne} then ;
+
+: player.canmove? ( x y -- )
+  player.state NOCLIP f@ not if
+    isneut? if NEUTABLE else WALKABLE then mapflag?
+  else drop drop 1 then ;
+
+12 9 N ' {jaye} defentity pjaye
+17 5 N ' {neut} defentity pneut
+
+: player isneut? if pneut else pjaye then ;
+
+: sched-move-entity ( entity -- ) :| jobdata move-entity |; sched-with ;
+: move-player
+  :| 1 player.state MOVING f!
+     player move-entity
+     0 player.state MOVING f!
+  |; sched
+  isneut? not if ( only jaye can have a party )
+    player.prevdir @ party each
+      dup player != if
+	dup entity.dir @ >r
+	dup >rot entity.dir !
+	sched-move-entity <r
+      else entity.dir @ player.prevdir ! then more drop
+  then ;
+
+: out-of-bounds ( x y -- b )
+  2dup 0 < swap 0 < or >rot mapsize ( b x y w h )
+  <rot <= >rot ( b b x w )
+  >= or or ;
+
+: leaving? ( x y dir -- b )
+  dup N = if drop swap drop 0 < else
+  dup W = if drop drop 0 < else
+  S = if swap drop mapsize swap drop >= else
+  drop mapsize drop >= then then then ;
+
+defer jaye-touch ( x y -- b )
+defer neut-touch ( x y -- b )
+
+: player-touch isneut? if neut-touch else jaye-touch then ;
+
+: touch-begin each 2dup more >rot drop drop ;
+: touch-next dup if rdrop done then drop rswap ;
+: touch-last ' done , ; immediate
+: ;touch [ ' touch-last , ' [ , ] ; immediate
+
+: check-player-touch ( x y -- b )
+  touch-begin entity-at dup if EVTOUCH entity>do 1 then
+  touch-next player-touch
+  touch-next out-of-bounds
+  touch-next player.canmove? not ;touch
+
+: try-move-player
+  player entity-dst check-player-touch not if move-player then ;
+
+: follow ( e -- )
+  player entity>pos <rot entity.pos! NODIR player.prevdir ! ;
+
+: check-entity-touch
+  touch-begin entity-at
+  touch-next out-of-bounds
+  touch-next WALKABLE mapflag? ;touch
+
+: try-move-entity ( e -- )
+  s" try-move-entity" type cr
+  dup entity-dst check-entity-touch not if move-entity then ;
+
+var q-level
+var q-player.x
+var q-player.y
+: queue-level q-level ! q-player.y ! q-player.x ! ; userword
+
+: player-tick
+  ^SPACE key-pressed if player.state ISNEUT fnot! then
+  0 ^LEFT key-down if drop 1 W player entity.dir ! then
+  ^RIGHT key-down if drop 1 E player entity.dir ! then
+  ^UP key-down if drop 1 N player entity.dir ! then
+  ^DOWN key-down if drop 1 S player entity.dir ! then
+  if ' try-move-player sched then ;
+
+( S T U F F )
+: reset-level
+  :| done |; ' entities redefine
+  :| drop drop 0 |; ' jaye-touch redefine
+  :| drop drop 0 |; ' neut-touch redefine ; userword
+
+: mode-move
+  player-tick
+  entities each EVTICK entity>do more
+  party each EVTICK entity>do more
+  pneut EVTICK entity>do
+
+  tick-mapedit jiles
+  tick-debounce
+  q-level @ dup if
+    0 q-level !
+    reset-level
+    loadlevel
+    q-player.x @ q-player.y @ tile>world player entity.pos!
+    party each follow more
+  else drop then ;
+
+' mode-move MODE-MOVE !
+' tick-debounce MODE-WAIT !
+
+: draw-entity
+  >r r@ entity.x @ r@ entity.y @
+  r@ entity.dir @ <r entity>sprite
+  sprite-bob draw-sprite ;
+
+var showmouse
+1 showmouse !
+var glitchlevel
+
+: full-draw
+  player entity.x @ 152 -
+  player entity.y @ 92 -
+  scroll
+
+  entities each draw-entity more
+  party each draw-entity more
+  pneut draw-entity
+
+  showmouse @ if
+    mouseworldpos 4 draw-sprite
+  then
+  glitchlevel @ glitch
+  draw-screen
+  draw-footer ;
+
+:noname
+  reset-level
+  MODE-MOVE @ ' tick redefine
+  ' full-draw ' draw redefine
+  :| pjaye yield done |; ' party redefine
+  :| MODE-WAIT @ ' tick redefine |; ' any-job-started redefine
+  :| MODE-MOVE @ ' tick redefine hide-footer |; ' all-jobs-complete redefine
+; ' onload redefine
--- a/game.prj
+++ b/game.prj
--- a/gameboot.jor
+++ b/gameboot.jor
@ -0,0 +1,35 @@
+: blah ' seremit task-emit ! ;
+blah
+
+s" game.log" open seekend fdeactivate const LOGFILE
+: emit-log ' fputc LOGFILE withfp ;
+: atexit LOGFILE factivate close ;
+
+: start-repl activate blah ' emit-log task-echo !
+  s" .:: J O R T H ( jean forth) ::." type cr
+  begin receive loadstring s" ok" type cr again ;
+task const REPL
+REPL start-repl
+
+defer tick
+defer draw
+defer loadlevel
+
+:noname
+s" input.jor" loadfile
+s" timer.jor" loadfile
+s" entity.jor" loadfile
+s" footer.jor" loadfile
+s" map.jor" loadfile
+s" state.jor" loadfile
+s" jiles.jor" loadfile
+s" job.jor" loadfile
+s" game.jor" loadfile
+; execute
+
+intern lev00001.jor
+
+:noname loadfile ; checkpoint _loadlevel
+' _loadlevel ' loadlevel redefine
+
+lev00001.jor loadlevel
--- a/input.jor
+++ b/input.jor
@ -0,0 +1,33 @@
+( K E Y B O A R D )
+1 const ^ESC
+15 const ^TAB
+28 const ^ENTER
+29 const ^CTRL
+51 const ^<
+52 const ^>
+56 const ^ALT
+57 const ^SPACE
+72 const ^UP
+75 const ^LEFT
+77 const ^RIGHT
+80 const ^DOWN
+
+: wait-key ( k -- ) begin dup key-pressed not while suspend repeat drop ;
+: udelta ( u u -- u )
+  2dup u> if
+    swap -1 swap - + 1 +
+  else
+    swap -
+  then ;
+
+( M O U S E )
+var prevbutton
+: tick-debounce
+  mousebuttons prevbutton ! ;
+
+1 const MOUSEL
+2 const MOUSER
+: mousedown ( button -- bool ) mousebuttons & ;
+: clicked ( button -- bool )
+  dup mousedown not swap
+  prevbutton @ & and ;
--- a/jazzbass.sbi
+++ b/jazzbass.sbi
--- a/jeanne.jor
+++ b/jeanne.jor
@ -0,0 +1,59 @@
+( J E A N N E )
+
+16 18 W ' {horse} defentity e_chuck
+14 22 N ' {car} defentity car
+
+e_chuck :touch
+  pete say" Hey there, Chuck."
+  chuck say" * w h i n n y *\(Hey there, Pete.)"
+;entity
+
+car :touch
+ move-player 1 player.state DRIVING f!
+;entity
+
+:noname
+  0 player.state DRIVING f!
+:| CHUCK-HOME flag@ if e_chuck yield then
+   player.driving? not CHUCK-FOLLOW flag@ not and if car yield then
+   done |; ' entities redefine
+
+ :|
+touch-begin S leaving? dup
+  if player.driving? not
+    if   pete say" I'm not walking."
+    else move-player 24 7 road.jor queue-level
+    then
+  then
+touch-next 6 21 2= dup
+  if player.driving? not
+    if CHUCK-FOLLOW flag@ not if
+	noone say" * knock knock *"
+	clear 30 sleep
+	pete say" Nobody home, I guess."
+	jeanne say" Go away before I call the\cops, Pete!"
+	pete say" Oh.\I guess she's still mad."
+	JEANNE-ANGRY setflag
+      else
+	pete say" I brought you your\damn horse, Jeanne!"
+	jeanne say" Oh my God. Is he okay?\Hold on, I'm coming outside."
+	pete say" He's fine."
+	W player entity.dir ! move-player move-player E player entity.dir !
+	( todo: jeanne sprite I guess )
+	chuck say" * n u z z l e *\(Jeanne! I'm home!)"
+	jeanne say" Jesus, Chuck, you're a wreck.\Let's get you fed and rested."
+	pete say" You're welcome."
+	jeanne say" Don't think for a MINUTE\I'm not still furious at you."
+	jeanne say" If I catch you on my property\again, I *will* call the cops."
+	pete say" Alright, alright, I'm going!\Christ, no good deed goes\unpunished."
+	CHUCK-HOME setflag CHUCK-FOLLOW clearflag
+	10 6 petehous.jor queue-level
+      then
+    else
+      pete say" Jeanne hates me enough already\without driving through her\front door!"
+    then
+  then
+touch-last |; ' player-touch redefine
+
+s" jeanne.map" load-map
+; ' onload redefine
--- a/jeanne.map
+++ b/jeanne.map
--- a/jiles.jor
+++ b/jiles.jor
@ -0,0 +1,114 @@
+var lcolor 0x0f lcolor !
+var rcolor 0x10 rcolor !
+var spriteindex
+
+var refresh-needed
+: refresh 1 refresh-needed ! ;
+
+array preview 128 allot
+
+: color! >r dup r@ @ = if drop else r@ ! refresh then rdrop ;
+
+: +sprite! spriteindex spritecount +!cycle spriteindex @ . refresh ;
+
+: draw-palette 0 0x11 for i 79 i 3 << drawfatbox next ;
+
+: draw-preview
+  0 18 for
+    0 edittarget = if
+      i preview tile>buf
+      spriteindex @ preview spr>buf
+    else
+      spriteindex @ preview tile>buf
+    then
+    i 3 % 2 * 65 + i 3 / 16 * preview paintbuf
+  next ;
+
+: mousecoord>sprcoord 2 edittarget = if 2 else 3 then >> ;
+: mousepos>sprpos mousecoord>sprcoord swap mousecoord>sprcoord swap ;
+: mousexys mousepos mousepos>sprpos spriteindex @ ;
+
+: mousepixel! ( color -- )
+  >r mousexys getpixel r@ != if
+    r@ mousexys putpixel refresh
+  then rdrop ;
+
+: gfxfilename
+  0 edittarget = if
+    s" sprite.gfx"
+  else 1 edittarget = if
+    NIGHT flag@ if
+      s" ntiles.gfx"
+    else
+      s" tiles.gfx"
+    then
+  else s" portrait.gfx" then then ;
+
+var jiles-old-tick
+var jiles-old-draw
+
+44 const ^Z
+45 const ^X
+31 const ^S
+20 const ^T
+33 const ^F
+19 const ^R
+46 const ^C
+47 const ^V
+73 const ^PgUp
+81 const ^PgDn
+
+var copysrc
+
+: jiles-tick
+  mousepos 128 < swap 128 < and if
+    MOUSEL mousedown if lcolor @ mousepixel! then
+    MOUSER mousedown if rcolor @ mousepixel! then
+  then
+  mousepos 136 < swap 312 >= and if
+    mousepos swap drop 3 >> dup
+    MOUSEL mousedown if lcolor color! else drop then
+    MOUSER mousedown if rcolor color! else drop then
+  then
+  ^LEFT key-pressed if -1 +sprite! then
+  ^RIGHT key-pressed if 1 +sprite! then
+  ^Z key-pressed if mousexys getpixel lcolor color! then
+  ^X key-pressed if mousexys getpixel rcolor color! then
+  ^S key-pressed if s" SAVING " type gfxfilename dup type cr savegfx then
+  ^T key-pressed if edittarget 1 + 3 % edittarget! 0 +sprite! then
+  ^C key-pressed if spriteindex @ copysrc ! then
+  ^V key-pressed if copysrc @ spriteindex @ paste-tile refresh then
+  ^F key-pressed if spriteindex @ flip-tile refresh then
+  ^R key-pressed if spriteindex @ vflip-tile refresh then
+  ^PgDn key-pressed if 5 +sprite! then
+  ^PgUp key-pressed if -5 +sprite! then
+  ^UP key-pressed if -1 spriteindex @ nudge-sprite refresh then
+  ^DOWN key-pressed if 1 spriteindex @ nudge-sprite refresh then
+  ^TAB key-pressed if
+    jiles-old-draw @ ' draw redefine
+    jiles-old-tick @ ' tick redefine
+    mousehide unfuck invalidate-map reloadtiles reloadportraits load-footer
+  then
+  tick-debounce
+;
+
+: jiles-draw
+  refresh-needed @ if
+    mousehide
+    draw-preview
+    spriteindex @ drawfatsprite
+    lcolor @ 77 0 drawfatbox
+    rcolor @ 78 0 drawfatbox
+    draw-palette
+    mouseshow
+    0 refresh-needed !
+  then ;
+
+: jiles
+  ^TAB key-pressed if
+    ' draw definition jiles-old-draw !
+    ' tick definition jiles-old-tick !
+    ' jiles-draw ' draw redefine
+    ' jiles-tick ' tick redefine
+    fuck mouseshow refresh
+  then ;
--- a/job.jor
+++ b/job.jor
@ -0,0 +1,86 @@
+defer any-job-started
+defer all-jobs-complete
+
+var JOBSTATE
+array JOBTASKS 4 cells allot
+array JOBS 8 cells allot
+array JOBDATA 8 cells allot
+
+: by-jobid ( jobid p -- p ) swap 1 - cells + ;
+
+: jobdata ( jobid -- jobid data ) dup JOBDATA by-jobid @ ;
+: jobdata! ( data jobid -- ) JOBDATA by-jobid ! ;
+
+: ijobtask-running ( -- i )
+  0 0 4 for JOBTASKS i cells + @ running = if drop i then next ;
+
+: jobtask-busy-flag ( ijobtask -- v f )
+  1 swap << JOBSTATE swap ;
+
+: job-scheduled-flag ( jobid -- v f )
+  0x08 swap << JOBSTATE swap ;
+
+: next-matching-jobid ( matcher -- jobid )
+  0 1 9 for dup not if
+    over i swap execute if drop i then
+  then next swap drop ;
+
+: job-unscheduled+xp ( jobid -- b xp )
+  dup job-scheduled-flag f@ not
+  swap JOBS by-jobid @ ;
+
+: next-unused-jobid ( -- jobid )
+  :| job-unscheduled+xp not and |; next-matching-jobid ;
+
+: next-waiting-jobid ( -- jobid )
+  :| job-unscheduled+xp and |; next-matching-jobid ;
+
+: on-job-complete ( jobid -- )
+  0 swap job-scheduled-flag f!
+  next-waiting-jobid dup if
+    dup running send
+    1 swap job-scheduled-flag f!
+  else
+    ( 0 ) ijobtask-running jobtask-busy-flag f!
+    JOBSTATE @ not if all-jobs-complete then
+  then ;
+
+: listen-for-jobs activate blah
+  begin receive ( jobid )
+    any-job-started
+    dup JOBS by-jobid 0 swap @!
+    execute
+    on-job-complete
+  again ;
+
+: start-jobtask ( i -- )
+  task dup listen-for-jobs swap cells JOBTASKS + ! ;
+
+: next-free-job-task ( -- task )
+  0 0 4 for dup not if
+    JOBSTATE 1 i << f@ not if
+      drop JOBTASKS i cells + @
+    then
+  then next ;
+
+: enqueue-job ( xp -- jobid )
+  next-unused-jobid dup if
+    dup >rot 1 - cells JOBS + !
+  else swap drop then ;
+
+: try-run-job ( jobid -- )
+  0 4 for i jobtask-busy-flag f@ not if
+    1 i jobtask-busy-flag f!
+    1 over job-scheduled-flag f!
+    JOBTASKS i cells + @ send breakfor
+  then next ;
+
+: sched ( xp -- ) enqueue-job try-run-job ;
+: sched-with ( data xp -- ) enqueue-job dup >rot jobdata! try-run-job ;
+
+:noname
+0 start-jobtask
+1 start-jobtask
+2 start-jobtask
+3 start-jobtask
+; ' onload redefine
--- a/jopl.c
+++ b/jopl.c
@ -0,0 +1,158 @@
+#include <dir.h>
+#include <stdlib.h>
+#include <time.h>
+#include "jorth.h"
+#include "adlib.h"
+#include "kbd.h"
+#include "timer.h"
+#include "serial.h"
+
+cell ontick = 0;
+void f_adlib_read() {
+  PUSHU(adlib_read());
+}
+
+void f_adlib_write() {
+  adlib_write(TOP().u & 0xff, ST1().u & 0xff);
+  DROP(2);
+}
+
+volatile int WAKE = 0;
+static void timer_callback() {
+  if (adlib_read() & 0x20) {
+    WAKE = 1;
+  }
+}
+
+int DONE = 0;
+static void f_quit() {
+  DONE = 1;
+}
+
+void f_keyWasPressed() {
+  int k = TOP().i;
+  TOP().i = keyWasPressed(k);
+  consumeKey(k);
+}
+
+void f_keydown() {
+  TOP().i = keyIsDown(TOP().i);
+}
+
+char *gather_input() {
+  static char buf[128];
+  static int ibuf = 0;
+
+  if (bioskey(1)) {
+    int key = bioskey(0);
+    char ch = key & 0xff;
+    if (ch == 0x08) {
+      if (ibuf > 0) {
+	printf("%c %c", ch, ch);
+	ibuf --;
+      }
+    } else {
+      buf[ibuf] = ch;
+      ibuf ++;
+      if (ch == 0x0d) {
+	printf("\n");
+	buf[ibuf] = 0;
+	ibuf = 0;
+	return buf;
+      } else {
+	printf("%c", ch);
+      }
+    }
+  }
+  return NULL;
+}
+
+void f_seremit() {
+  ser_write_byte(TOP().i);
+  if (TOP().i == '\n') {
+    ser_write_byte('\r');
+  }
+  DROP(1);
+}
+
+void f_random() {
+  TOP().i = random(TOP().i);
+}
+
+void do_repl(char *exe) {
+  adlib_init();
+
+  timer_init(TIMER_18HZ);
+  f_init(exe);
+
+  ser_init(SER_COM2, BAUD_19200, SER_8N1);
+  CDEF("seremit", f_seremit);
+  CDEF("_quit", f_quit);
+  CDEF("adlib!", f_adlib_write);
+  CDEF("adlib@", f_adlib_read);
+  CDEF("key-start", kbd_init);
+  CDEF("key-end", kbd_cleanup);
+  CDEF("key-debounce", kbd_debounce);
+  CDEF("key-pressed", f_keyWasPressed);
+  CDEF("key-down", f_keydown);
+  CDEF("rnd", f_random);
+  f_loadfile("jopl.jor");
+  ontick = f_lookupcp("ontick");
+  timer_setcallback(timer_callback);
+
+  f_taskloop();
+
+  while (!DONE) {
+    char *buf = gather_input();
+    if (buf) {
+      PUSHS(buf);
+      f_runstring("REPL send");
+    }
+    if (WAKE) {
+      WAKE = 0;
+      if (ontick.p != NULL) {
+	f_execcp(ontick);
+      }
+    }
+    f_taskloop();
+  }
+}
+
+#define RIGHT  0x01
+#define LEFT   0x02
+#define CTRL   0x04
+#define ALT    0x08
+
+void keything() {
+  int key, modifiers, done;
+  done = 0;
+  while (!done) {
+    /* function 1 returns 0 until a key is pressed */
+    while (bioskey(1) == 0);
+
+    /* function 0 returns the key that is waiting */
+    key = bioskey(0);
+
+    /* use function 2 to determine if shift keys were used */
+    modifiers = bioskey(2);
+    if (modifiers)
+    {
+      printf("[%#02x", modifiers);
+      if (modifiers & RIGHT) printf(" RIGHT");
+      if (modifiers & LEFT)  printf(" LEFT");
+      if (modifiers & CTRL)  printf(" CTRL");
+      if (modifiers & ALT)   printf(" ALT");
+      printf("]");
+    }
+    /* print out the character read */
+    printf("'%c' %#02x\n", key & 0xff, key);
+    if ((key & 0xff) == 'q') done = 1;
+
+  }
+}
+int main(int argc, char *argv[]) {
+//  keything();
+  randomize();
+  do_repl(argv[0]);
+  return 0;
+}
--- a/jopl.exe
+++ b/jopl.exe
--- a/jopl.jor
+++ b/jopl.jor
@ -0,0 +1,371 @@
+' putc task-emit !
+s" jopl.log" open seekend fdeactivate const LOGFILE
+: emit-log fdeactivate LOGFILE factivate fputc fdeactivate drop factivate ;
+: quit LOGFILE factivate close _quit ;
+
+: DBG :| ' seremit task-emit ! execute cr |; 0 task-emit preserving ;
+: DTYPE ' type DBG ;
+
+: start-repl activate
+  ' putc task-emit ! ' emit-log task-echo !
+  s" .:: J O P L ( jean OPL2 print loop) ::." type cr
+  begin receive loadstring s" ok" type cr again ;
+task const REPL
+REPL start-repl
+
+var voice
+var op
+
+: +voice! voice @ + 10 % voice ! ;
+
+: op-with-voice voice @
+  dup 5 > if 5 + then
+  dup 2 > if 5 + then
+  + op @ + ;
+: opreg create b, does> ub@ op-with-voice ;
+: voicereg create b, does> ub@ voice @ + ;
+
+0x20 opreg ar-flags
+0x40 opreg ar-level
+0x60 opreg ar-ad
+0x80 opreg ar-sr
+0xe0 opreg ar-wave
+0xc0 voicereg ar-alg
+
+0xa0 voicereg ar-freq
+0xb0 voicereg ar-note
+
+: op2 3 op ! ;
+: op1 0 op ! ;
+: loadop ( flags level ad sr wave -- )
+  ar-wave adlib!
+  ar-sr adlib!
+  ar-ad adlib!
+  ar-level adlib!
+  ar-flags adlib! ;
+
+: readop ( v -- )
+  >r r@ 4 + b@ r@ 3 + b@ r@ 2 + b@ r@ 1 + b@ <r b@ loadop ;
+
+: instrument ( alg f1 l1 ad1 sr1 w1 f2 l2 ad2 sr2 w2 -- )
+  create b, b, b, b, b, b, b, b, b, b, b, does>
+  dup dup 5 + op1 readop op2 readop
+  10 + b@ ar-alg adlib! ;
+
+0 0x01 0x10 0xf0 0x77 0 0x01 0x00 0xf0 0x77 0 instrument default
+
+: freqon ( oct freq -- )
+  dup 0xff & ar-freq adlib!
+  8 >> 0x03 & swap 2 << | 0x20 | ar-note adlib! ;
+: noteoff ( -- ) 0 ar-note adlib! ; userword
+
+array semitones
+3520 3520 />ratio ,
+3729 3520 />ratio ,
+3951 3520 />ratio ,
+4186 3520 />ratio ,
+4435 3520 />ratio ,
+4699 3520 />ratio ,
+4978 3520 />ratio ,
+5274 3520 />ratio ,
+5588 3520 />ratio ,
+5920 3520 />ratio ,
+6272 3520 />ratio ,
+6645 3520 />ratio ,
+
+: note dup 12 / 8 % swap 12 % cells semitones + @ 440 swap *<ratio ;
+: noteon noteoff note freqon ;
+
+: read-sbi-reg ( reg-cp -- )
+  fgetc swap execute adlib! ;
+
+: read-sbi-op-reg ( reg-cp -- )
+  dup op1 read-sbi-reg
+  op2 read-sbi-reg ;
+
+: loadsbi ( filename -- )
+  open 36 seek
+  ' ar-flags read-sbi-op-reg
+  ' ar-level read-sbi-op-reg
+  ' ar-ad read-sbi-op-reg
+  ' ar-sr read-sbi-op-reg
+  ' ar-wave read-sbi-op-reg
+  fgetc ar-alg adlib!
+  close ; userword
+
+: rndbyte 256 rnd dup . ;
+: rndop rndbyte rndbyte rndbyte rndbyte rndbyte s" loadop " type loadop ;
+: rndinst s" op1 " type op1 rndop s" op2 " type op2 rndop
+	  rndbyte s" ar-alg adlib! " type cr ar-alg adlib! ; userword
+
+: panic 9 -1 for i voice ! noteoff next ; userword
+
+var songticks
+
+var notestate
+var octave
+: oct+ octave @ 12 * + ; userword
+: rest songticks @ begin suspend dup songticks @ != until drop ; userword
+: beat begin dup songticks @ swap % 0 != while rest repeat drop ; userword
+: %O octave ! ; userword
+: %V voice ! ; userword
+: mknote create b, does> ub@ oct+ notestate @ if b, else noteon rest then ;
+: %loop 0xfe b, , ; userword
+: mod % ;
+: % notestate @ if 0xf0 b, else rest then ; userword
+: %% 0 for % next ; userword
+: %- notestate @ if 0xfd b, else noteoff then ; userword
+: %do 0xff b, , ; userword
+
+11 mknote G# userword
+10 mknote G  userword
+9  mknote F# userword
+8  mknote F  userword
+7  mknote E  userword
+6  mknote D# userword
+5  mknote D  userword
+4  mknote C# userword
+3  mknote C  userword
+2  mknote B  userword
+1  mknote A# userword
+0  mknote A  userword
+
+array tracks 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,
+
+: track ( i -- p ) cells tracks + ;
+: dotrack ( ip -- ip )
+  dup if dup 1 + swap ub@ >r
+    r@ 0xff = if dup @ swap cell + swap execute then
+    r@ 0xfe = if @ dotrack then
+    r@ 0xfd = if noteoff then
+    r@ 0xf0 < if r@ noteon then
+  rdrop then ;
+
+: track-tick ( i -- )
+  track dup @ dotrack swap ! ;
+
+: :track create here 1 notestate ! does> voice @ track ! ; userword
+: ;track %loop 0 notestate ! ; userword
+: shush 0 voice @ track ! %- ; userword
+
+: prev-name ( wordname -- wordname )
+  2 cells - @ 2 cells + ;
+: 'name [ ' [ , ' ' , ' ] , ] ` lit ; immediate
+
+: emit-octave ( note -- )
+  12 / dup octave @ != if dup octave ! . s" %O " type else drop then ;
+
+: emit-note ( note -- )
+  'name A swap 12 mod 0 for prev-name next type bl ;
+
+: emit-cmd ( cmd -- more )
+  dup 0xf0 = if s" % " type then
+  dup 0xfd = if s" %- " type then
+  dup 0xf0 < if dup emit-octave emit-note 1 then
+  dup 0xfe = if 'name ;track type cr drop 0 then ;
+
+: emit-track ( 'track -- )
+  -1 octave ! dup ` swap 2 cells +
+  'name :track type bl swap type bl
+  begin dup ub@ emit-cmd while 1 + repeat drop ; userword
+
+( T E X T )
+
+var textx
+var texty
+var textattr
+var textleft
+0x1f textattr !
+
+: out-direct ( c -- )
+  textattr @ 8 << |
+  texty @ 160 * textx @ 1 << +
+  0xb800 !far ;
+
+: setattr-to ( w -- )
+  texty @ 80 * textx @ +
+  dup <rot +
+  textattr @ >rot
+  for dup i 1 << 1 + 0xb800 b!far next drop ;
+
+: clearline
+  textattr @ 8 <<
+  texty @ 80 * textx @ +
+  texty @ 1 + 80 *
+  for dup i 1 << 0xb800 !far next drop ;
+
+: +textx! ( n -- )
+  textx @ + dup 80 >= if drop cr else textx ! then ;
+: emit-direct ( c -- )
+  dup '\n' = if textleft @ textx ! 1 texty +! drop else
+  dup '\r' = if drop else
+  out-direct 1 +textx! then then ;
+
+: rpad ( n -- )
+  textleft @ + textx @ for bl next ;
+
+: read-direct ( x y -- s )
+  80 * + here swap
+  begin dup 1 << 0xb800 b@far dup sp != while b, 1 + repeat
+  0 b, drop drop dup here! ;
+
+: status
+  0 textx ! 0 texty ! 0 textleft !
+  s"  V: " type voice @ .
+  s"  O: " type octave @ .
+  s"  T: " type songticks @ .
+  clearline ;
+
+: emit-status-cmd ( ip -- ip )
+  dup ub@ swap 1 + swap
+  dup 0xf0 = if s" % " type then
+  dup 0xfd = if s" - " type then
+  dup 0xf0 < if dup emit-note then
+  dup 0xfe = if
+    16 textattr +!
+    swap @ emit-status-cmd swap
+    -16 textattr +!
+  then drop ;
+
+: showtrack ( n -- )
+  dup . s" : " type
+  track @ dup if 20 0 for emit-status-cmd next then drop
+  clearline ;
+
+: trackstatus cr voice @ showtrack ;
+
+var tempo userword 1 tempo !
+: player
+  1 songticks +!
+  songticks @ tempo @ mod 0 = if
+    voice @
+    0 10 for i voice ! i track-tick next
+    voice !
+  then ;
+
+var t2
+: startt2
+  0x60 0x04 adlib!
+  0x80 0x04 adlib!
+  t2 @ 0x03 adlib!
+  0x42 0x04 adlib! ;
+
+: ontick startt2 player ' status 0 textleft textx texty preserving ( trackstatus ) ;
+
+: keynote [ inline|
+44 b, 31 b, 45 b, 32 b, 46 b, 47 b, 34 b, 48 b, 35 b, 49 b, 36 b, 50 b,
+16 b, 3  b, 17 b, 4  b, 18 b, 19 b, 6  b, 20 b, 7  b, 21 b, 8  b, 22 b,
+23 b, 10 b, 24 b, 11 b, 25 b,
+|inline ] 0 29 for dup i + ub@ key-pressed if drop i 3 + rdrop rdrop ret then next
+  drop 51 key-pressed if 15 else 0 then ; userword
+
+: onkeynote ( cp -- ) keynote dup if oct+ swap execute else drop drop then ;
+
+var stopkeys
+: stoponesc 1 key-pressed if 1 stopkeys ! then ;
+: voicekeys
+  78 key-pressed if 1 octave +! then
+  74 key-pressed if -1 octave +! then
+  75 key-pressed if -1 +voice! then
+  77 key-pressed if 1 +voice! then ;
+
+: dokeys ( cp -- )
+  >r 0 stopkeys ! key-start begin
+    key-debounce r@ execute suspend
+  stopkeys @ until key-end rdrop ;
+
+: nextnote ( ip -- ip )
+  dup if
+    dup ub@ >r
+    r@ 0xff = if drop 0 else
+    r@ 0xfe = if 1 + @ nextnote then then
+    rdrop
+  then ;
+
+: setnote ( note -- )
+  voice @ track @ nextnote
+  dup if b! else drop drop then ;
+
+: record
+  0x4f textattr !
+  :| stoponesc voicekeys
+     ' setnote onkeynote
+     41 key-pressed if 0xfd setnote then
+     52 key-down if 0xf0 setnote then
+  |; dokeys
+  0x1f textattr ! ; userword
+
+: jamkeys
+  stoponesc voicekeys
+  ' noteon onkeynote
+  41 key-pressed if noteoff then
+  88 key-pressed if rndinst then ;
+
+: jam ' jamkeys dokeys ; userword
+
+var menuscroll
+var menuy
+var menuw
+
+defer onselect
+
+: menu-at ( cp x y w -- )
+  :| menuw ! texty ! dup textx ! textleft ! ' emit-direct task-emit !
+     0 menuscroll ! 0 menuy !
+     execute ' noop ' onselect redefine |;
+  0 textleft task-emit preserving ;
+
+: menu-lines ( -- count ) 24 texty @ - ;
+: menu-skip menuscroll @ 0 max ;
+: menu-selectedy menuy @ menu-skip - texty @ + ;
+
+: menuitem-bg ( attr -- )
+  :| menu-selectedy texty !
+     textleft @ textx !
+     textattr ! menuw @ setattr-to |;
+  0 texty textx textattr preserving ;
+
+: deselect-menu ( -- ) 0x1f menuitem-bg ;
+: select-menu ( -- ) 0x30 menuitem-bg ;
+
+: selected-text textx @ menu-selectedy read-direct ;
+
+: draw-menu ( cp -- ) 0 texty textattr preserving select-menu ;
+
+: change-selection ( dy -- )
+  deselect-menu menuy +!pos select-menu onselect ;
+
+: page-selection ( redraw dy -- 1 )
+  dup menuscroll +!pos menuy +!pos drop 1 ;
+
+: key-menu ( -- redraw )
+  :|
+    0 ( redraw )
+    72 key-pressed if -1 change-selection then
+    80 key-pressed if 1 change-selection then
+    73 key-pressed if -10 page-selection then
+    81 key-pressed if 10 page-selection then
+  |; draw-menu ;
+
+: draw-filemenu ( glob -- )
+  :| findfile
+     menu-skip 0 for drop nextfile next
+     menu-lines 0 for dup if type else drop then 13 rpad cr nextfile next
+     drop |; draw-menu ;
+
+: inst ( -- )
+  :| selected-text loadsbi |; ' onselect redefine
+  :| s" *.sbi" draw-filemenu
+     :| jamkeys
+	key-menu if s" *.sbi" draw-filemenu then
+	28 key-pressed if 1 stopkeys ! then
+     |; dokeys
+  |; 66 1 13 menu-at ; userword
+
+: dune ( -- ) s" dune" chdir inst s" .." chdir ; userword
+
+:noname
+  9 -1 for i voice ! default next
+  startt2
+  ' emit-direct task-emit !
+; ' onload redefine
--- a/jopl.prj
+++ b/jopl.prj
--- a/jorth.c
+++ b/jorth.c
--- a/jorth.h
+++ b/jorth.h
@ -0,0 +1,75 @@
+#include <stdio.h>
+
+#define MEM_SIZE 24576
+#define STACK_SIZE 64
+#define RSTACK_SIZE 64
+
+void f_init(char *exe);
+
+void f_cdef();
+void f_immediate();
+
+void f_loadfile(char *filename);
+void f_runstring(char *s);
+
+void f_quiet();
+void f_loud();
+void f_interpreter();
+
+union cell_union;
+typedef union cell_union cell;
+
+union cell_union {
+  int i;
+  unsigned int u;
+  cell *p;
+  char *s;
+  void (*f)();
+  FILE *fp;
+};
+
+extern char mem[MEM_SIZE];
+extern cell *HERE;
+extern cell *LATEST;
+extern cell IP;
+extern cell W;
+extern cell *rstack;
+extern cell *stack;
+
+#define F_NAMELEN_MASK 0x7f
+#define F_IMMEDIATE 0x80
+
+#define CELL_OFFSET(cp, b) ((cell*)(((char *)(cp)) + b))
+#define TOP() (*(stack - 1))
+#define ST1() (*(stack - 2))
+#define ST2() (*(stack - 3))
+void DROP(int n);
+void PUSHC(cell c);
+void PUSHI(int i);
+void PUSHU(unsigned int u);
+void PUSHCP(cell *c);
+#define PUSHP(p) PUSHCP((cell*)p)
+void PUSHS(char *s);
+void RPUSH(cell c);
+#define RPOP() (--rstack)
+#define RTOP() (*(rstack - 1))
+
+void f_key();
+void f_word();
+void f_emit();
+void f_puts();
+void f_dot();
+void f_cr();
+void f_comma();
+void f_bcomma();
+void f_create(); // name --
+void f_cdef(); // func name --
+void f_doconst();
+void f_compileword();
+
+cell f_lookupcp(char *name);
+void f_execcp(cell cp);
+
+#define CDEF(name, def) PUSHP(def); PUSHS(name); f_cdef()
+#define ICONST(name, v) CDEF(name, f_doconst); PUSHI(v); f_comma()
+#define PCONST(name, p) CDEF(name, f_doconst); PUSHP(p); f_comma()
--- a/kbd.c
+++ b/kbd.c
@ -0,0 +1,78 @@
+#include <stdio.h>
+#include <dos.h>
+#include "kbd.h"
+
+static void interrupt (*oldKbdISR)() = NULL;
+
+void kbd_cleanup() {
+  if (oldKbdISR != NULL) {
+    setvect(KBD_INT, oldKbdISR);
+    oldKbdISR = NULL;
+  }
+}
+
+volatile unsigned char keybuf[128] = { 0 };
+volatile char kbd_triggered = 0;
+
+static void interrupt kbd_isr() {
+  unsigned char raw;
+  char ctl;
+
+  disable();
+
+  raw = inp(0x60);
+  ctl = inp(0x61) | 0x82;
+  outp(0x61, ctl);
+  outp(0x61, ctl & 0x7f);
+
+  if (raw & 0x80) {
+    keybuf[raw & 0x7f] &= ~KEY_SIGNAL;
+  } else {
+    keybuf[raw] |= KEY_SIGNAL;
+  }
+  kbd_triggered = raw;
+  outp(0x20, 0x20);
+  enable();
+}
+
+unsigned char kbd_wait() {
+  kbd_triggered = 0;
+  while (!kbd_triggered) {}
+  return kbd_triggered;
+}
+
+void kbd_init() {
+  if (oldKbdISR == NULL) {
+    memset(keybuf, 0, 128);
+    oldKbdISR = getvect(KBD_INT);
+    setvect(KBD_INT, kbd_isr);
+    atexit(kbd_cleanup);
+  }
+}
+
+void kbd_debounce() {
+  int i = 0;
+
+  disable();
+  for (i = 0; i < 128; i ++) {
+    unsigned char signal = keybuf[i] & KEY_SIGNAL;
+    unsigned char keystate = keybuf[i] & 0x0f;
+
+    if (!signal) {
+      if (keystate == KEY_RELEASED) {
+	keystate = KEY_OFF;
+      } else if (keystate != KEY_OFF) {
+	keystate = KEY_RELEASED;
+      }
+    } else {
+      if (keystate == KEY_OFF) {
+	keystate = KEY_PRESSED;
+      } else if (keystate == KEY_PRESSED) {
+	keystate = KEY_DOWN;
+      }
+    }
+
+    keybuf[i] = signal | keystate;
+  }
+  enable();
+}
--- a/kbd.h
+++ b/kbd.h
@ -0,0 +1,108 @@
+/*** K E Y B O A R D ***/
+#define KBD_INT 0x09
+
+extern volatile unsigned char keybuf[128];
+extern volatile char kbd_triggered;
+
+void kbd_init();
+void kbd_debounce(); // call once per frame
+void kbd_cleanup();
+unsigned char kbd_wait();
+
+#define KEY_OFF 0
+#define KEY_PRESSED 1
+#define KEY_DOWN 2
+#define KEY_RELEASED 3
+#define KEY_SIGNAL 0x80
+
+#define keyIsDown(k) (keybuf[k] & KEY_SIGNAL)
+#define keyWasPressed(k) ((keybuf[k] & 0x0f) == KEY_PRESSED)
+#define consumeKey(k) (keybuf[k] = keyWasPressed(k) ? KEY_DOWN : keybuf[k])
+#define keyWasReleased(k) ((keybuf[k] & 0x0f) == KEY_RELEASED)
+
+#define K_ESC   1
+#define K_1     2
+#define K_2	3
+#define K_3	4
+#define K_4	5
+#define K_5	6
+#define K_6	7
+#define K_7	8
+#define K_8	9
+#define K_9	10
+#define K_0	11
+#define K_MINUS	12
+#define K_EQUAL	13
+#define K_BKSP	14
+#define K_TAB	15
+#define K_Q	16
+#define K_W	17
+#define K_E	18
+#define K_R	19
+#define K_T	20
+#define K_Y	21
+#define K_U	22
+#define K_I	23
+#define K_O	24
+#define K_P	25
+#define K_LBRK	26
+#define K_RBRK	27
+#define K_ENTER 28
+#define K_CTRL  29
+#define K_A	30
+#define K_S	31
+#define K_D	32
+#define K_F	33
+#define K_G	34
+#define K_H	35
+#define K_J	36
+#define K_K	37
+#define K_L	38
+#define K_SEMI	39
+#define K_APOS	40
+#define K_TILDE	41
+#define K_LSHFT 42
+#define K_BSLSH 43
+#define K_Z	44
+#define K_X	45
+#define K_C	46
+#define K_V	47
+#define K_B	48
+#define K_N	49
+#define K_M	50
+#define K_COMMA	51
+#define K_DOT	52
+#define K_SLASH	53
+#define K_RSHFT	54
+#define K_PSCRN	55
+#define K_ALT	56
+#define K_SPACE 57
+#define K_CAPS	58
+#define K_F1	59
+#define K_F2	60
+#define K_F3	61
+#define K_F4	62
+#define K_F5	63
+#define K_F6	64
+#define K_F7	65
+#define K_F8	66
+#define K_F9	67
+#define K_F10	68
+#define K_NUMLK	69
+#define K_SCRL	70
+#define K_HOME	71
+#define K_UP    72
+#define K_PGUP	73
+#define K_NDASH	74
+#define K_LEFT  75
+#define K_CENT	76
+#define K_RIGHT 77
+#define K_NPLUS	78
+#define K_END 	79
+#define K_DOWN  80
+#define K_PGDN	81
+#define K_INS	82
+#define K_DEL	83
+#define K_F11	87
+#define K_F12	88
+
--- a/lev00001.jor
+++ b/lev00001.jor
@ -0,0 +1,7 @@
+( L E V E L 0 0 0 0 1 )
+
+:noname
+  :| done |; ' entities redefine
+
+  s" lev00001.map" load-map
+; ' onload redefine
--- a/lev00001.map
+++ b/lev00001.map
--- a/map.jor
+++ b/map.jor
@ -0,0 +1,87 @@
+( M A P )
+var tileselect
+: invalidate-map mapsize mapsize! ;
+: mouseworldpos mousepos scrollpos +pos ;
+: mousetile mouseworldpos world>tile ;
+: tile ( x y -- ptr ) mapsize drop * + map + ;
+
+1 const WALKABLE
+2 const NEUTABLE
+
+array tileflags
+( sky )        0 b,
+( cloud )      0 b,
+( wall )       NEUTABLE b,
+( carpet )     WALKABLE b,
+( comp-off )   0 b,
+( comp-on )    NEUTABLE b,
+( table )      0 b,
+( chair )      0 b,
+( table-brok ) 0 b,
+
+here tileflags - 1 - const MAXTILE
+
+: mapflag? ( x y flag -- b ) >rot tile b@ tileflags + b@ & ;
+
+: tick-mapedit
+  tileselect @
+  ^< key-pressed if 1 - then
+  ^> key-pressed if 1 + then
+  0 max MAXTILE min
+(  dup 0 < if drop MAXTILE then
+  dup MAXTILE > if drop 0 then )
+  tileselect !
+
+  MOUSEL mousedown if tileselect @ mousetile tile b! invalidate-map then
+  MOUSER clicked if
+    mouseworldpos world>tile
+    2dup tile b@ tileselect !
+    swap . . cr then ;
+
+: copy-mapseg ( neww oldw y -- )
+  >r ( oldw neww r: y )
+  2dup min >rot ( copyw neww oldw )
+  r@ * map + ( copyw neww src )
+  swap <r * map + ( copyw src dst )
+  swap <rot memmove ;
+
+: resize-map ( neww newh -- )
+  swap mapsize >r ( newh neww oldw r: oldh )
+  2dup < if 1 <r else <r 1 - 0 then ( newh neww copyw ystart ylim )
+  for 2dup i copy-mapseg next
+  drop swap mapsize! ; userword
+
+: mapw mapsize drop ;
+: maph mapsize nip ;
+
+: offset-map ( p d -- p ) dup 0 < if drop else + then ;
+
+: shift-map ( dx dy -- )
+  maph over abs - >r ( dx dy r: h )
+  swap mapw over abs - >rot ( w dy dx r: h )
+  2dup map swap offset-map
+    swap mapw * offset-map >rot ( w end dy dx r: h )
+  map swap negate offset-map
+    swap mapw * negate offset-map ( w end start r: h )
+  2dup > if r@ mapw * + swap r@ mapw * + swap then
+  <r 0 for
+    3dup <rot memmove
+    2dup < if mapw + swap mapw + swap
+	   else mapw - swap mapw - swap then
+  next drop drop drop invalidate-map ; userword
+
+: save-map ( filename -- )
+  fdeactivate swap overwrite
+  mapsize swap fput fput
+  mapsize * map fwrite
+  factivate ; userword
+
+: load-map ( filename -- )
+  fdeactivate swap open
+  fget fget
+  2dup * map fread
+  mapsize!
+  factivate ; userword
+
+: fill-map ( tile -- )
+  0 mapsize * for dup map i + b! next drop invalidate-map ; userword
--- a/mouse.c
+++ b/mouse.c
@ -0,0 +1,55 @@
+#include <dos.h>
+#include "mouse.h";
+
+/*** M O U S E ***/
+Mouse_t MOUSE;
+
+void far mouse_callback() {
+  asm {
+    mov ax, DGROUP
+    mov ds, ax
+    shr cx, 1
+    mov MOUSE.x, cx
+    mov MOUSE.y, dx
+    mov MOUSE.buttons, bx
+  }
+}
+
+void mouse_cleanup() {
+  //uninstall handler
+  asm {
+    mov ax, 0ch
+    mov dx, 0
+    mov es, dx
+    mov cx, 0
+    int 33h
+
+    xor ax, ax
+    int 33h
+  }
+}
+
+void mouse_init() {
+  unsigned seg_mouse_callback = FP_SEG(mouse_callback);
+  unsigned off_mouse_callback = FP_OFF(mouse_callback);
+  unsigned int result;
+  asm {
+    xor ax, ax
+    int 33h
+    mov result, ax
+  }
+  if (result == 0) {
+    printf("Mouse driver not installed\n");
+    exit(1);
+  }
+  atexit(mouse_cleanup);
+
+  asm {
+    mov ax, seg_mouse_callback
+    mov es, ax
+    mov dx, off_mouse_callback
+    mov ax, 0ch
+    mov cx, 1fh
+    int 33h
+  }
+}
--- a/mouse.h
+++ b/mouse.h
@ -0,0 +1,13 @@
+/*** M O U S E ***/
+typedef struct {
+  unsigned int x;
+  unsigned int y;
+  unsigned int buttons;
+} Mouse_t;
+
+extern Mouse_t MOUSE;
+
+void mouse_init();
+
+#define mouse_hide() asm { mov ax, 02h; int 33h }
+#define mouse_show() asm { mov ax, 01h; int 33h }
--- a/ntiles.gfx
+++ b/ntiles.gfx
--- a/ntiles.tif
+++ b/ntiles.tif
--- a/pete.jor
+++ b/pete.jor
@ -0,0 +1,63 @@
+( P E T E )
+
+13 8 N ' {car} defentity car
+32 5 W ' {horse} defentity e_chuck
+17 10 W ' {boat} defentity boat
+26 10 W ' {duck} defentity duck1
+32 7 E ' {duck} defentity duck2
+
+car :touch
+  move-player
+  1 player.state DRIVING f!
+;entity
+
+boat :touch
+  move-player
+  1 player.state BOATING f!
+;entity
+
+e_chuck :touch
+  pete say" It's good to have you\back, Chuck."
+  chuck say" * w h i n n y *\(I remember this place...)"
+;entity
+
+:noname
+:| player.driving? not CHUCK-FOLLOW flag@ not and if car yield then
+   CHUCK-STOLEN flag@ if e_chuck yield then
+   player.boating? not if boat yield then
+   duck1 yield duck2 yield
+   done |; ' entities redefine
+
+ :|
+touch-begin S leaving? dup
+  if player.driving? not CHUCK-FOLLOW flag@ not and
+    if   pete say" It's too far to walk to town."
+    else move-player 5 10 road.jor queue-level
+    then
+  then
+touch-next N leaving? dup
+  if move-player 24 49 space.jor queue-level then
+touch-next 13 8 2= player.driving? and dup
+  if move-player
+    0 player.state DRIVING f!
+    W player entity.dir !
+    move-player
+  then
+touch-next 19 9 2= CHUCK-FOLLOW flag@ and player entity.dir @ E = and dup
+  if pete say" Hmm, yeah, lots of good\grazing over here..."
+     say" Let's get you comfy, Chuck." move-player then
+touch-next 22 9 2= CHUCK-FOLLOW flag@ and dup
+  if pete say" Welcome home, old buddy."
+     chuck say" * n e i g h *\(OK, Pete.)"
+     CHUCK-FOLLOW clearflag CHUCK-STOLEN setflag
+     13 7 petehous.jor queue-level then
+touch-next 12 7 2= player.driving? not and dup
+  if move-player 16 9 petehous.jor queue-level then
+touch-next 30 7 2= dup
+  if pete say" It's... kinda swampy.\I don't wanna get wet if I\don't have to." then
+touch-next 30 9 2= dup
+  if pete say" Feels spooky over here,\somehow." then
+touch-last |; ' player-touch redefine
+
+s" pete.map" load-map
+; ' onload redefine
--- a/pete.map
+++ b/pete.map
--- a/petehous.jor
+++ b/petehous.jor
@ -0,0 +1,95 @@
+( P E T E ' S   H O U S E )
+
+16 5 N ' {pete-table} defentity table
+15 5 N ' {chair} defentity chair
+7 6 N ' {pete-bed} defentity bed
+10 9 N ' {phone} defentity e_phone
+18 3 N ' {fridge} defentity fridge
+
+table :touch pete say" Yesterday's breakfast is still\on the table."
+  say" Maybe the day before's too." ;entity
+chair :touch pete say" I've had my morning coffee\already." ;entity
+bed :touch pete say" I'm not tired yet." ;entity
+fridge :touch pete say" Should get some more beer soon." ;entity
+
+e_phone :touch phone :|
+
+s" [don't pick up]"
+:| pete say" Hmm... no answer." |; yield
+
+s" Hey Pete, what's up?"
+:| pete say" Not much, old friend!"
+  0 begin phone :|
+    JEANNE-ANGRY flag@ CHUCK-GONE flag@ not and if
+      s" I hear Jeanne's awful mad\at you!"
+      :| pete say" Ohh, she'll come round."
+	 phone say" What'd you do, anyway?"
+	 pete say" Me?! What makes you think I\did anything?"
+	 phone say" Come on, Pete, how long\have we known each other?"
+	 pete say" Haw haw haw! Well, it's a\pretty good story..."
+	 say" I was taking Chuck out for a\midnight ride, see..."
+	 phone say" *sigh* You didn't even think\of asking, did you."
+	 pete say" Hell no! He's my horse!"
+	 phone say" Chuck hasn't been your horse\for years, Pete. That's what\happens when you sell them."
+	 pete say" Quit moralizing and let me tell\my story. So there I was,\riding on the trail..."
+	 say" We get to the clearing, and\I look up at the stars."
+	 say" It's the clearest night\you've ever seen in your life."
+	 say" Just as I'm looking up,\I see something."
+	 phone say" 'Something'?"
+	 pete say" I have seen my share of\airplanes and shooting stars.\This was not that."
+	 say" I'm not saying it was aliens..."
+	 phone say" ... but it was aliens."
+	 pete say" I'm not saying it!\You said it."
+	      say" Anyway, I get off Chuck and\lie down on the grass, to\get a better look, see?"
+	      say" Maybe have a pull or two of\whiskey, while I'm watching\the sky."
+	      say" I guess I must've dozed off,\because next thing I know\it's morning and Chuck's gone."
+	 phone say" You LOST him??"
+	 pete say" I figured he just went home!\But when I went to Jeanne's,\he wasn't there."
+	 phone say" You lost him."
+	 pete say" He's a smart old goat,\just like me. He'll\turn up soon."
+	 CHUCK-GONE setflag
+      |; yield
+    then
+    CHUCK-GONE flag@ if
+      s" You found Chuck yet?"
+      :| pete say" I'm sure he'll turn up soon!\Sheesh, get off my back." |; yield
+    then
+    CHUCK-FOLLOW flag@ if
+      s" You found Chuck yet?"
+      :| pete say" He's right here."
+	 chuck say" * s n o r t *"
+	 phone say" You brought him in your house??"
+	 phone say" Of course you did.\Never mind.\Don't even bother explaining."
+      |; yield
+    then
+    CHUCK-STOLEN flag@ CHUCK-HOME flag@ or CHUCK-EXPLAINED flag@ not and if
+      s" You found Chuck yet?"
+      :| pete say" He found his way home."
+	 phone say" Well, thank goodness\for that."
+	 CHUCK-EXPLAINED setflag
+      |; yield
+    then
+    s" Goodbye, Pete." :| pete say" Goodbye!" drop 1 |; yield
+    done |; choose
+  dup until drop
+|; yield
+
+done |; choose ;entity
+
+:noname
+  reset-level
+  :| table yield chair yield bed yield e_phone yield fridge yield done |; ' entities redefine
+  :|
+touch-begin 16 10 2= dup if
+  move-player 12 8 pete.jor queue-level
+then touch-next 9 4 2= dup if
+  pete say" The closet is a disaster.\I don't want to deal with that\right now."
+then touch-next 11 4 2= dup if
+  pete say" I'm already dressed."
+then touch-next 16 3 2= dup if
+  pete say" The sink's full of nasty dishes.\I'm not touching them."
+then touch-last |; ' player-touch redefine
+
+  s" petehous.map" load-map
+; ' onload redefine
+
--- a/petehous.map
+++ b/petehous.map
--- a/portrait.gfx
+++ b/portrait.gfx
--- a/portrait.tif
+++ b/portrait.tif
--- a/repl.jor
+++ b/repl.jor
@ -0,0 +1,6 @@
+: start-repl activate ' putc task-emit !
+  s" .:: J O R T H ( jean forth) ::." type cr
+  begin receive loadstring s" ok" type cr again ;
+task const REPL
+REPL start-repl
+
--- a/road.jor
+++ b/road.jor
@ -0,0 +1,32 @@
+( O V E R W O R L D )
+
+24 4 N ' {horse} defentity chuck
+
+:noname
+  CHUCK-FOLLOW flag@ not player.state DRIVING f!
+  :| CHUCK-HOME flag@ if chuck yield then
+     done |; ' entities redefine
+  :|
+touch-begin E leaving? dup
+  if pete say" It's 100 miles to the next town." then
+touch-next 24 15 2= CHUCK-FOLLOW flag@ and dup
+  if pete say" I'm not walking all the way into\town with a horse!" then
+touch-next 5 9 2= dup
+  if move-player 13 12 pete.jor queue-level then
+touch-next 13 6 2= dup
+  if move-player 38 71 trail1.jor queue-level then
+touch-next 24 6 2= dup
+  if move-player 13 22 jeanne.jor queue-level then
+touch-next 39 33 2= dup
+  if pete say" School's out for the day,\looks like." then
+touch-next 32 36 2= dup
+  if mary say" General store and post office." then
+touch-next 35 39 2= dup
+  if pete say" Community center." then
+touch-next tile b@ 17 = dup
+  if pete say" I'm not one to drop in\unannounced." then
+touch-last |; ' player-touch redefine
+s" road.map" load-map
+
+; ' onload redefine
+
--- a/road.map
+++ b/road.map
--- a/serial.c
+++ b/serial.c
@ -0,0 +1,109 @@
+#include <stdio.h>
+#include <dos.h>
+#include "serial.h"
+
+int comport = 0;
+
+#define SER_LATCH_LO 0
+#define SER_LATCH_HI 1
+#define SER_TX 0
+#define SER_RX 0
+#define SER_IER 1
+#define SER_LCR 3
+#define SER_MCR 4
+#define SER_LSR 5
+
+#define PIC1 0x20
+#define OCW1 0x21
+#define PIC_EOI 0x20
+
+// COM1 - IRQ4, COM2 - IRQ3, COM3 - IRQ4, COM4 - IRQ3
+#define SER_IRQ(port) (4 - (port % 2))
+#define SER_VECTOR(irq) (0x08 + (irq))
+
+static char readbuf[SER_READ_BUFFER_SIZE];
+static int ireadbufStart = 0;
+static volatile int ireadbufLim = 0;
+static int irq = 0;
+
+static void interrupt (*oldSerISR)() = NULL;
+
+static void interrupt ser_isr() {
+  while (inp(comport + SER_LSR) & 0x01) {
+    readbuf[ireadbufLim] = inp(comport + SER_RX);
+    ireadbufLim = (ireadbufLim + 1) % SER_READ_BUFFER_SIZE;
+  }
+  outp(PIC1, PIC_EOI);
+}
+
+static void ser_cleanup() {
+  if (irq) {
+    int ocw = inp(OCW1) | (1 << irq);
+    outp(OCW1, ocw);
+    setvect(SER_VECTOR(irq), oldSerISR);
+    irq = 0;
+  }
+}
+
+void ser_init(int port, int baudrate, int protocol) {
+  int far *comport_addr = MK_FP(0x0040, 0x0000);
+  int lcr, ocw;
+  comport = comport_addr[port];
+  irq = SER_IRQ(port);
+
+  outp(comport + SER_LCR, 0x80);
+  outp(comport + SER_LATCH_HI, baudrate >> 8);
+  outp(comport + SER_LATCH_LO, baudrate & 0xff);
+  outp(comport + SER_LCR, protocol);
+  outp(comport + SER_MCR, 0x0b);
+
+  oldSerISR = getvect(SER_VECTOR(irq));
+  setvect(SER_VECTOR(irq), ser_isr);
+  ocw = inp(OCW1) & ~(1 << irq);
+  outp(OCW1, ocw);
+  outp(comport + SER_IER, 0x01);
+
+  atexit(ser_cleanup);
+}
+
+int ser_poll() {
+  int result = SER_NODATA;
+  if (ireadbufStart != ireadbufLim) {
+    result = readbuf[ireadbufStart];
+    ireadbufStart = (ireadbufStart + 1) % SER_READ_BUFFER_SIZE;
+  }
+  return result;
+}
+
+void ser_write_byte(char byte) {
+  while (!(inp(comport + SER_LSR) & 0x20)) {}
+  outp(comport + SER_TX, byte);
+}
+
+void ser_write(char *str) {
+  for (; *str; str ++) {
+    ser_write_byte(*str);
+  }
+}
+
+int ser_getline(char *line) {
+  int i = strlen(line);
+  int value;
+  for (value = ser_poll(); value != SER_NODATA; value = ser_poll()) {
+    if (value == '\b' || value == 127) {
+      i --;
+    } else {
+      line[i] = value;
+      i ++;
+    }
+    line[i] = '\0';
+    ser_write_byte(value); // echo
+
+    if (value == '\r') {
+      line[i - 1] = '\n';
+      ser_write_byte('\n');
+      return 1;
+    }
+  }
+  return 0;
+}
--- a/serial.h
+++ b/serial.h
@ -0,0 +1,29 @@
+#define SER_COM1 0
+#define SER_COM2 1
+#define SER_COM3 2
+#define SER_COM4 3
+
+#define SER_8N1 0x03
+
+#define BAUD_50     0x0900
+#define BAUD_110    0x0417
+#define BAUD_220    0x020c
+#define BAUD_300    0x0180
+#define BAUD_600    0x00c0
+#define BAUD_1200   0x0060
+#define BAUD_2400   0x0030
+#define BAUD_4800   0x0018
+#define BAUD_9600   0x000c
+#define BAUD_19200  0x0006
+#define BAUD_38400  0x0003
+#define BAUD_57600  0x0002
+#define BAUD_115200 0x0001
+
+#define SER_READ_BUFFER_SIZE 64
+#define SER_NODATA -1
+
+void ser_init(int port, int baudrate, int protocol);
+int ser_poll();
+void ser_write_byte(char byte);
+void ser_write(char *str);
+int ser_getline(char *line);
--- a/BIN
+++ b/BIN
--- a/space.jor
+++ b/space.jor
@ -0,0 +1,26 @@
+( S P A C E )
+
+24 10 N ' {aliem} defentity aliem
+28 28 N ' {pete-bed} defentity bed
+19 21 N ' {phone} defentity e_phone
+
+aliem :touch
+  pete say" hey mr aliem"
+;entity
+
+:noname
+:| aliem yield bed yield e_phone yield done |; ' entities redefine
+
+:| touch-begin S leaving? dup
+  if move-player 0 glitchlevel ! 19 0 pete.jor queue-level then
+touch-next 5 11 2= dup
+  if move-player 41 37 tile>world player entity.pos! then
+touch-next 41 37 2= dup
+  if move-player 5 11 tile>world player entity.pos! then
+touch-next 44 23 2= dup
+  if pete say" It's...." say" home?" then
+touch-last |; ' player-touch redefine
+
+s" space.map" load-map
+4 glitchlevel !
+; ' onload redefine
--- a/space.map
+++ b/space.map
--- a/sprite.gfx
+++ b/sprite.gfx
--- a/sprite.tif
+++ b/sprite.tif
--- a/state.jor
+++ b/state.jor
@ -0,0 +1,23 @@
+0 const JEANNE-ANGRY      userword
+1 const CHUCK-GONE        userword
+2 const CHUCK-FOLLOW	  userword
+3 const CHUCK-HOME	  userword
+4 const CHUCK-STOLEN	  userword
+5 const CHUCK-EXPLAINED	  userword
+6 const NIGHT		  userword
+
+7 const FLAG-COUNT
+
+array flags FLAG-COUNT 8 / 1 + allot
+
+: flagstof ( f -- v f ) dup 8 / flags + swap 8 % 1 swap << ;
+: flagsf! ( b f -- ) flagstof f! ;
+: flag@ ( f -- b ) flagstof f@ ; userword
+: setflag 1 swap flagsf! ; userword
+: clearflag 0 swap flagsf! ; userword
+
+: day s" tiles.gfx" loadtiles invalidate-map NIGHT clearflag ; userword
+: night s" ntiles.gfx" loadtiles invalidate-map NIGHT setflag ; userword
+
+: {car-drive} NIGHT flag@ if {car-lit} else {car} then ;
+
--- a/template.map
+++ b/template.map
--- a/testbed.c
+++ b/testbed.c
@ -0,0 +1,759 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <dos.h>
+#include <alloc.h>
+#include <ctype.h>
+
+#include "video.h"
+#include "kbd.h"
+#include "mouse.h"
+#include "tiff.h"
+#include "tiles.h"
+#include "serial.h"
+#include "timer.h"
+#include "jorth.h"
+#include "egamap.h"
+#include "adlib.h"
+
+/*** T E X T ***/
+char far *font = NULL;
+
+void text_init() {
+  unsigned int fontSeg, fontOff;
+  asm {
+    push es
+    push bp
+    mov ah, 11h
+    mov al, 30h
+    mov bh, 3
+    int 10h
+    mov ax, bp
+    pop bp
+    mov fontSeg, es
+    mov fontOff, ax
+    pop es
+  }
+  font = MK_FP(fontSeg, fontOff);
+}
+
+void text_draw_char(unsigned int vidOffset, unsigned char c) {
+  unsigned int fontOffset = c << 3;
+  int i;
+  for (i = 0; i < 8; i ++) {
+    VID[vidOffset] = font[fontOffset++];
+    vidOffset += PAGE_STRIDE;
+  }
+}
+
+void text_draw(unsigned int vidOffset, unsigned char *s) {
+  while (*s) {
+    text_draw_char(vidOffset++, *s++);
+  }
+}
+
+/*** I / O ***/
+size_t fwritefar(FILE *fp, void far *buf, size_t length) {
+  char nearbuf[32];
+  size_t written = 0;
+  size_t towrite;
+
+  for (; towrite = min(32, length), length > 0; length -= towrite) {
+    movedata(FP_SEG(buf), FP_OFF(buf) + written, _SS, nearbuf, towrite);
+    if (!fwrite(nearbuf, towrite, 1, fp)) {
+      break;
+    }
+    written += towrite;
+  }
+  return written;
+}
+
+size_t freadfar(FILE *fp, void far *buf, size_t length) {
+  char nearbuf[32];
+  size_t totalread = 0;
+  size_t toread;
+
+  for (; toread = min(32, length), length > 0; length -= toread) {
+    size_t bytesread = fread(nearbuf, 1, toread, fp);
+    movedata(_SS, nearbuf, FP_SEG(buf), FP_OFF(buf) + totalread, bytesread);
+    totalread += bytesread;
+    if (bytesread != toread) {
+      break;
+    }
+  }
+  return totalread;
+}
+
+/*** S C R A T C H ***/
+#define PORTRAIT_GFX
+
+#define NUM_SPRITES 64
+#define TILE_STRIDE 64
+#define SPRITE_STRIDE 80
+#define PORTRAIT_STRIDE 256
+unsigned int far *tiles;
+unsigned int far *sprites;
+unsigned int far *portraits;
+unsigned char map[10000];
+
+
+void deallocate_gfx() {
+  if (tiles)     farfree(tiles);
+  if (sprites)   farfree(sprites);
+  if (portraits) farfree(portraits);
+}
+
+void allocate_gfx() {
+  unsigned long memleft = farcoreleft();
+  tiles = farmalloc(NUM_TILES * TILE_STRIDE * 2);
+  sprites = farmalloc(NUM_SPRITES * SPRITE_STRIDE * 2);
+  portraits = farmalloc(NUM_PORTRAITS * PORTRAIT_STRIDE * 2);
+  atexit(deallocate_gfx);
+
+  if (!tiles || !sprites || !portraits) {
+    printf("%lu bytes free - need %lu\n", memleft,
+      (unsigned long)
+	((NUM_TILES * TILE_STRIDE * 2) +
+	 (NUM_SPRITES * SPRITE_STRIDE * 2) +
+	 (NUM_PORTRAITS * PORTRAIT_STRIDE * 2)));
+    exit(1);
+  }
+}
+
+void fillMap() {
+  unsigned int x, y, z;
+  z = 0;
+
+  for (y = 0; y < 100; y ++) {
+    for (x = 0; x < 100; x ++) {
+      map[x + (y * 100)] = ((x + y + z) >> 2) % 4;
+    }
+  }
+}
+
+void readTifTiles(char *filename) {
+  FILE *f;
+  TifImageMeta_t meta;
+
+  f = fopen(filename, "rb");
+  meta = tifLoadMeta(f);
+  tifLoad(f, meta, tiles, NUM_TILES * 16, 16, 4);
+  fclose(f);
+
+  loadTiles(OFF_TILES, tiles);
+}
+
+void readTiles(char *filename) {
+  FILE *f = fopen(filename, "rb");
+  freadfar(f, tiles, NUM_TILES * TILE_STRIDE * 2);
+  fclose(f);
+
+  loadTiles(OFF_TILES, tiles);
+}
+
+void f_loadtiles() {
+  if (tolower(TOP().s[strlen(TOP().s) - 1]) == 'f') {
+    readTifTiles(TOP().s);
+  } else {
+    readTiles(TOP().s);
+  }
+  DROP(1);
+}
+
+void f_load_footer() {
+  FILE *f = fopen("FOOTER.TIF", "rb");
+  TifImageMeta_t meta = tifLoadMeta(f);
+  tifLoadEGA(f, meta, 0, 48, 336);
+  fclose(f);
+}
+
+void f_reloadportraits() {
+  blitMemToVid(OFF_PORTRAITS, portraits, PORTRAIT_STRIDE >> 2, NUM_PORTRAITS);
+}
+
+void game_init() {
+  FILE *f;
+  TifImageMeta_t meta;
+
+  allocate_gfx();
+
+  mouse_init();
+
+  setEGAMode();
+  atexit(vid_cleanup);
+
+  kbd_init();
+  timer_init(TIMER_30HZ);
+  text_init();
+
+  tile_init();
+  fillMap();
+
+  f_load_footer();
+
+  f = fopen("sprite.gfx", "rb");
+  freadfar(f, sprites, NUM_SPRITES * SPRITE_STRIDE * 2);
+  fclose(f);
+
+#ifdef PORTRAIT_GFX
+  f = fopen("portrait.gfx", "rb");
+  freadfar(f, portraits, NUM_PORTRAITS * PORTRAIT_STRIDE * 2);
+  fclose(f);
+  f_reloadportraits();
+#else
+  f = fopen("PORTRAIT.TIF", "rb");
+  meta = tifLoadMeta(f);
+  tifLoad(f, meta, portraits, NUM_PORTRAITS * 32, 32, 4);
+  tifLoadEGA(f, meta, OFF_PORTRAITS, NUM_PORTRAITS * 32, 32);
+  fclose(f);
+#endif
+
+  readTiles("tiles.gfx");
+
+  loadMap(map, 100, 100);
+  scroll(0, 0);
+}
+
+void f_seremit() {
+  ser_write_byte(TOP().i);
+  if (TOP().i == '\n') {
+    ser_write_byte('\r');
+  }
+  DROP(1);
+}
+
+void f_keyWasPressed() {
+  int k = TOP().i;
+  TOP().i = keyWasPressed(k);
+  consumeKey(k);
+}
+
+void f_keyIsDown() {
+  TOP().i = keyIsDown(TOP().i);
+}
+
+void f_drawSprite() { // ( x y sprite -- )
+  drawSprite(&sprites[TOP().i * SPRITE_STRIDE], ST2().i, ST1().i, NULL);
+  DROP(3);
+}
+
+void f_scroll() { // ( x y -- )
+  scroll(ST1().i, TOP().i);
+  DROP(2);
+}
+
+void f_scrollpos() { // ( -- x y )
+  PUSHI(screen.scrollX);
+  PUSHI(screen.scrollY);
+}
+
+void f_ticks() {
+  PUSHU(timer_counter);
+}
+
+void f_splitscreen() {
+  setSplitScreen(399 - (TOP().i << 1));
+  DROP(1);
+}
+
+void f_textc() { // ( col line c color -- )
+  setWriteMode(0);
+  setPlaneColor(TOP().u);
+  DROP(1);
+  text_draw_char(ST2().u + (ST1().u * PAGE_STRIDE), TOP().i);
+  DROP(3);
+}
+
+void f_text() { // ( col line s color -- )
+  setWriteMode(0);
+  setPlaneColor(TOP().u);
+  DROP(1);
+  text_draw(ST2().u + (ST1().u * PAGE_STRIDE), TOP().s);
+  DROP(3);
+}
+
+void f_map() {
+  PUSHP(map);
+}
+
+void f_mapsize() { // ( -- w h )
+  PUSHI(screen.w);
+  PUSHI(screen.h);
+}
+
+void f_mapsize_set() { // ( w h -- )
+  loadMap(map, ST1().i, TOP().i);
+  DROP(2);
+}
+
+void f_mousepos() { // ( -- x y )
+  PUSHI(MOUSE.x);
+  PUSHI(MOUSE.y);
+}
+void f_mousebuttons() {
+  PUSHI(MOUSE.buttons);
+}
+
+void f_drawportrait() {
+  setAllPlanes();
+  setWriteMode(1);
+  blit32x32(OFF_PORTRAITS + (TOP().u << 7), (PAGE_STRIDE << 3) + 1);
+  DROP(1);
+}
+
+void f_adlib() {
+  adlib_write(TOP().u, ST1().u);
+  DROP(2);
+}
+
+cell f_atexit;
+void f_cleanup() {
+  f_execcp(f_atexit);
+}
+
+void f_glitch() {
+  int count = TOP().u;
+  int i, x, y;
+  DROP(1);
+  for (i = 0; i < count; i ++) {
+    x = screen.scrollX + (rand() % 352) - 16;
+    y = screen.scrollY + (rand() % 232) - 16;
+    switch(rand()%2) {
+      case 0:
+	drawSprite(sprites + (rand() % (NUM_SPRITES * SPRITE_STRIDE)), x, y, NULL);
+	break;
+      case 1:
+	drawSprite(mem + (rand() % MEM_SIZE), x, y, NULL);
+	break;
+    }
+  }
+}
+
+/* JILES */
+#define SCREEN_STRIDE 40
+
+typedef enum {
+  ET_SPRITE = 0,
+  ET_TILE = 1,
+  ET_PORTRAIT = 2
+} EditTarget_t;
+EditTarget_t editTarget = ET_SPRITE;
+
+unsigned int far *getTarget(int index) {
+  if (editTarget == ET_SPRITE) {
+    return &sprites[index * SPRITE_STRIDE];
+  } else if (editTarget == ET_TILE) {
+    return &tiles[index * TILE_STRIDE];
+  } else {
+    return &portraits[index * PORTRAIT_STRIDE];
+  }
+}
+
+#define ET_STRIDE (editTarget == ET_SPRITE ? SPRITE_STRIDE : \
+		  (editTarget == ET_TILE ? TILE_STRIDE : PORTRAIT_STRIDE))
+
+int getsprpixel(int x, int y, unsigned int far *spr) {
+  int shift = (15 - (x % 16));
+  int plane_stride = 16;
+  int b, g, r, i, v;
+  if (editTarget == ET_PORTRAIT) {
+    y = y << 1;
+    if (x > 15) y ++;
+    plane_stride = 64;
+  }
+  spr += y;
+  b = (*spr & (1 << shift)) >> shift; spr += plane_stride;
+  g = (*spr & (1 << shift)) >> shift; spr += plane_stride;
+  r = (*spr & (1 << shift)) >> shift; spr += plane_stride;
+  i = (*spr & (1 << shift)) >> shift; spr += plane_stride;
+  v = editTarget != ET_SPRITE || (*spr & (1 << shift)) ? 0 : 1;
+  return b | (g << 1) | (r << 2) | (i << 3) | (v << 4);
+}
+int resetEnabledCache = 0;
+
+#define setResetEnabledCached(m) \
+  if (resetEnabledCache != m) { \
+    resetEnabledCache = m; \
+    setResetEnabled(m); \
+  }
+
+void drawFatBox(int x, int y, int color) {
+  int faty;
+  int fill1 = color <= 0x0f ? 0xff : 0x55;
+  int fill2 = fill1 == 0xff ? 0xff : 0xaa;
+  unsigned int dst = SCREEN_STRIDE * y;
+
+  if (color > 0x0f) {
+    setResetEnabledCached(0);
+  } else {
+    setResetEnabledCached(0x0f);
+    setResetMask(color);
+  }
+  for ( faty = 0; faty < 8; faty ++) {
+    VID[dst + x + (SCREEN_STRIDE * faty)] = (faty % 2) ? fill1 : fill2;
+  }
+}
+
+void drawDoubleFatBox(int x, int y, int colorl, int colorr) {
+  int faty, plane;
+  unsigned int dst = (SCREEN_STRIDE * y) + x;
+
+  setResetEnabledCached(0);
+
+  for ( plane = 0; plane < 4; plane ++ ) {
+    int fill = colorr & ( 1 << plane ) ? 0x0f : 0x00;
+    fill |=    colorl & ( 1 << plane ) ? 0xf0 : 0x00;
+
+    setPlane( plane );
+    for ( faty = 0; faty < 4; faty ++ ) {
+      VID[dst + (SCREEN_STRIDE * faty)] = fill;
+    }
+  }
+}
+
+void f_drawfatsprite() {
+  int isprite = TOP().i;
+  unsigned int far *spr = getTarget(isprite);
+  int x, y;
+
+  DROP(1);
+  if (editTarget != ET_PORTRAIT) {
+    setAllPlanes();
+    for ( y = 0; y < 16; y ++ ) {
+      for ( x = 0; x < 16; x ++ ) {
+	int color = getsprpixel(x, y, spr);
+	drawFatBox(x, y << 3, color);
+      }
+    }
+  } else {
+    for ( y = 0; y < 32; y ++ ) {
+      for ( x = 0; x < 32; x += 2 ) {
+	int colorl = getsprpixel(    x, y, spr);
+	int colorr = getsprpixel(x + 1, y, spr);
+	drawDoubleFatBox(x >> 1, y << 2, colorl, colorr);
+      }
+    }
+    setAllPlanes();
+  }
+}
+
+void f_drawfatbox() {
+  drawFatBox(ST1().i, TOP().i, ST2().i);
+  DROP(3);
+}
+
+void f_savegfx() {
+  FILE *fp = fopen(TOP().s, "wb");
+  if (editTarget == ET_SPRITE) {
+    fwritefar(fp, sprites, NUM_SPRITES * SPRITE_STRIDE * 2);
+  } else if (editTarget == ET_TILE) {
+    fwritefar(fp, tiles, NUM_TILES * TILE_STRIDE * 2);
+  } else {
+    fwritefar(fp, portraits, NUM_PORTRAITS * PORTRAIT_STRIDE * 2);
+  }
+  fclose(fp);
+  DROP(1);
+}
+
+void f_mousehide() {
+  mouse_hide();
+}
+
+void f_mouseshow() {
+  mouse_show();
+}
+
+void f_resetvideo() {
+  setLogicalWidth(SCREEN_STRIDE >> 1);
+  setResetEnabledCached(0);
+  setWriteMode(0);
+  setAllPlanes();
+  setDisplayOffset(0);
+  setHorizontalPan(0);
+}
+
+void f_putpixel() {
+  int isprite = TOP().i;
+  unsigned int far *spr = getTarget(isprite);
+  int x = ST2().i;
+  int y = ST1().i;
+  int color, shift, b, g, r, i, v;
+  int plane_stride = 16;
+
+  DROP(3);
+  color = TOP().i;
+  DROP(1);
+
+  shift = (15 - (x % 16));
+  if (editTarget == ET_PORTRAIT) {
+    y = y << 1;
+    if (x > 15) y ++;
+    plane_stride = 64;
+  }
+
+  b = (color & 0x01);
+  g = (color & 0x02) >> 1;
+  r = (color & 0x04) >> 2;
+  i = (color & 0x08) >> 3;
+  v = ((color & 0x10) >> 4) ^ 1;
+  spr = &spr[y];
+
+  *spr = (*spr & ~(1 << shift)) | (b << shift); spr += plane_stride;
+  *spr = (*spr & ~(1 << shift)) | (g << shift); spr += plane_stride;
+  *spr = (*spr & ~(1 << shift)) | (r << shift); spr += plane_stride;
+  *spr = (*spr & ~(1 << shift)) | (i << shift); spr += plane_stride;
+  if (editTarget == ET_SPRITE) {
+    *spr = (*spr & ~(1 << shift)) | (v << shift);
+  }
+}
+
+void f_getpixel() {
+  int isprite = TOP().i;
+  unsigned int far *spr = getTarget(isprite);
+  int x = ST2().i;
+  int y = ST1().i;
+  DROP(2);
+
+  TOP().i = getsprpixel(x, y, spr);
+}
+
+void f_spritecount() {
+  if (editTarget == ET_SPRITE) {
+    PUSHI(NUM_SPRITES);
+  } else if (editTarget == ET_TILE) {
+    PUSHI(NUM_TILES);
+  } else if (editTarget == ET_PORTRAIT) {
+    PUSHI(NUM_PORTRAITS);
+  }
+}
+
+void f_tile2buf() {
+  unsigned int *buf = (unsigned int *)TOP().p;
+  unsigned int itile = ST1().u;
+  DROP(2);
+  writeTile(buf, &tiles[itile * TILE_STRIDE]);
+}
+
+void f_spr2buf() {
+  unsigned int *buf = (unsigned int *)TOP().p;
+  unsigned int isprite = ST1().u;
+  DROP(2);
+  overlaySprite(buf, &sprites[isprite * SPRITE_STRIDE], 0, 0, NULL);
+}
+
+void f_remap_spr2buf() {
+  unsigned int *buf = (unsigned int *)TOP().p;
+  unsigned int isprite = ST1().u;
+  char *remap = (char*)ST2().p;
+  DROP(3);
+  overlaySprite(buf, &sprites[isprite * SPRITE_STRIDE], 0, 0, remap);
+
+}
+
+void f_pastetile() {
+  unsigned int far *src = getTarget(ST1().i);
+  unsigned int far *dst = getTarget(TOP().i);
+  unsigned int stride = ET_STRIDE;
+  unsigned int i;
+
+  DROP(2);
+  for (i = 0; i < stride; i ++) {
+    dst[i] = src[i];
+  }
+}
+
+void f_fliptile() {
+  unsigned int far *dst = getTarget(TOP().i);
+  unsigned int stride = ET_STRIDE;
+  unsigned int i;
+  unsigned int bit;
+
+  DROP(1);
+  for (i = 0; i < stride; i ++) {
+    unsigned int src = dst[i];
+    unsigned int result = 0;
+    for (bit = 0; bit < 16; bit ++) {
+      if (src & (1 << bit)) {
+	result |= (1 << (15 - bit));
+      }
+    }
+    if (editTarget == ET_PORTRAIT && ((i % 2) == 1)) {
+      bit = dst[i - 1];
+      dst[i - 1] = result;
+      dst[i] = bit;
+    } else {
+      dst[i] = result;
+    }
+  }
+}
+
+void f_vfliptile() {
+  unsigned int far *dst;
+  unsigned int far *gfx = editTarget == ET_SPRITE ? sprites : tiles;
+  unsigned int stride = editTarget == ET_SPRITE ? SPRITE_STRIDE : TILE_STRIDE;
+  unsigned int y;
+  unsigned int plane;
+
+  if (editTarget == ET_PORTRAIT) return; // TODO
+  dst = &gfx[TOP().i * stride];
+  DROP(1);
+  for (plane = 0; plane < (editTarget == ET_SPRITE ? 5 : 4); plane ++) {
+    for (y = 0; y < 8; y ++) {
+      unsigned int tmp = dst[y];
+      dst[y] = dst[15 - y];
+      dst[15 - y] = tmp;
+    }
+    dst += 16;
+  }
+}
+
+void f_nudgesprite() {
+  unsigned int far *dst = &sprites[TOP().i * SPRITE_STRIDE];
+  int direction = ST1().i < 0 ? -1 : 1;
+  int ystart = direction < 0 ? 0 : 15;
+  int ylim = direction < 0 ? 15 : 0;
+  int plane, y;
+  unsigned int itransparent = direction < 0 ? 64 : 79;
+  DROP(2);
+  if (dst[itransparent] != 0 || editTarget != ET_SPRITE) {
+    return;
+  }
+  for (plane = 0; plane < 5; plane ++) {
+    for (y = ystart; y != ylim; y -= direction) {
+      dst[y] = dst[y - direction];
+    }
+    dst[ylim] = 0;
+    dst += 16;
+  }
+}
+
+void f_paintbuf() {
+  unsigned int *buf = (unsigned int *)TOP().p;
+  int y = ST1().i;
+  int x = ST2().i;
+  DROP(3);
+  paintBuffer(buf, x + (y * SCREEN_STRIDE));
+}
+
+void f_setedittarget() {
+  editTarget = TOP().i;
+}
+
+void f_getedittarget() {
+  PUSHI(editTarget);
+}
+
+void f_reloadtiles() {
+  loadTiles(OFF_TILES, tiles);
+}
+
+/* INIT */
+void game_f_init(char *exe, char *bootjor) {
+  f_init(exe);
+  CDEF("seremit", f_seremit);
+  CDEF("key-pressed", f_keyWasPressed);
+  CDEF("key-down", f_keyIsDown);
+  CDEF("key-start", kbd_init);
+  CDEF("key-end", kbd_cleanup);
+  CDEF("draw-sprite", f_drawSprite);
+  CDEF("draw-portrait", f_drawportrait);
+  CDEF("scroll", f_scroll);
+  CDEF("scrollpos", f_scrollpos);
+  CDEF("draw-screen", drawScreen);
+  CDEF("split-screen", f_splitscreen);
+  CDEF("ticks", f_ticks);
+  CDEF("text", f_text);
+  CDEF("textc", f_textc);
+  CDEF("map", f_map);
+  CDEF("mapsize", f_mapsize);
+  CDEF("mapsize!", f_mapsize_set);
+  CDEF("mousepos", f_mousepos);
+  CDEF("mousebuttons", f_mousebuttons);
+  CDEF("loadtiles", f_loadtiles);
+  CDEF("glitch", f_glitch);
+  CDEF("unfuck", tile_init);
+  CDEF("load-footer", f_load_footer);
+  CDEF("fuck", f_resetvideo);
+
+  CDEF("mouseshow", f_mouseshow);
+  CDEF("mousehide", f_mousehide);
+  CDEF("drawfatsprite", f_drawfatsprite);
+  CDEF("drawfatbox", f_drawfatbox);
+  CDEF("putpixel", f_putpixel);
+  CDEF("getpixel", f_getpixel);
+  CDEF("spritecount", f_spritecount);
+  CDEF("savegfx", f_savegfx);
+  CDEF("tile>buf", f_tile2buf);
+  CDEF("spr>buf", f_spr2buf);
+  CDEF("remap-spr>buf", f_remap_spr2buf);
+  CDEF("paintbuf", f_paintbuf);
+  CDEF("edittarget", f_getedittarget);
+  CDEF("edittarget!", f_setedittarget);
+  CDEF("reloadtiles", f_reloadtiles);
+  CDEF("reloadportraits", f_reloadportraits);
+  CDEF("paste-tile", f_pastetile);
+  CDEF("flip-tile", f_fliptile);
+  CDEF("vflip-tile", f_vfliptile);
+  CDEF("nudge-sprite", f_nudgesprite);
+
+  f_loadjor(bootjor);
+
+  f_atexit = f_lookupcp("atexit");
+  atexit(f_cleanup);
+
+}
+
+void f_poll() {
+  static char line[128] = { 0 };
+
+  while (ser_getline(line)) {
+    PUSHS(line);
+    f_runstring("REPL send");
+    f_taskloop();
+    line[0] = '\0';
+  }
+}
+
+int DONE = 0;
+static void f_quit() {
+  DONE = 1;
+}
+void do_repl(char *exe) {
+  char buf[128];
+
+  f_init(exe);
+  CDEF("quit", f_quit);
+  CDEF("adlib", f_adlib);
+
+  f_loadfile("repl.jor");
+  f_taskloop();
+
+  while (!DONE) {
+    PUSHS(gets(buf));
+    f_runstring("REPL send");
+    f_taskloop();
+  }
+}
+
+int main(int argc, char *argv[]) {
+  cell tick, draw;
+  char *bootjor = "gameboot.jor";
+  if (argc > 1) {
+    bootjor = argv[1];
+  }
+  ser_init(SER_COM2, BAUD_19200, SER_8N1);
+  game_init();
+  game_f_init(argv[0], bootjor);
+  tick = f_lookupcp("tick");
+  draw = f_lookupcp("draw");
+
+  while (!keyIsDown(K_ESC)) {
+    kbd_debounce();
+    f_poll();
+    f_taskloop();
+    f_execcp(tick);
+    f_taskloop();
+    f_execcp(draw);
+  }
+
+  return 0;
+}
--- a/tiff.c
+++ b/tiff.c
@ -0,0 +1,187 @@
+#include <dos.h>
+#include "tiff.h"
+#include "video.h"
+
+/*** T I F F ***/
+typedef struct {
+  unsigned int endian;
+  unsigned int version;
+  unsigned long ifdOffset;
+} TifHeader_t;
+
+#define TIF_WIDTH 256
+#define TIF_HEIGHT 257
+#define TIF_BITSPERSAMPLE 258
+#define TIF_COMPRESSION 259
+#define TIF_STRIPOFFSETS 273
+#define TIF_ROWSPERSTRIP 278
+
+typedef struct {
+  unsigned int id;
+  unsigned int dataType;
+  unsigned long dataCount;
+  unsigned long dataOffset;
+} TifTag_t;
+
+TifImageMeta_t tifLoadMeta(FILE *f) {
+  TifImageMeta_t meta = {0, 0, 0, 0, 0};
+  TifHeader_t header;
+  TifTag_t tag;
+  unsigned int i, tagCount;
+
+  fseek(f, 0, SEEK_SET);
+  fread(&header, 8, 1, f);
+
+  if (header.endian != 0x4949 || header.version != 0x2a) {
+    goto fail;
+  }
+  fseek(f, header.ifdOffset, SEEK_SET);
+  fread(&tagCount, 2, 1, f);
+  for (i = 0; i < tagCount; i ++) {
+    fread(&tag, 12, 1, f);
+    if (tag.id == TIF_WIDTH) {
+      meta.width = tag.dataOffset;
+    } else if (tag.id == TIF_HEIGHT) {
+      meta.height = tag.dataOffset;
+    } else if (tag.id == TIF_BITSPERSAMPLE) {
+      if (tag.dataOffset != 4) goto fail;
+    } else if (tag.id == TIF_COMPRESSION) {
+      if (tag.dataOffset != 1) goto fail;
+    } else if (tag.id == TIF_STRIPOFFSETS) {
+      meta.stripCount = tag.dataCount;
+      meta.stripOffsets = tag.dataOffset;
+    } else if (tag.id == TIF_ROWSPERSTRIP) {
+      meta.rowsPerStrip = tag.dataOffset;
+    }
+  }
+  return meta;
+fail:
+  meta.stripCount = 0;
+  return meta;
+}
+
+int tifLoadEGA(FILE *f, TifImageMeta_t meta, unsigned int vidOffset, int maxY, unsigned int w) {
+  int istrip;
+  int irow;
+  int ipixelpair;
+  int y = 0;
+  unsigned long offset;
+  unsigned char rowData[MAX_WIDTH >> 1];
+  volatile unsigned char far *out = &VID[vidOffset];
+  unsigned char b, g, r, i;
+
+  if (meta.width > MAX_WIDTH || (meta.width % 8) != 0) {
+    return 0;
+  }
+  setWriteMode(0);
+
+  for (istrip = 0; istrip < meta.stripCount; istrip ++) {
+    fseek(f, meta.stripOffsets + (istrip << 2), SEEK_SET);
+    fread(&offset, 4, 1, f);
+    fseek(f, offset, SEEK_SET);
+
+    for (irow = 0; irow < meta.rowsPerStrip; irow ++) {
+      int ipixelpairLim = meta.width >> 1;
+      fread(rowData, 1, ipixelpairLim, f);
+      b = g = r = i = 0;
+      for (ipixelpair = 0; ipixelpair < ipixelpairLim; ipixelpair ++) {
+	unsigned char pixelpair = rowData[ipixelpair];
+	int bpair = (pixelpair & 0x01) | (pixelpair & 0x10) >> 3;
+	int gpair = (pixelpair & 0x02) >> 1 | (pixelpair & 0x20) >> 4;
+	int rpair = (pixelpair & 0x04) >> 2 | (pixelpair & 0x40) >> 5;
+	int ipair = (pixelpair & 0x08) >> 3 | (pixelpair & 0x80) >> 6;
+	int shift = (3 - (ipixelpair % 4)) << 1;
+
+	b |= bpair << shift;
+	g |= gpair << shift;
+	r |= rpair << shift;
+	i |= ipair << shift;
+
+	if (shift == 0 || ipixelpair == ipixelpairLim - 1) {
+	  // todo: use write mode 2, this is slooww
+	  setPlane(PLANE_B); *out = b;
+	  setPlane(PLANE_R); *out = r;
+	  setPlane(PLANE_G); *out = g;
+	  setPlane(PLANE_I); *out = i;
+	  out ++;
+	  b = g = r = i = 0;
+	}
+      }
+      y++;
+      if (y == maxY) {
+	return y;
+      }
+      out += (w - meta.width) >> 3;
+    }
+  }
+  return y;
+}
+
+int tifLoad(FILE *f, TifImageMeta_t meta, unsigned int far *planeBuf, int maxY, int yRepeat, int planes) {
+  int istrip;
+  int irow;
+  int ipixelpair;
+  int y = 0;
+  unsigned long offset;
+  unsigned char rowData[MAX_WIDTH >> 1];
+  unsigned int planeStride = (meta.width >> 4) * yRepeat;
+  unsigned int far *bp = planeBuf;
+  unsigned int far *gp = bp + planeStride;
+  unsigned int far *rp = gp + planeStride;
+  unsigned int far *ip = rp + planeStride;
+  unsigned int far *mp = ip + planeStride;
+  unsigned int bv, gv, rv, iv;
+
+  if (meta.width > MAX_WIDTH || (meta.width % 16) != 0 || planes < 4 || planes > 5) {
+    return 0;
+  }
+
+  for (istrip = 0; istrip < meta.stripCount; istrip ++) {
+    fseek(f, meta.stripOffsets + (istrip << 2), SEEK_SET);
+    fread(&offset, 4, 1, f);
+    fseek(f, offset, SEEK_SET);
+
+    for (irow = 0; irow < meta.rowsPerStrip; irow ++) {
+      int ipixelpairLim = meta.width >> 1;
+      fread(rowData, 1, ipixelpairLim, f);
+      bv = gv = rv = iv = 0;
+      for (ipixelpair = 0; ipixelpair < ipixelpairLim; ipixelpair ++) {
+	unsigned char pixelpair = rowData[ipixelpair];
+	int bpair = (pixelpair & 0x01) | (pixelpair & 0x10) >> 3;
+	int gpair = (pixelpair & 0x02) >> 1 | (pixelpair & 0x20) >> 4;
+	int rpair = (pixelpair & 0x04) >> 2 | (pixelpair & 0x40) >> 5;
+	int ipair = (pixelpair & 0x08) >> 3 | (pixelpair & 0x80) >> 6;
+	int shift = (7 - (ipixelpair % 8)) << 1;
+
+	bv |= bpair << shift;
+	gv |= gpair << shift;
+	rv |= rpair << shift;
+	iv |= ipair << shift;
+
+	if (shift == 0 || ipixelpair == ipixelpairLim - 1) {
+	  *bp++ = bv;
+	  *gp++ = gv;
+	  *rp++ = rv;
+	  *ip++ = iv;
+	  if (planes == 5) {
+	    iv = ~(bv & gv & rv & iv);
+	    *mp++ = iv;
+	  }
+	  bv = gv = rv = iv = 0;
+	}
+      }
+      y++;
+      if (y == maxY) {
+	return y;
+      }
+      if (y % yRepeat == 0) {
+	bp += planeStride * (planes - 1);
+	gp += planeStride * (planes - 1);
+	rp += planeStride * (planes - 1);
+	ip += planeStride * (planes - 1);
+	mp += planeStride * (planes - 1);
+      }
+    }
+  }
+  return y;
+}
--- a/tiff.h
+++ b/tiff.h
@ -0,0 +1,17 @@
+#include <stdio.h>
+
+/*** T I F F ***/
+
+typedef struct {
+  unsigned int width;
+  unsigned int height;
+  unsigned long rowsPerStrip;
+  unsigned long stripCount;
+  unsigned long stripOffsets;
+} TifImageMeta_t;
+
+#define MAX_WIDTH 328
+
+TifImageMeta_t tifLoadMeta(FILE *f);
+int tifLoadEGA(FILE *f, TifImageMeta_t meta, unsigned int vidOffset, int maxY, unsigned int w);
+int tifLoad(FILE *f, TifImageMeta_t meta, unsigned int far *planeBuf, int maxY, int yRepeat, int planes);
--- a/tiles.c
+++ b/tiles.c
@ -0,0 +1,329 @@
+#include <dos.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include "video.h"
+#include "tiles.h"
+#include "egamap.h"
+
+/*** T I L E S ***/
+
+// Tiles are 16x16 bitmaps, stored as arrays of words.
+// Each tile has 4 or 5 planes (depending on whether it is a tile or sprite)
+// which are stored adjacant to each other; ie. a 16-word array of blue,
+// followed by a 16-word array of green, etc.
+// Tiles in RAM are stored byte-swapped to aid in fast bit-shifting, and must
+// be byte-swapped before being written to video memory.
+
+// Because bit-shifting operations happen on little-endian words:
+// 01234567 89ABCDEF << 3 => 34567XXX BCDEF012
+// which is wrong. So instead we do:
+// 89ABCDEF 01234567 << 3 => BCDEFXXX 3456789A byteswap => 3456789A BCDEFXXX
+
+void tile_init() {
+  setLogicalWidth(PAGE_STRIDE >> 1);
+}
+
+void blitTile(unsigned int offsetFrom, unsigned int offsetTo) {
+  int y;
+  for (y = 0; y < 16; y ++) {
+    VID[offsetTo] = VID[offsetFrom ++];
+    VID[offsetTo + 1] = VID[offsetFrom ++];
+    offsetTo += PAGE_STRIDE;
+  }
+}
+
+void blitSolidBlock(unsigned int offsetTo, unsigned char color) {
+  int y;
+  setPlaneColor(color);
+  for (y = 0; y < 16; y ++) {
+    VID[offsetTo] = 0xff;
+    VID[offsetTo + 1] = 0xff;
+    offsetTo += PAGE_STRIDE;
+  }
+}
+
+void blit32x32(unsigned int offsetFrom, unsigned int offsetTo) {
+  int y;
+  for (y = 0; y < 32; y ++) {
+    VID[offsetTo] = VID[offsetFrom ++];
+    VID[offsetTo + 1] = VID[offsetFrom ++];
+    VID[offsetTo + 2] = VID[offsetFrom ++];
+    VID[offsetTo + 3] = VID[offsetFrom ++];
+    offsetTo += PAGE_STRIDE;
+  }
+}
+
+void blitMemToVid(unsigned int offset, unsigned int far *mem, unsigned int planeStride, int count) {
+  int i, j, plane;
+
+  offset = offset >> 1; // word aligned
+  setWriteMode(0);
+  for (i = 0; i < count; i ++) {
+    for (plane = 0; plane < 4; plane ++) {
+      unsigned int drawOffset = offset;
+      unsigned int bmp;
+
+      setPlane(plane);
+      for (j = 0; j < planeStride; j ++) {
+	bmp = mem[j];
+	WVID[drawOffset + j] = (bmp << 8) | (bmp >> 8);
+      }
+      mem += planeStride;
+    }
+    offset += planeStride;
+  }
+  setAllPlanes();
+}
+
+#define D_NOTHING 0x80
+#define D_BGTILE 0x81
+#define isBufIndex(d) (!((d) & 0x80))
+
+#define nextBufferIndex(i) ((i + 1) % NUM_BUFFERS)
+
+TiledScreen_t screen = { 0, 0, 0, 0, { OFF_PAGE1, OFF_PAGE2 }, 0, 0, NULL, NULL,
+  0, 0, 0, 0, 0 };
+
+
+void paintBufferPlane(unsigned int *buf, unsigned int vidOffset, int stride, int plane) {
+  unsigned int drawOffset = vidOffset >> 1;
+  unsigned int y, bmp;
+  for (y = 0; y < 16; y ++) {
+    bmp = buf[y + (BUF_WSTRIDE * plane)];
+    WVID[drawOffset] = (bmp << 8) | (bmp >> 8);
+    drawOffset += stride >> 1;
+  }
+}
+
+void loadTiles(unsigned int tilesOffset, unsigned int far *memTiles) {
+  int i, plane;
+  screen.tilesOffset = tilesOffset;
+  screen.memTiles = memTiles;
+  setWriteMode(0);
+  for (plane = 0; plane < 4; plane ++) {
+    unsigned int drawOffset = tilesOffset >> 1;
+    setPlane(plane);
+    for (i = 0; i < NUM_TILES; i ++) {
+      unsigned int y, bmp;
+      unsigned int far *buf = &memTiles[(i * BUF_WSIZE) + (BUF_WSTRIDE * plane)];
+      for (y = 0; y < 16; y ++) {
+	bmp = buf[y];
+	WVID[drawOffset ++] = (bmp << 8) | (bmp >> 8);
+      }
+    }
+  }
+  setAllPlanes();
+}
+
+void loadMap(unsigned char *map, unsigned int w, unsigned int h) {
+  screen.map = map;
+  screen.w = w;
+  screen.h = h;
+  memset(screen.dirty, D_BGTILE, PAGE_TILES_COUNT * 2);
+}
+
+void writeTile(unsigned int *buf, unsigned int far *tile) {
+  int i;
+  for (i = 0; i < BUF_WSIZE; i ++) {
+    buf[i] = tile[i];
+  }
+}
+
+void overlaySprite(unsigned int *buf, unsigned int far *sprite, int shift, int yStart, char *remap) {
+  unsigned int far *mask;
+  unsigned int maskval;
+  int y, h, plane;
+
+  if (yStart < 0) {
+    sprite = &sprite[-yStart];
+    h = yStart + 16;
+  } else {
+    buf = &buf[yStart];
+    h = 16 - yStart;
+  }
+  mask = &sprite[BUF_WSTRIDE * 4];
+  if (!remap) {
+    if (shift < 0) {
+      shift = -shift;
+      for (plane = 0; plane < 4; plane ++) {
+	for (y = 0; y < h; y ++) {
+	  maskval = mask[y] << shift;
+	  buf[y] = (buf[y] & ~maskval) | ((sprite[y] << shift) & maskval);
+	}
+	sprite += BUF_WSTRIDE;
+	buf += BUF_WSTRIDE;
+      }
+    } else {
+      for (plane = 0; plane < 4; plane ++) {
+	for (y = 0; y < h; y ++) {
+	  maskval = mask[y] >> shift;
+	  buf[y] = (buf[y] & ~maskval) | ((sprite[y] >> shift) & maskval);
+	}
+	sprite += BUF_WSTRIDE;
+	buf += BUF_WSTRIDE;
+      }
+    }
+  } else {
+    unsigned int b, bo, g, go, r, ro, i, io, bgri;
+    int bit;
+    if (shift < 0) {
+      shift = -shift;
+#define SPLANE(b, y, p) b[y + (BUF_WSTRIDE * (p))]
+#define DO_REMAP(ss, bitstart, bitlim) \
+      for (y = 0; y < h; y ++) { \
+	bo = go = ro = io = 0; \
+	b = SPLANE(sprite, y, 0); \
+	g = SPLANE(sprite, y, 1); \
+	r = SPLANE(sprite, y, 2); \
+	i = SPLANE(sprite, y, 3); \
+	for (bit = (bitstart); bit < (bitlim); bit ++) { \
+	  int bshift = 1 << bit; \
+	  bgri = ((b & bshift) ? 0x01 : 0x00) | \
+		 ((g & bshift) ? 0x02 : 0x00) | \
+		 ((r & bshift) ? 0x04 : 0x00) | \
+		 ((i & bshift) ? 0x08 : 0x00); \
+	  bgri = remap[bgri]; \
+	  if (bgri & 0x01) bo |= bshift; \
+	  if (bgri & 0x02) go |= bshift; \
+	  if (bgri & 0x04) ro |= bshift; \
+	  if (bgri & 0x08) io |= bshift; \
+	} \
+	maskval = mask[y] ss shift; \
+	SPLANE(buf, y, 0) = (SPLANE(buf, y, 0) & ~maskval) | ((bo ss shift) & maskval); \
+	SPLANE(buf, y, 1) = (SPLANE(buf, y, 1) & ~maskval) | ((go ss shift) & maskval); \
+	SPLANE(buf, y, 2) = (SPLANE(buf, y, 2) & ~maskval) | ((ro ss shift) & maskval); \
+	SPLANE(buf, y, 3) = (SPLANE(buf, y, 3) & ~maskval) | ((io ss shift) & maskval); \
+      }
+
+      DO_REMAP(<<, shift, 16)
+    } else {
+      DO_REMAP(>>, 0, 16 - shift)
+
+#undef DO_REMAP
+#undef SPLANE
+    }
+  }
+}
+
+int prepareBuffer(int pageX, int pageY) {
+  unsigned char *dirty = &screen.dirty[screen.currentPage][pageX + (pageY * PAGE_TILES_W)];
+  int i;
+  if (!isBufIndex(*dirty)) {
+    unsigned int startX = screen.scrollX >> 4;
+    unsigned int startY = screen.scrollY >> 4;
+    unsigned char tile = screen.map[startX + pageX + ((startY + pageY) * screen.w)];
+    unsigned char ibuffer = screen.nextBuffer;
+    screen.nextBuffer = nextBufferIndex(ibuffer);
+    *dirty = ibuffer;
+    writeTile(screen.buffer[ibuffer], &screen.memTiles[tile * BUF_WSIZE]);
+    screen.bufferOffset[ibuffer] = screen.pageOffset[screen.currentPage]
+      + (pageX << 1) + (pageY * PAGE_STRIDE * 16);
+  }
+  return *dirty;
+}
+
+void drawSpriteToBuf(unsigned int far *sprite, int pageX, int pageY, int shift, int yStart, char *remap) {
+  unsigned int *buf;
+
+  if (pageX < 0 || pageY < 0 ||
+      pageX >= PAGE_TILES_W || pageY >= PAGE_TILES_H ||
+      shift >= 16 || shift <= -16 ||
+      yStart <= -16 || yStart >= 16) {
+    return;
+  }
+
+  buf = screen.buffer[prepareBuffer(pageX, pageY)];
+  overlaySprite(buf, sprite, shift, yStart, remap);
+}
+
+void drawSprite(unsigned int far *sprite, int x, int y, char *remap) {
+  int pageX = (int)(x - (screen.scrollX & 0xfff0)) >> 4;
+  int pageY = (int)(y - (screen.scrollY & 0xfff0)) >> 4;
+  int pageOffsetX = x & 0x0f;
+  int pageOffsetY = y & 0x0f;
+
+  drawSpriteToBuf(sprite, pageX, pageY, pageOffsetX, pageOffsetY, remap);
+  drawSpriteToBuf(sprite, pageX + 1, pageY, pageOffsetX - 16, pageOffsetY, remap);
+  drawSpriteToBuf(sprite, pageX, pageY + 1, pageOffsetX, pageOffsetY - 16, remap);
+  drawSpriteToBuf(sprite, pageX + 1, pageY + 1, pageOffsetX - 16, pageOffsetY - 16, remap);
+}
+
+void scroll(int newX, int newY) {
+  newX = min(max(newX, 0), (screen.w << 4) - 320);
+  newY = min(max(newY, 0), (screen.h << 4) - 200);
+  if ((screen.scrollX & 0xfff0) != (newX & 0xfff0) ||
+      (screen.scrollY & 0xfff0) != (newY & 0xfff0)) {
+    int mapX, mapY;
+    unsigned char page;
+    for (page = 0; page < 2; page ++) {
+      int mapOffsetOld = (screen.scrollX >> 4) + ((screen.scrollY >> 4) * screen.w);
+      int mapOffsetNew = (newX >> 4) + ((newY >> 4) * screen.w);
+      unsigned char *dirty = screen.dirty[page];
+      for (mapY = 0; mapY < PAGE_TILES_H; mapY ++) {
+	for (mapX = 0; mapX < PAGE_TILES_W; mapX ++) {
+	  if (*dirty != D_NOTHING ||
+	    screen.map[mapOffsetOld + mapX] != screen.map[mapOffsetNew + mapX]) {
+	    *dirty = D_BGTILE;
+	  }
+	  dirty ++;
+	}
+	mapOffsetNew += screen.w;
+	mapOffsetOld += screen.w;
+      }
+    }
+  }
+  screen.scrollX = newX;
+  screen.scrollY = newY;
+}
+
+void paintBuffer(unsigned int *buf, unsigned int vidOffset) {
+  int plane;
+  setWriteMode(0);
+  for (plane = 0; plane < 4; plane ++) {
+    setPlane(plane);
+    paintBufferPlane(buf, vidOffset, 40, plane);
+  }
+}
+
+void drawScreen() {
+  unsigned int startX = screen.scrollX >> 4;
+  unsigned int startY = screen.scrollY >> 4;
+  unsigned int offsetX = screen.scrollX - (startX << 4);
+  unsigned int offsetY = screen.scrollY - (startY << 4);
+  unsigned int drawOffset = screen.pageOffset[screen.currentPage];
+  unsigned int scrollOffset = drawOffset + (offsetX >> 3) + (offsetY * PAGE_STRIDE);
+  unsigned char *dirty = screen.dirty[screen.currentPage];
+  unsigned int x, y, di, plane, bmp;
+
+  setAllPlanes();
+  setWriteMode(1);
+
+  di = 0;
+  for (y = startY; y < startY + PAGE_TILES_H; y ++) {
+    for (x = startX; x < startX + PAGE_TILES_W; x ++) {
+      if (dirty[di++] == D_BGTILE) {
+	char tile = screen.map[x + (y * screen.w)];
+	blitTile(screen.tilesOffset + (tile << 5), drawOffset);
+      }
+      drawOffset += 2;
+    }
+    drawOffset += PAGE_STRIDE * 15;
+  }
+  setWriteMode(0);
+  for(plane = 0; plane < 4; plane ++) {
+    setPlane(plane);
+    for (di = screen.firstBuffer; di != screen.nextBuffer; di = nextBufferIndex(di)) {
+      paintBufferPlane(screen.buffer[di], screen.bufferOffset[di], PAGE_STRIDE, plane);
+    }
+  }
+  setAllPlanes();
+
+  setDisplayOffset(scrollOffset);
+  setHorizontalPan(screen.scrollX & 0x07);
+
+  screen.currentPage ^= 1;
+  screen.firstBuffer = screen.nextBuffer;
+  for (di = 0; di < PAGE_TILES_COUNT; di ++) {
+    dirty[di] = isBufIndex(dirty[di]) ? D_BGTILE : D_NOTHING;
+  }
+}
--- a/tiles.gfx
+++ b/tiles.gfx
--- a/tiles.h
+++ b/tiles.h
@ -0,0 +1,48 @@
+/*** T I L E S ***/
+#ifndef __TILES_H__
+#define __TILES_H__
+
+void tile_init();
+
+void loadTiles(unsigned int tilesOffset, unsigned int far *memTiles);
+void loadMap(unsigned char *map, unsigned int w, unsigned int h);
+void drawSprite(unsigned int far *sprite, int x, int y, char *remap);
+void scroll(int newX, int newY);
+void drawScreen();
+
+void blit32x32(unsigned int offsetFrom, unsigned int offsetTo);
+void blitMemToVid(unsigned int offset, unsigned int far *mem, unsigned int planeStride, int count);
+
+void writeTile(unsigned int *buf, unsigned int far *tile);
+void overlaySprite(unsigned int *buf, unsigned int far *sprite, int shift, int yStart, char *remap);
+void paintBuffer(unsigned int *buf, unsigned int vidOffset);
+
+#define PAGE_TILES_W 21
+#define PAGE_TILES_H 14
+#define PAGE_TILES_COUNT (PAGE_TILES_H * PAGE_TILES_W)
+#define PAGE_STRIDE (PAGE_TILES_W << 1)
+
+#define NUM_BUFFERS 20
+#define BUF_WSTRIDE 16
+#define BUF_WSIZE (BUF_WSTRIDE * 4)
+
+typedef struct {
+  unsigned int w;
+  unsigned int h;
+  int scrollX;
+  int scrollY;
+  unsigned int pageOffset[2];
+  unsigned char dirty[2][PAGE_TILES_COUNT];
+  unsigned int tilesOffset;
+  unsigned int far *memTiles;
+  unsigned char *map;
+  unsigned int buffer[NUM_BUFFERS][BUF_WSIZE];
+  unsigned int bufferOffset[NUM_BUFFERS];
+  unsigned char currentPage;
+  unsigned char nextBuffer;
+  unsigned char firstBuffer;
+} TiledScreen_t;
+
+extern TiledScreen_t screen;
+
+#endif
--- a/tiles.tif
+++ b/tiles.tif
--- a/timer.c
+++ b/timer.c
@ -0,0 +1,44 @@
+#include <stdio.h>
+#include <dos.h>
+#include "timer.h"
+
+#define TIMER_INTERRUPT 0x1c
+#define REG_8253_CTL 0x43
+#define REG_COUNTER0 0x40
+
+volatile unsigned int timer_counter = 0;
+
+static void interrupt (*oldTimerISR)() = NULL;
+static void (*callback)() = NULL;
+
+static void interrupt timer_isr() {
+  disable();
+  timer_counter ++;
+  if (callback) callback();
+  enable();
+  oldTimerISR();
+}
+
+void timer_setcallback(void (*cb)()) {
+  callback = cb;
+}
+
+void timer_setrate(unsigned int rate) {
+  outp(REG_8253_CTL, 0x3c);
+  outp(REG_COUNTER0, rate & 0xff);
+  outp(REG_COUNTER0, (rate >> 8) & 0xff);
+}
+
+static void timer_cleanup() {
+  if (oldTimerISR != NULL) {
+    setvect(TIMER_INTERRUPT, oldTimerISR);
+    timer_setrate(TIMER_18HZ);
+    oldTimerISR = NULL;
+  }
+}
+void timer_init(unsigned int rate) {
+  timer_setrate(rate);
+  oldTimerISR = getvect(TIMER_INTERRUPT);
+  setvect(TIMER_INTERRUPT, timer_isr);
+  atexit(timer_cleanup);
+}
--- a/timer.h
+++ b/timer.h
@ -0,0 +1,12 @@
+#define TIMER_60HZ 0x4dae
+#define TIMER_50HZ 0x5d37
+#define TIMER_40HZ 0x7486
+#define TIMER_30HZ 0x965c
+#define TIMER_20HZ 0xe90b
+#define TIMER_18HZ 0xffff
+
+extern volatile unsigned int timer_counter;
+
+void timer_init(unsigned int rate);
+void timer_setrate(unsigned int rate);
+void timer_setcallback(void (*cb)());
--- a/timer.jor
+++ b/timer.jor
@ -0,0 +1,37 @@
+( timer + lerping )
+: clamp0 ( range val -- i )
+  2dup  <= if drop else
+  dup 0 <= if drop drop 0 else
+	      swap drop then then ;
+: >ratio ( range value -- f )
+  over swap clamp0 swap />ratio ;
+: <ratio ( range ratio -- v ) *<ratio ;
+: >range ( start end -- start range ) over - ;
+: <range ( start range -- start end ) over + ;
+: lerpr ( start end ratio ) >r >range <r <ratio + ;
+: lerpn ( start1 end1 start2 end2 val )
+  >r >range <r <rot - >ratio lerpr ;
+: lerp ( start end duration start -- i )
+  ticks udelta ( start end duration delta )
+  >ratio lerpr ;
+
+: triggered ( duration timer -- b )
+  dup >r @ ticks udelta ( duration delta )
+  2dup <= if drop <r +! 1 else drop drop rdrop 0 then ;
+
+: now! ( timer -- ) ticks swap ! ;
+: advance! ( timer -- delta )
+  dup @ ticks udelta ( timer delta )
+  dup <rot +! ;
+
+: move-to ( target speed p -- )
+  dup >r @ >rot ticks ( from to duration start )
+  begin
+    4dup lerp r@ !
+    <rot dup r@ @ != ( from duration start to !done )
+  while
+    >rot suspend
+  repeat rdrop drop drop drop drop ;
+
+: sleep ( count -- )
+  ticks swap begin over ticks udelta over u< while suspend repeat drop drop ;
--- a/trail1.jor
+++ b/trail1.jor
@ -0,0 +1,54 @@
+( T R A I L 1 )
+
+50 17 E ' {horse} defentity e_chuck
+39 71 N ' {car} defentity car
+
+car :touch
+ CHUCK-FOLLOW flag@ if
+   pete say" I can't leave Chuck here!"
+ else
+   move-player 1 player.state DRIVING f!
+ then
+;entity
+
+e_chuck :touch
+ pete say" Woah, boy. Calm down." move-player
+ chuck say" * w h i n n y *\(You came back!)"
+ pete say" Of course I did, boy.\Of course I did."
+ p_chuck follow CHUCK-GONE clearflag CHUCK-FOLLOW setflag
+;entity
+
+:noname
+0 player.state DRIVING f!
+
+:| CHUCK-GONE flag@ if e_chuck yield then
+   player.driving? not if car yield then
+   done |; ' entities redefine
+
+:|
+touch-begin S leaving? dup
+  if player.driving? not CHUCK-FOLLOW flag@ not and
+    if   pete say" I'm not walking."
+    else move-player 13 7 road.jor queue-level
+    then
+  then
+CHUCK-GONE flag@ if
+  touch-next 49 17 2= dup
+    if
+      pete say" Oh for the love of..."
+      say" Chuck! How on Earth did you\end up over there!?"
+      W e_chuck entity.dir !
+      chuck say" * n e i g h *\(Help me Pete, I'm lost!)"
+    then
+then
+touch-next 3 56 2= dup
+  if
+    1 glitchlevel !
+    pete say" This is where I buried it."
+    say" All those years ago."
+    0 glitchlevel !
+  then
+touch-last |; ' player-touch redefine
+
+s" trail1.map" load-map
+; ' onload redefine
--- a/trail1.map
+++ b/trail1.map
--- a/video.c
+++ b/video.c
@ -0,0 +1,39 @@
+#include <dos.h>
+#include "video.h"
+
+void vid_cleanup() {
+  setTextMode();
+}
+
+void setSplitScreen(unsigned int y) {
+  int val;
+  outport(REG_CRTC, 0x18 | (y << 8));
+  outp(REG_CRTC, 7);
+  val = inp(REG_CRTC + 1);
+  val &= ~0x10;
+  val |= (y & 0x100) >> 4;
+  outp(REG_CRTC + 1, val);
+  outp(REG_CRTC, 9);
+  val = inp(REG_CRTC + 1);
+  val &= ~0x40;
+  outp(REG_CRTC + 1, val);
+}
+
+void unsetSplitScreen() {
+  outport(REG_CRTC, 0xff18);
+  outport(REG_CRTC, 0x1107);
+  outport(REG_CRTC, 0x0f09);
+}
+
+
+void setDisplayOffset(unsigned int offset) {
+  outport(REG_CRTC, 0x0c | (offset & 0xff00));
+  outport(REG_CRTC, 0x0d | (offset << 8));
+}
+
+void setHorizontalPan(int offset) {
+  inp(0x3da); // INPUT_STATUS_1?
+  outp(REG_AC, 0x13 | 0x20);
+  outp(REG_AC, offset);
+}
+
--- a/video.h
+++ b/video.h
@ -0,0 +1,39 @@
+/*** V I D E O ***/
+#define setMode(hexval) asm { mov ax, hexval; int 10h }
+
+#define setVGAMode() setMode(0013h)
+#define setEGAMode() setMode(000Dh)
+#define setTextMode() setMode(0003h)
+
+#define REG_AC   0x03c0
+#define REG_TS   0x03c4
+#define REG_GDC  0x03ce
+#define REG_CRTC 0x03d4
+
+#define PLANE_B 0x00
+#define PLANE_G 0x01
+#define PLANE_R 0x02
+#define PLANE_I 0x03
+#define setPlane(p) outport(REG_TS, 2 | (0x100 << p))
+#define setPlaneColor(c) outport(REG_TS, 2 | (c << 8))
+#define setAllPlanes() setPlaneColor(0x0f)
+
+#define setWriteMode(m) outport(REG_GDC, 0x05 | (m << 8))
+#define setBitMask(m) outport(REG_GDC, 0x08 | (m << 8))
+
+#define setResetEnabled(m) outport(REG_GDC, 0x01 | (m << 8))
+#define setResetMask(m) outport(REG_GDC, m << 8)
+
+#define VID ((volatile char far *)MK_FP(0xa000, 0))
+#define WVID ((volatile int far *)MK_FP(0xa000, 0))
+
+#define flipPage(p) outport(REG_CRTC, 0x0c | (p << 8))
+
+#define setLogicalWidth(w) outport(REG_CRTC, 0x13 | (w << 8))
+
+void vid_cleanup();
+void setSplitScreen(unsigned int y);
+void unsetSplitScreen();
+void setDisplayOffset(unsigned int offset);
+void setHorizontalPan(int offset);
+