Add hiking trail, chuck plot, beginnings of adlib driver

adlib.c

@@ -0,0 +1,14 @@
+#include <dos.h>
+
+static void adlib_wait(int delay) {
+  int i;
+  for (i = 0; i < delay; i ++) inp(0x388);
+}
+
+void adlib_write(int reg, int val) {
+  int i;
+  outp(0x388, reg);
+  adlib_wait(6);
+  outp(0x389, val);
+  adlib_wait(35);
+}

adlib.h

@@ -0,0 +1 @@
+void adlib_write(int reg, int val);

defs.jor

@@ -5,17 +5,20 @@
 : 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 ;
 
+: negate 0 swap - ;
+: abs dup 0 < if negate then ;
+
 : ~ -1 ^ ;
 : f! ( b v flag -- )
-  r> dup @ ( b v val r: flag )
+  >rot r> r@ @ >rot ( val flag b r: v )
-  <rot if r< | else r< ~ & then ( v newval )
+  if | else ~ & then r< ! ;
-  swap ! ;
 : f@ ( v flag -- ) swap @ & ;
-: fnot! 2dup f@ not f! ;
+: fnot! ( v flag -- ) over @ ^ swap ! ;
 
 : expile state if , else execute then ;
 

game.jor

@@ -30,15 +30,19 @@ defer player
 
 1 const MOVING
 2 const DRIVING
+4 const NOCLIP
+
+: player.driving? player.state DRIVING f@ ;
 
 : {player}
-  player.state DRIVING f@ if {car}
+  player.driving? if {car}
   else player.state MOVING f@ if {pete-walk}
   else {pete-stand} then then ;
 
-: player.driving? player.state DRIVING f@ ;
 : player.canmove? ( x y -- )
-  player.driving? if DRIVABLE else WALKABLE then mapflag? ;
+  player.state NOCLIP f@ not if
+  player.driving? if DRIVABLE else WALKABLE then mapflag?
+  else drop drop 1 then ;
 
 12 9 N ' {player} defentity player
 
@@ -111,6 +115,10 @@ player :tick
 : hello-world
   player.state DRIVING fnot! ;
 
+: reset-level
+  :| player yield 0 |; ' entities redefine
+  :| drop drop 0 |; ' player-touch redefine ;
+
 : mode-move
   entities each EVTICK entity>do more
   tick-mapedit
@@ -120,6 +128,7 @@ player :tick
   tick-debounce
   q-level @ dup if
     0 q-level !
+    reset-level
     loadlevel
     q-player.x @ q-player.y @ tile>world player entity.pos!
   else drop then ;
@@ -142,10 +151,6 @@ player :tick
   draw-screen
   draw-footer ;
 
-: reset-level
-  :| player yield 0 |; ' entities redefine
-  :| drop drop 0 |; ' player-touch redefine ;
-
 :noname
   reset-level
   MODE-MOVE @ ' tick redefine

gameboot.jor

@@ -18,12 +18,14 @@ s" timer.jor" loadfile
 s" footer.jor" loadfile
 s" map.jor" loadfile
 s" game.jor" loadfile
+s" state.jor" loadfile
 ; execute
 
 intern pete.jor
 intern petehous.jor
 intern road.jor
 intern jeanne.jor
+intern trail1.jor
 
 :noname loadfile ; checkpoint _loadlevel
 ' _loadlevel ' loadlevel redefine

jeanne.jor

@@ -13,10 +13,9 @@ car :touch
 ;entity
 
 :noname
-  reset-level
   0 player.state DRIVING f!
 :| player yield
-   e_chuck yield
+   chuck.state @ CHUCK-HOME = if e_chuck yield then
    player.driving? not if car yield then
    0 |; ' entities redefine
 

jorth.c

@@ -525,7 +525,10 @@ void f_lit_() {
 
 void f_number() { // str -- (num 1 | str 0)
   int num = 0, result;
-  result = sscanf(TOP().s, "%d", &num);
+  result = sscanf(TOP().s, "0x%x", &num);
+  if (result != 1) {
+    result = sscanf(TOP().s, "%d", &num);
+  }
   if (result == 1) {
     TOP().i = num;
     PUSHI(result == 1);

map.jor

@@ -66,6 +66,25 @@ here tileflags - 1 - const MAXTILE
   for 2dup i copy-mapseg next
   drop swap mapsize! ;
 
+: 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 ;
+
 : save-map ( filename -- )
   fdeactivate swap overwrite
   mapsize swap fput fput

repl.jor

@@ -3,3 +3,4 @@
   begin receive loadstring s" ok" type cr again ;
 task const REPL
 REPL start-repl
+

road.jor

@@ -3,7 +3,6 @@
 24 4 N ' {horse} defentity chuck
 
 :noname
-  reset-level
   1 player.state DRIVING f!
   :| player yield chuck yield 0 |; ' entities redefine
   :|
@@ -12,7 +11,7 @@ touch-begin E leaving? dup
 touch-next 5 9 2= dup
   if player move-entity 13 12 pete.jor queue-level then
 touch-next 13 6 2= dup
-  if pete say" Old hiking trail." then
+  if player move-entity 38 71 trail1.jor queue-level then
 touch-next 24 6 2= dup
   if player move-entity 13 22 jeanne.jor queue-level then
 touch-next 39 33 2= dup

state.jor

@@ -0,0 +1,4 @@
+0 const CHUCK-LOST
+1 const CHUCK-FOLLOW
+2 const CHUCK-HOME
+var chuck.state

testbed.c

@@ -11,6 +11,7 @@
 #include "timer.h"
 #include "jorth.h"
 #include "egamap.h"
+#include "adlib.h"
 
 /*** T E X T ***/
 char far *font = NULL;
@@ -193,6 +194,11 @@ void f_drawportrait() {
   DROP(1);
 }
 
+void f_adlib() {
+  adlib_write(ST1().u, TOP().u);
+  DROP(2);
+}
+
 void game_f_init() {
   f_init();
   CDEF("seremit", f_seremit);
@@ -217,7 +223,7 @@ void game_f_init() {
 }
 
 void f_poll() {
-  static char line[256] = { 0 };
+  static char line[128] = { 0 };
 
   int i = strlen(line);
   int value;
@@ -248,10 +254,11 @@ static void f_quit() {
   DONE = 1;
 }
 void do_repl() {
-  char buf[256];
+  char buf[128];
 
   f_init();
   CDEF("quit", f_quit);
+  CDEF("adlib", f_adlib);
 
   f_loadfile("repl.jor");
   f_taskloop();

trail1.jor

@@ -0,0 +1,42 @@
+( T R A I L 1 )
+
+38 60 E ' {horse} defentity e_chuck
+39 71 N ' {car} defentity car
+
+car :touch
+ player move-entity 1 player.state DRIVING f!
+;entity
+
+:noname
+0 player.state DRIVING f!
+
+:| player yield
+   chuck.state @ CHUCK-LOST = if e_chuck yield then
+   player.driving? not if car yield then
+   0 |; ' entities redefine
+
+:|
+touch-begin S leaving? dup
+  if player.driving? not
+    if   pete say" I'm not walking."
+    else player move-entity 13 7 road.jor queue-level
+    then
+  then
+chuck.state @ CHUCK-LOST = if
+  touch-next 37 60 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
+    pete say" This is where I buried it."
+    say" All those years ago."
+  then
+touch-last |; ' player-touch redefine
+
+s" trail1.map" load-map
+; ' onload redefine