implement Rexx clearing rubble

footer.jor

@@ -108,6 +108,7 @@ var cchoose
   does> dup @ text-color ! cell + @ draw-portrait ;
 
 0 LGREEN character neut userword
+1 YELLOW character rexx userword
 3 LBLUE character jaye userword
 5 CYAN character gord userword
 

game.jor

@@ -5,35 +5,26 @@ var objects
 
 : obj-entity ( optr -- entity ) cell + @ ;
 
-: single-entity-at ( x y 0 entity -- x y entity|0 b )
-  swap drop >r 2dup ( x y x y r:e )
-  r@ entity>pos world>tile 2= ( x y b r:e )
-  if <r else rdrop 0 then dup ;
-
-: entity-at ( x y -- entity|0 )
-  0 entities each single-entity-at if break then more
-  dup not objects @ and if
-    objects @ links each
-      >r r@ obj-entity single-entity-at if rdrop break else <r then
-    more
-  then
-  >rot drop drop ;
-
 ( P L A Y E R )
 var player.state userword
 var player.prevdir
 
 1 const MOVING userword
 2 const NOCLIP userword
-4 const ISNEUT userword
+4 const ISREXX userword
 8 const HASNEUT userword
+16 const ISPROG userword
 
 1 player.state HASNEUT f!
 
 : noclip player.state NOCLIP fnot! ; userword
 
-: isneut? player.state ISNEUT f@ ; userword
+: f-rexx ( -- v f ) player.state ISREXX ;
-: isjaye? isneut? not ; userword
+
+: isprog? player.state ISPROG f@ ;
+: isneut? isprog? f-rexx f@ not and ; userword
+: isjaye? isprog? not ; userword
+: isrexx? isprog? f-rexx f@ and ; userword
 
 : {jaye}
   isjaye? player.state MOVING f@ and
@@ -44,10 +35,33 @@ var player.prevdir
     isneut? if NEUTABLE else WALKABLE then mapflag?
   else drop drop 1 then ;
 
-14 9 N ' {jaye} defentity pjaye
+: {-neut-} f-rexx f@ if {blank} else {neut} then ;
-17 5 N ' {neut} defentity pneut
+14 9 N ' {jaye} defentity Jaye
+17 5 N ' {-neut-} defentity Neut
 
-: player isneut? if pneut else pjaye then ;
+defer player-prog
+defer player-human
+
+: player isprog? if player-prog else player-human then ;
+
+: replace-entity-at ( x y 0 entity -- x y entity|0 b )
+  swap drop >r 2dup ( x y x y r:e )
+  r@ entity>pos world>tile 2= ( x y b r:e )
+  if <r else rdrop 0 then dup ;
+
+: single-entity-at ( x y entity|0 entity -- x y entity|0 )
+  over not if replace-entity-at then drop ;
+
+: entity-at ( x y -- entity|0 )
+  0 entities each replace-entity-at if break then more
+  dup not objects @ and if
+    objects @ links each
+      >r r@ obj-entity replace-entity-at if rdrop break else <r then
+    more
+  then
+  Neut single-entity-at
+  Jaye single-entity-at
+  >rot drop drop ;
 
 : sched-move-entity ( entity -- ) :| jobdata move-entity |; sched-with ;
 : move-player
@@ -56,7 +70,7 @@ var player.prevdir
 
   1 player.state MOVING f!
 
-  isneut? not if ( only jaye can have a party )
+  isjaye? if ( only jaye can have a party )
     player.prevdir @ party each
       dup player != if
 	dup entity.dir @ >r
@@ -82,7 +96,15 @@ var player.prevdir
 defer jaye-touch ( x y -- b )
 defer neut-touch ( x y -- b )
 
-: player-touch isneut? if neut-touch else jaye-touch then ;
+: rexx-touch ( x y -- b )
+  2dup RUBBLE mapflag? if
+    tile 3 swap b! invalidate-map
+  else drop drop then 0 ;
+
+: player-touch
+  isneut? if neut-touch else
+  isrexx? if rexx-touch else
+	     jaye-touch then then ;
 
 : touch-begin each 2dup more >rot drop drop ;
 : touch-next dup if rdrop done then drop rswap ;
@@ -99,7 +121,7 @@ defer neut-touch ( x y -- b )
   player entity-dst check-player-touch not if move-player then ;
 
 : follow ( e -- )
-  pjaye entity>pos <rot entity.pos! NODIR player.prevdir ! ;
+  Jaye entity>pos <rot entity.pos! NODIR player.prevdir ! ;
 
 : check-entity-touch
   touch-begin entity-at
@@ -115,8 +137,8 @@ var q-level
 
 : player-tick
   ^SPACE key-pressed player.state HASNEUT f@ and if
-    player.state ISNEUT fnot!
+    player.state ISPROG fnot!
-    isneut? if prog-view else human-view then
+    isprog? if prog-view else human-view then
   then
   0 ^LEFT key-down if drop 1 W player entity.dir ! then
   ^RIGHT key-down if drop 1 E player entity.dir ! then
@@ -127,6 +149,8 @@ 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
@@ -136,7 +160,7 @@ var q-level
 (  objects @ if objects @ links each dup obj-entity EVTICK entity>do more )
   entities each EVTICK entity>do more
   party each EVTICK entity>do more
-  pneut EVTICK entity>do
+  Neut EVTICK entity>do
 
   DEV if tick-mapedit jiles then
   tick-debounce
@@ -155,9 +179,6 @@ var q-level
 var glitchlevel
 var quaking
 
-var _dorubber
-: rubber _dorubber @ not _dorubber ! ;
-
 : full-draw
   quaking @ not if
     player entity.x @ 152 -
@@ -167,12 +188,12 @@ var _dorubber
     0 ticks 3 % 13 * 8 % scroll
   then
 
-  _dorubber @ objects @ and if
+  party each draw-entity more
+  player.state HASNEUT f@ if Neut draw-entity then
+  objects @ if
     objects @ links each dup obj-entity draw-entity more
   then
   entities each draw-entity more
-  party each draw-entity more
-  player.state HASNEUT f@ if pneut draw-entity then
 
   DEV if
     mouseworldpos 4 draw-sprite
@@ -220,7 +241,11 @@ does> @ objects ! ;
 : statechange? ( ev -- b )
   dup EVACT = over EVDEACT = or swap EVTOG = or ;
 
-: blankentity array here >r N ' {duck} allotentity <r ;
+var _dorubber
+: rubber _dorubber @ not _dorubber ! ;
+: {tileent} _dorubber @ if {duck} else {blank} then ;
+
+: blankentity array here >r N ' {tileent} allotentity <r ;
 
 : linked-entity responder entity.user @ execute ;
 
@@ -235,7 +260,7 @@ does> @ objects ! ;
 : handle-teleport ( ev -- )
   EVTOUCH = isneut? and COMP-ON responder>tile? and if
     linked-entity dup computer-on? if
-      entity>pos pneut entity.pos!
+      entity>pos Neut entity.pos!
     else drop then
   then ;
 
@@ -244,7 +269,7 @@ does> @ objects ! ;
 : listener! ( entity listener ) swap ! ;
 
 : entering-door? ( ev -- b )
-  EVTOUCH = isjaye? and DOOR-OPENED responder>tile? and ;
+  EVTOUCH = isneut? not and DOOR-OPENED responder>tile? and ;
 
 : door-listener ( ev -- )
   dup entering-door? if move-player then
@@ -259,7 +284,7 @@ does> @ objects ! ;
 
 : switch create-linked-object
   :| dup EVTOUCH = isneut? and if move-player then
-     dup EVTOUCH = if
+     dup EVTOUCH = isrexx? not and if
        responder EVTOG entity>do
        isjaye? if wait-for-arrow-up then
      then
@@ -291,11 +316,19 @@ does> @ objects ! ;
 : 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
   ' full-draw ' draw redefine
-  :| pjaye yield done |; ' party redefine
+  :| Jaye yield done |; ' party redefine
   :| ' tick-debounce ' tick redefine |; ' any-job-started redefine
   :| ' mode-move ' tick redefine hide-footer |; ' all-jobs-complete redefine
 ; ' onload redefine

lev00001.jor

@@ -64,8 +64,8 @@ sexit :noname
 
   s" lev00001.map" load-map
   0 player.state HASNEUT f!
-  14 9 tile>world pjaye entity.pos!
+  14 9 tile>world Jaye entity.pos!
-  c1 entity>pos pneut entity.pos!
+  c1 entity>pos Neut entity.pos!
 
   DEV not if ' intro sched then
 

lev00002.jor

@@ -52,7 +52,7 @@ c2 :noname
   reset-level O
 
   s" lev00002.map" load-map
-  11 11 tile>world pjaye entity.pos!
+  11 11 tile>world Jaye entity.pos!
-  10 12 tile>world pneut entity.pos!
+  10 12 tile>world Neut entity.pos!
 
 ; ' onload redefine

lev00003.jor

@@ -15,6 +15,25 @@ end.jor 0 4 exitdoor dx
 
 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 ;
 
 : flicker c1 EVTOG entity>do 15 sleep ;
 
@@ -22,10 +41,12 @@ var gord-introduced
 c1 :noname
   dup EVTOUCH = isneut? and gord-introduced @ not and if
     1 gord-introduced !
+DEV not if
     neut say" HUMAN PRESENCE\DETECTED"
     flicker flicker flicker flicker
     neut say" > HUMAN ASSISTANCE IS\REQUIRED"
     neut say" > IF HUMAN IS PRESENT\PLEASE RESPOND"
+    hide-footer
     human-view
     flicker flicker flicker flicker
     gord say" What the..."
@@ -44,6 +65,7 @@ c1 :noname
     human-view
     gord say" Huh? Oh, there is a\switch there on the wall."
     gord say" Never thought about what\it connected to."
+then
     5 sleep b1 EVACT entity>do 15 sleep
     gord say" > I TURNED IT ON"
     prog-view
@@ -61,7 +83,7 @@ c1 :noname
   :| Gord yield Rexx yield done |; ' entities redefine
 
   s" lev00003.map" load-map
-  7 11 tile>world pjaye entity.pos!
+  7 11 tile>world Jaye entity.pos!
-  6 12 tile>world pneut entity.pos!
+  6 12 tile>world Neut entity.pos!
 
 ; ' onload redefine

map.jor

@@ -7,6 +7,7 @@ var tileselect
 
 1 const WALKABLE
 2 const NEUTABLE
+4 const RUBBLE
 
 array tileflags
 ( sky )             0 b,
@@ -17,18 +18,18 @@ array tileflags
 ( comp-on )         NEUTABLE b,
 ( table )           0 b,
 ( chair )           0 b,
-( table-brok )      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 )      0 b,
+( chair-brok )      RUBBLE b,
 ( bookcase )        0 b,
-( bookcase-broke )  0 b,
+( bookcase-broke )  RUBBLE b,
 ( scattered books ) WALKABLE b,
 ( plant )           0 b,
-( tipped plant )    0 b,
+( tipped plant )    RUBBLE b,
 ( scanner-off )     NEUTABLE b,
 ( scanner-on )      NEUTABLE b,
 ( cracked-wall )    0 b,