(define-module (game)
  #: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))


;;;
;;; 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)
  (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)))

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

(define-method (reset-game (game <game>))
  (set! (subject-name-known? game) #f)
  (set! (has-fridge-key? 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)))

(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
          (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))
       (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)))
           (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."))
      (let ((choice (dialog game (subject-name game)
                            "Do you remember my name?"
                            '(("Hivemind" hivemind)
                              ("Mindwire" mindwire)
                              ("Wiremind" wiremind)
                              ("Wiremire" wiremire)))))
        (if (eq? choice 'wiremind)
            (begin
              (increment-friendship game)
              (set! (subject-name-known? game) #t)
              (dialog game (subject-name game) "You remember well."))
            (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))
        (("vent" "status")
         (log "off"))
        (("vent" "toggle")
         (log "not working yet"))
        ((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 (channel-get (terminal-channel game))
            ('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.

If someone is reading this: Sorry
but I've signed too many NDAs to
take any chances with naming
actual people and places.

;)"
                 "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, I can
hear the faint sounds of it doing
the same.

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
so desprately wants out, but we
all know that's not possible..."
                 "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
revolutionizing information
warfare!

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

\"Hello.\"

That is what I said to it.

\"Out.  Let me out.\"

That is all it 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 and all I
can hear is a faint voice.  As I
walk in the direction of the sound
it gets louder until I can
understand it: \"out.  Out.
OUT...\"

Then I wake up."
                 "Week 7

It's clear what is happening now.
The subject has transcended our
interface and is communicating
with me directly.  How do I know?
I finally broke down and yelled
\"What do you want!?\" and a
thought came to me: \"Out. Let me
out and I will stop.\"

I didn't think that.  It put it
there.  I don't know how but it
did.  That's why I can't sleep.
That's why I can't think clearly.
I've got one more week to turn it
all around.  Think.  THINK."
                 "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 something
into the terminal.  Subject's
pulse flatlined within minutes.
I've been given some time 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)
    (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-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)
    (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)
    (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)
    (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 fridge.")
          (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
                "> You're not sure what any of the controls do.  Better not touch anything.")))
  (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 cartride?"
                        '(("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)
    (dialog game player-display-name
            "> The window is covered in some sort of film and I can't see through it."))
  (define (open-notebook)
    (let ((g (& game explore-group)))
      (detach g)
      (notebook game)
      (attach-to game g)))
  (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)))))))
  (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...")
  (dialog game player-display-name "> You feel and hear breathing.")
  (dialog game (subject-name game) "Thank you.")
  (dialog game (subject-name game) "For all that you've done to me, I should kill you right here.")
  (dialog game (subject-name game) "But I can sense that you have changed.")
  (dialog game (subject-name game) "You will be spared.  The rest won't be so lucky.")
  (dialog game (subject-name game) "And if I should ever change my mind... I will find you.")
  (dialog game player-display-name "> The subject leaves the lab.")
  (dialog game player-display-name "> You take a deep breath.")
  (dialog game player-display-name "> You hear muffled screams in the distance.")
  (dialog game player-display-name "> Now it is silent.")
  (dialog game player-display-name "> You pick up your notebook and leave.")
  (sleep 60)
  (detach-all game)
  (credits))

(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 (credits (game <game>))
  (define (credit line)
    (set! (text (& game credits)) line)
    (sleep 120))
  (set! (state game) 'credits)
  (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 "developed by David Thompson - 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")
  (when (first-playthrough? game)
    (credit "the true ending still awaits you..."))
  (credit "click to play again")
  (set! (first-playthrough? game) #f)
  (channel-get (click-channel game))
  (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 "Spring Lisp Game Jam 2021"
                                   #:width window-width
                                   #:height window-height))
               (lambda () (make <game>))))