From 2a5f8fad86d78adc82fa8c7cd94f3fe854dee025 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Sun, 30 Oct 2022 21:25:15 -0400 Subject: Day 2 progress. --- .dir-locals.el | 3 +- .gitignore | 1 + apple-town-fair/assets.scm | 4 + apple-town-fair/dialog-box.scm | 9 +- apple-town-fair/game.scm | 355 +++++++++++++++++++++++++++++------------ apple-town-fair/menu.scm | 6 +- apple-town-fair/place.scm | 11 +- apple-town-fair/save-state.scm | 24 ++- assets/images/common.kra | Bin 0 -> 359246 bytes assets/images/common.png | Bin 0 -> 77610 bytes assets/images/home.kra | Bin 282034 -> 361922 bytes assets/images/home.png | Bin 32886 -> 50907 bytes assets/images/trail.kra | Bin 0 -> 504368 bytes assets/images/trail.png | Bin 0 -> 104887 bytes 14 files changed, 289 insertions(+), 124 deletions(-) create mode 100644 assets/images/common.kra create mode 100644 assets/images/common.png create mode 100644 assets/images/trail.kra create mode 100644 assets/images/trail.png diff --git a/.dir-locals.el b/.dir-locals.el index 78f84d5..fb2de2e 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -1,4 +1,5 @@ ((scheme-mode . ((eval . (put 'with-agenda 'scheme-indent-function 1)) - (eval . (put 'repeat 'scheme-indent-function 1))))) + (eval . (put 'repeat 'scheme-indent-function 1)) + (eval . (put 'with-dialog 'scheme-indent-function 1))))) diff --git a/.gitignore b/.gitignore index 6e220e4..1f3c373 100644 --- a/.gitignore +++ b/.gitignore @@ -1,6 +1,7 @@ *~ *.go *.tar.gz +*.kra-autosave.kra /Makefile /Makefile.in /aclocal.m4 diff --git a/apple-town-fair/assets.scm b/apple-town-fair/assets.scm index 8aacf46..3d8136d 100644 --- a/apple-town-fair/assets.scm +++ b/apple-town-fair/assets.scm @@ -19,6 +19,8 @@ chickadee-image dialog-box-image home-background-image + common-background-image + trail-background-image farm-stand-background-image)) (define (scope-datadir file-name) @@ -38,4 +40,6 @@ (define-image chickadee-image (image-file "chickadee.png")) (define-image dialog-box-image (image-file "dialog-box.png")) (define-image home-background-image (image-file "home.png")) +(define-image common-background-image (image-file "common.png")) +(define-image trail-background-image (image-file "trail.png")) (define-image farm-stand-background-image (image-file "farm-stand.png")) diff --git a/apple-town-fair/dialog-box.scm b/apple-town-fair/dialog-box.scm index 0731e72..22565bd 100644 --- a/apple-town-fair/dialog-box.scm +++ b/apple-town-fair/dialog-box.scm @@ -35,13 +35,16 @@ #:name 'label #:rank 1 #:font monogram-font - #:vertical-align 'top - #:text (text dialog))) + #:vertical-align 'top)) (set! (width dialog) (width (& dialog background))) (set! (height dialog) (height (& dialog background))) + (refresh-label dialog)) + +(define-method (refresh-label (dialog )) + (set! (text (& dialog label)) (text dialog)) (teleport (& dialog label) 10.0 (- (height dialog) 10.0))) (define-method (on-change (dialog ) slot old new) (case slot ((text) - (set! (text (& dialog label)) new)))) + (refresh-label dialog)))) diff --git a/apple-town-fair/game.scm b/apple-town-fair/game.scm index 13ec3f0..b85c2e8 100644 --- a/apple-town-fair/game.scm +++ b/apple-town-fair/game.scm @@ -21,7 +21,7 @@ #:use-module (apple-town-fair light-overlay) #:use-module (apple-town-fair menu) #:use-module (apple-town-fair place) - #:use-module (apple-town-fair save-state) + ;;#:use-module (apple-town-fair save-state) #:use-module (apple-town-fair time-display) #:use-module (catbird) #:use-module (catbird mode) @@ -32,144 +32,291 @@ #:use-module (chickadee graphics path) #:use-module (chickadee math) #:use-module (chickadee math vector) + #:use-module (chickadee scripting) #:use-module (oop goops) + #:use-module (srfi srfi-1) #:export (make-game-scene)) + +;;; +;;; Game scene +;;; + (define %time-wake 6) -(define %time-sleep 21) +(define %time-sleep 22) (define %day-start 0) (define %day-end 2) -(define %start-money 20.0) - -(define-method (make-home) - (make - #:name 'place - #:title "Home" - #:background home-background-image - #:actions (list (make - #:name "Test" - #:condition (const #t) - #:exec (lambda (mode) - (pk 'testing)))))) +(define %money-start 20.0) -(define-method (make-farm-stand) - (make - #:name 'place - #:title "Farm Stand" - #:background farm-stand-background-image)) - -(define-class () +(define-class () (story-points #:accessor story-points #:init-keyword #:story-points #:init-value 0) - (day #:accessor day #:init-keyword #:day #:init-value 0) + (day #:accessor day #:init-keyword #:day #:init-value %day-start) (time #:accessor time #:init-keyword #:time #:init-value %time-wake) - (money #:accessor money #:init-keyword #:money #:init-value %start-money) + (money #:accessor money #:init-keyword #:money #:init-value %money-start) (inventory #:accessor inventory #:init-keyword #:inventory #:init-value '()) (flags #:accessor flags #:init-keyword #:flags #:init-value '())) -(define-method (on-enter (mode )) - (let ((scene (parent mode))) - (attach-to scene - (make - #:name 'overlay - #:rank 8) - (make - #:name 'dialog - #:rank 9 - #:text "Hello, world! +(define-method (on-boot (scene )) + (attach-to scene + (make + #:name 'overlay + #:rank 8) + (make + #:name 'dialog + #:rank 9 + #:text "Hello, world! How many characters fit on a line? 50 characters!! Hello, world! Hello, world! Hello, world!") - (make - #:name 'time - #:rank 9)) - (teleport (& scene time) - (- %game-width (width (& scene time))) - (- %game-height (height (& scene time)))) - (reset-game mode))) - -(define-method (change-place (mode ) (new-place )) - (let* ((scene (parent mode)) - (old-place (& scene place))) + (make + #:name 'time + #:rank 9)) + (teleport (& scene time) + (- %game-width (width (& scene time))) + (- %game-height (height (& scene time)))) + (reset-game scene)) + +(define-method (change-place (scene ) (new-place )) + (let ((old-place (& scene place))) (when old-place (detach old-place)) (attach-to scene new-place) (set! (where (& scene time)) (title new-place)) - (advance-clock mode 1) + (advance-clock scene 1) (when (& scene menu) (detach (& scene menu))) (attach-to scene (make #:name 'menu #:rank 9 - #:items (map name (actions new-place)))))) - -(define-method (change-time (mode ) t) - (let ((scene (parent mode))) - (set! (time mode) (clamp %time-wake %time-sleep t)) - (set! (time (& scene overlay)) (time mode)) - (set! (time (& scene time)) (time mode)))) - -(define-method (change-day (mode ) d) - (let ((scene (parent mode))) - (set! (day mode) (clamp %day-start %day-end d)) - (set! (day (& scene time)) (day mode)))) - -(define-method (reset-game (mode )) - (let ((scene (parent mode))) - (change-day mode %day-start) - (change-time mode %time-wake) - (change-place mode (make-home)) - (set! (story-points mode) 0) - (set! (inventory mode) '()) - (set! (flags mode) '()) - (set! (money mode) %start-money) - (hide (& scene dialog)))) - -(define-method (go-to-bed (mode )) - (let ((scene (parent mode))) - (if (= (day mode) %day-end) - (reset-game mode) - (begin - (change-time mode %time-wake) - (change-day mode (+ (day mode) 1)))))) - -(define-method (advance-clock (mode ) n) - (change-time mode (+ (time mode) n)) - (when (= (time mode) %time-sleep) - (go-to-bed mode))) - -(define-method (advance-clock-once (mode )) - (advance-clock mode 1)) - -(define-method (quit-game (mode )) - (exit-catbird)) + #:items (map name (actions new-place)) + #:position (vec2 8.0 32.0))))) + +(define-method (change-time (scene ) t) + (set! (time scene) (clamp %time-wake %time-sleep t)) + (set! (time (& scene overlay)) (time scene)) + (set! (time (& scene time)) (time scene))) + +(define-method (change-day (scene ) d) + (set! (day scene) (clamp %day-start %day-end d)) + (set! (day (& scene time)) (day scene))) + +(define-method (go-to-bed (scene )) + (if (= (day scene) %day-end) + (reset-game scene) + (begin + (change-time scene %time-wake) + (change-day scene (+ (day scene) 1))))) + +(define-method (advance-clock (scene ) n) + (change-time scene (+ (time scene) n)) + (when (= (time scene) %time-sleep) + (go-to-bed scene))) + +(define-method (dialog (scene ) who str) + (let ((node (& scene dialog))) + (set! (text node) str) + (show node) + (yield + (lambda (k) + (set! (cont (major-mode scene)) k))))) + +(define-method (inner-monologue (scene ) str) + (dialog scene "You" (string-append "> " str))) + +(define-method (reset-game (scene )) + (change-day scene %day-start) + (change-time scene %time-wake) + (change-place scene (make-home)) + (set! (story-points scene) 0) + (set! (inventory scene) '()) + (set! (flags scene) '()) + (set! (money scene) %money-start) + (hide (& scene dialog))) + +;;; +;;; Dialog mode +;;; + +(define-class () + (cont #:accessor cont #:init-value #f)) + +(define-method (advance-dialog (mode )) + (let ((k (cont mode))) + (and k (k)))) + +(define-method (switch-to-dialog-mode (scene )) + (push-major-mode scene (make ))) + +(define-syntax-rule (with-dialog scene body ...) + (begin + (switch-to-dialog-mode scene) + body ... + (pop-major-mode scene))) + +(bind-input (key-press 'return) advance-dialog) + + +;;; +;;; Places and actions +;;; -(define-method (go-to-farm-stand (mode )) - (change-place mode (make-farm-stand))) +(define-method (home-pet-cat (scene )) + (with-dialog scene + (inner-monologue scene "Chickadee is curled up on a couch cushion.") + (inner-monologue scene "You walk up to the couch, and reach down to pet +her.") + (dialog scene "Chickadee" "Meeoooow~ :3") + (inner-monologue scene "Chickadee purs loudly."))) -(define-method (go-home (mode )) - (change-place mode (make-home))) +(define-method (home-bake-pie (scene )) + (with-dialog scene + (inner-monologue scene "You check the baking cabinet.") + (inner-monologue scene "Inside you find flour, sugar, cinnamon, and +other spices.") + (inner-monologue scene "You check the fridge.") + (inner-monologue scene "Inside you find butter, but no apples.") + (inner-monologue scene "There are no apples on the counter, either.") + (inner-monologue scene "It seems an important ingredient is missing..."))) -(define-method (up-selection (mode )) +(define-method (home-carve-pumpkin (scene )) + (with-dialog scene + (inner-monologue scene "You don't have a pumpkin to carve. :("))) + +(define-method (home-watch-tv (scene )) + (with-dialog scene + (inner-monologue scene "You go to the living room and turn on the TV.") + (dialog scene "TV Person" "... more at 11.") + (inner-monologue scene "You turn the TV off."))) + +(define-method (home-inspect-garden (scene )) + (with-dialog scene + (inner-monologue scene "You walk over to the vegetable garden.") + (inner-monologue scene "There hasn't been a frost yet, but the summer +vegetables are all done. The tomato vines are +black and withered.") + (inner-monologue scene "The carrots, however, are unfazed by the cold. +The colder it gets, the sweeter they become as +they convert starches to sugars to store energy +for the winter.") + (inner-monologue scene "Pick the carrots?"))) + +(define-method (home-go-to-trail (scene )) + (change-place scene (make-trail))) + +(define-method (home-go-to-common (scene )) + (change-place scene (make-common))) + +(define-method (make-home) + (make + #:name 'place + #:title "Home" + #:background home-background-image + #:actions (list (make + #:name "Pet the cat" + #:exec home-pet-cat) + (make + #:name "Bake an apple pie" + #:exec home-bake-pie) + (make + #:name "Carve a pumpkin" + #:exec home-carve-pumpkin) + (make + #:name "Watch TV" + #:exec home-watch-tv) + (make + #:name "Inspect the garden" + #:exec home-inspect-garden) + (make + #:name "Go to the town common" + #:exec home-go-to-common) + (make + #:name "Go to the trail" + #:exec home-go-to-trail)))) + +(define-method (common-go-home (scene )) + (change-place scene (make-home))) + +(define-method (make-common) + (make + #:name 'place + #:title "Town Common" + #:background common-background-image + #:actions (list (make + #:name "Go home" + #:exec common-go-home)))) + +(define-method (trail-go-to-farm-stand (scene )) + (change-place scene (make-farm-stand))) + +(define-method (trail-go-home (scene )) + (change-place scene (make-home))) + +(define-method (make-trail) + (make + #:name 'place + #:title "Trail" + #:background trail-background-image + #:actions (list (make + #:name "Go to the farm stand" + #:exec trail-go-to-farm-stand) + (make + #:name "Go home" + #:exec trail-go-home)))) + +(define-method (farm-stand-go-to-trail (scene )) + (change-place scene (make-trail))) + +(define-method (make-farm-stand) + (make + #:name 'place + #:title "Farm Stand" + #:background farm-stand-background-image + #:actions (list (make + #:name "Go to the trail" + #:exec farm-stand-go-to-trail)))) + + +;;; +;;; Choose action mode +;;; + +(define-class ()) + +(define-method (advance-clock-once (mode )) + (advance-clock (parent mode) 1)) + +(define-method (quit-game (mode )) + (exit-catbird)) + +(define-method (up-selection (mode )) (up-selection (& (parent mode) menu) 1)) -(define-method (down-selection (mode )) +(define-method (down-selection (mode )) (down-selection (& (parent mode) menu) 1)) -(define-method (confirm-selection (mode )) - (pk 'chose (selection (& (parent mode) menu)))) +(define-method (confirm-selection (mode )) + (let* ((scene (parent mode)) + (place (& scene place)) + (chosen (selection (& scene menu))) + (action (find (lambda (a) + (string=? (name a) chosen)) + (actions place)))) + (run-script scene + (hide (& scene menu)) + (perform action scene) + (hide (& scene dialog)) + (show (& scene menu))))) -(bind-input (key-press 'r) reset-game) -(bind-input (key-press 'escape) quit-game) -(bind-input (key-press 'f) go-to-farm-stand) -(bind-input (key-press 'h) go-home) -(bind-input (key-press 'up) up-selection) -(bind-input (key-press 'down) down-selection) -(bind-input (key-press 'return) confirm-selection) +(bind-input (key-press 'r) reset-game) +(bind-input (key-press 'escape) quit-game) +(bind-input (key-press 'up) up-selection) +(bind-input (key-press 'down) down-selection) +(bind-input (key-press 'return) confirm-selection) (define (make-game-scene) - (make + (make #:name 'game - #:major-mode (make ))) + #:major-mode (make ))) diff --git a/apple-town-fair/menu.scm b/apple-town-fair/menu.scm index ad3b893..3ec4b2e 100644 --- a/apple-town-fair/menu.scm +++ b/apple-town-fair/menu.scm @@ -75,11 +75,11 @@ (define-method (select-item (menu ) i) (let* ((i (clamp 0 (- (length (items menu)) 1) i)) - (node (list-ref (item-nodes menu) i))) + (nodes (item-nodes menu))) (set! (selected-item menu) i) - (when node + (unless (null? nodes) (set! (position-y (& menu highlight)) - (position-y node))))) + (position-y (list-ref nodes i)))))) (define-method (selection (menu )) (let ((node (list-ref (item-nodes menu) (selected-item menu)))) diff --git a/apple-town-fair/place.scm b/apple-town-fair/place.scm index 2cfb5ed..b96130d 100644 --- a/apple-town-fair/place.scm +++ b/apple-town-fair/place.scm @@ -32,14 +32,13 @@ (name #:accessor name #:init-keyword #:name) (condition #:accessor condition #:init-keyword #:condition #:init-form (const #t)) - (exec #:accessor exec #:init-keyword #:exec) - (duration #:accessor duration #:init-keyword #:duration #:init-value 1)) + (exec #:accessor exec #:init-keyword #:exec)) -(define-method (performable? (action ) state) - ((condition action) state)) +(define-method (performable? (action ) scene) + ((condition action) scene)) -(define-method (perform (action ) state) - ((exec action) state)) +(define-method (perform (action ) scene) + ((exec action) scene)) (define-class () (title #:accessor title #:init-keyword #:title #:init-value "Unknown") diff --git a/apple-town-fair/save-state.scm b/apple-town-fair/save-state.scm index 2ff27a7..abeb3e6 100644 --- a/apple-town-fair/save-state.scm +++ b/apple-town-fair/save-state.scm @@ -14,21 +14,31 @@ ;;; along with this program. If not, see ;;; . (define-module (apple-town-fair save-state) + #:use-module (apple-town-fair common) #:use-module (catbird config) #:use-module (oop goops) #:export ( - place - story-points + %day-end + %day-start + %money-start + %time-sleep + %time-wake + flags inventory money - flags)) + story-points)) + +(define %time-wake 6) +(define %time-sleep 22) +(define %day-start 0) +(define %day-end 2) +(define %money-start 20.0) (define-root-class () - (place #:accessor place #:init-keyword #:place #:init-value 'home) (story-points #:accessor story-points #:init-keyword #:story-points #:init-value 0) - (day #:accessor day #:init-keyword #:day #:init-value 0) - (time #:accessor time #:init-keyword #:time #:init-value 0) + (day #:accessor day #:init-keyword #:day #:init-value %day-start) + (time #:accessor time #:init-keyword #:time #:init-value %time-wake) + (money #:accessor money #:init-keyword #:money #:init-value %money-start) (inventory #:accessor inventory #:init-keyword #:inventory #:init-value '()) - (money #:accessor money #:init-keyword #:money #:init-value 20.0) (flags #:accessor flags #:init-keyword #:flags #:init-value '())) diff --git a/assets/images/common.kra b/assets/images/common.kra new file mode 100644 index 0000000..7177a99 Binary files /dev/null and b/assets/images/common.kra differ diff --git a/assets/images/common.png b/assets/images/common.png new file mode 100644 index 0000000..e185f0f Binary files /dev/null and b/assets/images/common.png differ diff --git a/assets/images/home.kra b/assets/images/home.kra index 292f9c6..ee7d33a 100644 Binary files a/assets/images/home.kra and b/assets/images/home.kra differ diff --git a/assets/images/home.png b/assets/images/home.png index e05d305..0973211 100644 Binary files a/assets/images/home.png and b/assets/images/home.png differ diff --git a/assets/images/trail.kra b/assets/images/trail.kra new file mode 100644 index 0000000..cc4f35d Binary files /dev/null and b/assets/images/trail.kra differ diff --git a/assets/images/trail.png b/assets/images/trail.png new file mode 100644 index 0000000..04caf73 Binary files /dev/null and b/assets/images/trail.png differ -- cgit v1.2.3