implement party system

defs.jor

@@ -9,6 +9,9 @@
 : 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 ;
 

game.jor

@@ -14,6 +14,7 @@ task const JOB
 JOB listen-for-jobs
 
 ( T I C K )
+defer party
 defer entities
 
 : entity-at ( x y -- entity|0 )
@@ -26,6 +27,7 @@ defer entities
 
 ( P L A Y E R )
 var player.state
+var player.prevdir
 defer player
 
 1 const MOVING
@@ -59,6 +61,12 @@ defer player
 : move-player
   1 player.state MOVING f!
   player move-entity
+  player.prevdir @ party each
+    dup player != if
+      dup entity.dir @ r>
+      dup >rot entity.dir !
+      move-entity r<
+    else entity.dir @ player.prevdir ! then more drop
   0 player.state MOVING f! ;
 
 : out-of-bounds ( x y -- b )
@@ -111,11 +119,12 @@ player :tick
 
 ( S T U F F )
 : reset-level
-  :| player yield done |; ' entities redefine
+  :| done |; ' entities redefine
   :| drop drop 0 |; ' player-touch redefine ;
 
 : mode-move
   entities each EVTICK entity>do more
+  party each EVTICK entity>do more
   tick-mapedit
   tick-debounce
   q-level @ dup if
@@ -141,6 +150,8 @@ var showmouse
   scroll
 
   entities each draw-entity more
+  party each draw-entity more
+
   showmouse @ if
     mouseworldpos 4 draw-sprite
   then

jeanne.jor

@@ -14,8 +14,7 @@ car :touch
 
 :noname
   0 player.state DRIVING f!
-:| player yield
+:| chuck.state @ CHUCK-HOME = if e_chuck yield then
-   chuck.state @ CHUCK-HOME = if e_chuck yield then
    player.driving? not if car yield then
    done |; ' entities redefine
 

pete.jor

@@ -8,8 +8,7 @@ car :touch
 ;entity
 
 :noname
-:| player yield
+:| player.driving? not if car yield then
-   player.driving? not if car yield then
    done |; ' entities redefine
 
  :|

petehous.jor

@@ -11,7 +11,7 @@ bed :touch pete say" I'm not tired yet." ;entity
 
 :noname
   reset-level
-  :| player yield table yield chair yield bed yield done |; ' entities redefine
+  :| table yield chair yield bed yield done |; ' entities redefine
   :|
 touch-begin 16 10 2= dup if
   player move-entity 12 8 pete.jor queue-level

road.jor

@@ -4,8 +4,7 @@
 
 :noname
   1 player.state DRIVING f!
-  :| player yield
+  :| chuck.state @ CHUCK-HOME = if chuck yield then
-     chuck.state @ CHUCK-HOME = if chuck yield then
      done |; ' entities redefine
   :|
 touch-begin E leaving? dup

slide.jor

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

state.jor

@@ -3,3 +3,10 @@
 2 const CHUCK-FOLLOW
 3 const CHUCK-HOME
 var chuck.state
+
+16 18 W ' {horse} defentity p_chuck
+:noname
+  :| player yield
+     chuck.state @ CHUCK-FOLLOW = if p_chuck yield then
+  done |; ' party redefine
+; ' onload redefine

trail1.jor

@@ -10,8 +10,7 @@ car :touch
 :noname
 0 player.state DRIVING f!
 
-:| player yield
+:| chuck.state @ CHUCK-SEARCH = if e_chuck yield then
-   chuck.state @ CHUCK-SEARCH = if e_chuck yield then
    player.driving? not if car yield then
    done |; ' entities redefine