path: root/apple-town-fair/game.scm

;;; Copyright © 2022 David Thompson <davet@gnu.org>
;;;
;;; This program is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation, either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program.  If not, see
;;; <http://www.gnu.org/licenses/>.
(define-module (apple-town-fair game)
  #:use-module (apple-town-fair assets)
  #:use-module (apple-town-fair common)
  #:use-module (apple-town-fair config)
  #:use-module (apple-town-fair dialog-box)
  #: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 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)
  #:use-module (oop goops)
  #:use-module (srfi srfi-1)
  #:export (make-game-scene))


;;;
;;; Game scene
;;;

(define %time-wake 6)
(define %time-sleep 22)
(define %day-start 0)
(define %day-end 2)
(define %money-start 20.0)

(define-class <game> (<scene>)
  (story-points #:accessor story-points #:init-keyword #:story-points
                #: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 '())
  (flags #:accessor flags #:init-keyword #:flags #:init-value '()))

(define-method (on-boot (scene <game>))
  (attach-to scene
             (make <light-overlay>
               #:name 'overlay
               #:rank 8)
             (make <dialog-box>
               #:name 'dialog
               #:rank 9
               #:text "Hello, world!
How many characters fit on a line? 50 characters!!
Hello, world!
Hello, world!
Hello, world!")
             (make <time-display>
               #:name 'time
               #:rank 9))
  (teleport (& scene time)
            (- %game-width (width (& scene time)))
            (- %game-height (height (& scene time))))
  (reset-game scene))

(define-method (friday? (scene <game>))
  (= (day scene) 0))

(define-method (saturday? (scene <game>))
  (= (day scene) 1))

(define-method (sunday? (scene <game>))
  (= (day scene) 2))

(define-method (in-inventory? (scene <game>) thing)
  (memq thing (inventory scene)))

(define-method (take-out (scene <game>) thing)
  (and (in-inventory? scene thing)
       (begin
         (discard scene thing)
         thing)))

(define-method (pick-up (scene <game>) thing)
  (set! (inventory scene) (cons thing (inventory scene))))

(define-method (discard (scene <game>) thing)
  (set! (inventory scene) (delq thing (inventory scene))))

(define-method (enough-money? (scene <game>) desired-spend)
  (>= (money scene) desired-spend))

(define-method (spend (scene <game>) amount)
  (set! (money scene) (- (money scene) amount)))

(define-method (add-flag (scene <game>) flag)
  (set! (flags scene) (cons flag (flags scene))))

(define-method (change-place/init (scene <game>) (new-place <place>))
  (let ((old-place (& scene place)))
    (when old-place
      (detach old-place))
    (when (& scene menu)
      (detach (& scene menu)))
    (attach-to scene new-place)
    (set! (where (& scene time)) (title new-place))
    (attach-to scene
               (make <menu>
                 #:name 'menu
                 #:rank 9
                 #:items (map name (actions new-place))
                 #:position (vec2 8.0 32.0)))))

(define-method (change-place (scene <game>) (new-place <place>))
  (run-script scene
    (push-major-mode scene (make <nothing-mode>))
    (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 <game>) 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 <game>) d)
  (set! (day scene) (clamp %day-start %day-end d))
  (set! (day (& scene time)) (day scene)))

(define-method (go-to-bed (scene <game>))
  (if (= (day scene) %day-end)
      (reset-game scene)
      (begin
        (change-time scene %time-wake)
        (change-day scene (+ (day scene) 1))
        (change-place scene (make-home)))))

(define-method (advance-clock (scene <game>) 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 <game>) who str)
  (let ((node (& scene dialog)))
    (set! (text node) (word-wrap str))
    (show node)
    (yield
     (lambda (k)
       (set! (cont (major-mode scene)) k)))))

(define-method (inner-monologue (scene <game>) str)
  (dialog scene "You" (string-append "> " str)))

(define-method (reset-game (scene <game>))
  (change-day scene %day-start)
  (change-time scene %time-wake)
  (change-place/init 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 <dialog-mode> (<major-mode>)
  (cont #:accessor cont #:init-value #f))

(define-method (advance-dialog (mode <dialog-mode>))
  (let ((k (cont mode)))
    (and k (k))))

(define-method (switch-to-dialog-mode (scene <game>))
  (push-major-mode scene (make <dialog-mode>)))

(define-syntax-rule (with-dialog scene body ...)
  (begin
    (switch-to-dialog-mode scene)
    body ...
    (pop-major-mode scene)))

(bind-input <dialog-mode> (key-press 'return) advance-dialog)


;;;
;;; Places and actions
;;;

(define-method (home-pet-cat (scene <game>))
  (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 (home-bake-pie (scene <game>))
  (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.")
    (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 <canvas>
                        #: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 <game>))
  (with-dialog scene
    (inner-monologue scene "You don't have a pumpkin to carve. :(")))

(define-method (home-watch-tv (scene <game>))
  (with-dialog scene
    (inner-monologue scene "You go to the living room and turn on the TV.")
    (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 <game>))
  (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.")
    ;; 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 <game>))
  (change-place scene (make-trail)))

(define-method (home-go-to-common (scene <game>))
  (change-place scene (make-common)))

(define-method (home-go-to-farm-stand (scene <game>))
  (change-place scene (make-farm-stand)))

(define-method (home-go-to-bed (scene <game>))
  (go-to-bed scene))

(define-method (make-home)
  (make <place>
    #:name 'place
    #:title "Home"
    #:background home-background-image
    #:actions (list (make <action>
                      #:name "Pet the cat"
                      #:exec home-pet-cat)
                    (make <action>
                      #:name "Bake an apple pie"
                      #:exec home-bake-pie)
                    (make <action>
                      #:name "Carve a pumpkin"
                      #:exec home-carve-pumpkin)
                    (make <action>
                      #:name "Watch TV"
                      #:exec home-watch-tv)
                    (make <action>
                      #:name "Inspect the garden"
                      #:exec home-inspect-garden)
                    (make <action>
                      #:name "Go to the town common"
                      #:exec home-go-to-common)
                    (make <action>
                      #:name "Go to the farm stand"
                      #:exec home-go-to-farm-stand)
                    (make <action>
                      #:name "Go to the trail"
                      #:exec home-go-to-trail)
                    (make <action>
                      #:name "Go to bed"
                      #:exec home-go-to-bed))))

(define-method (common-go-home (scene <game>))
  (change-place scene (make-home)))

(define-method (common-read-memorial (scene <game>))
  (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 <sprite>
                 #: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 <place>
    #:name 'place
    #:title "Town Common"
    #:background common-background-image
    #:actions (list (make <action>
                      #:name "Read memorial"
                      #:exec common-read-memorial)
                    (make <action>
                      #:name "Go home"
                      #:exec common-go-home))))

(define-method (trail-go-to-orchard (scene <game>))
  (change-place scene (make-orchard)))

(define-method (trail-go-home (scene <game>))
  (change-place scene (make-home)))

(define-method (trail-look-around (scene <game>))
  #t)

(define-method (trail-forest-bathe (scene <game>))
  #t)

(define-method (make-trail)
  (make <place>
    #:name 'place
    #:title "Trail"
    #:background trail-background-image
    #:actions (list (make <action>
                      #:name "Look around"
                      #:exec trail-look-around)
                    (make <action>
                      #:name "Forest bathe"
                      #:exec trail-forest-bathe)
                    (make <action>
                      #:name "Go to the orchard"
                      #:exec trail-go-to-orchard)
                    (make <action>
                      #:name "Go home"
                      #:exec trail-go-home))))

(define-method (farm-stand-go-home (scene <game>))
  (change-place scene (make-home)))

(define-method (make-farm-stand)
  (make <place>
    #:name 'place
    #:title "Farm Stand"
    #:background farm-stand-background-image
    #:actions (list (make <action>
                      #:name "Go home"
                      #:exec farm-stand-go-home))))

(define-method (orchard-go-to-trail (scene <game>))
  (change-place scene (make-trail)))

(define-method (orchard-enter-store (scene <game>))
  (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 <place>
    #:name 'place
    #:title "Orchard"
    #:background orchard-background-image
    #:actions (list (make <action>
                      #:name "Enter the store"
                      #:exec orchard-enter-store)
                    (make <action>
                      #:name "Go to the trail"
                      #:exec orchard-go-to-trail))))


;;;
;;; Choose action mode
;;;

(define-class <choose-action-mode> (<major-mode>))

(define-method (advance-clock-once (mode <choose-action-mode>))
  (advance-clock (parent mode) 1))

(define-method (quit-game (mode <choose-action-mode>))
  (exit-catbird))

(define-method (up-selection (mode <choose-action-mode>))
  (up-selection (& (parent mode) menu) 1))

(define-method (down-selection (mode <choose-action-mode>))
  (down-selection (& (parent mode) menu) 1))

(define-method (confirm-selection (mode <choose-action-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 <choose-action-mode> (key-press 'r) reset-game)
(bind-input <choose-action-mode> (key-press 'escape) quit-game)
(bind-input <choose-action-mode> (key-press 'up) up-selection)
(bind-input <choose-action-mode> (key-press 'down) down-selection)
(bind-input <choose-action-mode> (key-press 'return) confirm-selection)

(define (make-game-scene)
  (make <game>
    #:name 'game
    #:major-mode (make <choose-action-mode>)))