Day 1 progress.

1 files changed, 77 insertions, 10 deletions

diff --git a/apple-town-fair/game.scm b/apple-town-fair/game.scm
index 878dbac..13ec3f0 100644
--- a/apple-town-fair/game.scm
+++ b/apple-town-fair/game.scm
@@ -17,10 +17,13 @@
   #: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)
@@ -38,8 +41,24 @@
 (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-method (make-farm-stand)
+  (make <place>
+    #:name 'place
+    #:title "Farm Stand"
+    #:background farm-stand-background-image))
+
 (define-class <game-mode> (<major-mode>)
-  (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)
@@ -51,12 +70,17 @@
 (define-method (on-enter (mode <game-mode>))
   (let ((scene (parent mode)))
     (attach-to scene
-               (make <place>
-                 #:name 'home
-                 #:background home-background-image)
                (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))
@@ -65,6 +89,22 @@
               (- %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)))
+    (when old-place
+      (detach old-place))
+    (attach-to scene new-place)
+    (set! (where (& scene time)) (title new-place))
+    (advance-clock mode 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))
@@ -77,11 +117,15 @@
     (set! (day (& scene time)) (day mode))))
 
 (define-method (reset-game (mode <game-mode>))
-  (change-day mode %day-start)
-  (change-time mode %time-wake)
-  (set! (inventory mode) '())
-  (set! (flags mode) '())
-  (set! (money mode) %start-money))
+  (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)))
@@ -99,8 +143,31 @@
 (define-method (advance-clock-once (mode <game-mode>))
   (advance-clock mode 1))
 
-(bind-input <game-mode> (key-press 'space) advance-clock-once)
+(define-method (quit-game (mode <game-mode>))
+  (exit-catbird))
+
+(define-method (go-to-farm-stand (mode <game-mode>))
+  (change-place mode (make-farm-stand)))
+
+(define-method (go-home (mode <game-mode>))
+  (change-place mode (make-home)))
+
+(define-method (up-selection (mode <game-mode>))
+  (up-selection (& (parent mode) menu) 1))
+
+(define-method (down-selection (mode <game-mode>))
+  (down-selection (& (parent mode) menu) 1))
+
+(define-method (confirm-selection (mode <game-mode>))
+  (pk 'chose (selection (& (parent mode) 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)
 
 (define (make-game-scene)
   (make <scene>