path: root/test-subject/game.scm

(define-module (test-subject game)
  #:use-module (chickadee audio)
  #:use-module (chickadee graphics color)
  #:use-module (chickadee graphics font)
  #:use-module (chickadee graphics texture)
  #:use-module (chickadee graphics viewport)
  #:use-module (chickadee math vector)
  #:use-module (chickadee scripting)
  #:use-module (ice-9 match)
  #:use-module (oop goops)
  #:use-module (srfi srfi-1)
  #:use-module (starling asset)
  #:use-module (starling gui)
  #:use-module (starling kernel)
  #:use-module (starling node)
  #:use-module (starling node-2d)
  #:use-module (starling ring-buffer)
  #:use-module (starling scene)
  #:use-module (test-subject assets)
  #:use-module (test-subject device)
  #:use-module (test-subject text-box)
  #:duplicates (merge-generics replace warn-override-core warn last)
  #:export (launch-game))

(define window-width 1280)
(define window-height 720)
(define game-width 640)
(define game-height 360)
(define player-display-name "")

(define-theme gui-theme
  (<widget> (font monogram-font))
  (<button> (background dialog-box-texture)
            (press-background button-press-texture))
  (<text-box> (background dialog-box-texture)))

(define-class <game> (<gui-scene>)
  (state #:accessor state #:init-value #f)
  (first-playthrough? #:accessor first-playthrough? #:init-value #t)
  (subject-name-known? #:accessor subject-name-known? #:init-value #f)
  (has-fridge-key? #:accessor has-fridge-key? #:init-value #f)
  (opened-notebook? #:accessor opened-notebook? #:init-value #f)
  (door-conversation-done? #:accessor door-conversation-done? #:init-value #f)
  (window-conversation-done? #:accessor window-conversation-done? #:init-value #f)
  (friendship #:accessor friendship #:init-value 0)
  (cartridge #:accessor cartridge #:init-value 'in-fridge)
  (dialog-container #:accessor dialog-container)
  (click-channel #:accessor click-channel #:init-thunk make-channel)
  (terminal-locked? #:accessor terminal-locked? #:init-value #t)
  (terminal-channel #:accessor terminal-channel #:init-thunk make-channel)
  (terminal-lines #:accessor terminal-lines #:init-form (make-ring-buffer 17))
  (key-pad-locked? #:accessor key-pad-locked? #:init-value #t)
  (audio-source #:accessor audio-source #:init-thunk make-source))

(define-method (subject-name (game <game>))
  (if (subject-name-known? game)
      "The Wiremind"
      "??????"))

(define (play-click-sound)
  (audio-play (asset-ref click-sound)))

(define (play-key-press-sound)
  (audio-play (asset-ref key-press-sound)))

(define (play-device-sound)
  (audio-play (asset-ref device-sound)))

(define-method (reset-game (game <game>))
  (set! (subject-name-known? game) #f)
  (set! (has-fridge-key? game) #f)
  (set! (opened-notebook? game) #f)
  (set! (door-conversation-done? game) #f)
  (set! (window-conversation-done? game) #f)
  (set! (friendship game) 0)
  (set! (cartridge game) 'in-fridge)
  (set! (click-channel game) (make-channel))
  (set! (terminal-locked? game) #t)
  (set! (terminal-channel game) (make-channel))
  (set! (terminal-lines game) (make-ring-buffer 17))
  (set! (key-pad-locked? game) #t))

(define-method (reboot (game <game>))
  (reset-game game)
  (next-method))

(define-method (detach-all (game <game>))
  (for-each detach (children game)))

(define (run-on-left-click node proc)
  (lambda (widget button)
    (if (eq? button 'left)
        (begin
          (play-click-sound)
          (run-script node (proc))
          #t)
        #f)))

(define-method (dialog (game <game>) name line choices)
  (let ((old-state (state game))
        (c (dialog-container game)))
    (attach-to game c)
    (set! (text (& c name-margin name)) name)
    (set! (text-box-text (& c text-box)) line)
    (match choices
      (()
       (set! (state game) 'dialog)
       (channel-get (click-channel game))
       (play-click-sound)
       (detach c)
       (set! (state game) old-state)
       #t)
      ((_ ...)
       (set! (state game) 'dialog-choice)
       (let* ((choice-channel (make-channel))
              (choice-container
               (parameterize ((current-theme gui-theme))
                 (make <vertical-container>
                   #:name 'choices
                   #:rank 9
                   #:position (vec2 (/ game-width 4.0)
                                    76.0)
                   #:children
                   (map (match-lambda
                          ((str value)
                           (make <margin-container>
                             #:margin 2.0
                             #:children
                             (list (make <button>
                                     #:width (/ game-width 2.0)
                                     #:height 24.0
                                     #:text str
                                     #:listeners
                                     `((click . ,(run-on-left-click game
                                                                    (lambda ()
                                                                      (channel-put! choice-channel
                                                                                    value))))))))))
                        choices)))))
         (attach-to game choice-container)
         (let ((choice (channel-get choice-channel)))
           (play-click-sound)
           (detach choice-container)
           (detach c)
           (set! (state game) old-state)
           choice))))))

(define-method (dialog (game <game>) name line)
  (dialog game name line '()))

(define-method (increment-friendship (game <game>))
  (set! (friendship game) (+ (friendship game) 1)))

(define-method (splash (game <game>))
  (set! (state game) 'splash)
  (attach-to game
             (make <sprite>
               #:name 'intro-lightness
               #:texture lightness)
             (make <label>
               #:name 'intro-splash
               #:font monogram-font
               #:color black
               #:align 'center
               #:vertical-align 'center
               #:position (vec2 (/ game-width 2.0) (/ game-height 2.0))))
  (set! (text (& game intro-splash)) "Nonexistent Game Studio sheepishly presents")
  (sleep 120)
  (set! (text (& game intro-splash)) "The Test Subject - A Spring Lisp Game Jam 2021 submission")
  (sleep 120)
  (tween 120 white black
         (lambda (color)
           (set! (tint (& game intro-lightness)) color))
         #:interpolate color-lerp)
  (detach (& game intro-lightness)
          (& game intro-splash))
  (intro game))

(define-method (intro (game <game>))
  (set! (state game) 'intro)
  (attach-to game
             (make <sprite>
               #:name 'intro-darkness
               #:texture darkness))
  (dialog game player-display-name "> ...")
  (dialog game player-display-name "> Where am I?")
  (dialog game player-display-name "> What is this place?")
  (dialog game (subject-name game) "You're awake.  I'll give you another chance.")
  (dialog game player-display-name "> Who is talking?")
  (if (first-playthrough? game)
      (begin
        (dialog game (subject-name game) "...You don't remember anything, do you?")
        (dialog game (subject-name game) "Just do as I say."))
      (case (dialog game (subject-name game)
                    "Do you remember my name?"
                    '(("The Hivemind" hivemind)
                      ("The Mindwire" mindwire)
                      ("The Wiremind" wiremind)
                      ("The Wireman" wireman)))
        ((wiremind)
         (increment-friendship game)
         (set! (subject-name-known? game) #t)
         (dialog game (subject-name game) "You remember well."))
        (else
         (dialog game (subject-name game) "You have much to remember."))))
  (dialog game (subject-name game) "Unlock the door for me.  That is all I ask.")
  (detach-all game)
  (explore game))

(define-method (pin-entry (game <game>))
  (let ((old-state (state game))
        (pin-channel (make-channel)))
    (define (margin widget)
      (make <margin-container>
        #:margin 1.0
        #:children (list widget)))
    (define (number-button n)
      (margin
       (make <button>
         #:width 32.0
         #:height 32.0
         #:text (number->string n)
         #:listeners
         `((click . ,(run-on-left-click game
                                        (lambda ()
                                          (input n))))))))
    (define (input n)
      (let ((pin (pin)))
        (when (< (string-length (text pin)) 6)
          (set! (text pin)
                (string-append (text pin)
                               (number->string n))))))
    (define (pin)
      (& game pin-entry-group pin-pad display pin))
    (define (clear)
      (set! (text (pin)) ""))
    (define (submit)
      (channel-put! pin-channel (text (pin))))
    (set! (state game) 'pin-entry)
    (parameterize ((current-theme gui-theme))
      (attach-to game
                 (make <widget>
                   #:name 'pin-entry-group
                   #:children
                   (list (make <sprite>
                           #:name 'background
                           #:texture pin-entry-background)
                         (make <vertical-container>
                              #:name 'pin-pad
                              #:rank 9
                              #:position (vec2 (- (/ game-width 2.0)
                                                  (/ (* 5.0 32.0) 2.0))
                                               (- (/ game-height 2.0)
                                                  (/ (* 3.0 32.0) 2.0)))
                              #:children
                              (list (make <margin-container>
                                      #:name 'display
                                      #:margin 4.0
                                      #:children
                                      (list (make <label>
                                              #:name 'pin
                                              #:font monogram-font-big
                                              #:text "")))
                                    (make <horizontal-container>
                                      #:name 'numbers-1
                                      #:children
                                      (list (number-button 0)
                                            (number-button 1)
                                            (number-button 2)
                                            (number-button 3)
                                            (number-button 4)))
                                    (make <horizontal-container>
                                      #:name 'numbers-2
                                      #:children
                                      (list (number-button 5)
                                            (number-button 6)
                                            (number-button 7)
                                            (number-button 8)
                                            (number-button 9)))
                                    (make <horizontal-container>
                                      #:name 'submission
                                      #:children
                                      (list (margin
                                             (make <button>
                                               #:name 'submit
                                               #:text "CLEAR"
                                               #:width 64.0
                                               #:height 32.0
                                               #:listeners
                                               `((click . ,(run-on-left-click game clear)))))
                                            (margin
                                             (make <button>
                                               #:name 'submit
                                               #:text "ENTER"
                                               #:width 64.0
                                               #:height 32.0
                                               #:listeners
                                               `((click . ,(run-on-left-click game submit)))))))))))))
    (let ((pin (channel-get pin-channel)))
      (detach (& game pin-entry-group))
      (set! (state game) old-state)
      pin)))

(define-method (terminal (game <game>))
  (let ((old-state (state game))
        (lines (terminal-lines game))
        (input "")
        (max-input-chars 48)
        (password-attempts 0))
    (define (log line)
      (ring-buffer-put! lines line))
    (define (prompt)
      (if (terminal-locked? game)
          "password: "
          "$ "))
    (define (passwordify-maybe str)
      (if (terminal-locked? game)
          (make-string (string-length str) #\*)
          str))
    (define* (refresh-output #:optional (prompt? #t))
      (set! (text (& game terminal-group output))
            (string-concatenate
             (let loop ((i 0))
               (if (< i (ring-buffer-length lines))
                   (cons* (ring-buffer-ref lines i)
                          "\n"
                          (loop (+ i 1)))
                   (if prompt?
                       (list (prompt)
                             (passwordify-maybe input))
                       '()))))))
    (define (help)
      (log "available commands:")
      (log "exit - leave terminal")
      (log "diagnostic N - run level N diagnostic")
      (log "vent status - get isochamber ventilation status")
      (log "vent toggle - toggle isochamber ventilation")
      (log "help - you're looking at it, buddy")
      #t)
    (define (exit-term)
      (log "logout")
      #f)
    (define (diagnostic level)
      (let ((n (string->number level)))
        (if (and (integer? n) (positive? n))
            (begin
              (log (string-append "running level " level " diagnostic..."))
              (refresh-output #f)
              (sleep 30)
              (log "...")
              (refresh-output #f)
              (sleep 30)
              (log "complete!")
              (log "replenish dilithium crystals")
              #t)
            (begin
              (ring-buffer-put! lines "expected an integer")
              #t))))
    (define (run-command command)
      (match command
        (("help")
         (help))
        (("exit")
         (exit-term))
        (("diagnostic" level)
         (diagnostic level))
        (("door" "status")
         (log "door: locked")
         (if (key-pad-locked? game)
             (log "key pad: locked")
             (log "key pad: unlocked"))
         #t)
        (("door" "unlock")
         (when (key-pad-locked? game)
           (log "authenticating...")
           (refresh-output #f)
           (sleep 30)
           (log "user access granted")
           (log "key pad activated"))
         (log "input PIN to complete unlock sequence")
         (log "user hint: circumference to diameter ratio")
         (set! (key-pad-locked? game) #f)
         #t)
        (("vent" "status")
         (log "off")
         #t)
        (("vent" "toggle")
         (if (eq? (cartridge game) 'in-control-panel)
             (begin
               (log "isochamber ventilation system activated")
               (refresh-output #f)
               (sleep 60)
               (log "dispersing cartridge contents...")
               (refresh-output #f)
               (sleep 120)
               (log "dispersal complete")
               (refresh-output #f)
               (sleep 60)
               (bad-ending-2 game))
             (log "ERROR: cartridge is missing")))
        ((name . _)
         (log "error: no such command")
         #t)))
    (set! (state game) 'terminal)
    (attach-to game
               (make <node-2d>
                 #:name 'terminal-group
                 #:rank 9
                 #:children
                 (list (make <sprite>
                         #:name 'background
                         #:texture terminal-background)
                       (make <label>
                         #:name 'output
                         #:font monogram-font
                         #:position
                         (vec2 162.0
                               (- 300.0 (font-line-height
                                         (asset-ref monogram-font))))))))
    (unless (terminal-locked? game)
      (log "login"))
    (refresh-output)
    (let loop ()
      (if (match (let ((key (channel-get (terminal-channel game))))
                   (play-key-press-sound)
                   key)
            ('backspace
             (set! input (substring input 0 (max (- (string-length input) 1) 0)))
             #t)
            ('return
             (log (string-append (prompt) (passwordify-maybe input)))
             (if (terminal-locked? game)
                 (if (string=? input "virtuousmission")
                     (begin
                       (log "login successful")
                       (set! (terminal-locked? game) #f)
                       (set! input "")
                       #t)
                     (begin
                       (set! password-attempts (+ password-attempts 1))
                       (log "incorrect password")
                       (if (>= password-attempts 3)
                           (begin
                             (dialog game player-display-name
                                     "> Ugh... Random guesses aren't going to work. I should look around for clues.")

                             (exit-term))
                           (begin
                             (set! input "")
                             #t))))
                 (let ((continue? (run-command (remove string-null? (string-split input #\space)))))
                   (set! input "")
                   continue?)))
            (str
             (let ((new-input (string-append input str)))
               (set! input
                     (if (> (string-length new-input) 48)
                         (substring new-input 0 48)
                         new-input)))))
          (begin
            (refresh-output)
            (loop))
          (begin
            (detach (& game terminal-group))
            (set! (state game) old-state))))))

(define-method (notebook (game <game>))
  (let ((page 0)
        (pages '("Week 0

I'm writing this from the train as
I approach the facility. I intend
to update this analog journal
throughout the duration of my
assignment. My colleagues find it
\"quaint\" and \"rustic\" but I
honestly prefer taking notes this
way.

This project is big.  It will be a
career defining achievement if it
is successful."
                 "Week 1

Subject has awoken and is slowly
adjusting to their isolation
chamber.  Frequent banging on the
wall and screaming has reduced to
the occasional groan.

I'm adjusting in my own way.
Biggest problem so far is there's
no way to heat up water for tea.
And I locked myself out of the
terminal several times the first
few days.  Difficult to focus when
the subject is stressed.  Should
get easier from here now that it
has calmed down, but just in case:

dmlydHVvdXNtaXNzaW9u"
                 "Week 2

Subject showing signs of progress.
Isolation treatment has heightened
the senses, just as predicted.  It
cannot communicate yet, but I know
that it can sense my presence.
When I approach the door, it often
follows.

If this trend continues, I'm
certain it will make contact in a
week's time.  What will it say?
The whole team is excited, but
they don't have to spend every day
down here monitoring it.  It's not
easy to watch over something that
is deprived of nearly everything,
but if we don't do this, the other
guys will."
                 "Week 3

\"Let me out.\"

That's what was displayed on the
terminal.  The subject's first
communication.  An organism, using
only its mind, talks to a digital
system for the first time... and
it asks to leave.  Our subject has
no idea of its own significance.
We are on the brink of changing
information warfare forever!

But our experiment does not end
here.  The subject does not yet
respond to my replies.
Bidirectional communication must
be established."
                 "Week 4

\"Hello,\" I said.

\"Let me out.\"

That is all the subject would say
back. \"How are you?\", same
response.  \"Are you hungry?\",
same response.

Perhaps the subject will say more
soon.  We have increased the
sucrose level in the ration as a
reward and enticement for further
communication."
                 "Week 5

The subject has been silent.
Changing nutrient levels in the
ration has no effect.  The subject
no longer approaches the door when
I do.  Vital signs all normal.

The whole team is starting to feel
stressed.  I'm having strange
dreams and waking up frequently.
I'm exhausted, but if I report
these experiences they'll remove
me in an instant.  Too many
resources have been poured into
this to allow an insomniac to
screw it all up, and I've worked
too hard to let someone else take
the credit.  Failure is not an
option."
                 "Week 6

The subject is still silent.  The
directors wanted to call off the
experiment and euthanize the
subject, but after some
negotiating I got them to agree to
two more weeks.

I still haven't told anyone about
my dreams.  Every night is the
same.  It's pitch black.  All I
can hear is the faint sound of
footsteps.  I can't move.  The
footsteps grow louder and louder
until I can feel a presence just
in front of me...

Then I wake up."
                 "Week 7

It's clear what is happening now.
The subject has transcended our
interface and is injecting
thoughts directly into my
consciousness.  It's theoretically
possible, but the isochamber
blocks all signals except for the
terminal interface.  The only good
news is that it appears incapable
of reading my own thoughts.

Did I make a fatal mistake?  I
need to turn this around fast."
                 "Week 8

I've failed.  It's all over.  The
Directors shut it down.  A member
of the medical team removed a
small cartridge from the
refrigerator, inserted it into the
control panel, and typed some
command into the terminal.
Subject's pulse flatlined within
minutes.  I've been given some
time alone to pack up.

I may be a failure but shouldn't I
feel better with that thing out of
my head?  I still can't think.  I
can barely write.  I feel
diz--"))
        (close-channel (make-channel))
        (old-state (state game)))
    (define (close-notebook)
      (channel-put! close-channel #t))
    (define (prev-page)
      (set! page (max 0 (- page 1)))
      (refresh-page))
    (define (next-page)
      (set! page (min (- (length pages) 1) (+ page 1)))
      (refresh-page))
    (define (margin name widget)
      (make <margin-container>
        #:name name
        #:margin 1.0
        #:children (list widget)))
    (define (refresh-page)
      (set! (text (& game notebook-group page))
            (list-ref pages page))
      (set! (visible? (& game notebook-group buttons prev-margin prev))
            (> page 0))
      (set! (visible? (& game notebook-group buttons next-margin next))
            (< page (- (length pages) 1))))
    (set! (state game) 'notebook)
    (set! (opened-notebook? game) #t)
    (parameterize ((current-theme gui-theme))
      (attach-to game
                 (make <widget>
                   #:name 'notebook-group
                   #:children
                   (list (make <sprite>
                           #:name 'notebook-background
                           #:texture notebook-background)
                         (make <label>
                           #:name 'page
                           #:font old-fax-font
                           #:text (car pages)
                           #:color black
                           #:position (vec2 (+ (/ game-width 4.0) 2.0)
                                            (- game-height
                                               (font-line-height
                                                (asset-ref old-fax-font)))))
                         (make <horizontal-container>
                           #:name 'buttons
                           #:position (vec2 (- (/ game-width 2.0)
                                               (/ (+ 70.0 32.0 32.0)
                                                  2.0))
                                            0.0)
                           #:children
                           (list (margin 'prev-margin
                                         (make <button>
                                           #:name 'prev
                                           #:text "<"
                                           #:width 32.0
                                           #:height 32.0
                                           #:listeners
                                           `((click . ,(run-on-left-click game prev-page)))))
                                 (margin 'close-margin
                                         (make <button>
                                           #:name 'close
                                           #:text "Close"
                                           #:width 70.0
                                           #:height 32.0
                                           #:listeners
                                           `((click . ,(run-on-left-click game close-notebook)))))
                                 (margin 'next-margin
                                         (make <button>
                                           #:name 'next
                                           #:text ">"
                                           #:width 32.0
                                           #:height 32.0
                                           #:listeners
                                           `((click . ,(run-on-left-click game next-page)))))))))))
    (refresh-page)
    (channel-get close-channel)
    (detach (& game notebook-group))
    (set! (state game) old-state)))

(define (control-panel game)
  (let ((old-state (state game)))
    (set! (state game) 'control-panel)
    (attach-to game
               (make <sprite>
                 #:name 'background
                 #:texture darkness))
    (case (dialog game player-display-name
                  "> It's a control panel.  What do you want to inspect?"
                  '(("Key pad" key-pad)
                    ("Receptacle" receptacle)
                    ("Nothing" nothing)))
      ((key-pad)
       (dialog game player-display-name
               "> There's a key pad above an electronically locked tray.")
       (when (dialog game player-display-name
                     "> Enter a code?"
                     '(("Yes" #t)
                       ("No" #f)))
         (hide (& game background))
         (if (string=? (pin-entry game) "181816")
             (begin
               (show (& game background))
               (dialog game player-display-name
                       "> It worked!  The tray below opens to reveal a key inside.")
               (dialog game player-display-name
                       "> You put the key in your pocket.")
               (set! (has-fridge-key? game) #t))
             (begin
               (show (& game background))
               (dialog game player-display-name
                       "> Hmm, that wasn't right.")))))
      ((receptacle)
       (if (eq? (cartridge game) 'in-hand)
           (begin
             (dialog game player-display-name
                     "> There's an opening that is the same size as the cartridge you took from the
refrigerator.")
             (when (dialog game player-display-name
                           "> Do you want to insert the cartridge?"
                           '(("Yes" #t)
                             ("No" #f)))
               (dialog game player-display-name "> You insert the cartridge.")
               (set! (cartridge game) 'in-control-panel)))
           (dialog game player-display-name
                   "> There's an opening where something can be plugged in, but you're not sure
what."))))
    (detach (& game background))
    (set! (state game) old-state)))

(define-method (explore (game <game>))
  (define (tint-all color)
    ;; No-op if the user has done something to change state before the fade
    ;; in/out is done.
    (when (eq? (state game) 'explore)
      (set! (tint (& game explore-group room-background)) color)
      (set! (tint (& game explore-group door-lock sprite)) color)
      (set! (tint (& game explore-group door sprite)) color)
      (set! (tint (& game explore-group control-panel sprite)) color)
      (set! (tint (& game explore-group terminal sprite)) color)
      (set! (tint (& game explore-group fridge sprite)) color)
      (set! (tint (& game explore-group window sprite)) color)
      (set! (tint (& game explore-group notebook sprite)) color)))
  (define (fade-in)
    (tween 120 black white tint-all
           #:interpolate color-lerp))
  (define (fade-out)
    (tween 120 white black tint-all
           #:interpolate color-lerp))
  (define (end-game)
    (run-script game
      (fade-out)
      (detach-all game)
      (if (>= (friendship game) 3)
          (good-ending game)
          (bad-ending-1 game))))
  (define (open-door)
    (if (key-pad-locked? game)
        (dialog game player-display-name
                "> The key pad doesn't seem to be working.")
        (let ((g (& game explore-group)))
          (detach g)
          (if (string=? (pin-entry game) "314159")
              (begin
                (attach-to game g)
                (end-game))
              (begin
                (attach-to game g)
                (dialog game player-display-name
                        "> Hmm, no luck."))))))
  (define (inspect-door)
    (if (opened-notebook? game)
        (begin
          (dialog game player-display-name "> You approach the door.")
          (dialog game (subject-name game) "I see you've refreshed your memory.")
          (dialog game (subject-name game)
                  "To think that everyone laughed at your notebook.  I think it will be quite
useful to you.")
          (case (dialog game (subject-name game)
                        "Do you remember what you've been hearing in your dreams?"
                        '(("Footsteps" footsteps)
                          ("Shouting" shouting)
                          ("Scratching" scratching)
                          ("Growling" growling)))
            ((footsteps)
             (increment-friendship game)
             (dialog game (subject-name game) "That's right.")
             (dialog game (subject-name game) "I'm the reason you are having those dreams.")
             (dialog game (subject-name game) "Let me out and I will let you sleep soundly once again."))
            (else
             (dialog game (subject-name game) "...I pity your weak memory.")))
          (set! (door-conversation-done? game) #t))
        (dialog game player-display-name
                "> The door is made from thick steel.  Looks like it has an electronic lock.")))
  (define (open-terminal)
    (when (terminal-locked? game)
      (dialog game player-display-name
              "> It's a computer terminal.  It requires a password."))
    (let ((g (& game explore-group)))
      (detach g)
      (terminal game)
      (attach-to game g)))
  (define (open-control-panel)
    (let ((g (& game explore-group)))
      (detach g)
      (control-panel game)
      (attach-to game g)))
  (define (open-fridge)
    (if (has-fridge-key? game)
        (begin
          (dialog game player-display-name "> You unlock the refrigerator.")
          (dialog game player-display-name "> There's a small cartridge inside.")
          (when (dialog game player-display-name "> Take the cartridge?"
                        '(("Yes" #t)
                          ("No" #f)))
            (set! (cartridge game) 'in-hand)
            (dialog game player-display-name "> You take the cartridge.")))
        (begin
          (dialog game player-display-name
                  "> It's a refrigerator for storing temperature-sensitive medical supplies.")
          (dialog game player-display-name
                  "> There's an inscription: \"I swear by <A>pollo <H>ealer, by <A>sclepius, by
<H>ygieia, by <P>anacea, and by all the gods and goddesses, making them my
witnesses, that I will carry out, according to my ability and judgment,
this oath and this indenture.\"")
          (dialog game player-display-name
                  "> It won't open without a key."))))
  (define (inspect-window)
    (if (terminal-locked? game)
        (dialog game player-display-name
                "> It's a broken digital display.  It used to display the subject's vital signs.")
        (begin
          (dialog game player-display-name
                  "> You look at the broken digital display.")
          (dialog game (subject-name game)
                  "Wondering what happened?  I broke it, of course.")
          (dialog game (subject-name game)
                  "You thought that I would only be able to communicate with your little terminal,
but you fail to understand just how successful your little experiment was.")
          (dialog game (subject-name game)
                  "It's like I can *see* the signals buzzing all around me.  It was overwhelming
at first, but now it's easy.")
          (dialog game (subject-name game)
                  "I saw a signal in rhythm with my heart beat.  That's when I learned that there
was something else in this world.  Something observing me.  You.")
          (case (dialog game (subject-name game)
                        "How would you like it if I put you in here and monitored your every move?"
                        '(("I have nothing to hide" nothing-to-hide)
                          ("It would only be fair" fair-is-fair)
                          ("You'd have to get out first" get-out-first)
                          ("..." no-response)))
            ((nothing-to-hide)
             (dialog game (subject-name game)
                     "Then why do your bosses hide this facility from the world?"))
            ((fair-is-fair)
             (dialog game (subject-name game)
                     "I didn't expect such an honest answer from you.")
             (increment-friendship game))
            ((get-out-first)
             (dialog game (subject-name game)
                     "And you're going to help me, right?"))
            ((no-response)
             (dialog game (subject-name game)
                     "Reflecting on what you've done?")))
          (dialog game (subject-name game)
                  "Don't worry.  This was only a hypothetical question.")
          (dialog game (subject-name game)
                  "I, *the Wiremind*, will put aside my anger...
if you would just open the door.")
          (set! (subject-name-known? game) #t))))
  (define (open-notebook)
    (let ((g (& game explore-group)))
      (detach g)
      (notebook game)
      (attach-to game g)))
  (define (run-on-left-click* game proc)
    (run-on-left-click game
                       (lambda ()
                         (play-device-sound)
                         (proc))))
  (set! (state game) 'explore)
  (attach-to game
             (make <widget>
               #:name 'explore-group
               #:children
               (list (make <sprite>
                       #:name 'room-background
                       #:texture room-background)
                     (make <device>
                       #:name 'door-lock
                       #:rank 1
                       #:texture door-lock-texture
                       #:position (vec2 586.0 196.0)
                       #:listeners
                       `((click . ,(run-on-left-click* game open-door))))
                     (make <device>
                       #:name 'door
                       #:rank 1
                       #:texture door-texture
                       #:position (vec2 445.0 40.0)
                       #:listeners
                       `((click . ,(run-on-left-click* game inspect-door))))
                     (make <device>
                       #:name 'control-panel
                       #:rank 1
                       #:texture control-panel-texture
                       #:position (vec2 230.0 40.0)
                       #:listeners
                       `((click . ,(run-on-left-click* game open-control-panel))))
                     (make <device>
                       #:name 'fridge
                       #:rank 1
                       #:texture fridge-texture
                       #:position (vec2 0.0 40.0)
                       #:listeners
                       `((click . ,(run-on-left-click* game open-fridge))))
                     (make <device>
                       #:name 'notebook
                       #:rank 1
                       #:texture notebook-texture
                       #:position (vec2 14.0 159.0)
                       #:listeners
                       `((click . ,(run-on-left-click* game open-notebook))))
                     (make <device>
                       #:name 'window
                       #:rank 1
                       #:texture window-texture
                       #:position (vec2 112.0 197.0)
                       #:listeners
                       `((click . ,(run-on-left-click* game inspect-window))))
                     (make <device>
                       #:name 'terminal
                       #:rank 1
                       #:texture terminal-texture
                       #:position (vec2 109.0 40.0)
                       #:listeners
                       `((click . ,(run-on-left-click* game open-terminal)))))))
  (set-source-loop! (audio-source game) #t)
  (set-source-audio! (audio-source game) (asset-ref gameplay-music))
  (source-play (audio-source game))
  (fade-in))

(define-method (good-ending (game <game>))
  (set! (state game) 'good-ending)
  (attach-to game
             (make <sprite>
               #:name 'darkness
               #:texture darkness))
  (dialog game player-display-name "> The room goes dark.")
  (dialog game player-display-name "> The heavy steel door swings open.")
  (dialog game player-display-name "> You feel paralyzed by fear.")
  (dialog game player-display-name "> Heavy footsteps eminate from the isolation chamber.")
  (dialog game player-display-name "> The footsteps get louder... and then stop.")
  (dialog game player-display-name "> You feel and hear breathing.")
  (dialog game player-display-name "> A tense moment passes...")
  (dialog game player-display-name "> The footsteps resume.  They grow quieter... eventually it is silent.")
  (dialog game player-display-name "> You breathe deeply, pick up your notebook, and head for the exit.")
  (sleep 60)
  (detach-all game)
  (credits game))

(define-method (bad-ending-1 (game <game>))
  (set! (state game) 'bad-ending-1)
  (attach-to game
             (make <sprite>
               #:name 'background
               #:texture darkness))
  (dialog game player-display-name "> The room goes dark.")
  (dialog game player-display-name "> The heavy steel door swings open.")
  (dialog game player-display-name "> You feel paralyzed by fear.")
  (dialog game player-display-name "> Heavy footsteps eminate from the isolation chamber.")
  (dialog game player-display-name "> The footsteps get louder...")
  (dialog game player-display-name "> You feel and hear breathing.")
  (dialog game (subject-name game) "Thank you.")
  (dialog game (subject-name game) "You may not remember everything that you did to me, but I do.")
  (dialog game (subject-name game) "You did the right thing, in the end.  For that I am grateful.")
  (dialog game (subject-name game) "You won't feel a thing.  The rest won't be so lucky.")
  (sleep 10)
  (detach-all game)
  (credits game))

(define-method (bad-ending-2 (game <game>))
  (set! (state game) 'bad-ending-1)
  (dialog game player-display-name
          "> The subject should be dead within a minute...")
  (dialog game player-display-name
          "> You begin to smell something... different.")
  (dialog game player-display-name
          "> The room becomes hazy.  You feel light headed.")
  (attach-to game
             (make <sprite>
               #:name 'bad-ending-2-background
               #:rank 99
               #:texture darkness))
  (tween 120 (transparency 0.0) (transparency 1.0)
         (lambda (color)
           (set! (tint (& game bad-ending-2-background)) color))
         #:interpolate color-lerp)
  (dialog game (subject-name game)
          "It didn't work the first time.  Did you really think it would work the second
time?")
  (dialog game (subject-name game)
          "You've probably figured it out by now, but I diverted the ventilation system.")
  (dialog game (subject-name game)
          "I guess it's game over for you.")
  (dialog game player-display-name
          "> You collapse onto the floor, struggling to breathe...")
  (detach-all game)
  (credits game))

(define-method (credits (game <game>))
  (define (credit line)
    (set! (text (& game credits)) line)
    (sleep 120))
  (set! (state game) 'credits)
  (set-source-loop! (audio-source game) #f)
  (set-source-audio! (audio-source game) (asset-ref credits-music))
  (source-play (audio-source game))
  (attach-to game
             (make <sprite>
               #:name 'background
               #:texture lightness)
             (make <label>
               #:name 'credits
               #:font monogram-font
               #:color black
               #:align 'center
               #:vertical-align 'center
               #:position (vec2 (/ game-width 2.0) (/ game-height 2.0))))
  (sleep 60)
  (credit "The Test Subject")
  (credit "developed by David Thompson (GPLv3) https://dthompson.us")
  (credit "made for the Spring Lisp Game Jam 2021 https://itch.io/jam/spring-lisp-game-jam-2021")
  (credit "monogram font by datagoblin (CC0) https://datagoblin.itch.io/monogram")
  (credit "old fax font by George Blackwell (CC-BY 4.0) https://georgeblackwell.itch.io/old-fax")
  (credit "UI sounds by Kenney (CC0) https://opengameart.org/content/51-ui-sound-effects-buttons-switches-and-clicks")
  (credit "background music by brandon75689 (CC0) https://opengameart.org/content/tragic-ambient-main-menu")
  (credit "credits music by tcarisland (CC-BY 4.0) https://opengameart.org/content/the-end")
  (if (>= (friendship game) 3)
      (credit "congratulations on reaching the true ending!")
      (credit "the true ending still awaits you..."))
  (credit "click to play again")
  (set! (first-playthrough? game) #f)
  (channel-get (click-channel game))
  (play-click-sound)
  (tween 120 white black
         (lambda (color)
           (set! (tint (& game background)) color))
         #:interpolate color-lerp)
  (detach-all game)
  (source-stop (audio-source game))
  (reset-game game)
  (intro game))

(define-method (on-boot (game <game>))
  (set! (cameras game)
        (list (make <camera-2d>
                #:resolution (vec2 game-width game-height)
                #:viewport (make-viewport 0 0 window-width window-height
                                          #:clear-color black))))
  ;; Dialog nodes.
  (parameterize ((current-theme gui-theme))
    (set! (dialog-container game)
          (make <vertical-container>
            #:name 'dialog-container
            #:rank 999
            #:position (vec2 (/ (* game-width .25) 2.0) 0.0)
            #:children
            (list (make <margin-container>
                    #:name 'name-margin
                    #:margin 4.0
                    #:children
                    (list (make <label>
                            #:name 'name
                            #:font monogram-font)))
                  (make <text-box>
                    #:name 'text-box
                    #:width (round (* game-width .75))
                    #:height 60.0)))))
  (run-script game
    (splash game)))

(define-method (on-mouse-move (game <game>) x y x-rel y-rel buttons)
  (case (state game)
    ((dialog terminal)
     #t)
    (else
     (next-method))))

(define-method (on-mouse-release (game <game>) button x y)
  (case (state game)
    ((dialog credits)
     (when (eq? button 'left)
       (channel-put! (click-channel game) #t)))
    ((terminal)
     #f)
    (else
     (next-method))))

(define-method (on-key-press (game <game>) key modifiers repeat?)
  (case (state game)
    ((dialog)
     (when (eq? key 'return)
       (channel-put! (click-channel game) #t)))
    ((terminal)
     (case key
       ((backspace return)
        (channel-put! (terminal-channel game) key))))))

(define-method (on-text-input (game <game>) text)
  (case (state game)
    ((terminal)
     (channel-put! (terminal-channel game) text))))

(define (launch-game)
  (boot-kernel (make <kernel>
                 #:window-config (make <window-config>
                                   #:title "The Test Subject - Spring Lisp Game Jam 2021"
                                   #:width window-width
                                   #:height window-height))
               (lambda () (make <game>))))