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 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 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 (change-place (scene <game>) (new-place <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
               (make <menu>
                 #:name 'menu
                 #:rank 9
                 #:items (map name (actions new-place))
                 #:position (vec2 8.0 32.0)))))

(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)))))

(define-method (advance-clock (scene <game>) n)
  (change-time scene (+ (time scene) n))
  (when (= (time scene) %time-sleep)
    (go-to-bed scene)))

(define-method (dialog (scene <game>) 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 <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 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.")
    (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.")
    (dialog scene "TV Person" "... more at 11.")
    (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.")
    (inner-monologue scene "Pick the 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 (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 trail"
                      #:exec home-go-to-trail))))

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

(define-method (make-common)
  (make <place>
    #:name 'place
    #:title "Town Common"
    #:background common-background-image
    #:actions (list (make <action>
                      #:name "Go home"
                      #:exec common-go-home))))

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

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

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

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

(define-method (make-farm-stand)
  (make <place>
    #:name 'place
    #:title "Farm Stand"
    #:background farm-stand-background-image
    #:actions (list (make <action>
                      #:name "Go to the trail"
                      #:exec farm-stand-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>)))