Add basic time progression and game state reset.

8 files changed, 361 insertions, 13 deletions

diff --git a/apple-town-fair/assets.scm b/apple-town-fair/assets.scm
index 1f9b15e..b2fbecc 100644
--- a/apple-town-fair/assets.scm
+++ b/apple-town-fair/assets.scm
@@ -16,7 +16,8 @@
 (define-module (apple-town-fair assets)
   #:use-module (catbird asset)
   #:export (monogram-font
-            chickadee-image))
+            chickadee-image
+            home-background-image))
 
 (define (scope-datadir file-name)
   (let ((prefix (or (getenv "APPLE_TOWN_FAIR_DATADIR") (getcwd))))
@@ -33,3 +34,4 @@
 
 (define-font monogram-font (font-file "monogram_extended.ttf") 12)
 (define-image chickadee-image (image-file "chickadee.png"))
+(define-image home-background-image (image-file "home.png"))
diff --git a/apple-town-fair/common.scm b/apple-town-fair/common.scm
index 5fe5bb3..8407f2d 100644
--- a/apple-town-fair/common.scm
+++ b/apple-town-fair/common.scm
@@ -24,10 +24,34 @@
   #:use-module (catbird scene)
   #:use-module (catbird node)
   #:use-module (catbird node-2d)
-  #:export (steps
-            full-screen-rectangle
+  #:use-module (ice-9 format)
+  #:export (day
+            day->string
             fade-in
-            fade-out))
+            fade-out
+            full-screen-rectangle
+            refresh
+            steps
+            time
+            time->string))
+
+(define-accessor day)
+(define-accessor time)
+(define-generic refresh)
+
+(define (day->string n)
+  (cond
+   ((= n 0) "Friday")
+   ((= n 1) "Saturday")
+   ((= n 2) "Sunday")
+   (else "??????")))
+
+(define (time->string n)
+  (let ((n* (modulo n 12)))
+    (format #f "~2,'0d:00 ~a"
+            (if (= n* 0) 12 n*)
+            (if (> n 11) "PM" "AM"))))
+
 
 (define (steps n)
   (* n (current-timestep)))
diff --git a/apple-town-fair/game.scm b/apple-town-fair/game.scm
new file mode 100644
index 0000000..878dbac
--- /dev/null
+++ b/apple-town-fair/game.scm
@@ -0,0 +1,108 @@
+;;; 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 light-overlay)
+  #:use-module (apple-town-fair place)
+  #:use-module (apple-town-fair save-state)
+  #:use-module (apple-town-fair time-display)
+  #: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 (oop goops)
+  #:export (make-game-scene))
+
+(define %time-wake 6)
+(define %time-sleep 21)
+(define %day-start 0)
+(define %day-end 2)
+(define %start-money 20.0)
+
+(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)
+  (time #:accessor time #:init-keyword #:time #:init-value %time-wake)
+  (money #:accessor money #:init-keyword #:money #:init-value %start-money)
+  (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 <place>
+                 #:name 'home
+                 #:background home-background-image)
+               (make <light-overlay>
+                 #:name 'overlay
+                 #:rank 8)
+               (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-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>))
+  (change-day mode %day-start)
+  (change-time mode %time-wake)
+  (set! (inventory mode) '())
+  (set! (flags mode) '())
+  (set! (money mode) %start-money))
+
+(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))
+
+(bind-input <game-mode> (key-press 'space) advance-clock-once)
+(bind-input <game-mode> (key-press 'r) reset-game)
+
+(define (make-game-scene)
+  (make <scene>
+    #:name 'game
+    #:major-mode (make <game-mode>)))
diff --git a/apple-town-fair/light-overlay.scm b/apple-town-fair/light-overlay.scm
new file mode 100644
index 0000000..57f8121
--- /dev/null
+++ b/apple-town-fair/light-overlay.scm
@@ -0,0 +1,85 @@
+;;; 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 light-overlay)
+  #:use-module (apple-town-fair common)
+  #:use-module (apple-town-fair config)
+  #:use-module (catbird node)
+  #:use-module (catbird node-2d)
+  #:use-module (chickadee graphics color)
+  #:use-module (oop goops)
+  #:export (<light-overlay>))
+
+;; A simple translucent color to overlay on the scene to poorly but
+;; adequately simulate the time of day.
+(define-class <light-overlay> (<node-2d>)
+  (time #:accessor time #:init-keyword #:time #:init-value 6 #:observe? #t))
+
+(define-method (default-width (light <light-overlay>))
+  %game-width)
+
+(define-method (default-height (light <light-overlay>))
+  %game-height)
+
+(define-method (on-boot (light <light-overlay>))
+  (attach-to light
+             (make <canvas>
+               #:name 'overlay))
+  (refresh light))
+
+(define-method (on-change (light <light-overlay>) slot old new)
+  (refresh light))
+
+(define-method (overlay-color (light <light-overlay>))
+  (let ((t (time light)))
+    (cond
+     ((= t 6)
+      (make-color 0.0 0.0 0.0 0.5))
+     ((= t 7)
+      (make-color 0.0 0.0 0.0 0.3))
+     ((= t 8)
+      (make-color 0.0 0.0 0.0 0.1))
+     ((= t 9)
+      (make-color 0.0 0.0 0.0 0.0))
+     ((= t 10)
+      (make-color 0.0 0.0 0.0 0.0))
+     ((= t 11)
+      (make-color 0.0 0.0 0.0 0.0))
+     ((= t 12)
+      (make-color 0.0 0.0 0.0 0.0))
+     ((= t 13)
+      (make-color 0.0 0.0 0.0 0.0))
+     ((= t 14)
+      (make-color 0.0 0.0 0.0 0.0))
+     ((= t 15)
+      (make-color 0.0 0.0 0.0 0.0))
+     ((= t 16)
+      (make-color 0.0 0.0 0.0 0.0))
+     ((= t 17)
+      (make-color 0.0 0.0 0.0 0.1))
+     ((= t 18)
+      (make-color 0.0 0.0 0.0 0.2))
+     ((= t 19)
+      (make-color 0.0 0.0 0.0 0.4))
+     ((= t 20)
+      (make-color 0.0 0.0 0.0 0.7))
+     ((= t 21)
+      (make-color 0.0 0.0 0.0 0.8))
+     (else
+      (make-color 0.0 0.0 0.0 0.0)))))
+
+(define-method (refresh (light <light-overlay>))
+  (set! (painter (& light overlay))
+        (full-screen-rectangle (overlay-color light))))
diff --git a/apple-town-fair/place.scm b/apple-town-fair/place.scm
new file mode 100644
index 0000000..45534a9
--- /dev/null
+++ b/apple-town-fair/place.scm
@@ -0,0 +1,28 @@
+;;; 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 place)
+  #:use-module (catbird node)
+  #:use-module (catbird node-2d)
+  #:use-module (oop goops)
+  #:export (<place>))
+
+(define-class <place> (<node-2d>)
+  (background #:accessor background #:init-keyword #:background))
+
+(define-method (on-boot (place <place>))
+  (attach-to place
+             (make <sprite>
+               #:texture (slot-ref place 'background))))
diff --git a/apple-town-fair/save-state.scm b/apple-town-fair/save-state.scm
new file mode 100644
index 0000000..2ff27a7
--- /dev/null
+++ b/apple-town-fair/save-state.scm
@@ -0,0 +1,34 @@
+;;; 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 save-state)
+  #:use-module (catbird config)
+  #:use-module (oop goops)
+  #:export (<save-state>
+            place
+            story-points
+            inventory
+            money
+            flags))
+
+(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)
+  (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/apple-town-fair/splash.scm b/apple-town-fair/splash.scm
index 8a1b0e3..9fcbd5b 100644
--- a/apple-town-fair/splash.scm
+++ b/apple-town-fair/splash.scm
@@ -17,6 +17,7 @@
   #:use-module (apple-town-fair assets)
   #:use-module (apple-town-fair config)
   #:use-module (apple-town-fair common)
+  #:use-module (apple-town-fair game)
   #:use-module (chickadee graphics color)
   #:use-module (chickadee graphics path)
   #:use-module (chickadee math vector)
@@ -69,23 +70,26 @@
                  #:text "https://dthompson.us/projects/chickadee.html"))
     (run-script scene
       (unless (getenv "SKIP_SPLASH")
-        (fade-in scene 1.0)
-        (sleep 1.0)
-        (fade-out scene 1.0))
-      (let ((new-scene (make <scene>))
-            (region (car (all-regions))))
-        ;;(replace-scene region (make-game-scene))
-        #t))))
+        (let ((duration 0.25))
+          (fade-in scene duration)
+          (sleep duration)
+          (fade-out scene duration)))
+      (switch-to-game-scene mode))))
+
+(define-method (switch-to-game-scene (mode <splash-mode>))
+  (replace-scene (car (all-regions))
+                 (make-game-scene)))
 
 (define (launch-game)
   (set! *random-state* (random-state-from-platform))
   (run-catbird
    (lambda ()
      (let ((region (create-full-region))
-           (scene (make <scene>)))
+           (scene (make <scene>
+                    #:name 'splash
+                    #:major-mode (make <splash-mode>))))
        (take-controller-focus 0 region)
        (replace-scene region scene)
-       (replace-major-mode scene (make <splash-mode>))
        (set! (camera region)
              (make <camera-2d>
                #:width %game-width
diff --git a/apple-town-fair/time-display.scm b/apple-town-fair/time-display.scm
new file mode 100644
index 0000000..c36618f
--- /dev/null
+++ b/apple-town-fair/time-display.scm
@@ -0,0 +1,63 @@
+;;; 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 time-display)
+  #:use-module (apple-town-fair assets)
+  #:use-module (apple-town-fair common)
+  #:use-module (catbird node)
+  #:use-module (catbird node-2d)
+  #:use-module (chickadee graphics color)
+  #:use-module (chickadee graphics path)
+  #:use-module (chickadee math vector)
+  #:use-module (oop goops)
+  #:export (<time-display>))
+
+(define-class <time-display> (<node-2d>)
+  (day #:accessor day #:init-keyword #:day #:init-value 0 #:observe? #t)
+  (time #:accessor time #:init-keyword #:time #:init-value 0 #:observe? #t))
+
+(define-method (on-boot (t <time-display>))
+  (attach-to t
+             (make <canvas>
+               #:name 'background)
+             (make <label>
+               #:name 'day
+               #:font monogram-font)
+             (make <label>
+               #:name 'time
+               #:font monogram-font))
+  (refresh t))
+
+(define-method (refresh (t <time-display>))
+  (let ((padding 4.0))
+    (set! (text (& t day)) (day->string (day t)))
+    (set! (text (& t time)) (time->string (time t)))
+    (set! (position-x (& t day)) padding)
+    (set! (position-x (& t time)) padding)
+    (set! (position-y (& t time)) padding)
+    (place-above (& t time) (& t day) #:padding padding)
+    (set! (width t) (+ (max (width (& t day)) (width (& t time)))
+                       (* padding 2.0)))
+    (set! (height t) (+ (height (& t day))
+                        (height (& t time))
+                        (* padding 3.0)))
+    (unless (painter (& t background))
+      (set! (painter (& t background))
+            (with-style ((fill-color (make-color 1.0 0.0 0.0 0.25)))
+              (fill
+               (rectangle (vec2 0.0 0.0) (width t) (height t))))))))
+
+(define-method (on-change (t <time-display>) slot old new)
+  (refresh t))