diff --git a/footer.jim b/footer.jim index 78718a9..fd28552 100755 Binary files a/footer.jim and b/footer.jim differ diff --git a/footer.jor b/footer.jor index 142cebe..84a4324 100755 --- a/footer.jor +++ b/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 diff --git a/game.jim b/game.jim index 03bdd94..90993af 100755 Binary files a/game.jim and b/game.jim differ diff --git a/game.jor b/game.jor index d77043c..912479e 100755 --- a/game.jor +++ b/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 r@ obj-entity single-entity-at if rdrop break else 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 -: isjaye? isneut? not ; userword +: f-rexx ( -- v f ) player.state ISREXX ; + +: 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 -17 5 N ' {neut} defentity pneut +: {-neut-} f-rexx f@ if {blank} else {neut} then ; +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 r@ obj-entity replace-entity-at if rdrop break else 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 pos 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 N ' {tileent} allotentity @ 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 diff --git a/jiles.jim b/jiles.jim index 33f429e..e8b9b25 100755 Binary files a/jiles.jim and b/jiles.jim differ diff --git a/job.jim b/job.jim index 1023fd5..e96c3e6 100755 Binary files a/job.jim and b/job.jim differ diff --git a/lev00001.jim b/lev00001.jim index c804687..fa2c0ad 100755 Binary files a/lev00001.jim and b/lev00001.jim differ diff --git a/lev00001.jor b/lev00001.jor index 98e4377..59a8f62 100755 --- a/lev00001.jor +++ b/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! - c1 entity>pos pneut entity.pos! + 14 9 tile>world Jaye entity.pos! + c1 entity>pos Neut entity.pos! DEV not if ' intro sched then diff --git a/lev00002.jor b/lev00002.jor index 8b166f4..56d79cb 100755 --- a/lev00002.jor +++ b/lev00002.jor @@ -52,7 +52,7 @@ c2 :noname reset-level O s" lev00002.map" load-map - 11 11 tile>world pjaye entity.pos! - 10 12 tile>world pneut entity.pos! + 11 11 tile>world Jaye entity.pos! + 10 12 tile>world Neut entity.pos! ; ' onload redefine diff --git a/lev00003.jim b/lev00003.jim index 3be38ad..d48e77f 100755 Binary files a/lev00003.jim and b/lev00003.jim differ diff --git a/lev00003.jor b/lev00003.jor index ef6e3a3..ef78f74 100755 --- a/lev00003.jor +++ b/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! - 6 12 tile>world pneut entity.pos! + 7 11 tile>world Jaye entity.pos! + 6 12 tile>world Neut entity.pos! ; ' onload redefine diff --git a/map.jim b/map.jim index 010b830..a1edbe0 100755 Binary files a/map.jim and b/map.jim differ diff --git a/map.jor b/map.jor index f9d2917..b661783 100755 --- a/map.jor +++ b/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, diff --git a/portrait.gfx b/portrait.gfx index c1eb0bf..e9b95b8 100755 Binary files a/portrait.gfx and b/portrait.gfx differ diff --git a/state.jim b/state.jim index 1230a3c..07c4cfe 100755 Binary files a/state.jim and b/state.jim differ