finish up level 6, implement libb hack key

entity.jor

@@ -5,6 +5,7 @@
  3 const EVACT
  4 const EVDEACT
  5 const EVTOG
+ 6 const EVHACK
 
 : world>tile 4 >> swap 4 >> swap ; userword
 : tile>world 4 << swap 4 << swap ; userword
@@ -104,9 +105,10 @@ array frames
 2 3 2 5 defanim {jaye-walk}
 4 defstatic {duck}
 13 14 2 5 defmulti {neut}
+19 20 2 5 defmulti {libb}
 5 defstatic {rexx}
 
 : sprite-bob ( x y sprindex -- x y sprindex )
-  dup 13 >= over 18 <= and if
+  dup 13 >= over 20 <= and if
     >rot 2dup + ticks + 40 % 20 < if 1 + then <rot
   then ;

game.jor

@@ -25,6 +25,7 @@ var player.prevdir
 8 const HASGORD userword
 16 const ISPROG userword
 32 const GORDSIT userword
+64 const HASLIBB userword
 
 1 player.state HASNEUT f!
 
@@ -37,6 +38,7 @@ var posessed-rexx
 : isjaye? isprog? not ; userword
 : isrexx? isprog? posessed-rexx @ and ; userword
 : gord-follow? player.state HASGORD f@ ;
+: haslibb? player.state HASLIBB f@ ;
 
 : {jaye}
   isjaye? player.state MOVING f@ and
@@ -56,8 +58,10 @@ var posessed-rexx
 14 9 N ' {jaye} defentity Jaye
 17 5 N ' {neut} defentity Neut
 -10 -10 N ' {gord} defentity Gord
+-10 -10 N ' {libb} defentity Libb
 
-: gord-present? Gord entity>pos drop 0 >= ;
+: entity-present? entity>pos drop 0 >= ;
+: gord-present? Gord entity-present? ;
 
 : player
   isrexx? if posessed-rexx @ else
@@ -152,19 +156,39 @@ defer on-gord-sit
   dir>pos +pos touchable-entity-at EVTOUCH entity>do ;
 
 : activate-gord
-  Gord entity>pos world>tile
-  2dup N activate-dir
-  2dup S activate-dir
-  2dup E activate-dir
-       W activate-dir ;
+  player.state GORDSIT f@ if
+    :| Gord entity>pos world>tile
+       2dup N activate-dir
+       2dup S activate-dir
+       2dup E activate-dir
+	    W activate-dir |; sched
+  then ;
+var hack-handled
+: hacked 1 hack-handled ! ;
+: activate-libb
+  haslibb? if Libb entity-present? not if
+    :| 0 hack-handled !
+       Neut entity>pos world>tile touchable-entity-at EVHACK entity>do
+       hack-handled @ not if
+	 libb say" don't think i can hack that."
+       then |; sched
+  then then ;
 
 : touch-begin each 2dup more >rot drop drop ;
 : touch-next dup if rdrop done then drop rswap ;
 : touch-last ' done , ; immediate
 : ;touch [ ' touch-last , ' [ , ] ; immediate
 
+: neut-touch-libb ( x y -- b )
+  Libb entity>pos world>tile 2= isneut? and if
+    move-player
+    -100 -100 Libb entity.pos!
+    1
+  else 0 then ;
+
 : check-player-touch ( x y -- b )
-  touch-begin touchable-entity-at dup if EVTOUCH entity>do 1 then
+  touch-begin neut-touch-libb
+  touch-next touchable-entity-at dup if EVTOUCH entity>do 1 then
   touch-next touch-override
   touch-next rexx-touch
   touch-next do-gord-sit
@@ -185,11 +209,9 @@ var q-level
     player.state ISPROG fnot!
     isprog? if prog-view else human-view then
   then then
-  ^Z key-pressed if player.state GORDSIT f@ if
-    :| isprog? 0 player.state ISPROG f!
-       activate-gord
-       player.state ISPROG f! |; sched
-  then then
+  ^Z key-pressed if
+    isprog? if activate-libb else activate-gord 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
   ^UP key-down if drop 1 N player entity.dir ! then
@@ -201,12 +223,16 @@ defer reset-level userword
 
 67 const ^F9
 
+: boss-tick
+  ^F9 key-pressed if
+    ticks boss
+    unfuck invalidate-map reloadtiles reloadportraits
+    ticks!
+  then ;
+
 : mode-move
   player-tick
-  ^F9 key-pressed if
-    boss
-    unfuck invalidate-map reloadtiles reloadportraits load-footer
-  then
+  boss-tick
 
   ticking-objects @ if
     ticking-objects @ links
@@ -223,6 +249,8 @@ defer reset-level userword
     party each follow more
   else drop then ;
 
+: mode-wait tick-debounce boss-tick ;
+
 : draw-entity
   >r r@ entity.x @ r@ entity.y @
   r@ entity.dir @ <r entity>sprite
@@ -243,6 +271,7 @@ var quaking
   party each dup Jaye != if draw-entity else drop then more
   Jaye draw-entity
   player.state HASNEUT f@ if Neut draw-entity then
+  Libb entity-present? if Libb draw-entity then
   visible-objects@ if
     visible-objects@ links each dup obj-entity draw-entity more
   then
@@ -322,9 +351,11 @@ does>
   :| dup door-listener entering-door? if
     gord-follow? not gord-present? and if
       jaye say" I'm not leaving Gord behind."
+    else Libb entity-present? if
+      neut say" I SHOULD PROBABLY RETRIEVE\LIBB."
     else
       responder entity.user @ queue-level
-    then
+    then then
   then |; listener! ;
 
 : statechange? ( ev -- b )
@@ -363,6 +394,7 @@ does>
      then then |; listener! ;
 
 : computer-on? ( entity -- b ) COMP-ON entity>tile? ;
+: switch-on? ( entity -- b ) SWITCH-ON entity>tile? ;
 
 : handle-teleport ( ev -- )
   EVTOUCH = isneut? and COMP-ON responder>tile? and if
@@ -375,6 +407,7 @@ does>
 : computer blankentity swap , dup link-object
   :| dup EVTOUCH = isjaye? and if responder EVACT entity>do then
      dup EVTOUCH = isneut? and COMP-ON responder>tile? and if move-player then
+     dup EVHACK = if hacked libb say" nothing interesting on this one." then
      dup COMP-ON COMP-OFF handle-onoff
      handle-teleport |; listener! ;
 
@@ -383,7 +416,16 @@ does>
        move-player
        responder EVACT entity>do
      then
-     dup EVUNTOUCH = isneut? and if responder EVDEACT entity>do then
+     dup EVHACK = if
+       libb say" that's easy."
+       responder entity>pos Libb entity.pos!
+       hacked
+     then
+     dup EVUNTOUCH = isneut? and if
+       Libb entity>pos responder entity>pos 2= not if
+	 responder EVDEACT entity>do
+       then
+     then
      dup SCAN-ON SCAN-OFF handle-onoff
      SCAN-ON handle-link |; listener! ;
 
@@ -406,6 +448,7 @@ does>
 : cancel-ev ( ev -- EVNOP ) drop EVNOP ;
 
 : with-gord Gord follow 1 player.state HASGORD f! ;
+: with-libb 1 player.state HASLIBB f! ;
 
 Gord :noname
   dup EVTOUCH = isjaye? and gord-follow? not and if
@@ -436,6 +479,6 @@ Gord @ const gord-listener
   :| Jaye yield
      gord-follow? if Gord yield then
      done |; ' party redefine
-  :| ' tick-debounce ' tick redefine |; ' any-job-started redefine
+  :| ' mode-wait ' tick redefine |; ' any-job-started redefine
   :| ' mode-move ' tick redefine hide-footer |; ' all-jobs-complete redefine
 ; ' onload redefine

lev00006.jor

@@ -20,11 +20,10 @@ 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
-  :| dup EVTOUCH = if
+  :| dup EVTOUCH = isrexx? not and if
        pady-introduced @ not if
 	 pady say" Hello, stranger! I'm Pady,\the friendly keypad lock!"
 	 jaye say" I need to get through this\door, Pady."
@@ -35,19 +34,13 @@ var pady-introduced
 	 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."
+	   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."
+	   haslibb? if
+	     libb say" oh jeez, let me at her, neut."
 	   then
 	 then
-       else
+       else isprog? not if
 	 PAD-OFF responder>tile? if
 	   runon pady say" Enter your 4-digit door code!\And have a super day!"
 	   read-code keypad-code = if
@@ -59,7 +52,16 @@ var pady-introduced
 	 else
 	   pady say" Oh hi again! I missed you too!"
 	 then
-       then
+       then then
+     then
+     dup EVHACK = if
+       pady say" Another strange program!\My, I'm popular today!"
+       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 hacked
      then
      dup PAD-ON PAD-OFF handle-onoff
      PAD-ON handle-link |; listener! ;
@@ -81,18 +83,33 @@ defer term-loop
 ' term-loop 18 9 computer c7
 ' term-loop 8 6 computer c8
 ' term-loop 12 6 computer c9
+' term-loop 14 11 computer cx
 
 : ret-if-on ( e -- ) dup computer-on? if rdrop else drop then ;
 : first-on ( -- e )
   c1 ret-if-on c2 ret-if-on c3 ret-if-on c4 ret-if-on c5 ret-if-on
-  c6 ret-if-on c7 ret-if-on c8 ret-if-on c9 ret-if-on 0 ;
+  c6 ret-if-on c7 ret-if-on c8 ret-if-on c9 ret-if-on cx ret-if-on 0 ;
 defer cmp-next-on
 : next-on ( e -- e )
   :| over = if drop ' ret-if-on ' cmp-next-on redefine then |; ' cmp-next-on redefine
   c1 cmp-next-on c2 cmp-next-on c3 cmp-next-on c4 cmp-next-on c5 cmp-next-on
-  c6 cmp-next-on c7 cmp-next-on c8 cmp-next-on c9 cmp-next-on first-on ;
+  c6 cmp-next-on c7 cmp-next-on c8 cmp-next-on c9 cmp-next-on cx cmp-next-on
+  first-on ;
 :noname responder next-on ; ' term-loop redefine
 
+5197 ' d1 3 2 keypad k1
+-1 ' d2 17 2 keypad k2 ( must be hacked )
+2757 ' d3 4 10 keypad k3
+7777 ' d5 16 10 keypad k5
+
+' cx 10 3 switch b1
+' c7 19 11 switch b2
+
+' d4 3 0 scanner s1
+
+LEV_END 13 12 exitdoor dx
+' dx 14 12 scanner sx
+
 c1 :noname dup chain-listener EVACT = if
   term say" .:: welcome to farquaad ::.\please select your choice:"
   0 begin :|
@@ -133,8 +150,8 @@ c4 :noname
     term say" bill's workstation\keep out dipshits"
   then
   dup EVTOUCH = if isneut? if
-  has-libb @ not if
-    1 has-libb !
+  haslibb? not if
+    with-libb
     libb say" well, well, well.\what have we here?"
     libb say" > /version"
     neut say" < NEUT v0.71.4rc12"
@@ -158,14 +175,13 @@ c4 :noname
     neut say" IT NEVER HURTS TO HELP."
     libb say" that's the spirit."
     neut say" > UPLOAD.EXE /LIBB"
+    libb say" aww yiss."
+    libb say" press z when you need me\to mess with something."
   then
 then then chain-listener ;
 
 c5 :noname dup chain-listener EVACT = if
-  term say" Subject: Password security\A reminder to all developers\about security best practice:"
-  term say" DO NOT WRITE DOWN PASSWORDS!\We pay significant license fees\for encrypted password"
-  term say" managers for all employees!\Use it to generate and store\secure passwords!"
-  gord say" There's a sticky note attached\to the monitor that says\'7777'."
+
 then ;
 
 c6 :noname dup chain-listener EVACT = if
@@ -182,15 +198,18 @@ c7 :noname dup chain-listener EVTOUCH = if isprog? not if
   term say" Actively neutralizing:\1 threat(s)"
 then then ;
 
-5197 ' d1 3 2 keypad k1
--1 ' d2 17 2 keypad k2 ( must be hacked )
-2757 ' d3 4 10 keypad k3
-7777 ' d5 16 10 keypad k5
+c8 :noname dup chain-listener EVACT = if
+  term say" Subject: Password security\A reminder to all developers\about security best practice:"
+  term say" DO NOT WRITE DOWN PASSWORDS!\We pay significant license fees\for encrypted password"
+  term say" managers for all employees!\Use it to generate and store\secure passwords!"
+  gord say" There's a sticky note attached\to the monitor that says\'7777'."
+then ;
 
-' c7 19 11 switch b1
-
-LEV_END 13 12 exitdoor dx
-' dx 14 12 scanner sx
+cx :noname dup EVTOUCH = if isprog? not if b1 switch-on? not if
+  jaye say" This is the sign-in terminal\used by visitors."
+  jaye say" It's not turning on for some\reason."
+  drop EVNOP
+then then then chain-listener ;
 
 :noname O
   5 1 tile>world Jaye entity.pos!

testbed.c

@@ -169,25 +169,40 @@ void f_load_footer() {
   fclose(f);
 }
 
+void copyVidmem(unsigned int from, unsigned int to, unsigned int count) {
+  unsigned int i;
+
+  setAllPlanes();
+  setWriteMode(1);
+
+  for (i = 0; i < count; i ++) {
+    VID[to] = VID[from];
+    to ++; from ++;
+  }
+}
+
 void f_reloadportraits() {
   blitMemToVid(OFF_PORTRAITS, portraits, PORTRAIT_STRIDE >> 2, NUM_PORTRAITS);
 }
 
 void showtextscreen(char* filename) {
   FILE *f;
-  vid_cleanup();
   f = fopen(filename, "rb");
   freadfar(f, MK_FP(0xb800, 0), 4000);
   gotoxy(1, 24);
 }
 void shownag() {
+  vid_cleanup();
   showtextscreen("NEUTNAG.BIN");
 }
 
 void f_showboss() {
+  copyVidmem(0, OFF_TILES, SIZE_FOOTER);
+  setMode(0083h)
   showtextscreen("BOSSKEY.BIN");
   kbd_wait();
-  setEGAMode();
+  setMode(008Dh)
+  copyVidmem(OFF_TILES, 0, SIZE_FOOTER);
 }
 
 void game_init() {
@@ -271,6 +286,10 @@ void f_scrollpos() { // ( -- x y )
 void f_ticks() {
   PUSHU(timer_counter);
 }
+void f_setticks() {
+  timer_counter = TOP().u;
+  DROP(1);
+}
 
 void f_splitscreen() {
   setSplitScreen(399 - (TOP().i << 1));
@@ -706,6 +725,7 @@ void game_f_init(char *exe, char *bootjor) {
   CDEF("draw-screen", drawScreen);
   CDEF("split-screen", f_splitscreen);
   CDEF("ticks", f_ticks);
+  CDEF("ticks!", f_setticks);
   CDEF("text", f_text);
   CDEF("textc", f_textc);
   CDEF("map", f_map);