From 01825bf8f09f75cbe15eee97300a49fe332b502c Mon Sep 17 00:00:00 2001 From: David Thompson Date: Tue, 8 Nov 2022 21:02:06 -0500 Subject: Add all the stuff I was doing before I quit the jam. --- apple-town-fair/game.scm | 266 +++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 235 insertions(+), 31 deletions(-) (limited to 'apple-town-fair/game.scm') diff --git a/apple-town-fair/game.scm b/apple-town-fair/game.scm index b85c2e8..5ede549 100644 --- a/apple-town-fair/game.scm +++ b/apple-town-fair/game.scm @@ -24,12 +24,14 @@ ;;#:use-module (apple-town-fair save-state) #:use-module (apple-town-fair time-display) #:use-module (catbird) + #:use-module (catbird asset) #:use-module (catbird mode) #:use-module (catbird node) #:use-module (catbird node-2d) #:use-module (catbird scene) #:use-module (chickadee graphics color) #:use-module (chickadee graphics path) + #:use-module (chickadee graphics texture) #:use-module (chickadee math) #:use-module (chickadee math vector) #:use-module (chickadee scripting) @@ -78,15 +80,47 @@ Hello, world!") (- %game-height (height (& scene time)))) (reset-game scene)) -(define-method (change-place (scene ) (new-place )) +(define-method (friday? (scene )) + (= (day scene) 0)) + +(define-method (saturday? (scene )) + (= (day scene) 1)) + +(define-method (sunday? (scene )) + (= (day scene) 2)) + +(define-method (in-inventory? (scene ) thing) + (memq thing (inventory scene))) + +(define-method (take-out (scene ) thing) + (and (in-inventory? scene thing) + (begin + (discard scene thing) + thing))) + +(define-method (pick-up (scene ) thing) + (set! (inventory scene) (cons thing (inventory scene)))) + +(define-method (discard (scene ) thing) + (set! (inventory scene) (delq thing (inventory scene)))) + +(define-method (enough-money? (scene ) desired-spend) + (>= (money scene) desired-spend)) + +(define-method (spend (scene ) amount) + (set! (money scene) (- (money scene) amount))) + +(define-method (add-flag (scene ) flag) + (set! (flags scene) (cons flag (flags scene)))) + +(define-method (change-place/init (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 scene 1) (when (& scene menu) (detach (& scene menu))) + (attach-to scene new-place) + (set! (where (& scene time)) (title new-place)) (attach-to scene (make #:name 'menu @@ -94,6 +128,14 @@ Hello, world!") #:items (map name (actions new-place)) #:position (vec2 8.0 32.0))))) +(define-method (change-place (scene ) (new-place )) + (run-script scene + (push-major-mode scene (make )) + (fade-out scene 0.5) + (change-place/init scene new-place) + (fade-in scene 0.5) + (pop-major-mode scene))) + (define-method (change-time (scene ) t) (set! (time scene) (clamp %time-wake %time-sleep t)) (set! (time (& scene overlay)) (time scene)) @@ -108,16 +150,52 @@ Hello, world!") (reset-game scene) (begin (change-time scene %time-wake) - (change-day scene (+ (day scene) 1))))) + (change-day scene (+ (day scene) 1)) + (change-place scene (make-home))))) (define-method (advance-clock (scene ) n) (change-time scene (+ (time scene) n)) (when (= (time scene) %time-sleep) (go-to-bed scene))) +(define* (word-wrap str #:optional (columns 50)) + (let ((n (string-length str))) + (string-join + (let loop ((i 0) + (column 0) + (line-start 0) + (word-start #f) + (whitespace-start #f)) + (cond + ((= i n) + (list (substring str line-start i))) + ((char=? (string-ref str i) #\newline) + (let ((j (+ i 1))) + (cons (substring str line-start (or whitespace-start i)) + (loop j 0 j #f #f)))) + ((> column columns) + (let ((j (or word-start whitespace-start i))) + (cons (substring str line-start j) + (loop j 0 j j #f)))) + ((char-whitespace? (string-ref str i)) + (if (= i line-start) + (loop (+ i 1) column (+ i 1) #f #f) + (loop (+ i 1) (+ column 1) line-start #f (or whitespace-start i)))) + (else + (loop (+ i 1) (+ column 1) line-start (or word-start i) #f)))) + "\n"))) + +;; (display +;; (word-wrap +;; "Hello there. This is a test of word wrapping. I sure hope it works well. Testing testing, one two three. + + +;; Goodbye. +;; ")) + (define-method (dialog (scene ) who str) (let ((node (& scene dialog))) - (set! (text node) str) + (set! (text node) (word-wrap str)) (show node) (yield (lambda (k) @@ -129,7 +207,7 @@ Hello, world!") (define-method (reset-game (scene )) (change-day scene %day-start) (change-time scene %time-wake) - (change-place scene (make-home)) + (change-place/init scene (make-home)) (set! (story-points scene) 0) (set! (inventory scene) '()) (set! (flags scene) '()) @@ -166,20 +244,57 @@ Hello, world!") (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.") + (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 (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 "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..."))) + (let ((apples (or (take-out scene 'heirloom-apples) + (take-out scene 'gala-apples) + (take-out scene 'macoun-apples) + (take-out scene 'cortland-apples) + (take-out scene 'honeycrisp-apples)))) + (if apples + (begin + (inner-monologue scene "Inside you find butter.") + (inner-monologue scene "You close the fridge.") + (if (eq? apples 'heirloom-apples) + (inner-monologue scene "You have the apples you found in the forest.") + (inner-monologue scene "You have apples you bought at the orchard.")) + (inner-monologue scene "You have everything you need to bake a pie!") + ;; (if (yes/no scene "Bake an apple pie?")) + (inner-monologue scene "You mix flour and butter and salt to form the crust.") + (inner-monologue scene "You put the crust in the fridge to chill.") + (inner-monologue scene "You preheat the oven to 325.") + (inner-monologue scene "You peel and slice the apples, saving the peels for the compost pile. The sliced apples go into a large mixing bowl.") + (inner-monologue scene "To the sliced apples you add a teaspoon of cinnamon, a quarter teaspoon of nutmeg, a half cup of sugar, and a quarter cup of flour to thicken the filling.") + (inner-monologue scene "You roll out the pie crust into two circles, +press one circle into a pie plate, and dump in the +bowl of sliced apples.") + (inner-monologue scene "You place the second crust circle on top and slice three slits into it.") + (inner-monologue scene "You place the pie in the oven and wait...") + (fade-out scene 1.0) + (advance-clock scene 1) + (let ((bg (make + #:rank 999 + #:painter (full-screen-rectangle black)))) + (attach-to scene bg) + (sleep 1.0) + (detach bg)) + (fade-in scene 1.0) + (inner-monologue scene "It's done! You remove the pie from the oven and place it on the stovetop to cool.") + (pick-up scene + (if (eq? apples 'heirloom-apples) + 'fantastic-apple-pie + 'pretty-good-apple-pie))) + (begin + (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 (home-carve-pumpkin (scene )) (with-dialog scene @@ -188,20 +303,27 @@ other spices.") (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.") + (cond + ((and (friday? scene) (= (time scene) 6)) + (dialog scene "Meteorologist" "... And now for today's forecast.") + (dialog scene "Meteorologist" "We're looking at a sunny fall day with a high around 54 degrees in the early afternoon, but look out! It seems our first frost is on its way with a low of about 29 overnight. Stay warm out there!") + (dialog scene "Meteorologist" "And now back to the channel 5 team for your local news coverage!")) + (else + (dialog scene "Voiceover" "Are you tired of *this*?") + (inner-monologue scene "Another infomercial..."))) (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?"))) + (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.") + ;; TODO: Choose whether or not to pick carrots. + ;;(if (yes/no scene "Pick the carrots?")) + (when (saturday? scene) + (inner-monologue scene "There has been a frost overnight. The carrots will surely be very sweet and delicious now.")) + (inner-monologue scene "You pull the carrots from the soil.") + (pick-up scene (if (saturday? scene) 'frost-sweetened-carrots 'carrots)))) (define-method (home-go-to-trail (scene )) (change-place scene (make-trail))) @@ -209,6 +331,12 @@ for the winter.") (define-method (home-go-to-common (scene )) (change-place scene (make-common))) +(define-method (home-go-to-farm-stand (scene )) + (change-place scene (make-farm-stand))) + +(define-method (home-go-to-bed (scene )) + (go-to-bed scene)) + (define-method (make-home) (make #:name 'place @@ -232,42 +360,89 @@ for the winter.") (make #:name "Go to the town common" #:exec home-go-to-common) + (make + #:name "Go to the farm stand" + #:exec home-go-to-farm-stand) (make #:name "Go to the trail" - #:exec home-go-to-trail)))) + #:exec home-go-to-trail) + (make + #:name "Go to bed" + #:exec home-go-to-bed)))) (define-method (common-go-home (scene )) (change-place scene (make-home))) +(define-method (common-read-memorial (scene )) + (with-dialog scene + (inner-monologue scene "You walk over to the stone memorial monument on the north side of the common.") + (attach-to scene + (make + #:name 'burned-town + #:rank 1 + #:texture burned-town-image + #:position (vec2 (/ (- %game-width + (texture-width + (artifact burned-town-image))) + 2.0 ) + 78.0))) + (run-script scene + (tween 0.25 0.0 1.0 + (lambda (a) + (set! (tint (& scene burned-town)) (transparency a))))) + (dialog scene "Memorial" "In memory of the settlers lost during the siege and subsequent burning of this town by the Nipmuck Indians. + +August 1675") + (run-script scene + (tween 0.25 1.0 0.0 + (lambda (a) + (set! (tint (& scene burned-town)) (transparency a)))) + (detach (& scene burned-town))))) + (define-method (make-common) (make #:name 'place #:title "Town Common" #:background common-background-image #:actions (list (make + #:name "Read memorial" + #:exec common-read-memorial) + (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-to-orchard (scene )) + (change-place scene (make-orchard))) (define-method (trail-go-home (scene )) (change-place scene (make-home))) +(define-method (trail-look-around (scene )) + #t) + +(define-method (trail-forest-bathe (scene )) + #t) + (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) + #:name "Look around" + #:exec trail-look-around) + (make + #:name "Forest bathe" + #:exec trail-forest-bathe) + (make + #:name "Go to the orchard" + #:exec trail-go-to-orchard) (make #:name "Go home" #:exec trail-go-home)))) -(define-method (farm-stand-go-to-trail (scene )) - (change-place scene (make-trail))) +(define-method (farm-stand-go-home (scene )) + (change-place scene (make-home))) (define-method (make-farm-stand) (make @@ -275,8 +450,37 @@ for the winter.") #:title "Farm Stand" #:background farm-stand-background-image #:actions (list (make + #:name "Go home" + #:exec farm-stand-go-home)))) + +(define-method (orchard-go-to-trail (scene )) + (change-place scene (make-trail))) + +(define-method (orchard-enter-store (scene )) + (with-dialog scene + (inner-monologue scene "You step into the orchard's store and are immediately greeted by the scent of apples and cinnamon.") + (inner-monologue scene "The wooden store shelves are loaded with different types of apples in 1/2 peck size bags. Gala, Macoun, Cortland, Honeycrisp... there's a lot of variety here.") + (inner-monologue scene "In the back of the store there are apple pies, apple dumplings, apple crisps, and cider donuts.") + (inner-monologue scene "You hear the low hum of a refrigerator full of apple cider, unpasteurized and made on site.") + (dialog scene "Cashier" "Welcome! Let me know if you need anything.") + ;; TODO: Select type of apples to buy, or to not buy anything. + (when (enough-money? scene 8.00) + (inner-monologue scene "You buy a 1/2 peck of Cortland apples.") + (spend scene 8.00) + (pick-up scene 'cortland-apples) + (dialog scene "Cashier" "Thank you! Enjoy!")))) + +(define-method (make-orchard) + (make + #:name 'place + #:title "Orchard" + #:background orchard-background-image + #:actions (list (make + #:name "Enter the store" + #:exec orchard-enter-store) + (make #:name "Go to the trail" - #:exec farm-stand-go-to-trail)))) + #:exec orchard-go-to-trail)))) ;;; -- cgit v1.2.3