Add crude pin pad entry.

1 files changed, 121 insertions, 4 deletions

diff --git a/game.scm b/game.scm
index 43e1daf..7277322 100644
--- a/game.scm
+++ b/game.scm
@@ -37,6 +37,7 @@
 (define-asset room-background (load-image "assets/images/room.png"))
 (define-asset scanner-texture (load-image "assets/images/scanner.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))
 
 
 ;;;
@@ -101,8 +102,10 @@
 ;;;
 
 (define-theme gui-theme
-  (<text-box> (background dialog-box-texture)
-              (font monogram-font)))
+  (<widget> (font monogram-font))
+  (<button> (background dialog-box-texture)
+            (press-background dialog-box-texture))
+  (<text-box> (background dialog-box-texture)))
 
 (define-class <game> (<gui-scene>)
   (state #:accessor state #:init-value #f)
@@ -136,6 +139,114 @@
   (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 . ,(lambda (widget button)
+                       (if (eq? button 'left)
+                           (begin
+                             (input n)
+                             #t)
+                           #f)))))))
+    (define (input n)
+      (let ((pin (& game pin-pad display pin)))
+        (when (< (string-length (text pin)) 6)
+          (set! (text pin)
+                (string-append (text pin)
+                               (number->string n))))))
+    (define (clear)
+      (set! (text (& game pin-pad display pin)) ""))
+    (define (submit)
+      (channel-put! pin-channel (text (& game pin-pad display pin))))
+    (set! (state game) 'pin-entry)
+    (parameterize ((current-theme gui-theme))
+      (attach-to game
+                 ;; Hack to block clicks on devices in the room.
+                 (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)))
+                   #: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 . ,(lambda (widget button)
+                                                  (if (eq? button 'left)
+                                                      (begin
+                                                        (clear)
+                                                        #t)
+                                                      #f))))))
+                                 (margin
+                                  (make <button>
+                                    #:name 'submit
+                                    #:text "ENTER"
+                                    #:width 64.0
+                                    #:height 32.0
+                                    #:listeners
+                                    `((click . ,(lambda (widget button)
+                                                  (if (eq? button 'left)
+                                                      (begin
+                                                        (submit)
+                                                        #t)
+                                                      #f))))))))))))
+    (let ((pin (channel-get pin-channel)))
+      (pk 'pin pin)
+      (detach (& game blocker) (& game pin-pad))
+      (set! (state game) old-state))))
+
 (define-method (explore (game <game>))
   (define (tint-all color)
     (set! (tint (& game room-background)) color)
@@ -166,7 +277,8 @@
                `((click . ,(lambda (widget button)
                              (if (eq? button 'left)
                                  (begin
-                                   (end-game)
+                                   (run-script game
+                                     (pin-entry game))
                                    #t)
                                  #f))))))
   (fade-in))
@@ -228,9 +340,14 @@
 
 (define-method (on-mouse-release (game <game>) button x y)
   (case (state game)
-    ('dialog
+    ((dialog)
      (when (eq? button 'left)
        (channel-put! (click-channel game) #t)))
+    ((good-ending bad-ending-1)
+     (when (eq? button 'left)
+       (detach-all game)
+       (run-script game
+         (intro game))))
     (else
      (next-method))))