From 1d7091c3eee8c04fb3872659b528e6b7e1115387 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson@vistahigherlearning.com>
Date: Tue, 20 Apr 2021 21:38:52 -0400
Subject: Add more devices and a dialog mode with choices.

---
 game.scm | 125 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++------
 1 file changed, 114 insertions(+), 11 deletions(-)

(limited to 'game.scm')

diff --git a/game.scm b/game.scm
index 9e0e1d1..83d2cc0 100644
--- a/game.scm
+++ b/game.scm
@@ -28,6 +28,7 @@
 (define game-width 640)
 (define game-height 360)
 (define player-display-name "")
+(define thing-display-name "??????")
 
 
 ;;;
@@ -35,11 +36,16 @@
 ;;;
 
 (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 room-background (load-image "assets/images/room.png"))
 (define-asset door-lock-texture (load-image "assets/images/door-lock.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 monogram-font (load-font "assets/fonts/monogram_extended.ttf" 12))
 (define-asset monogram-font-big (load-font "assets/fonts/monogram_extended.ttf" 24))
 
@@ -121,7 +127,7 @@
 (define-theme gui-theme
   (<widget> (font monogram-font))
   (<button> (background dialog-box-texture)
-            (press-background dialog-box-texture))
+            (press-background button-press-texture))
   (<text-box> (background dialog-box-texture)))
 
 (define-class <game> (<gui-scene>)
@@ -133,11 +139,15 @@
   (terminal-channel #:accessor terminal-channel #:init-thunk make-channel)
   (terminal-lines #:accessor terminal-lines #:init-form (make-ring-buffer 17)))
 
-(define-method (reboot (game <game>))
+(define-method (reset-game (game <game>))
+  (set! (friendship game) 0)
   (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! (terminal-lines game) (make-ring-buffer 17)))
+
+(define-method (reboot (game <game>))
+  (reset-game game)
   (next-method))
 
 (define-method (detach-all (game <game>))
@@ -151,16 +161,54 @@
           #t)
         #f)))
 
-(define-method (dialog (game <game>) name line)
+(define-method (dialog (game <game>) name line choices)
   (let ((old-state (state game))
         (c (dialog-container game)))
-    (set! (state game) 'dialog)
     (attach-to game c)
     (set! (text (& c name-margin name)) name)
     (set! (text (& c text-box)) line)
-    (channel-get (click-channel game))
-    (detach c)
-    (set! (state game) old-state)))
+    (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 (intro (game <game>))
   (set! (state game) 'intro)
@@ -171,6 +219,15 @@
   (dialog game player-display-name "> ...")
   (dialog game player-display-name "> Where am I?")
   (dialog game player-display-name "> What is this place?")
+  (let ((choice (dialog game thing-display-name
+                        "Coke or Pepsi?"
+                        '(("Coke" coke)
+                          ("Pepsi" pepsi)))))
+    (if (eq? choice 'coke)
+        (begin
+          (set! (friendship game) 3)
+          (dialog game thing-display-name "Excellent choice!"))
+        (dialog game thing-display-name "Ew gross")))
   (detach-all game)
   (explore game))
 
@@ -400,7 +457,11 @@
   (define (tint-all color)
     (set! (tint (& game room-background)) color)
     (set! (tint (& game door-lock sprite)) color)
-    (set! (tint (& game terminal sprite)) color))
+    (set! (tint (& game door sprite)) color)
+    (set! (tint (& game control-panel sprite)) color)
+    (set! (tint (& game terminal sprite)) color)
+    (set! (tint (& game fridge sprite)) color)
+    (set! (tint (& game window sprite)) color))
   (define (fade-in)
     (tween 60 black white tint-all
            #:interpolate color-lerp))
@@ -411,15 +472,28 @@
     (run-script game
       (fade-out)
       (detach-all game)
-      (if (> (friendship game) 3)
+      (if (>= (friendship game) 3)
           (good-ending game)
           (bad-ending-1 game))))
   (define (open-door)
     (if (string=? (pin-entry game) "314159")
         (end-game)
-        (pk 'invalid-access-code)))
+        (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)
     (terminal game))
+  (define (open-control-panel)
+    (dialog game player-display-name
+            "> Oooh, knobs and blinking lights."))
+  (define (open-fridge)
+    (dialog game player-display-name
+            "> Any leftovers in here?"))
+  (define (inspect-window)
+    (dialog game player-display-name
+            "> The window is covered in some sort of film and I can't see through it."))
   (attach-to game
              (make <sprite>
               #:name 'room-background
@@ -431,6 +505,34 @@
                #: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 '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
@@ -504,6 +606,7 @@
     ((good-ending bad-ending-1)
      (when (eq? button 'left)
        (detach-all game)
+       (reset-game game)
        (run-script game
          (intro game))))
     ((terminal)
-- 
cgit v1.2.3