diff options
Diffstat (limited to 'apple-town-fair')
| -rw-r--r-- | apple-town-fair/assets.scm | 4 | ||||
| -rw-r--r-- | apple-town-fair/common.scm | 30 | ||||
| -rw-r--r-- | apple-town-fair/game.scm | 108 | ||||
| -rw-r--r-- | apple-town-fair/light-overlay.scm | 85 | ||||
| -rw-r--r-- | apple-town-fair/place.scm | 28 | ||||
| -rw-r--r-- | apple-town-fair/save-state.scm | 34 | ||||
| -rw-r--r-- | apple-town-fair/splash.scm | 22 | ||||
| -rw-r--r-- | apple-town-fair/time-display.scm | 63 |
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)) |