Add scanner, second level, more office objects. Game is completable!

end.jor

@@ -0,0 +1,10 @@
+( E N D )
+
+:noname
+  reset-level
+
+  s" end.map" load-map
+  7 11 tile>world pjaye entity.pos!
+  6 12 tile>world pneut entity.pos!
+
+; ' onload redefine

entity.jor

@@ -1,8 +1,9 @@
 0 const EVTICK
 1 const EVTOUCH
-2 const EVACT
+2 const EVUNTOUCH
-3 const EVDEACT
+3 const EVACT
-4 const EVTOG
+4 const EVDEACT
+5 const EVTOG
 
 : world>tile 4 >> swap 4 >> swap ; userword
 : tile>world 4 << swap 4 << swap ; userword
@@ -24,13 +25,16 @@ var _responder
 : entity>sprite cell + @ execute ;
 : entity>do ( entity event )
   swap dup if
+    responder >rot
     dup _responder !
     @ execute
+    _responder !
   else drop drop then ;
 
 : 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 , ]

footer.jor

@@ -29,7 +29,7 @@ WHITE text-color !
 
 var textx
 var texty
-100 ( 2 ) const textspeed
+( 100 ) 2 const textspeed
 var textleft
 : textleftsay 6 textleft ! ;
 : textleftchoice 8 textleft ! ;

game.jor

@@ -11,7 +11,7 @@ var objects
 
 : single-entity-at ( x y 0 entity -- x y entity|0 b )
   swap drop >r 2dup ( x y x y r:e )
-  r@ entity.x @ r@ entity.y @ world>tile 2= ( x y b 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 )
@@ -32,6 +32,8 @@ var player.prevdir
 4 const ISNEUT userword
 8 const HASNEUT userword
 
+1 player.state HASNEUT f!
+
 : noclip player.state NOCLIP fnot! ; userword
 
 : isneut? player.state ISNEUT f@ ; userword
@@ -53,6 +55,9 @@ var player.prevdir
 
 : sched-move-entity ( entity -- ) :| jobdata move-entity |; sched-with ;
 : move-player
+  player entity>pos world>tile entity-at
+  dup if EVUNTOUCH entity>do else drop then
+
   1 player.state MOVING f!
 
   isneut? not if ( only jaye can have a party )
@@ -98,7 +103,7 @@ defer neut-touch ( x y -- b )
   player entity-dst check-player-touch not if move-player then ;
 
 : follow ( e -- )
-  player entity>pos <rot entity.pos! NODIR player.prevdir ! ;
+  pjaye entity>pos <rot entity.pos! NODIR player.prevdir ! ;
 
 : check-entity-touch
   touch-begin entity-at
@@ -110,9 +115,7 @@ defer neut-touch ( x y -- b )
   dup entity-dst check-entity-touch not if move-entity then ;
 
 var q-level
-var q-player.x
+: queue-level q-level ! ; userword
-var q-player.y
-: queue-level q-level ! q-player.y ! q-player.x ! ; userword
 
 : player-tick
   ^SPACE key-pressed player.state HASNEUT f@ and
@@ -143,7 +146,6 @@ var q-player.y
     0 q-level !
     reset-level
     loadlevel
-    q-player.x @ q-player.y @ tile>world player entity.pos!
     party each follow more
   else drop then ;
 
@@ -204,10 +206,12 @@ does> @ objects ! ;
 10 const DOOR-OPENED
 11 const SWITCH-OFF
 12 const SWITCH-ON
-
+20 const SCAN-OFF
+21 const SCAN-ON
 
 : entity>tile ( entity -- tile ) entity>pos world>tile tile ;
 : entity>tile? ( entity expected - b ) swap entity>tile b@ = ;
+: responder>tile? ( expected - b ) responder swap entity>tile? ;
 
 : toggleval ( off on val -- off|on ) over = not if swap then drop ;
 : toggletile ( entity off on -- )
@@ -225,32 +229,71 @@ does> @ objects ! ;
 
 : blankentity array here >r N ' {duck} allotentity <r ;
 
+: linked-entity responder entity.user @ execute ;
+
 : handle-link ( ev ontile -- )
   swap statechange? if
-    responder swap entity>tile? if EVACT else EVDEACT then
+    responder>tile? if EVACT else EVDEACT then
-    responder entity.user @ swap entity>do
+    linked-entity swap entity>do
   else drop then ;
 
-: door blankentity dup link-object
+: computer-on? ( entity -- b ) COMP-ON entity>tile? ;
-  :| dup EVTOUCH = isjaye? and responder DOOR-OPENED entity>tile? and if
-       move-player
-     then
-     DOOR-OPENED DOOR-CLOSED handle-onoff
-  |; swap ! ;
 
-: switch blankentity swap , dup link-object
+: handle-teleport ( ev -- )
+  EVTOUCH = isneut? and COMP-ON responder>tile? and if
+    linked-entity dup computer-on? if
+      entity>pos pneut entity.pos!
+    else drop then
+  then ;
+
+: create-object blankentity dup link-object ;
+: create-linked-object blankentity swap , dup link-object ;
+: listener! ( entity listener ) swap ! ;
+
+: entering-door? ( ev -- b )
+  EVTOUCH = isjaye? and DOOR-OPENED responder>tile? and ;
+
+: door-listener ( ev -- )
+  dup entering-door? if move-player then
+  DOOR-OPENED DOOR-CLOSED handle-onoff ;
+
+: door create-object ' door-listener listener! ;
+
+: exitdoor create-linked-object
+  :| dup door-listener entering-door? if
+    responder entity.user @ queue-level
+  then |; listener! ;
+
+: switch create-linked-object
   :| dup EVTOUCH = isneut? and if move-player then
-     dup EVTOUCH = if responder EVTOG entity>do then
+     dup EVTOUCH = if
+       responder EVTOG entity>do
+       isjaye? if wait-for-arrow-up then
+     then
      dup SWITCH-ON SWITCH-OFF handle-onoff
-     SWITCH-ON handle-link |; swap ! ;
+     SWITCH-ON handle-link |; listener! ;
 
 : computer blankentity swap , dup link-object
   :| dup EVTOUCH = isjaye? and if responder EVACT entity>do then
-     dup EVTOUCH = isneut? and if move-player then
+     dup EVTOUCH = isneut? and COMP-ON responder>tile? and if move-player then
      dup COMP-ON COMP-OFF handle-onoff
-     COMP-ON handle-link |; swap ! ;
+     handle-teleport |; listener! ;
 
-: chainev ( entity xp -- ) swap dup @ , ! ; immediate
+: scanner create-linked-object
+  :| dup EVTOUCH = isneut? and if
+       move-player
+       responder EVACT entity>do
+     then
+     dup EVUNTOUCH = isneut? and if responder EVDEACT entity>do then
+     dup SCAN-ON SCAN-OFF handle-onoff
+     SCAN-ON handle-link |; listener! ;
+
+( usage: entity :noname [ ev -- ev ] ... chain-listener ;
+  ONLY works with :noname at top-level interpretation time - not :| |;
+  compiles a reference to the previous listener into the :noname func
+  and sets the listener of the entity on the stack to the new func )
+
+: chain-listener ( entity xp -- ) swap dup @ , ! ; immediate
 
 :noname
   reset-level

gameboot.jor

@@ -28,8 +28,11 @@ s" game.jor" loadfile
 ; execute
 
 intern lev00001.jor
+intern lev00002.jor
+intern end.jor
 
 :noname loadfile ; checkpoint _loadlevel
 ' _loadlevel ' loadlevel redefine
 
 lev00001.jor loadlevel
+

input.jor

@@ -20,6 +20,15 @@
     swap -
   then ;
 
+: current-arrows
+  ^UP key-down if 0x01 else 0 then
+  ^DOWN key-down if 0x02 else 0 then |
+  ^LEFT key-down if 0x04 else 0 then |
+  ^RIGHT key-down if 0x08 else 0 then | ;
+
+: wait-for-arrow-up
+  current-arrows begin dup current-arrows & while suspend repeat drop ;
+
 ( M O U S E )
 var prevbutton
 : tick-debounce

lev00001.jor

@@ -13,18 +13,24 @@
 
 objects: O
 
+defer last-term
+
 12 9 door d1
-d1 12 8 switch s1
+' d1 12 8 switch s1
-0 15 8 computer c1
+' last-term 15 8 computer c1
 
 7 6 door d2
-d2 6 6 switch s2
+' d2 6 6 switch s2
-0 1 4 computer c2
+' c1 1 4 computer c2
+' c2 ' last-term redefine
+
+lev00002.jor 10 0 exitdoor dexit
+' dexit 9 0 scanner sexit
 
 d1 :noname
   dup EVTOUCH = isjaye? and d1 DOOR-CLOSED entity>tile? and if
     jaye say" It won't open!"
-  then chainev ;
+  then chain-listener ;
 
 c1 :noname
   dup EVTOUCH = isjaye? and if
@@ -37,19 +43,30 @@ c1 :noname
     else
       jaye say" Neut is running now.\I can hit the space bar\to control them."
     then
-  then chainev ;
+  then chain-listener ;
 c2 :noname
   dup EVTOUCH = isjaye? and if
     c2 COMP-OFF entity>tile? if
       jaye say" Looks like there's still\power to this terminal."
     then
     jaye say" If I turn a terminal on,\Neut can use it to\travel through the network."
-  then chainev ;
+  then chain-listener ;
+
+sexit :noname
+  dup EVTOUCH = isjaye? and if
+    jaye say" It's a card scanner.\It should open this door."
+    jaye say" It's not reading my card\for some reason.\Quake must've damaged it."
+    jaye say" Neut might be able to\hack it..."
+  then chain-listener ;
 
 :noname
   reset-level O
 
   s" lev00001.map" load-map
-(  ' intro sched )
+  0 player.state HASNEUT f!
+  14 9 tile>world pjaye entity.pos!
+  c1 entity>pos pneut entity.pos!
+
+  ' intro sched
 
 ; ' onload redefine

lev00002.jor

@@ -0,0 +1,59 @@
+( L E V E L 0 0 0 0 2 )
+
+objects: O
+
+11 9 door d1
+13 8 door d2
+15 7 door d3
+13 3 door d4
+9 4 door d5
+7 5 door d6
+8 10 door d7
+4 9 door d8
+2 6 door d9
+4 2 door d10
+
+end.jor 7 0 exitdoor dx
+' dx 6 0 scanner sx
+
+: unconnected :| 0 |; ;
+defer c10 ' c10 5 1 computer cx
+' cx 5 4 computer _c10 ' _c10 ' c10 redefine
+defer c8 ' c8 11 4 computer c9
+' c9 16 1 computer _c8 ' _c8 ' c8 redefine
+defer c6 ' c6 16 10 computer c7
+' c7 14 6 computer _c6 ' _c6 ' c6 redefine
+defer c3 ' c3 10 6 computer c5
+defer c2 ' c2 5 6 computer c4
+' c5 1 9 computer _c3 ' _c3 ' c3 redefine
+' c4 1 2 computer _c2 ' _c2 ' c2 redefine
+' c2 9 11 computer c1
+
+' d7 0 4 scanner sc1
+' d3 10 0 scanner sc2
+' d1 11 0 scanner sc3
+' d5 12 0 scanner sc4
+' d2 13 7 scanner sc5
+' d4 17 9 scanner sc6
+
+' c3 13 6 switch s1
+' d6 14 0 switch s2
+' d8 15 0 switch s3
+' d9 16 0 switch s4
+' d10 2 0 switch s5
+
+c2 :noname
+  dup EVTOUCH = isneut? and c4 computer-on? not and if
+    neut say" DESTINATION TERMINAL\IS DISCONNECTED"
+    neut say" PLEASE CONTACT YOUR\SYSTEM ADMINISTRATOR"
+    neut say" THIS INCIDENT HAS\BEEN REPORTED"
+  then chain-listener ;
+
+:noname
+  reset-level O
+
+  s" lev00002.map" load-map
+  11 11 tile>world pjaye entity.pos!
+  10 12 tile>world pneut entity.pos!
+
+; ' onload redefine

map.jor

@@ -9,20 +9,29 @@ var tileselect
 2 const NEUTABLE
 
 array tileflags
-( sky )        0 b,
+( sky )             0 b,
-( cloud )      0 b,
+( cloud )           0 b,
-( wall )       NEUTABLE b,
+( wall )            NEUTABLE b,
-( carpet )     WALKABLE b,
+( carpet )          WALKABLE b,
-( comp-off )   0 b,
+( comp-off )        0 b,
-( comp-on )    NEUTABLE b,
+( comp-on )         NEUTABLE b,
-( table )      0 b,
+( table )           0 b,
-( chair )      0 b,
+( chair )           0 b,
-( table-brok ) 0 b,
+( table-brok )      0 b,
-( door-close ) 0 b,
+( door-close ) 	    0 b,
-( door-open )  WALKABLE b,
+( door-open )       WALKABLE b,
-( switch-off ) NEUTABLE b,
+( switch-off )      NEUTABLE b,
-( switch-on )  NEUTABLE b,
+( switch-on )       NEUTABLE b,
-( window )     0 b,
+( window )          0 b,
+( chair-brok )      0 b,
+( bookcase )        0 b,
+( bookcase-broke )  0 b,
+( scattered books ) WALKABLE b,
+( plant )           0 b,
+( tipped plant )    0 b,
+( scanner-off )     NEUTABLE b,
+( scanner-on )      NEUTABLE b,
+( cracked-wall )    0 b,
 
 here tileflags - 1 - const MAXTILE