diff options
Diffstat (limited to 'game.scm')
| -rw-r--r-- | game.scm | 209 |
1 files changed, 180 insertions, 29 deletions
@@ -1,15 +1,20 @@ -(use-modules (chickadee graphics color) - (chickadee graphics font) - (chickadee graphics texture) - (chickadee graphics viewport) - (chickadee math vector) - (oop goops) - (starling asset) - (starling gui) - (starling kernel) - (starling node) - (starling node-2d) - (starling scene)) +(define-module (game) + #:use-module (chickadee graphics color) + #:use-module (chickadee graphics font) + #:use-module (chickadee graphics texture) + #:use-module (chickadee graphics viewport) + #:use-module (chickadee math vector) + #:use-module (chickadee scripting) + #:use-module (ice-9 match) + #:use-module (oop goops) + #:use-module (starling asset) + #:use-module (starling gui) + #:use-module (starling kernel) + #:use-module (starling node) + #:use-module (starling node-2d) + #:use-module (starling scene) + #:duplicates (merge-generics) + #:export (launch-game)) ;;; @@ -20,6 +25,7 @@ (define window-height 720) (define game-width 640) (define game-height 360) +(define player-display-name "") ;;; @@ -29,6 +35,7 @@ (define-asset dialog-box-texture (load-image "assets/images/dialog-box.png")) (define-asset darkness (load-image "assets/images/darkness.png")) (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)) @@ -39,6 +46,15 @@ (define-class <text-box> (<widget>) (text #:accessor text #:init-keyword #:text #:init-value "" #:watch? #t)) +(define-method (on-change (text-box <text-box>) slot-name old new) + (case slot-name + ((text) + (let ((l (& text-box text))) + (when l + (set! (text l) new)))) + (else + (next-method)))) + (define-method (apply-theme (text-box <text-box>)) (next-method) (replace text-box @@ -55,6 +71,32 @@ ;;; +;;; Device +;;; + +;; An object you can interact with by clicking. +(define-class <device> (<margin-container>) + (texture #:accessor texture #:init-keyword #:texture + #:init-value null-texture #:watch? #t)) + +(define-method (on-change (device <device>) slot-name old new) + (case slot-name + ((texture) + (let ((sprite (& device sprite))) + (when sprite + (set! (texture sprite) new)))) + (else + (next-method)))) + +(define-method (apply-theme (device <device>)) + (next-method) + (replace device + (make <sprite> + #:name 'sprite + #:texture (texture device)))) + + +;;; ;;; Game ;;; @@ -63,18 +105,99 @@ (font monogram-font))) (define-class <game> (<gui-scene>) - (state #:accessor state #:init-value #f)) + (state #:accessor state #:init-value #f) + (friendship #:accessor friendship #:init-value 0) + (dialog-container #:accessor dialog-container) + (click-channel #:getter click-channel #:init-thunk make-channel)) + +(define-method (detach-all (game <game>)) + (for-each detach (children game))) + +(define-method (dialog (game <game>) name line) + (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))) (define-method (intro (game <game>)) (set! (state game) 'intro) - (parameterize ((current-theme gui-theme)) - (attach-to game - (make <sprite> - #:texture darkness) - (make <text-box> - #:text "Hello" - #:width game-width - #:height 50.0)))) + (attach-to game + (make <sprite> + #:name 'intro-darkness + #:texture darkness)) + (dialog game player-display-name "> ...") + (dialog game player-display-name "> Where am I?") + (dialog game player-display-name "> What is this place?") + (detach-all game) + (explore game)) + +(define-method (explore (game <game>)) + (define (tint-all color) + (set! (tint (& game room-background)) color) + (set! (tint (& game scanner sprite)) color)) + (define (fade-in) + (tween 60 black white tint-all + #:interpolate color-lerp)) + (define (fade-out) + (tween 60 white black tint-all + #:interpolate color-lerp)) + (define (end-game) + (run-script game + (fade-out) + (detach-all game) + (if (> (friendship game) 3) + (good-ending game) + (bad-ending-1 game)))) + (attach-to game + (make <sprite> + #:name 'room-background + #:texture room-background) + (make <device> + #:name 'scanner + #:rank 1 + #:texture scanner-texture + #:position (vec2 586.0 196.0) + #:listeners + `((click . ,(lambda (widget button) + (if (eq? button 'left) + (begin + (end-game) + #t) + #f)))))) + (fade-in)) + +(define-method (good-ending (game <game>)) + (set! (state game) 'good-ending) + (attach-to game + (make <sprite> + #:name 'darkness + #:texture darkness) + (make <label> + #:name 'message + #:font monogram-font + #:text "this is the good ending. I am so proud of you. congratulations." + #:align 'center + #:vertical-align 'center + #:position (vec2 (/ game-width 2.0) (/ game-height 2.0))))) + +(define-method (bad-ending-1 (game <game>)) + (set! (state game) 'bad-ending-1) + (attach-to game + (make <sprite> + #:name 'darkness + #:texture darkness) + (make <label> + #:name 'message + #:font monogram-font + #:text "uh oh this is the bad ending. sorry, bucko." + #:align 'center + #:vertical-align 'center + #:position (vec2 (/ game-width 2.0) (/ game-height 2.0))))) (define-method (on-boot (game <game>)) (set! (cameras game) @@ -82,11 +205,39 @@ #:resolution (vec2 game-width game-height) #:viewport (make-viewport 0 0 window-width window-height #:clear-color black)))) - (intro game)) - -(boot-kernel (make <kernel> - #:window-config (make <window-config> - #:title "Spring Lisp Game Jam 2021" - #:width window-width - #:height window-height)) - (lambda () (make <game>))) + ;; Dialog nodes. + (parameterize ((current-theme gui-theme)) + (set! (dialog-container game) + (make <vertical-container> + #:name 'dialog-container + #:rank 999 + #:children + (list (make <margin-container> + #:name 'name-margin + #:margin 4.0 + #:children + (list (make <label> + #:name 'name + #:font monogram-font))) + (make <text-box> + #:name 'text-box + #:width game-width + #:height 50.0))))) + (run-script game + (intro game))) + +(define-method (on-mouse-release (game <game>) button x y) + (case (state game) + ('dialog + (when (eq? button 'left) + (channel-put! (click-channel game) #t))) + (else + (next-method)))) + +(define (launch-game) + (boot-kernel (make <kernel> + #:window-config (make <window-config> + #:title "Spring Lisp Game Jam 2021" + #:width window-width + #:height window-height)) + (lambda () (make <game>)))) |