summaryrefslogtreecommitdiff
path: root/apple-town-fair
diff options
context:
space:
mode:
Diffstat (limited to 'apple-town-fair')
-rw-r--r--apple-town-fair/assets.scm4
-rw-r--r--apple-town-fair/common.scm30
-rw-r--r--apple-town-fair/game.scm108
-rw-r--r--apple-town-fair/light-overlay.scm85
-rw-r--r--apple-town-fair/place.scm28
-rw-r--r--apple-town-fair/save-state.scm34
-rw-r--r--apple-town-fair/splash.scm22
-rw-r--r--apple-town-fair/time-display.scm63
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))