Day 2 progress.

14 files changed, 289 insertions, 124 deletions

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 <dialog-box>))
+  (set! (text (& dialog label)) (text dialog))
   (teleport (& dialog label) 10.0 (- (height dialog) 10.0)))
 
 (define-method (on-change (dialog <dialog-box>) 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 <place>
-    #:name 'place
-    #:title "Home"
-    #:background home-background-image
-    #:actions (list (make <action>
-                      #:name "Test"
-                      #:condition (const #t)
-                      #:exec (lambda (mode)
-                               (pk 'testing))))))
+(define %money-start 20.0)
 
-(define-method (make-farm-stand)
-  (make <place>
-    #:name 'place
-    #:title "Farm Stand"
-    #:background farm-stand-background-image))
-
-(define-class <game-mode> (<major-mode>)
+(define-class <game> (<scene>)
   (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 <game-mode>))
-  (let ((scene (parent mode)))
-    (attach-to scene
-               (make <light-overlay>
-                 #:name 'overlay
-                 #:rank 8)
-               (make <dialog-box>
-                 #:name 'dialog
-                 #:rank 9
-                 #:text "Hello, world!
+(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 mode)))
-
-(define-method (change-place (mode <game-mode>) (new-place <place>))
-  (let* ((scene (parent mode))
-         (old-place (& scene place)))
+             (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 mode 1)
+    (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))))))
-
-(define-method (change-time (mode <game-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 <game-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 <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 <game-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 <game-mode>) n)
-  (change-time mode (+ (time mode) n))
-  (when (= (time mode) %time-sleep)
-    (go-to-bed mode)))
-
-(define-method (advance-clock-once (mode <game-mode>))
-  (advance-clock mode 1))
-
-(define-method (quit-game (mode <game-mode>))
-  (exit-catbird))
+                 #: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 (go-to-farm-stand (mode <game-mode>))
-  (change-place mode (make-farm-stand)))
+(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 (go-home (mode <game-mode>))
-  (change-place mode (make-home)))
+(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 (up-selection (mode <game-mode>))
+(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 <game-mode>))
+(define-method (down-selection (mode <choose-action-mode>))
   (down-selection (& (parent mode) menu) 1))
 
-(define-method (confirm-selection (mode <game-mode>))
-  (pk 'chose (selection (& (parent mode) menu))))
+(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 <game-mode> (key-press 'r) reset-game)
-(bind-input <game-mode> (key-press 'escape) quit-game)
-(bind-input <game-mode> (key-press 'f) go-to-farm-stand)
-(bind-input <game-mode> (key-press 'h) go-home)
-(bind-input <game-mode> (key-press 'up) up-selection)
-(bind-input <game-mode> (key-press 'down) down-selection)
-(bind-input <game-mode> (key-press 'return) confirm-selection)
+(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 <scene>
+  (make <game>
     #:name 'game
-    #:major-mode (make <game-mode>)))
+    #:major-mode (make <choose-action-mode>)))
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 <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 <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 <action>) state)
-  ((condition action) state))
+(define-method (performable? (action <action>) scene)
+  ((condition action) scene))
 
-(define-method (perform (action <action>) state)
-  ((exec action) state))
+(define-method (perform (action <action>) scene)
+  ((exec action) scene))
 
 (define-class <place> (<node-2d>)
   (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
 ;;; <http://www.gnu.org/licenses/>.
 (define-module (apple-town-fair save-state)
+  #:use-module (apple-town-fair common)
   #:use-module (catbird config)
   #:use-module (oop goops)
   #:export (<save-state>
-            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 <save-state> ()
-  (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
--- /dev/null
+++ b/assets/images/common.kra
diff --git a/assets/images/common.png b/assets/images/common.png
new file mode 100644
index 0000000..e185f0f
--- /dev/null
+++ b/assets/images/common.png
diff --git a/assets/images/home.kra b/assets/images/home.kra
index 292f9c6..ee7d33a 100644
--- a/assets/images/home.kra
+++ b/assets/images/home.kra
diff --git a/assets/images/home.png b/assets/images/home.png
index e05d305..0973211 100644
--- a/assets/images/home.png
+++ b/assets/images/home.png
diff --git a/assets/images/trail.kra b/assets/images/trail.kra
new file mode 100644
index 0000000..cc4f35d
--- /dev/null
+++ b/assets/images/trail.kra
diff --git a/assets/images/trail.png b/assets/images/trail.png
new file mode 100644
index 0000000..04caf73
--- /dev/null
+++ b/assets/images/trail.png