Make car drivable; refactor jorth module bootstrapping sequence

boot.jor

@@ -57,7 +57,7 @@ key " const '"'
 : definition ( cpdeferred ) cell + @ ;
 
 defer onload
-: postload onload ' noop ' onload redefine ;
+: postload ' onload definition ' noop ' onload redefine execute ;
 
 : loadimage ( -- [0 | onload] )
   fget fget fget fget fget ( onload tasks latest size start )

defs.jor

@@ -65,6 +65,8 @@
     1 + ( cp i+1 )
   repeat drop drop then drop ;
 
+: words latest links each dup wordname type bl more ;
+
 ( tasks )
 : mailbox 2 cells + ;
 : task-ip task-user-size cells + ;

entity.jor

@@ -7,6 +7,8 @@
 : entity.dir 2 cells + ;
 : entity>sprite cell + @ execute ;
 : entity>do ( entity event ) swap @ execute ;
+: entity>pos dup entity.x @ swap entity.y @ ;
+: entity.pos! ( x y entity ) <rot over entity.x ! entity.y ! ;
 
 var entity-defstate
 : entitydo-ev ( [cp ifhere] ev -- )

game.jor

@@ -1,23 +1,3 @@
-: blah ' seremit task-emit ! ;
-blah
-
-: start-repl activate blah
-  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
-
-:noname
-s" input.jor" loadfile
-s" entity.jor" loadfile
-s" timer.jor" loadfile
-s" footer.jor" loadfile
-s" map.jor" loadfile
-; execute
-
 ( J O B )
 var MODE-MOVE
 var MODE-WAIT
@@ -57,8 +37,9 @@ defer player
   else player.state MOVING f@ if {pete-walk}
   else {pete-stand} then then ;
 
+: player.driving? player.state DRIVING f@ ;
 : player.canmove? ( x y -- )
-  player.state DRIVING f@ if DRIVABLE else WALKABLE then mapflag? ;
+  player.driving? if DRIVABLE else WALKABLE then mapflag? ;
 
 12 9 N ' {player} defentity player
 
@@ -82,6 +63,12 @@ defer player
   <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 ;
+
 : no-touch drop drop 0 ;
 defer player-touch ( x y -- b )
 ' no-touch ' player-touch redefine
@@ -141,9 +128,7 @@ player :tick
   draw-screen
   draw-footer ;
 
+:noname
 MODE-MOVE @ ' tick redefine
 ' full-draw ' draw redefine
-
+; ' onload redefine
-:noname
-  s" pete.jor" loadfile
-; ' onload redefine

gameboot.jor

@@ -0,0 +1,22 @@
+: blah ' seremit task-emit ! ;
+blah
+
+: start-repl activate blah
+  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
+
+:noname
+s" input.jor" loadfile
+s" entity.jor" loadfile
+s" timer.jor" loadfile
+s" footer.jor" loadfile
+s" map.jor" loadfile
+s" game.jor" loadfile
+
+s" pete.jor" loadfile
+; ' onload redefine

jorth.c

@@ -844,6 +844,14 @@ void f_loadfile(char *filename) {
   f_cexecute();
 }
 
+void f_loadjor(char *filename) {
+  PUSHS(filename);
+  PUSHS("loadjor");
+  f_lookup();
+  DROP(1);
+  f_cexecute();
+}
+
 // does not use the jorth interpreter defined in boot.jor
 void f_loadfile_cterp(char *filename) {
   cell *start = HERE;

pete.jor

@@ -1,24 +1,24 @@
 ( P E T E )
 
-8 8 E ' {car} defentity car
+13 8 N ' {car} defentity car
 
-var cartimer
+car :touch
-car :tick 60 cartimer triggered if
+  1 player.state DRIVING f!
-  :| car entity.dir @ E = if W else E then car entity.dir !
+  car entity>pos player entity.pos!
-  car try-move-entity |; JOB send
-then
-:touch pete say" What an old rustbucket.
-Hasn't driven in years."
 ;entity
 
 :noname
-  :|
+  :| player yield
-  player yield
+     player.driving? not if car yield then
-  car yield
+     0 |; ' entities redefine
-  0 |;
-  ' entities redefine
 
-  cartimer now!
+  ( TODO: DSL for touch events? )
+  :| 2dup S leaving? player.driving? not and if
+       pete say" It's too far to walk to town."	1 else
+     2dup 12 7 2= if
+       player.driving? not if pete say" TODO: Go home" then 1
+     else 0 then then >rot drop drop
+  |; ' player-touch redefine
   s" pete.map" load-map
 ; ' onload redefine
 

testbed.c

@@ -213,7 +213,7 @@ void game_f_init() {
   CDEF("mousepos", f_mousepos);
   CDEF("mousebuttons", f_mousebuttons);
   CDEF("unfuck", tile_init);
-  f_loadfile("game.jor");
+  f_loadjor("gameboot.jor");
 }
 
 void f_poll() {