From a990bd0b24bac57a2051cba505b54238e5485149 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Sat, 29 Oct 2022 14:18:35 -0400 Subject: Add basic time progression and game state reset. --- apple-town-fair/assets.scm | 4 +- apple-town-fair/common.scm | 30 +++++++++-- apple-town-fair/game.scm | 108 ++++++++++++++++++++++++++++++++++++++ apple-town-fair/light-overlay.scm | 85 ++++++++++++++++++++++++++++++ apple-town-fair/place.scm | 28 ++++++++++ apple-town-fair/save-state.scm | 34 ++++++++++++ apple-town-fair/splash.scm | 22 ++++---- apple-town-fair/time-display.scm | 63 ++++++++++++++++++++++ 8 files changed, 361 insertions(+), 13 deletions(-) create mode 100644 apple-town-fair/game.scm create mode 100644 apple-town-fair/light-overlay.scm create mode 100644 apple-town-fair/place.scm create mode 100644 apple-town-fair/save-state.scm create mode 100644 apple-town-fair/time-display.scm (limited to 'apple-town-fair') 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 +;;; +;;; 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 +;;; . +(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 () + (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 )) + (let ((scene (parent mode))) + (attach-to scene + (make + #:name 'home + #:background home-background-image) + (make + #:name 'overlay + #:rank 8) + (make + #: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 ) 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 ) 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 )) + (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 )) + (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 ) n) + (change-time mode (+ (time mode) n)) + (when (= (time mode) %time-sleep) + (go-to-bed mode))) + +(define-method (advance-clock-once (mode )) + (advance-clock mode 1)) + +(bind-input (key-press 'space) advance-clock-once) +(bind-input (key-press 'r) reset-game) + +(define (make-game-scene) + (make + #:name 'game + #:major-mode (make ))) 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 +;;; +;;; 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 +;;; . +(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 ()) + +;; A simple translucent color to overlay on the scene to poorly but +;; adequately simulate the time of day. +(define-class () + (time #:accessor time #:init-keyword #:time #:init-value 6 #:observe? #t)) + +(define-method (default-width (light )) + %game-width) + +(define-method (default-height (light )) + %game-height) + +(define-method (on-boot (light )) + (attach-to light + (make + #:name 'overlay)) + (refresh light)) + +(define-method (on-change (light ) slot old new) + (refresh light)) + +(define-method (overlay-color (light )) + (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 )) + (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 +;;; +;;; 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 +;;; . +(define-module (apple-town-fair place) + #:use-module (catbird node) + #:use-module (catbird node-2d) + #:use-module (oop goops) + #:export ()) + +(define-class () + (background #:accessor background #:init-keyword #:background)) + +(define-method (on-boot (place )) + (attach-to place + (make + #: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 +;;; +;;; 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 +;;; . +(define-module (apple-town-fair save-state) + #:use-module (catbird config) + #:use-module (oop goops) + #:export ( + place + story-points + inventory + money + flags)) + +(define-root-class () + (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 )) - (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 )) + (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 (make + #:name 'splash + #:major-mode (make )))) (take-controller-focus 0 region) (replace-scene region scene) - (replace-major-mode scene (make )) (set! (camera region) (make #: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 +;;; +;;; 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 +;;; . +(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 ()) + +(define-class () + (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 )) + (attach-to t + (make + #:name 'background) + (make