flesh out Chuck's story

entity.jor

@@ -4,6 +4,12 @@
 : world>tile 4 >> swap 4 >> swap ;
 : tile>world 4 << swap 4 << swap ;
 
+: +pos ( x1 y1 x2 y2 -- x y )
+  <rot + >rot + swap ;
+
+: -pos ( x1 y1 x2 y2 -- x y )
+  negate swap negate swap +pos ;
+
 : defentity ( x y dir anim -- ) array ' drop , , , tile>world , , ;
 : entity.x 4 cells + ;
 : entity.y 3 cells + ;
@@ -28,12 +34,31 @@ var entity-defstate
 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
-  N = if 0 -1
-      else 0 1 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

game.jor

@@ -28,7 +28,6 @@ defer entities
 ( P L A Y E R )
 var player.state
 var player.prevdir
-defer player
 
 1 const MOVING
 2 const DRIVING
@@ -48,16 +47,6 @@ defer player
 
 12 9 N ' {player} defentity player
 
-: 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 ;
-
 : move-player
   1 player.state MOVING f!
   player move-entity
@@ -96,6 +85,9 @@ defer player-touch ( x y -- b )
 : 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
@@ -132,6 +124,7 @@ player :tick
     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 !

gameboot.jor

@@ -17,8 +17,8 @@ defer loadlevel
 
 :noname
 s" input.jor" loadfile
-s" entity.jor" loadfile
 s" timer.jor" loadfile
+s" entity.jor" loadfile
 s" footer.jor" loadfile
 s" map.jor" loadfile
 s" game.jor" loadfile

jeanne.jor

@@ -9,7 +9,7 @@ e_chuck :touch
 ;entity
 
 car :touch
- player move-entity 1 player.state DRIVING f!
+ move-player 1 player.state DRIVING f!
 ;entity
 
 :noname
@@ -22,18 +22,33 @@ car :touch
 touch-begin S leaving? dup
   if player.driving? not
     if   pete say" I'm not walking."
-    else player move-entity 24 7 road.jor queue-level
+    else move-player 24 7 road.jor queue-level
     then
   then
 touch-next 6 21 2= dup
   if player.driving? not
-    if
+    if CHUCK-FOLLOW state@ 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 setstate
+      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 setstate CHUCK-FOLLOW clearstate
+	10 6 petehous.jor queue-level
+      then
     else
       pete say" Jeanne hates me enough already\without driving through her\front door!"
     then

map.jor

@@ -1,7 +1,4 @@
 ( M A P )
-: +pos ( x1 y1 x2 y2 -- x y )
-  <rot + >rot + swap ;
-
 var tileselect
 : invalidate-map mapsize mapsize! ;
 : mouseworldpos mousepos scrollpos +pos ;

pete.jor

@@ -3,7 +3,7 @@
 13 8 N ' {car} defentity car
 
 car :touch
-  player move-entity
+  move-player
   1 player.state DRIVING f!
 ;entity
 
@@ -15,17 +15,17 @@ car :touch
 touch-begin S leaving? dup
   if player.driving? not
     if   pete say" It's too far to walk to town."
-    else player move-entity 5 10 road.jor queue-level
+    else move-player 5 10 road.jor queue-level
     then
   then
 touch-next 13 8 2= player.driving? and dup
-  if player move-entity
+  if move-player
     0 player.state DRIVING f!
     W player entity.dir !
-    player move-entity
+    move-player
   then
 touch-next 12 7 2= player.driving? not and dup
-  if player move-entity 16 9 petehous.jor queue-level then
+  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

petehous.jor

@@ -64,7 +64,7 @@ done |; choose ;entity
   :| table yield chair yield bed yield e_phone yield done |; ' entities redefine
   :|
 touch-begin 16 10 2= dup if
-  player move-entity 12 8 pete.jor queue-level
+  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

road.jor

@@ -3,18 +3,20 @@
 24 4 N ' {horse} defentity chuck
 
 :noname
-  1 player.state DRIVING f!
+  CHUCK-FOLLOW state@ not player.state DRIVING f!
   :| CHUCK-HOME state@ 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 state@ 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 player move-entity 13 12 pete.jor queue-level then
+  if move-player 13 12 pete.jor queue-level then
 touch-next 13 6 2= dup
-  if player move-entity 38 71 trail1.jor queue-level then
+  if move-player 38 71 trail1.jor queue-level then
 touch-next 24 6 2= dup
-  if player move-entity 13 22 jeanne.jor queue-level then
+  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

state.jor

@@ -4,13 +4,13 @@
 3 const CHUCK-HOME
 
 3 const LAST-STATE
-array state LAST-STATE 8 / 1 + allot
+array flags LAST-STATE 8 / 1 + allot
 
-: statef ( f -- v f ) dup 8 % 1 swap << swap 8 / state + swap ;
-: state! ( b f -- ) statef f! ;
-: state@ ( b f -- ) statef f@ ;
-: setstate 1 swap state! ;
-: clearstate 0 swap state! ;
+: flagstof ( f -- v f ) dup 8 % 1 swap << swap 8 / flags + swap ;
+: flagsf! ( b f -- ) flagstof f! ;
+: state@ ( b f -- ) flagstof f@ ;
+: setstate 1 swap flagsf! ;
+: clearstate 0 swap flagsf! ;
 
 16 18 W ' {horse} defentity p_chuck
 :noname

trail1.jor

@@ -4,7 +4,21 @@
 39 71 N ' {car} defentity car
 
 car :touch
- player move-entity 1 player.state DRIVING f!
+ CHUCK-FOLLOW state@ 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."
+ 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
+( e_chuck entity>pos p_chuck entity.pos!
+ p_chuck entity>pos player entity>pos facing player.prevdir ! )
+ CHUCK-GONE clearstate CHUCK-FOLLOW setstate
 ;entity
 
 :noname
@@ -16,9 +30,9 @@ car :touch
 
 :|
 touch-begin S leaving? dup
-  if player.driving? not
+  if player.driving? not CHUCK-FOLLOW state@ not and
     if   pete say" I'm not walking."
-    else player move-entity 13 7 road.jor queue-level
+    else move-player 13 7 road.jor queue-level
     then
   then
 CHUCK-GONE state@ if