1 files changed, 108 insertions, 0 deletions
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>)))