From 6ed676f681ac6eb8e2aa601a10508b360c716756 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson@vistahigherlearning.com>
Date: Thu, 22 Apr 2021 11:04:04 -0400
Subject: Add notebook mode.

---
 assets/fonts/old-fax.ttf               | Bin 0 -> 31388 bytes
 assets/images/notebook-background.png  | Bin 0 -> 1698 bytes
 assets/images/notebook-background.xcf  | Bin 0 -> 14323 bytes
 assets/images/notebook.png             | Bin 0 -> 1280 bytes
 assets/images/notebook.xcf             | Bin 0 -> 2008 bytes
 assets/images/pin-entry-background.png | Bin 0 -> 2881 bytes
 assets/images/pin-entry-background.xcf | Bin 0 -> 24591 bytes
 game.scm                               | 357 ++++++++++++++++++++++-----------
 8 files changed, 237 insertions(+), 120 deletions(-)
 create mode 100644 assets/fonts/old-fax.ttf
 create mode 100644 assets/images/notebook-background.png
 create mode 100644 assets/images/notebook-background.xcf
 create mode 100644 assets/images/notebook.png
 create mode 100644 assets/images/notebook.xcf
 create mode 100644 assets/images/pin-entry-background.png
 create mode 100644 assets/images/pin-entry-background.xcf

diff --git a/assets/fonts/old-fax.ttf b/assets/fonts/old-fax.ttf
new file mode 100644
index 0000000..2762ac4
Binary files /dev/null and b/assets/fonts/old-fax.ttf differ
diff --git a/assets/images/notebook-background.png b/assets/images/notebook-background.png
new file mode 100644
index 0000000..9b9916e
Binary files /dev/null and b/assets/images/notebook-background.png differ
diff --git a/assets/images/notebook-background.xcf b/assets/images/notebook-background.xcf
new file mode 100644
index 0000000..4f82eef
Binary files /dev/null and b/assets/images/notebook-background.xcf differ
diff --git a/assets/images/notebook.png b/assets/images/notebook.png
new file mode 100644
index 0000000..aa93b20
Binary files /dev/null and b/assets/images/notebook.png differ
diff --git a/assets/images/notebook.xcf b/assets/images/notebook.xcf
new file mode 100644
index 0000000..db99898
Binary files /dev/null and b/assets/images/notebook.xcf differ
diff --git a/assets/images/pin-entry-background.png b/assets/images/pin-entry-background.png
new file mode 100644
index 0000000..d2b85de
Binary files /dev/null and b/assets/images/pin-entry-background.png differ
diff --git a/assets/images/pin-entry-background.xcf b/assets/images/pin-entry-background.xcf
new file mode 100644
index 0000000..3b665d7
Binary files /dev/null and b/assets/images/pin-entry-background.xcf differ
diff --git a/game.scm b/game.scm
index 83d2cc0..7c23916 100644
--- a/game.scm
+++ b/game.scm
@@ -40,14 +40,18 @@
 (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 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))
 
 
 ;;;
@@ -249,80 +253,79 @@
                                         (lambda ()
                                           (input n))))))))
     (define (input n)
-      (let ((pin (& game pin-pad display pin)))
+      (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 (& game pin-pad display pin)) ""))
+      (set! (text (pin)) ""))
     (define (submit)
-      (channel-put! pin-channel (text (& game pin-pad display pin))))
+      (channel-put! pin-channel (text (pin))))
     (set! (state game) 'pin-entry)
     (parameterize ((current-theme gui-theme))
       (attach-to game
-                 ;; Hack to block clicks on devices in the room. Not working!
-                 (make <margin-container>
-                   #:name 'blocker
-                   #:rank 98
-                   #:width game-width
-                   #:height game-height
-                   #:listeners
-                   `((click . ,(lambda (widget button)
-                                 (pk 'hi)
-                                 #t))))
-                 (make <vertical-container>
-                   #:name 'pin-pad
-                   #:rank 99
-                   #:position (vec2 (- (/ game-width 2.0)
-                                       (/ (* 5.0 32.0) 2.0))
-                                    (- (/ game-height 2.0)
-                                       (/ (* 3.0 32.0) 2.0)))
+                 (make <widget>
+                   #:name 'pin-entry-group
                    #:children
-                   (list (make <horizontal-container>
-                           #:name 'display
-                           #: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)))))))))))
+                   (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 blocker) (& game pin-pad))
+      (detach (& game pin-entry-group))
       (set! (state game) old-state)
       pin)))
 
@@ -453,15 +456,100 @@
             (detach (& game terminal-group))
             (set! (state game) old-state))))))
 
+(define-method (notebook (game <game>))
+  (let ((page 0)
+        (pages '("Captain's log: Stardate 2404.26
+How many characters can I put on a
+line before I need to wrap it?"
+                 "This is a test"
+                 "Also a test"))
+        (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 room-background)) color)
-    (set! (tint (& game door-lock 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))
+    (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 60 black white tint-all
            #:interpolate color-lerp))
@@ -476,15 +564,22 @@
           (good-ending game)
           (bad-ending-1 game))))
   (define (open-door)
-    (if (string=? (pin-entry game) "314159")
-        (end-game)
-        (dialog game player-display-name
-                "> Hmm, no luck.")))
+    (let ((g (& game explore-group)))
+      (detach g)
+      (if (string=? (pin-entry game) "314159")
+          (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)
-    (terminal game))
+    (let ((g (& game explore-group)))
+      (detach g)
+      (terminal game)
+      (attach-to game g)))
   (define (open-control-panel)
     (dialog game player-display-name
             "> Oooh, knobs and blinking lights."))
@@ -494,52 +589,67 @@
   (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 <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 '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)))))
+             (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>))
@@ -598,6 +708,13 @@
   (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)
-- 
cgit v1.2.3