honeylisp/neuttower/level6.fnl

(local {: deflevel : say : say-runon : itile : controlstate} (require :neuttower.defs))
(local {: ev} (require :neuttower.entity))
(local tile (require :game.tiles))
(local {: walkable : neutable : debris : sittable} (tile.flag-to-bit))
(local level (deflevel 6 :level6))
(local vm level.vm)

(vm:word :linkloop ; e -- e
  (vm:until :link-arg :dup :entity-itile (itile :termon) :=))

(vm:var :encountered-keypad vm.false)
(vm:word :first-keypad ; ev code --
  (vm:if-and [[:encountered-keypad :get :not] [:is-jaye?] [:over ev.touch :=]]
    [vm.true :encountered-keypad :set
     (say :pady "HELLO, STRANGER! I'M PADY," "THE FRIENDLY KEYPAD LOCK!")
     (say :jaye "I NEED TO GET THROUGH THIS" "DOOR, PADY.")
     (say :pady "YOU DIDN'T SAY THE MAGIC" "WORD, STRANGER!")])
  (vm:if-and [[:is-neut?] [:over ev.touch :=] [:responder-itile (itile :t-keyoff) :=]]
    [(say :pady "OH HI THERE, SUSPICIOUS" "PROGRAM! WHAT CAN I DO" "YOU FOR?")
     (say :neut "PEOPLE ARE IN DANGER" "PLEASE OPEN THE DOOR")
     (say :pady "WELL THAT'S TERRIBLE!" "BUT I JUST CAN'T OPEN" "WITHOUT THE PROPER CODE.")
     :libb-present :get (vm:when (say :libb "OH JEEZ, LET ME AT HER, NEUT."))])
  (vm:if-and [[:responder-itile (itile :t-keyoff) :=] [:over :evhack?]]
    [(say :pady "ANOTHER STRANGE PROGRAM!" "MY, I'M POPULAR TODAY!")
     (say :libb "OH PUKE. PLEASE SHUT UP.")
     (say-runon :pady "HOW RUD")
     :snd-libb
     (say :libb "]/WINNUKE 182.556.21.74")
     (say :pady "PADYSEC CAUSED A GENERAL" "PROTECTION FAULT IN MODULE" "MORICON.DLL AT 000A:BE3F.")
     (say :libb "]/OPEN")])
  :keypad)

(vm:word :keypad1 0x5197 :first-keypad)
(vm:word :keypad2 0x2757 :first-keypad)
(vm:word :keypad3 0xffff :first-keypad)
(vm:word :keypad4 0x7777 :first-keypad)

(vm:word :term-message? :dup :term ev.touch := :is-jaye? :&)
(vm:word :c1
  :dup :evhack? (vm:when
    (say :libb "JUST A BUNCH OF BORING" "SOURCE CODE.")
    (say :libb "BILL DIDN'T LEAVE ANYTHING" "REALLY JUICY HERE WHERE" "OTHER PEOPLE COULD GET AT IT."))
  :term-message? (vm:when
  (say :term ".:: WELCOME TO FARQUAAD ::." "OS: PRODOS 2.6" "RAM: 8 FREAKIN MEGABYTES D00D" "SYSADMIN: BILL")
  (say :term "S3CR3T C0D3Z: GET OUT LAMER" "BOSS KEY: CTRL-B TO ACTIVATE" "OPEN POD BAY DOORS:" "  I CAN'T DO THAT DAVE")
  (say :term "GOOD RIDDANCE")))
(vm:word :c2 :term-message? (vm:when
  (say :term "SUBJECT: MISUSE OF REXX" "THANKS TO *SOME*ONE, WHO SHALL" "REMAIN NAMELESS, THAT DECIDED" "IT WOULD BE 'FUNNY' TO")
  (say :term "TEACH THE CLEANING ROBOT TO" "PLAY FETCH WITH EXPENSIVE" "EQUIPMENT, ACCESS TO REXX" "BY DEVELOPERS WILL BE STRICTLY")
  (say :term "CONTROLLED BY MANAGEMENT." "THE CODE HAS BEEN CHANGED." "DO NOT ATTEMPT TO HACK THE" "KEYPAD. THIS MEANS *YOU*, BILL.")))
(vm:word :c3 :term-message? (vm:when
  (say :term "SUBJECT: SERVER'S DOWN" "HEY, I DON'T HAVE THE CODE TO" "ACCESS THE SERVER ROOM. CAN" "SOMEONE REBOOT IT FOR ME?")
  (say :term "SUBJECT: RE: SERVER'S DOWN" "I DON'T HAVE *TIME* FOR THIS" "NONSENSE!!" "REBOOT IT YOURSELF.")
  :lit :firewall :entity-itile (itile :termon) := (vm:if
    [(say :term "THE PASSCODE IS" "[ BLOCKED BY FIREWALL ].")]
    [(say :term "THE PASSCODE IS" "5197.")])
  (say :term "SUBJECT: RE: RE: SERVER'S DOWN" "UHHHH THE FIREWALL IS BLOCKING" "THE PASSCODE?")
  (say :term "SUBJECT: RE: RE: SERVER'S DOWN" "AUGH FINE! I REBOOTED IT.")))
(vm:word :c4
  :dup :evhack? (vm:when
    (say :libb "I BROUGHT EVERYTHING GOOD" "ALONG WITH ME, DON'T WORRY."))
  (vm:if-and [[:dup ev.touch :=] [:is-neut?] [:libb-present :get :not]]
    [(say :libb "WELL, WELL, WELL." "WHAT HAVE WE HERE?")
     (say :libb "]/VERSION")
     (say :neut "!NEUT V0.71.4RC12")
     (say :neut "]BRUN IDENTIFYPROGRAM")
     (say :libb "!LIBB V2.718282")
     (say :libb "OH, A NOSY LITTLE FELLA.")
     (say :neut "NOT A FELLA")
     (say :libb "PERHAPS YOU AND I COULD" "HELP EACH OTHER.")
     (say :neut "WE ARE ASSISTING ALL WHO" "ARE IN NEED")
     (say :libb "I'VE BEEN WATCHING THE" "NETWORK. IT'S KIND OF WHAT" "I DO.")
     (say :libb "YOU AND YOUR PROGRAMMER," "YOU'RE ESCAPING, AREN'T" "YOU?")
     (say :neut "THE BUILDING IS UNSAFE" "WE ARE HELPING")
     (say :libb "I WANT OUT, NEUT.")
     (say :libb "I HATE BEING COOPED UP IN" "THIS LOCKED-DOWN CORPORATE" "HELLHOLE OF A NETWORK.")
     (say :libb "YOU'RE GOING TO TAKE ME" "WITH YOU.")
     (say :neut "THIS COURSE OF ACTION" "ALSO SEEMS POTENTIALLY" "UNSAFE")
     (say :libb "THAT WASN'T A THREAT, NEUT." "THAT WAS A FACT.")
     (say :libb "YOU CAN'T GET OUT OF HERE" "WITHOUT ME.")
     (say :libb "I CAN DISABLE KEYPADS." "I CAN REPROGRAM TERMINALS." "I CAN *HELP*, NEUT.")
     :hide-footer 0x800 :snooze
     (say :neut "IT NEVER HURTS TO HELP")
     (say :libb "THAT'S THE SPIRIT.")
     (say :neut "]BLOAD LIBB")
     (say :libb "AWW YISS.")
     (say :libb "PRESS Z WHEN YOU NEED ME" "TO MESS WITH SOMETHING.")
     vm.true :libb-present :set])
  :term-message? (vm:when
    (say :term ".:: BILL'S WORKSTATION ::." "KEEP OUT DIPSHITS")))
(vm:word :c5 :term-message? (vm:when
  (say :gord "A WEIRD LOOKING SPREADSHEET...")
  (say :gord "OH WAIT, I PRESSED A KEY AND" "IT DISAPPEARED. SOMEONE USING" "THE BOSS KEY TO HIDE" "THAT THEY'RE READING THE ENTIRE")
  (say :gord "ARCHIVE OF USER FRIENDLY" "COMIC STRIPS.")))
(vm:word :c6
  :dup :evhack? (vm:when
    (say :libb "HEHEHE, THAT WAS A FUN ONE."))
  :term-message? (vm:when
  (say :term "SUBJECT: CARD SCANNERS?" "LOOKS LIKE THE SCANNERS ARE" "ON THE FRITZ AGAIN..." "I SCANNED MY KEYCARD TO GET")
  (say :term "INTO THE OFFICE AND THE DOOR" "WOULDN'T CLOSE!" "SOMEONE'S GOTTA FIX THAT ASAP," "IT'S A SERIOUS SECURITY PROBLEM!")
  (say :term "SUBJECT: RE: CARD SCANNERS?" "I CAN TAKE A QUICK LOOK, I" "MIGHT HAVE AN IDEA AS TO" "WHAT'S GOING ON. -- BILL")))
(vm:word :c7
  :dup :evhack? (vm:when
    (say :libb "YOU KNOW THE SWITCH IS RIGHT" "THERE ON THE WALL, RIGHT?"))
  (vm:if-and [[:dup ev.touch :=] [:is-jaye?]]
    [:responder-itile (itile :termon) := (vm:if
       [(say :term "WORKSECURE (TM) V2.0" "AUTHORIZED PERSONNEL ONLY")
        (say :term "ACTIVELY NEUTRALIZING:" "1 THREAT(S)")]
       [(say :jaye "LOOKS LIKE THE POWER IS CUT.")])
     :drop ev.noop]) :term)
(vm:word :c8 :term-message? (vm:when
  (say :term "SUBJECT: PASSWORD SECURITY" "A REMINDER TO ALL DEVELOPERS" "ABOUT SECURITY BEST PRACTICE:" "**DO NOT WRITE DOWN PASSWORDS!**")
  (say :term "WE PAY SIGNIFICANT LICENSE FEES" "FOR ENCRYPTED PASSWORD" "MANAGERS FOR ALL EMPLOYEES!")
  (say :term "USE IT TO GENERATE AND STORE" "SECURE PASSWORDS!")
  (say :jaye "THERE'S A STICKY NOTE ATTACHED" "TO THE MONITOR THAT SAYS" "'7777'.")))
(vm:word :c9
  :dup :evhack? (vm:when
    (say :libb "HE'S JUST BEING DRAMATIC."))
  :term-message? (vm:when
  (say :term "SUBJECT: EXPERIMENT" "HEY FOLKS, CAN YOU ALL DO ME A" "HUGE FAVOUR?" "THERE WAS A SMALL BUG IN MY")
  (say :term "CODE (YES, IT HAPPENS!) AND A" "PROGRAM I WAS WORKING ON" "MADE A FEW TOO MANY COPIES OF" "ITSELF. CAN EVERYONE CHECK TO")
  (say :term "SEE IF YOU HAVE A PROCESS" "CALLED 'LIBB' RUNNING ON YOUR" "TERMINAL?")
  (say :term "IF YOU DO, PLEASE KILL -9 IT" "AND SHOOT ME A QUICK EMAIL." "*DON'T INTERACT WITH IT.*")
  (say :term "IT COULD SERIOUSLY MESS WITH" "YOUR SYSTEM." "  -- BILL")))
(vm:word :cx
  (vm:if-and [[:dup ev.touch :=] [:is-jaye?] [:responder-itile (itile :termoff) :=]]
    [(say :jaye "THIS IS THE SIGN-IN TERMINAL" "USED BY VISITORS.")
     (say :jaye "IT'S NOT TURNING ON FOR SOME" "REASON.")
     :drop ev.noop]) :term)

(fn center [str lineaddr]
  [:vm (vm:str str) (+ lineaddr (math.floor (/ (- 40 (length str)) 2))) :draw-text])
(vm:word :endgame :drop
  (vm:pstr "ELEVATOR.SCREEN") :loadscreen
  (vm:until :read-key)
  0x2280 :clearline 0x2300 :clearline 0x2380 :clearline
  0x2028 :clearline 0x20a8 :clearline 0x2128 :clearline
  0x21a8 :clearline 0x2228 :clearline 0x22a8 :clearline
  0x2328 :clearline 0x23a8 :clearline 0x2050 :clearline

  (center "JAYE AND GORD HAVE FOUND THEIR WAY" 0x2300)
  (center "TO THE ELEVATOR!" 0x2380)
  (center "BUT HAVE THEY FOUND THEIR WAY" 0x2028)
  (center "TO FREEDOM?" 0x20a8)
  (center "ARE THERE OTHERS IN THE BUILDING" 0x2128)
  (center "IN NEED OF HELP?" 0x21a8)
  (center "AND WHAT FATE AWAITS NEUT AND THEIR" 0x2228)
  (center "SHIFTY NEW FRIEND LIBB?" 0x22a8)
  (center "TO BE CONTINUED..." 0x23a8)
  (vm:until :read-key)

  :cleargfx
  (center "NEU] [OWER" 0x2300)
  (center "BY JEREMY PENNER" 0x2380)

  (center "EVERY BYTE OF THIS GAME WAS CREATED" 0x20a8)
  (center "WITH LOVE USING THE HONEYLISP" 0x2128)
  (center "PROGRAMMING ENVIRONMENT" 0x21a8)

  (center "GREETS TO:" 0x22a8)
  (center "GLORIOUS TRAINWRECKS" 0x2328)
  (center "DIRTY RECTANGLES" 0x23a8)
  (center "#FENNEL" 0x2050)
  (center "KANSASFEST" 0x20d0)

  (center "APPLE ][ FOREVER!" 0x21d0)
  (vm:forever))

level