diff options
| -rw-r--r-- | game.scm | 125 |
1 files changed, 121 insertions, 4 deletions
@@ -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)))) |