diff options
Diffstat (limited to 'game.scm')
-rw-r--r-- | game.scm | 1213 |
1 files changed, 0 insertions, 1213 deletions
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>)))) |