From 8fc01b81e0f95c8ea187d179b6f6a6b9afc4e79e Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson@vistahigherlearning.com>
Date: Sun, 25 Apr 2021 14:51:00 -0400
Subject: Break code up into modules.

---
 Makefile.am               |    6 +-
 configure.ac              |    4 +-
 game.scm                  | 1213 ---------------------------------------------
 run-game                  |    2 +-
 test-subject/assets.scm   |   52 ++
 test-subject/device.scm   |   42 ++
 test-subject/game.scm     | 1126 +++++++++++++++++++++++++++++++++++++++++
 test-subject/text-box.scm |   37 ++
 8 files changed, 1265 insertions(+), 1217 deletions(-)
 delete mode 100644 game.scm
 create mode 100644 test-subject/assets.scm
 create mode 100644 test-subject/device.scm
 create mode 100644 test-subject/game.scm
 create mode 100644 test-subject/text-box.scm

diff --git a/Makefile.am b/Makefile.am
index 4f5cd6a..70738c9 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -21,7 +21,11 @@ SUFFIXES = .scm .go
 moddir=$(prefix)/share/guile/site/$(GUILE_EFFECTIVE_VERSION)
 godir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache
 
-SOURCES = game.scm
+SOURCES = 					\
+  test-subject/assets.scm			\
+  test-subject/text-box.scm			\
+  test-subject/device.scm			\
+  test-subject/game.scm
 
 EXTRA_DIST += 					\
   COPYING
diff --git a/configure.ac b/configure.ac
index 582cdb7..21e90ac 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,7 +1,7 @@
 dnl -*- Autoconf -*-
 
-AC_INIT(spring-lisp-game-jam-2021, 0.1.0)
-AC_CONFIG_SRCDIR(lisp-game-jam)
+AC_INIT(test-subject, 0.1.0)
+AC_CONFIG_SRCDIR(test-subject)
 AC_CONFIG_AUX_DIR([build-aux])
 AM_INIT_AUTOMAKE([color-tests -Wall -Wno-portability foreign])
 AM_SILENT_RULES([yes])
diff --git a/game.scm b/game.scm
deleted file mode 100644
index ef0234c..0000000
--- a/game.scm
+++ /dev/null
@@ -1,1213 +0,0 @@
-(define-module (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)
-  #:duplicates (merge-generics replace warn-override-core warn last)
-  #:export (launch-game))
-
-
-;;;
-;;; Constants
-;;;
-
-(define window-width 1280)
-(define window-height 720)
-(define game-width 640)
-(define game-height 360)
-(define player-display-name "")
-
-
-;;;
-;;; Assets
-;;;
-
-(define-asset dialog-box-texture (load-image "assets/images/dialog-box.png"))
-(define-asset button-press-texture (load-image "assets/images/button-press.png"))
-(define-asset darkness (load-image "assets/images/darkness.png"))
-(define-asset lightness (load-image "assets/images/lightness.png"))
-(define-asset room-background (load-image "assets/images/room.png"))
-(define-asset door-lock-texture (load-image "assets/images/door-lock.png"))
-(define-asset pin-entry-background (load-image "assets/images/pin-entry-background.png"))
-(define-asset door-texture (load-image "assets/images/door.png"))
-(define-asset terminal-texture (load-image "assets/images/terminal.png"))
-(define-asset terminal-background (load-image "assets/images/terminal-background.png"))
-(define-asset control-panel-texture (load-image "assets/images/control-panel.png"))
-(define-asset fridge-texture (load-image "assets/images/fridge.png"))
-(define-asset window-texture (load-image "assets/images/window.png"))
-(define-asset notebook-texture (load-image "assets/images/notebook.png"))
-(define-asset notebook-background (load-image "assets/images/notebook-background.png"))
-(define-asset monogram-font (load-font "assets/fonts/monogram_extended.ttf" 12))
-(define-asset monogram-font-big (load-font "assets/fonts/monogram_extended.ttf" 24))
-(define-asset old-fax-font (load-font "assets/fonts/old-fax.ttf" 12))
-(define-asset click-sound (load-audio "assets/sounds/click1.wav"))
-(define-asset key-press-sound (load-audio "assets/sounds/switch6.wav"))
-(define-asset device-sound (load-audio "assets/sounds/switch38.wav"))
-(define-asset background-music (load-audio "assets/sounds/ambientmain_0.ogg" #:mode 'stream))
-(define-asset credits-music (load-audio "assets/sounds/end-theme.mp3" #:mode 'stream))
-
-
-;;;
-;;; Text Box
-;;;
-
-(define-class <text-box> (<widget>)
-  (text #:accessor text #:init-keyword #:text #:init-value "" #:watch? #t))
-
-(define-method (on-change (text-box <text-box>) slot-name old new)
-  (case slot-name
-    ((text)
-     (let ((l (& text-box text)))
-       (when l
-         (set! (text l) new))))
-    (else
-     (next-method))))
-
-(define-method (apply-theme (text-box <text-box>))
-  (next-method)
-  (replace text-box
-    (make <label>
-      #:name 'text
-      #:rank 1
-      #:font (font text-box)
-      #:text (text text-box)
-      #:position (vec2 6.0
-                       (- (height text-box)
-                          (font-line-height
-                           (asset-ref
-                            (font text-box))))))))
-
-
-;;;
-;;; Device
-;;;
-
-(define %device-hover-tint (rgb #xff7777))
-
-;; An object you can interact with by clicking.
-(define-class <device> (<margin-container>)
-  (texture #:accessor texture #:init-keyword #:texture
-           #:init-value null-texture #:watch? #t))
-
-(define-method (refresh-hover-state (device <device>))
-  ;; A crude way of showing the user something is clickable.
-  (set! (tint (& device sprite))
-        (if (hover? device)
-            %device-hover-tint
-            white)))
-
-(define-method (on-change (device <device>) slot-name old new)
-  (case slot-name
-    ((hover?)
-     (refresh-hover-state device))
-    ((texture)
-     (let ((sprite (& device sprite)))
-       (when sprite
-         (set! (texture sprite) new))))
-    (else
-     (next-method))))
-
-(define-method (apply-theme (device <device>))
-  (next-method)
-  (replace device
-    (make <sprite>
-      #:name 'sprite
-      #:rank 1
-      #:texture (texture device)))
-  (refresh-hover-state device))
-
-
-;;;
-;;; Game
-;;;
-
-(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-form (make-source #:loop? #t)))
-
-(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 (& 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 (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)
-      (when (zero? (random 2))
-        (log "quit wasting time!! open the door!!"))
-      (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)))
-         (let ((g (& game explore-group)))
-           (detach g)
-           (if (string=? (pin-entry game) "181816")
-               (begin
-                 (attach-to game g)
-                 (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
-                 (attach-to game g)
-                 (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)
-    (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))))
-  (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-audio! (audio-source game) (asset-ref background-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.")
-  (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-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)
-  (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
-    (intro 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>))))
diff --git a/run-game b/run-game
index 0fb9b15..b4d451c 100755
--- a/run-game
+++ b/run-game
@@ -1,3 +1,3 @@
 #!/bin/sh
 
-DEV_MODE=1 ./pre-inst-env guile -c '(use-modules (game)) (launch-game)'
+DEV_MODE=1 ./pre-inst-env guile -c '(use-modules (test-subject game)) (launch-game)'
diff --git a/test-subject/assets.scm b/test-subject/assets.scm
new file mode 100644
index 0000000..76f0d6d
--- /dev/null
+++ b/test-subject/assets.scm
@@ -0,0 +1,52 @@
+(define-module (test-subject assets)
+  #:use-module (chickadee audio)
+  #:use-module (chickadee graphics font)
+  #:use-module (chickadee graphics texture)
+  #:use-module (starling asset)
+  #:export (dialog-box-texture
+            button-press-texture
+            darkness
+            lightness
+            room-background
+            door-lock-texture
+            pin-entry-background
+            door-texture
+            terminal-texture
+            terminal-background
+            control-panel-texture
+            fridge-texture
+            window-texture
+            notebook-texture
+            notebook-background
+            monogram-font
+            monogram-font-big
+            old-fax-font
+            click-sound
+            key-press-sound
+            device-sound
+            gameplay-music
+            credits-music))
+
+(define-asset dialog-box-texture (load-image "assets/images/dialog-box.png"))
+(define-asset button-press-texture (load-image "assets/images/button-press.png"))
+(define-asset darkness (load-image "assets/images/darkness.png"))
+(define-asset lightness (load-image "assets/images/lightness.png"))
+(define-asset room-background (load-image "assets/images/room.png"))
+(define-asset door-lock-texture (load-image "assets/images/door-lock.png"))
+(define-asset pin-entry-background (load-image "assets/images/pin-entry-background.png"))
+(define-asset door-texture (load-image "assets/images/door.png"))
+(define-asset terminal-texture (load-image "assets/images/terminal.png"))
+(define-asset terminal-background (load-image "assets/images/terminal-background.png"))
+(define-asset control-panel-texture (load-image "assets/images/control-panel.png"))
+(define-asset fridge-texture (load-image "assets/images/fridge.png"))
+(define-asset window-texture (load-image "assets/images/window.png"))
+(define-asset notebook-texture (load-image "assets/images/notebook.png"))
+(define-asset notebook-background (load-image "assets/images/notebook-background.png"))
+(define-asset monogram-font (load-font "assets/fonts/monogram_extended.ttf" 12))
+(define-asset monogram-font-big (load-font "assets/fonts/monogram_extended.ttf" 24))
+(define-asset old-fax-font (load-font "assets/fonts/old-fax.ttf" 12))
+(define-asset click-sound (load-audio "assets/sounds/click1.wav"))
+(define-asset key-press-sound (load-audio "assets/sounds/switch6.wav"))
+(define-asset device-sound (load-audio "assets/sounds/switch38.wav"))
+(define-asset gameplay-music (load-audio "assets/sounds/ambientmain_0.ogg" #:mode 'stream))
+(define-asset credits-music (load-audio "assets/sounds/end-theme.mp3" #:mode 'stream))
diff --git a/test-subject/device.scm b/test-subject/device.scm
new file mode 100644
index 0000000..b15f270
--- /dev/null
+++ b/test-subject/device.scm
@@ -0,0 +1,42 @@
+(define-module (test-subject device)
+  #:use-module (chickadee graphics color)
+  #:use-module (chickadee graphics texture)
+  #:use-module (oop goops)
+  #:use-module (starling gui)
+  #:use-module (starling node)
+  #:use-module (starling node-2d)
+  #:export (<device>))
+
+(define %device-hover-tint (rgb #xff7777))
+
+;; An object you can interact with by clicking.
+(define-class <device> (<margin-container>)
+  (texture #:accessor texture #:init-keyword #:texture
+           #:init-value null-texture #:watch? #t))
+
+(define-method (refresh-hover-state (device <device>))
+  ;; A crude way of showing the user something is clickable.
+  (set! (tint (& device sprite))
+        (if (hover? device)
+            %device-hover-tint
+            white)))
+
+(define-method (on-change (device <device>) slot-name old new)
+  (case slot-name
+    ((hover?)
+     (refresh-hover-state device))
+    ((texture)
+     (let ((sprite (& device sprite)))
+       (when sprite
+         (set! (texture sprite) new))))
+    (else
+     (next-method))))
+
+(define-method (apply-theme (device <device>))
+  (next-method)
+  (replace device
+    (make <sprite>
+      #:name 'sprite
+      #:rank 1
+      #:texture (texture device)))
+  (refresh-hover-state device))
diff --git a/test-subject/game.scm b/test-subject/game.scm
new file mode 100644
index 0000000..4a03343
--- /dev/null
+++ b/test-subject/game.scm
@@ -0,0 +1,1126 @@
+(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-form (make-source #:loop? #t)))
+
+(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 (intro (game <game>))
+  (set! (state game) 'intro)
+  (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)) "a nonexistent game studio presents")
+  (sleep 120)
+  (set! (text (& game intro-splash)) "a lisp game jam entry")
+  (sleep 120)
+  (tween 120 white black
+         (lambda (color)
+           (set! (tint (& game intro-lightness)) color))
+         #:interpolate color-lerp)
+  (detach (& game intro-lightness)
+          (& game intro-splash))
+  (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)))
+         (let ((g (& game explore-group)))
+           (detach g)
+           (if (string=? (pin-entry game) "181816")
+               (begin
+                 (attach-to game g)
+                 (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
+                 (attach-to game g)
+                 (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)
+    (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))))
+  (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-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.")
+  (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-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)
+  (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
+    (intro 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>))))
diff --git a/test-subject/text-box.scm b/test-subject/text-box.scm
new file mode 100644
index 0000000..e46b396
--- /dev/null
+++ b/test-subject/text-box.scm
@@ -0,0 +1,37 @@
+(define-module (test-subject text-box)
+  #:use-module (chickadee graphics font)
+  #:use-module (chickadee math vector)
+  #:use-module (oop goops)
+  #:use-module (starling asset)
+  #:use-module (starling gui)
+  #:use-module (starling node)
+  #:use-module (starling node-2d)
+  #:duplicates (merge-generics replace warn-override-core warn last)
+  #:export (<text-box>
+            text-box-text))
+
+(define-class <text-box> (<widget>)
+  (text #:accessor text-box-text #:init-keyword #:text #:init-value "" #:watch? #t))
+
+(define-method (on-change (text-box <text-box>) slot-name old new)
+  (case slot-name
+    ((text)
+     (let ((l (& text-box text)))
+       (when l
+         (set! (text l) new))))
+    (else
+     (next-method))))
+
+(define-method (apply-theme (text-box <text-box>))
+  (next-method)
+  (replace text-box
+    (make <label>
+      #:name 'text
+      #:rank 1
+      #:font (font text-box)
+      #:text (text-box-text text-box)
+      #:position (vec2 6.0
+                       (- (height text-box)
+                          (font-line-height
+                           (asset-ref
+                            (font text-box))))))))
-- 
cgit v1.2.3