diff options
Diffstat (limited to 'test-subject')
| -rw-r--r-- | test-subject/assets.scm | 52 | ||||
| -rw-r--r-- | test-subject/device.scm | 42 | ||||
| -rw-r--r-- | test-subject/game.scm | 1126 | ||||
| -rw-r--r-- | test-subject/text-box.scm | 37 |
4 files changed, 1257 insertions, 0 deletions
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)))))))) |