summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--game.scm125
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))))