neuttower/lev00006.jor

( L E V E L 0 0 0 0 6 )

objects: O

2 const ^1
30 const code-y
20 const code-x

: wait-for-digit ( -- n )
  0 begin suspend ^1 dup 11 + for i key-pressed if drop i then next dup until
  ^1 - 1 + dup 10 = if drop 0 then ;
: draw-digit ( x n -- ) code-y swap 48 + text-color @ textc ;
: code-digit ( code x -- code )
  wait-for-digit swap code-x + over draw-digit swap 10 * + ;

: read-code ( -- n )
  WHITE text-color !
  s" ####" code-x code-y textxy
  0 0 code-digit
    1 code-digit
    2 code-digit
    3 code-digit ;

var pady-introduced
: keypad-code responder entity.user cell + @ ;
: keypad create-extra-linked-object
  :| dup EVTOUCH = 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."
	 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!"
	 then
       else
	 pady say" Oh hi again! I missed you too!"
       then
     then
     dup PAD-ON PAD-OFF handle-onoff
     PAD-ON handle-link |; listener! ;

3 1 door d1
17 1 door d2
4 11 door d3
10 9 door d4
16 11 door d5
defer term-loop
' term-loop 2 1 computer c1
' term-loop 2 3 computer c2
' term-loop 2 6 computer c3
' term-loop 2 10 computer c4
' term-loop 18 3 computer c5
' term-loop 18 6 computer c6
' term-loop 18 9 computer c7
' term-loop 8 6 computer c8
' term-loop 12 6 computer c9

: 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 ;
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 ;
:noname responder next-on ; ' term-loop redefine

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
then ;

c2 :noname dup chain-listener EVACT = if
  term say" Subject: Misuse of Rexx\Thanks to SOMEone, who shall\remain nameless, that decided"
  term say" that it would be 'funny' to\teach the cleaning robot to\play fetch with expensive"
  term say" equipment, access to Rexx\by developers will be strictly\controlled by management."
  term say" The code has been changed.\Do not attempt to hack the\keypad. This means YOU, Bill."
then ;

c3 :noname dup chain-listener EVACT = if
  term say" Subject: Server's down\Hey, I don't have the code to\access the server room. Can"
  term say" someone reboot it for me?"
  term say" Subject: RE: Server's down\I don't have TIME for this\nonsense!! Reboot it yourself."
  c7 computer-on? if
    term say" The passcode is\[ BLOCKED BY FIREWALL ]."
  else
    term say" The passcode is 5197."
  then
  term say" Subject: re: RE: Server's down\Uhhh the firewall blocked\the passcode?"
  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 !
    libb say" well, well, well.\what have we here?"
    libb say" > /version"
    neut say" < NEUT v0.71.4rc12"
    neut say" > IDENTIFY_PROGRAM.EXE"
    libb say" < libb v2.718282"
    libb say" oh, a nosy little fella."
    neut say" NOT A FELLA."
    libb say" perhaps you and i could\help each other."
    neut say" WE ARE ASSISTING ALL WHO\ARE IN NEED."
    libb say" i've been watching the\network. it's kind of what\i do."
    libb say" you and your programmer,\you're escaping, aren't\you?"
    neut say" THE BUILDING IS UNSAFE.\WE ARE HELPING."
    libb say" i want out, neut."
    libb say" i hate being cooped up in\this locked-down corporate\hellhole of a network."
    libb say" you're going to take me\with you."
    neut say" THIS COURSE OF ACTION\ALSO SEEMS POTENTIALLY\UNSAFE."
    libb say" that wasn't a threat, neut.\that was a fact."
    libb say" you can't get out of here\without me."
    libb say" i can disable keypads.\i can reprogram terminals.\i can HELP, neut."
    hide-footer 10 sleep
    neut say" IT NEVER HURTS TO HELP."
    libb say" that's the spirit."
    neut say" > UPLOAD.EXE /LIBB"
  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 ;

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)"
then then ;

5197 ' d1 3 2 keypad k1
-1 ' d2 17 2 keypad k2 ( must be hacked )
3456 ' 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

:noname O
  5 1 tile>world Jaye entity.pos!
  4 0 tile>world Neut entity.pos!
  with-gord
; ' onload redefine