boss key, speed up walking, libb hacking

game.jor

@@ -5,6 +5,14 @@ var objects
 var ticking-objects
 var visible-objects
 
+0 const rubber-on?
+: rubber rubber-on? not ' rubber-on? redefine ;
+: {tileent} rubber-on? if {duck} else {blank} then ;
+: visible-objects@ rubber-on? if objects else visible-objects then @ ;
+
+defer touchable-objects
+' objects ' touchable-objects redefine
+
 : obj-entity ( optr -- entity ) cell + @ ;
 
 ( P L A Y E R )
@@ -65,8 +73,8 @@ var posessed-rexx
 
 : entity-at ( x y -- entity|0 )
   0 entities each replace-entity-at if break then more
-  dup not objects @ and if
-    objects @ links each
+  dup not touchable-objects @ and if
+    touchable-objects @ links each
       >r r@ obj-entity replace-entity-at if rdrop break else <r then
     more
   then
@@ -74,9 +82,16 @@ var posessed-rexx
   Jaye single-entity-at
   >rot drop drop ;
 
+: touchable-entity-at ( x y -- entity|0 )
+  2dup ENTITY mapflag? not if
+    ' visible-objects ' touchable-objects redefine
+    entity-at
+    ' objects ' touchable-objects redefine
+  else entity-at then ;
+
 : sched-move-entity ( entity -- ) :| jobdata move-entity |; sched-with ;
 : move-player
-  player entity>pos world>tile entity-at
+  player entity>pos world>tile touchable-entity-at
   dup if EVUNTOUCH entity>do else drop then
 
   1 player.state MOVING f!
@@ -134,7 +149,7 @@ defer on-gord-sit
   else drop drop 0 then ;
 
 : activate-dir ( x y dir -- )
-  dir>pos +pos entity-at EVTOUCH entity>do ;
+  dir>pos +pos touchable-entity-at EVTOUCH entity>do ;
 
 : activate-gord
   Gord entity>pos world>tile
@@ -149,7 +164,7 @@ defer on-gord-sit
 : ;touch [ ' touch-last , ' [ , ] ; immediate
 
 : check-player-touch ( x y -- b )
-  touch-begin entity-at dup if EVTOUCH entity>do 1 then
+  touch-begin touchable-entity-at dup if EVTOUCH entity>do 1 then
   touch-next touch-override
   touch-next rexx-touch
   touch-next do-gord-sit
@@ -162,14 +177,6 @@ defer on-gord-sit
 : follow ( e -- )
   Jaye entity>pos <rot entity.pos! NODIR player.prevdir ! ;
 
-: check-entity-touch
-  touch-begin entity-at
-  touch-next out-of-bounds
-  touch-next WALKABLE mapflag? ;touch
-
-: try-move-entity ( e -- )
-  dup entity-dst check-entity-touch not if move-entity then ;
-
 var q-level
 : queue-level q-level ! ; userword
 
@@ -192,18 +199,20 @@ var q-level
 ( S T U F F )
 defer reset-level userword
 
+67 const ^F9
+
 : mode-move
   player-tick
+  ^F9 key-pressed if
+    boss
+    unfuck invalidate-map reloadtiles reloadportraits load-footer
+  then
 
   ticking-objects @ if
     ticking-objects @ links
     each dup obj-entity EVTICK entity>do more
   then
 
-( entities each EVTICK entity>do more
-  party each EVTICK entity>do more
-  Neut EVTICK entity>do )
-
   DEV if tick-mapedit jiles then
   tick-debounce
 
@@ -219,11 +228,6 @@ defer reset-level userword
   r@ entity.dir @ <r entity>sprite
   sprite-bob draw-sprite ;
 
-0 const rubber-on?
-: rubber rubber-on? not ' rubber-on? redefine ;
-: {tileent} rubber-on? if {duck} else {blank} then ;
-: visible-objects@ rubber-on? if objects else visible-objects then @ ;
-
 var glitchlevel
 var quaking
 
@@ -259,7 +263,7 @@ var defining-objects-ptr
 does>
   dup @ objects !
   dup cell + @ ticking-objects !
-  dup 2 cells + @ visible-objects ! ;
+  2 cells + @ visible-objects ! ;
 
 : obj-link-head! ( index -- )
   cells defining-objects-ptr @ + defining-objects-head @ swap ! ;

jorth.c

@@ -65,6 +65,10 @@ void f_here_set() {
   HERE = TOP().p;
   DROP(1);
 }
+void f_there() {
+  PUSHCP(&mem[MEM_SIZE]);
+}
+
 void f_latest() {
   PUSHCP(LATEST);
 }
@@ -1104,6 +1108,7 @@ void f_init(char *exe) {
   CDEF("new-word", f_create);
   CDEF("here", f_here);
   CDEF("here!", f_here_set);
+  CDEF("there", f_there);
   CDEF("latest", f_latest);
   CDEF("latest!", f_latest_set);
   CDEF("tasks", f_tasks);

jorth.h

@@ -1,7 +1,7 @@
 
 #include <stdio.h>
 
-#define MEM_SIZE 28762
+#define MEM_SIZE 32768
 #define STACK_SIZE 64
 #define RSTACK_SIZE 64
 

lev00006.jor

@@ -1,5 +1,4 @@
 ( L E V E L 0 0 0 0 6 )
-
 objects: O
 
 2 const ^1
@@ -21,6 +20,7 @@ objects: O
     2 code-digit
     3 code-digit ;
 
+var has-libb
 var pady-introduced
 : keypad-code responder entity.user cell + @ ;
 : keypad create-extra-linked-object
@@ -31,22 +31,41 @@ var pady-introduced
 	 pady say" You didn't say the magic\word, stranger!"
 	 1 pady-introduced !
        then
-       isneut? if move-player then
-       PAD-OFF responder>tile? if
-	 runon pady say" Enter your 4-digit door code!\And have a super day!"
-	 read-code keypad-code = if
-	   pady say" That's right! Hooray!\You get a gold star!"
-	   drop EVACT
-	 else
-	   pady say" Ohhh, sorry! That's not it.\Better luck next time!"
+       isneut? if
+	 move-player
+	 PAD-OFF responder>tile? if
+	   pady say" Oh hi there, suspicious\program! What can I do\you for?"
+	   has-libb @ if
+	     libb say" oh puke. please shut up."
+	     runon pady say" How rud"
+	     libb say" > /winnuke 182.556.21.74"
+	     pady say" PADYSEC caused a General\Protection Fault in module\MORICON.DLL at 000A:BE3F."
+	     libb say" > /open"
+	     drop EVACT
+	   else
+	     neut say" PEOPLE ARE IN DANGER\PLEASE OPEN THE DOOR"
+	     pady say" Well that's terrible!\But I just can't open\without the proper code."
+	   then
 	 then
        else
-	 pady say" Oh hi again! I missed you too!"
+	 PAD-OFF responder>tile? if
+	   runon pady say" Enter your 4-digit door code!\And have a super day!"
+	   read-code keypad-code = if
+	     pady say" That's right! Hooray!\You get a gold star!"
+	     drop EVACT
+	   else
+	     pady say" Ohhh, sorry! That's not it.\Better luck next time!"
+	   then
+	 else
+	   pady say" Oh hi again! I missed you too!"
+	 then
        then
      then
      dup PAD-ON PAD-OFF handle-onoff
      PAD-ON handle-link |; listener! ;
 
+18 1 defrexx r1
+
 3 1 door d1
 17 1 door d2
 4 11 door d3
@@ -76,12 +95,17 @@ defer cmp-next-on
 
 c1 :noname dup chain-listener EVACT = if
   term say" .:: welcome to farquaad ::.\please select your choice:"
-  :| s" about farquaad" :| term say" farquaad runs ms-dos 9:\the lOSt DOS" |; yield
-     s" s3cr3t c0d3z" :| term say" get out lamer" |; yield
-     s" wake bill" :| c4 EVACT entity>do term say" your wish is my command" |; yield
-     s" open pod bay doors" :| term say" i can't do that dave" |; yield
-     s" boss key" :| term say" press f12 to activate\at any time" |; yield
-     done |; choose
+  0 begin :|
+    s" about farquaad" :|
+       term say" os: ms-dos 9\ram: 8 freakin megabytes d00d\sysadmin: bill"
+       term say" don't mess with it!!!"
+     |; yield
+    s" s3cr3t c0d3z" :| term say" get out lamer" |; yield
+    s" boss key" :| term say" press f9 to activate" |; yield
+    s" open pod bay doors" :| term say" i can't do that dave" |; yield
+    s" log off" :| term say" good riddance" drop 1 |; yield
+    done |; choose
+  dup until drop
 then ;
 
 c2 :noname dup chain-listener EVACT = if
@@ -104,10 +128,13 @@ c3 :noname dup chain-listener EVACT = if
   term say" Subject: re: RE: Server's down\AUGH FINE I rebooted it."
 then ;
 
-var libb-intro
-c4 :noname dup EVTOUCH = if isneut? if
-  libb-intro @ not if
-    1 libb-intro !
+c4 :noname
+  dup EVACT = if
+    term say" bill's workstation\keep out dipshits"
+  then
+  dup EVTOUCH = if isneut? if
+  has-libb @ not if
+    1 has-libb !
     libb say" well, well, well.\what have we here?"
     libb say" > /version"
     neut say" < NEUT v0.71.4rc12"
@@ -141,6 +168,15 @@ c5 :noname dup chain-listener EVACT = if
   gord say" There's a sticky note attached\to the monitor that says\'7777'."
 then ;
 
+c6 :noname dup chain-listener EVACT = if
+  term say" Subject: Experiment\Hey folks, can you all do me a\huge favour?"
+  term say" There was a small bug in my\code (yes, it happens!) and a\program I was working on"
+  term say" made a few too many copies of\itself. Can everyone check to\see if you have a process"
+  term say" called 'LIBB' running on your\terminal?"
+  term say" If you do, please kill -9 it\and shoot me a quick email.\DON'T INTERACT WITH IT."
+  term say" It could seriously mess with\your system.\  -- Bill"
+then ;
+
 c7 :noname dup chain-listener EVTOUCH = if isprog? not if
   term say" WorkSecure (tm) v2.0\AUTHORIZED PERSONNEL ONLY"
   term say" Actively neutralizing:\1 threat(s)"
@@ -148,13 +184,11 @@ then then ;
 
 5197 ' d1 3 2 keypad k1
 -1 ' d2 17 2 keypad k2 ( must be hacked )
-3456 ' d3 4 10 keypad k3
+2757 ' d3 4 10 keypad k3
 7777 ' d5 16 10 keypad k5
 
 ' c7 19 11 switch b1
 
-18 1 defrexx r1
-
 LEV_END 13 12 exitdoor dx
 ' dx 14 12 scanner sx
 

map.jor

@@ -8,21 +8,22 @@ var tileselect
 1 const WALKABLE
 2 const NEUTABLE
 4 const RUBBLE
+8 const ENTITY
 
 array tileflags
 ( 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,
+( 4: comp-off )        ENTITY b,
+( 5: comp-on )         NEUTABLE ENTITY | 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,
+( 9: door-close )      ENTITY b,
+( 10:door-open )       WALKABLE ENTITY | b,
+( 11:switch-off )      NEUTABLE ENTITY | b,
+( 12:switch-on )       NEUTABLE ENTITY | b,
 ( 13:window )          0 b,
 ( 14:chair-brok )      RUBBLE b,
 ( 15:bookcase )        0 b,
@@ -30,12 +31,12 @@ array tileflags
 ( 17:scattered books ) WALKABLE RUBBLE | b,
 ( 18:plant )           0 b,
 ( 19:tipped plant )    RUBBLE b,
-( 20:scanner-off )     NEUTABLE b,
-( 21:scanner-on )      NEUTABLE b,
+( 20:scanner-off )     NEUTABLE ENTITY | b,
+( 21:scanner-on )      NEUTABLE ENTITY | b,
 ( 22:cracked-wall )    0 b,
-( 23:rexx-pod )        NEUTABLE b,
-( 24:keypad-off )      NEUTABLE b,
-( 25:keypad-on )       NEUTABLE b,
+( 23:rexx-pod )        NEUTABLE ENTITY | b,
+( 24:keypad-off )      NEUTABLE ENTITY | b,
+( 25:keypad-on )       NEUTABLE ENTITY | b,
 
 here tileflags - 1 - const MAXTILE
 
@@ -60,8 +61,6 @@ here tileflags - 1 - const MAXTILE
   ^< key-pressed if 1 - then
   ^> key-pressed if 1 + then
   0 max MAXTILE min
-(  dup 0 < if drop MAXTILE then
-  dup MAXTILE > if drop 0 then )
   tileselect !
 
   MOUSEL mousedown if tileselect @ mousetile tile b! invalidate-map then

testbed.c

@@ -173,13 +173,22 @@ void f_reloadportraits() {
   blitMemToVid(OFF_PORTRAITS, portraits, PORTRAIT_STRIDE >> 2, NUM_PORTRAITS);
 }
 
-void shownag() {
+void showtextscreen(char* filename) {
   FILE *f;
   vid_cleanup();
-  f = fopen("NEUTNAG.BIN", "rb");
+  f = fopen(filename, "rb");
   freadfar(f, MK_FP(0xb800, 0), 4000);
   gotoxy(1, 24);
 }
+void shownag() {
+  showtextscreen("NEUTNAG.BIN");
+}
+
+void f_showboss() {
+  showtextscreen("BOSSKEY.BIN");
+  kbd_wait();
+  setEGAMode();
+}
 
 void game_init() {
   FILE *f;
@@ -709,6 +718,7 @@ void game_f_init(char *exe, char *bootjor) {
   CDEF("unfuck", tile_init);
   CDEF("load-footer", f_load_footer);
   CDEF("fuck", f_resetvideo);
+  CDEF("boss", f_showboss);
 
   CDEF("mouseshow", f_mouseshow);
   CDEF("mousehide", f_mousehide);