Finish lev3, implement rexx as first-class reusable object

.gitignore

@@ -4,3 +4,6 @@
 *.swp
 *.log
 game.map
+neuttowr.map
+jopl.map
+

end.jor

@@ -4,7 +4,7 @@
   reset-level
 
   s" end.map" load-map
-  7 11 tile>world pjaye entity.pos!
-  6 12 tile>world pneut entity.pos!
+  7 11 tile>world Jaye entity.pos!
+  6 12 tile>world Neut entity.pos!
 
 ; ' onload redefine

entity.jor

@@ -17,6 +17,7 @@
 
 : allotentity ( x y dir anim -- ) ' drop , , , tile>world , , ;
 : defentity ( x y dir anim -- ) array allotentity ;
+
 var _responder
 : responder _responder @ ;
 : entity.user 5 cells + ;
@@ -35,18 +36,8 @@ var _responder
 : entity>pos dup entity.x @ swap entity.y @ ; userword
 : entity.pos! ( x y entity ) <rot over entity.x ! entity.y ! ; userword
 
-( TODO: I think this can die, it sucks )
-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
-: :act EVACT entitydo-ev ; immediate
-: ;entity ( entity cp ifhere -- )
-  [ ' then , ] ' drop , [ ' ; , ]
-  0 entity-defstate ! swap ! ; immediate
+: deflistener array ' drop , ;
+: evproxy ( ev entity -- ev ) over entity>do ;
 
 0 const W
 1 const E

game.jor

@@ -11,20 +11,19 @@ var player.prevdir
 
 1 const MOVING userword
 2 const NOCLIP userword
-4 const ISREXX userword
-8 const HASNEUT userword
-16 const ISPROG userword
+4 const HASNEUT userword
+8 const ISPROG userword
 
 1 player.state HASNEUT f!
 
 : noclip player.state NOCLIP fnot! ; userword
 
-: f-rexx ( -- v f ) player.state ISREXX ;
+var posessed-rexx
 
 : isprog? player.state ISPROG f@ ;
-: isneut? isprog? f-rexx f@ not and ; userword
+: isneut? isprog? posessed-rexx @ not and ; userword
 : isjaye? isprog? not ; userword
-: isrexx? isprog? f-rexx f@ and ; userword
+: isrexx? isprog? posessed-rexx @ and ; userword
 
 : {jaye}
   isjaye? player.state MOVING f@ and
@@ -35,14 +34,12 @@ var player.prevdir
     isneut? if NEUTABLE else WALKABLE then mapflag?
   else drop drop 1 then ;
 
-: {-neut-} f-rexx f@ if {blank} else {neut} then ;
 14 9 N ' {jaye} defentity Jaye
-17 5 N ' {-neut-} defentity Neut
+17 5 N ' {neut} defentity Neut
 
-defer player-prog
-defer player-human
-
-: player isprog? if player-prog else player-human then ;
+: player
+  isrexx? if posessed-rexx @ else
+  isneut? if Neut else Jaye then then ;
 
 : replace-entity-at ( x y 0 entity -- x y entity|0 b )
   swap drop >r 2dup ( x y x y r:e )
@@ -98,8 +95,14 @@ defer neut-touch ( x y -- b )
 
 : rexx-touch ( x y -- b )
   2dup RUBBLE mapflag? if
-    tile 3 swap b! invalidate-map
-  else drop drop then 0 ;
+    tile 3 swap b! invalidate-map 0
+  else 2dup tile b@ 23 = if
+    move-player
+    S posessed-rexx @ entity.dir !
+    posessed-rexx @ entity>pos Neut entity.pos!
+    0 posessed-rexx !
+    drop drop 1
+  else drop drop 0 then then ;
 
 : player-touch
   isneut? if neut-touch else
@@ -149,8 +152,6 @@ var q-level
 ( S T U F F )
 : reset-level
   0 objects !
-  ' Jaye ' player-human redefine
-  ' Neut ' player-prog redefine
   :| done |; ' entities redefine
   :| drop drop 0 |; ' jaye-touch redefine
   :| drop drop 0 |; ' neut-touch redefine ; userword
@@ -306,6 +307,14 @@ var _dorubber
      dup SCAN-ON SCAN-OFF handle-onoff
      SCAN-ON handle-link |; listener! ;
 
+: defrexx array here >r S ' {rexx} allotentity <r
+  dup link-object
+  :| EVTOUCH = isneut? and if
+       move-player
+       responder posessed-rexx !
+       -100 -100 Neut entity.pos!
+     then |; listener! ;
+
 0 const unconnected
 
 ( usage: entity :noname [ ev -- ev ] ... chain-listener ;
@@ -316,14 +325,6 @@ var _dorubber
 : chain-listener ( entity xp -- ) swap dup @ , ! ; immediate
 : cancel-ev ( ev -- EVNOP ) drop EVNOP ;
 
-Neut :noname
-  dup EVTOUCH = isrexx? and if
-    move-player
-    0 f-rexx f!
-    S player-prog entity.dir !
-    ' Neut ' player-prog redefine
-  then chain-listener ;
-
 :noname
   reset-level
   ' mode-move ' tick redefine

gameboot.jor

@@ -1,7 +1,9 @@
 : blah ' seremit task-emit ! ;
 blah
 
-1 const DEV
+0 const DEV
+
+: devon 1 ' DEV redefine ;
 
 s" game.log" open seekend fdeactivate const LOGFILE
 : emit-log ' fputc LOGFILE withfp ;

lev00001.jor

@@ -38,7 +38,7 @@ c1 :noname
       jaye say" Maybe Neut can help."
       neut say" NEUT v0.71.4rc12\ONLINE"
       neut say" PRESS SPACE TO TAKE CONTROL"
-      c1 entity>pos pneut entity.pos!
+      c1 entity>pos Neut entity.pos!
       1 player.state HASNEUT f!
     else
       jaye say" Neut is running now.\I can hit the space bar\to control them."
@@ -59,7 +59,7 @@ sexit :noname
     jaye say" Neut might be able to\hack it..."
   then chain-listener ;
 
-:noname
+:noname              
   reset-level O
 
   s" lev00001.map" load-map

lev00003.jor

@@ -3,37 +3,25 @@
 objects: O
 
 9 9 door d1
-7 5 door d2
-' d1 7 7 switch b1
-' d2 0 3 switch b2
+7 6 door d2
+12 8 door d3
 
-defer c2 ' c2 5 7 computer c1
-' c1 8 3 computer _c2 ' _c2 ' c2 redefine
+deflistener b1targ
+b1targ :noname d1 evproxy d2 evproxy chain-listener ;
+
+' d3 9 10 scanner s1
+
+' b1targ 7 7 switch b1
+
+defer c1 ' c1 8 3 computer c3
+' c3 12 11 computer c2
+' c2 5 7 computer _c1 ' _c1 ' c1 redefine
 
 end.jor 0 4 exitdoor dx
 ' dx 0 5 scanner sx
 
 6 7 N ' {gord-sit} defentity Gord
-5 2 S ' {rexx} defentity Rexx
-Rexx :noname
-  dup EVTOUCH = isneut? and if
-    move-player
-    1 f-rexx f!
-    ' Rexx ' player-prog redefine
-  then chain-listener ;
-
-var rexx-introduced
-Rexx :noname
-  dup EVTOUCH = isneut? and rexx-introduced @ not and if
-    1 rexx-introduced !
-    neut say" MOBILE ROBOTIC UNIT\IDENTIFY YOURSELF"
-    rexx say" Hiya boss!\I'm Rexx, the janitor!"
-    rexx say" And your best friend!"
-    neut say" A HUMAN IS IN PERIL"
-    neut say" YOUR ASSISTANCE IS\REQUIRED"
-    rexx say" You need me to take out\some garbage??"
-    rexx say" Oh boy! Let me at it!"
-  then chain-listener ;
+5 2 defrexx Rexx
 
 : flicker c1 EVTOG entity>do 15 sleep ;
 
@@ -77,10 +65,47 @@ then
     cancel-ev
   then chain-listener ;
 
+var rexx-introduced
+Rexx :noname
+  dup EVTOUCH = isneut? and rexx-introduced @ not and if
+    1 rexx-introduced !
+    neut say" MOBILE ROBOTIC UNIT\IDENTIFY YOURSELF"
+    rexx say" Hiya boss!\I'm Rexx, the janitor!"
+    rexx say" And your best friend!"
+    neut say" A HUMAN IS IN PERIL"
+    neut say" YOUR ASSISTANCE IS\REQUIRED"
+    rexx say" You need me to take out\some garbage??"
+    rexx say" Oh boy! Let me at it!"
+  then chain-listener ;
+
+var gord-jaye
+d2 :noname
+  dup EVTOUCH = isjaye? and
+      gord-jaye @ not and
+      6 6 WALKABLE mapflag? not and if
+    1 gord-jaye !
+    cancel-ev
+    move-player
+    jaye say" Hey! Gord?\I'm Jaye."
+    gord say" Jaye, am I glad to see you.\Can you move this desk?"
+    jaye say" Let me try..."
+    jaye say" . . . .\!!!!....."
+    jaye say" !!!!!!!!!!!!!...."
+    jaye say" No, I don't think I can."
+    gord say" I keep staring at that\cleaning robot."
+    gord say" He looks like he could\lift a building."
+  then chain-listener ;
+
+Gord :noname
+  dup EVTOUCH = isrexx? and if
+    gord say" AHHH NOOO\NOT GARBAGE\I AM NOT GARBAGE"
+    rexx say" Whatever you say, boss!"
+  then chain-listener ;
+
 :noname
   reset-level O
 
-  :| Gord yield Rexx yield done |; ' entities redefine
+  :| Gord yield done |; ' entities redefine
 
   s" lev00003.map" load-map
   7 11 tile>world Jaye entity.pos!

map.jor

@@ -10,30 +10,30 @@ var tileselect
 4 const RUBBLE
 
 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 )      RUBBLE b,
-( door-close ) 	    0 b,
-( door-open )       WALKABLE b,
-( switch-off )      NEUTABLE b,
-( switch-on )       NEUTABLE b,
-( window )          0 b,
-( chair-brok )      RUBBLE b,
-( bookcase )        0 b,
-( bookcase-broke )  RUBBLE b,
-( scattered books ) WALKABLE b,
-( plant )           0 b,
-( tipped plant )    RUBBLE b,
-( scanner-off )     NEUTABLE b,
-( scanner-on )      NEUTABLE b,
-( cracked-wall )    0 b,
-( rexx-pod )        NEUTABLE b,
+( 0: sky )             0 b,
+( 1: cloud )           0 b,
+( 2: wall )            NEUTABLE b,
+( 3: carpet )          WALKABLE b,
+( 4: comp-off )        0 b,
+( 5: comp-on )         NEUTABLE b,
+( 6: table )           0 b,
+( 7: chair )           0 b,
+( 8: table-brok )      RUBBLE b,
+( 9: door-close )      0 b,
+( 10:door-open )       WALKABLE b,
+( 11:switch-off )      NEUTABLE b,
+( 12:switch-on )       NEUTABLE b,
+( 13:window )          0 b,
+( 14:chair-brok )      RUBBLE b,
+( 15:bookcase )        0 b,
+( 16:bookcase-broke )  RUBBLE b,
+( 17:scattered books ) WALKABLE b,
+( 18:plant )           0 b,
+( 19:tipped plant )    RUBBLE b,
+( 20:scanner-off )     NEUTABLE b,
+( 21:scanner-on )      NEUTABLE b,
+( 22:cracked-wall )    0 b,
+( 23:rexx-pod )        NEUTABLE b,
 
 here tileflags - 1 - const MAXTILE