diff options
| -rw-r--r-- | Makefile.am | 2 | ||||
| -rw-r--r-- | apple-town-fair/assets.scm | 6 | ||||
| -rw-r--r-- | apple-town-fair/dialog-box.scm | 47 | ||||
| -rw-r--r-- | apple-town-fair/game.scm | 87 | ||||
| -rw-r--r-- | apple-town-fair/menu.scm | 92 | ||||
| -rw-r--r-- | apple-town-fair/place.scm | 28 | ||||
| -rw-r--r-- | apple-town-fair/splash.scm | 6 | ||||
| -rw-r--r-- | apple-town-fair/time-display.scm | 21 | ||||
| -rw-r--r-- | assets/images/dialog-box.png | bin | 0 -> 889 bytes | |||
| -rw-r--r-- | assets/images/dialog-box.xcf | bin | 0 -> 4775 bytes | |||
| -rw-r--r-- | assets/images/farm-stand.kra | bin | 0 -> 275755 bytes | |||
| -rw-r--r-- | assets/images/farm-stand.png | bin | 0 -> 58949 bytes | |||
| -rw-r--r-- | assets/images/home.kra | bin | 127928 -> 282034 bytes | |||
| -rw-r--r-- | assets/images/home.png | bin | 19961 -> 32886 bytes |
14 files changed, 267 insertions, 22 deletions
diff --git a/Makefile.am b/Makefile.am index 872cc6f..94f2bc6 100644 --- a/Makefile.am +++ b/Makefile.am @@ -34,6 +34,8 @@ SOURCES = \ apple-town-fair/save-state.scm \ apple-town-fair/time-display.scm \ apple-town-fair/light-overlay.scm \ + apple-town-fair/dialog-box.scm \ + apple-town-fair/menu.scm \ apple-town-fair/game.scm \ apple-town-fair/splash.scm diff --git a/apple-town-fair/assets.scm b/apple-town-fair/assets.scm index b2fbecc..8aacf46 100644 --- a/apple-town-fair/assets.scm +++ b/apple-town-fair/assets.scm @@ -17,7 +17,9 @@ #:use-module (catbird asset) #:export (monogram-font chickadee-image - home-background-image)) + dialog-box-image + home-background-image + farm-stand-background-image)) (define (scope-datadir file-name) (let ((prefix (or (getenv "APPLE_TOWN_FAIR_DATADIR") (getcwd)))) @@ -34,4 +36,6 @@ (define-font monogram-font (font-file "monogram_extended.ttf") 12) (define-image chickadee-image (image-file "chickadee.png")) +(define-image dialog-box-image (image-file "dialog-box.png")) (define-image home-background-image (image-file "home.png")) +(define-image farm-stand-background-image (image-file "farm-stand.png")) diff --git a/apple-town-fair/dialog-box.scm b/apple-town-fair/dialog-box.scm new file mode 100644 index 0000000..0731e72 --- /dev/null +++ b/apple-town-fair/dialog-box.scm @@ -0,0 +1,47 @@ +;;; 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 dialog-box) + #: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 math vector) + #:use-module (oop goops) + #:export (<dialog-box>)) + +(define-class <dialog-box> (<node-2d>) + (text #:accessor text #:init-keyword #:text #:init-value "" #:observe? #t)) + +(define-method (on-boot (dialog <dialog-box>)) + (attach-to dialog + (make <sprite> + #:name 'background + #:texture dialog-box-image) + (make <label> + #:name 'label + #:rank 1 + #:font monogram-font + #:vertical-align 'top + #:text (text dialog))) + (set! (width dialog) (width (& dialog background))) + (set! (height dialog) (height (& dialog background))) + (teleport (& dialog label) 10.0 (- (height dialog) 10.0))) + +(define-method (on-change (dialog <dialog-box>) slot old new) + (case slot + ((text) + (set! (text (& dialog label)) new)))) diff --git a/apple-town-fair/game.scm b/apple-town-fair/game.scm index 878dbac..13ec3f0 100644 --- a/apple-town-fair/game.scm +++ b/apple-town-fair/game.scm @@ -17,10 +17,13 @@ #:use-module (apple-town-fair assets) #:use-module (apple-town-fair common) #:use-module (apple-town-fair config) + #:use-module (apple-town-fair dialog-box) #:use-module (apple-town-fair light-overlay) + #:use-module (apple-town-fair menu) #:use-module (apple-town-fair place) #:use-module (apple-town-fair save-state) #:use-module (apple-town-fair time-display) + #:use-module (catbird) #:use-module (catbird mode) #:use-module (catbird node) #:use-module (catbird node-2d) @@ -38,8 +41,24 @@ (define %day-end 2) (define %start-money 20.0) +(define-method (make-home) + (make <place> + #:name 'place + #:title "Home" + #:background home-background-image + #:actions (list (make <action> + #:name "Test" + #:condition (const #t) + #:exec (lambda (mode) + (pk 'testing)))))) + +(define-method (make-farm-stand) + (make <place> + #:name 'place + #:title "Farm Stand" + #:background farm-stand-background-image)) + (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) @@ -51,12 +70,17 @@ (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 <dialog-box> + #:name 'dialog + #:rank 9 + #:text "Hello, world! +How many characters fit on a line? 50 characters!! +Hello, world! +Hello, world! +Hello, world!") (make <time-display> #:name 'time #:rank 9)) @@ -65,6 +89,22 @@ (- %game-height (height (& scene time)))) (reset-game mode))) +(define-method (change-place (mode <game-mode>) (new-place <place>)) + (let* ((scene (parent mode)) + (old-place (& scene place))) + (when old-place + (detach old-place)) + (attach-to scene new-place) + (set! (where (& scene time)) (title new-place)) + (advance-clock mode 1) + (when (& scene menu) + (detach (& scene menu))) + (attach-to scene + (make <menu> + #:name 'menu + #:rank 9 + #:items (map name (actions new-place)))))) + (define-method (change-time (mode <game-mode>) t) (let ((scene (parent mode))) (set! (time mode) (clamp %time-wake %time-sleep t)) @@ -77,11 +117,15 @@ (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)) + (let ((scene (parent mode))) + (change-day mode %day-start) + (change-time mode %time-wake) + (change-place mode (make-home)) + (set! (story-points mode) 0) + (set! (inventory mode) '()) + (set! (flags mode) '()) + (set! (money mode) %start-money) + (hide (& scene dialog)))) (define-method (go-to-bed (mode <game-mode>)) (let ((scene (parent mode))) @@ -99,8 +143,31 @@ (define-method (advance-clock-once (mode <game-mode>)) (advance-clock mode 1)) -(bind-input <game-mode> (key-press 'space) advance-clock-once) +(define-method (quit-game (mode <game-mode>)) + (exit-catbird)) + +(define-method (go-to-farm-stand (mode <game-mode>)) + (change-place mode (make-farm-stand))) + +(define-method (go-home (mode <game-mode>)) + (change-place mode (make-home))) + +(define-method (up-selection (mode <game-mode>)) + (up-selection (& (parent mode) menu) 1)) + +(define-method (down-selection (mode <game-mode>)) + (down-selection (& (parent mode) menu) 1)) + +(define-method (confirm-selection (mode <game-mode>)) + (pk 'chose (selection (& (parent mode) menu)))) + (bind-input <game-mode> (key-press 'r) reset-game) +(bind-input <game-mode> (key-press 'escape) quit-game) +(bind-input <game-mode> (key-press 'f) go-to-farm-stand) +(bind-input <game-mode> (key-press 'h) go-home) +(bind-input <game-mode> (key-press 'up) up-selection) +(bind-input <game-mode> (key-press 'down) down-selection) +(bind-input <game-mode> (key-press 'return) confirm-selection) (define (make-game-scene) (make <scene> diff --git a/apple-town-fair/menu.scm b/apple-town-fair/menu.scm new file mode 100644 index 0000000..ad3b893 --- /dev/null +++ b/apple-town-fair/menu.scm @@ -0,0 +1,92 @@ +;;; 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 menu) + #:use-module (apple-town-fair assets) + #:use-module (apple-town-fair common) + #:use-module (catbird asset) + #:use-module (catbird node) + #:use-module (catbird node-2d) + #:use-module (chickadee graphics color) + #:use-module (chickadee graphics path) + #:use-module (chickadee graphics text) + #:use-module (chickadee math) + #:use-module (chickadee math vector) + #:use-module (ice-9 match) + #:use-module (oop goops) + #:use-module (srfi srfi-1) + #:export (<menu> + down-selection + selection + up-selection)) + + +(define-class <menu> (<node-2d>) + (items #:accessor items #:init-keyword #:items) + (item-nodes #:accessor item-nodes) + (selected-item #:accessor selected-item)) + +(define-method (on-boot (menu <menu>)) + (let ((nodes (map (lambda (item) + (make <label> + #:rank 1 + #:font monogram-font + #:text item)) + (items menu))) + (padding 2.0)) + (attach-to menu + (make <canvas> + #:name 'highlight + #:painter + (with-style ((fill-color red)) + (fill + (rectangle (vec2 0.0 0.0) + (fold (lambda (node w) + (max w (width node))) + 0.0 + nodes) + (fold (lambda (node h) + (max h (height node))) + 0.0 + nodes)))))) + (apply attach-to menu nodes) + (let loop ((nodes (reverse nodes)) + (prev #f)) + (match nodes + (() #t) + ((node . rest) + (when prev + (place-above prev node #:padding padding)) + (loop rest node)))) + (set! (item-nodes menu) nodes) + (select-item menu 0))) + +(define-method (select-item (menu <menu>) i) + (let* ((i (clamp 0 (- (length (items menu)) 1) i)) + (node (list-ref (item-nodes menu) i))) + (set! (selected-item menu) i) + (when node + (set! (position-y (& menu highlight)) + (position-y node))))) + +(define-method (selection (menu <menu>)) + (let ((node (list-ref (item-nodes menu) (selected-item menu)))) + (and node (text node)))) + +(define-method (up-selection (menu <menu>) n) + (select-item menu (- (selected-item menu) n))) + +(define-method (down-selection (menu <menu>) n) + (select-item menu (+ (selected-item menu) n))) diff --git a/apple-town-fair/place.scm b/apple-town-fair/place.scm index 45534a9..2cfb5ed 100644 --- a/apple-town-fair/place.scm +++ b/apple-town-fair/place.scm @@ -14,13 +14,37 @@ ;;; along with this program. If not, see ;;; <http://www.gnu.org/licenses/>. (define-module (apple-town-fair place) + #:use-module (catbird config) #:use-module (catbird node) #:use-module (catbird node-2d) #:use-module (oop goops) - #:export (<place>)) + #:export (<action> + condition + duration + exec + performable? + perform + <place> + title + actions)) + +(define-root-class <action> () + (name #:accessor name #:init-keyword #:name) + (condition #:accessor condition #:init-keyword #:condition + #:init-form (const #t)) + (exec #:accessor exec #:init-keyword #:exec) + (duration #:accessor duration #:init-keyword #:duration #:init-value 1)) + +(define-method (performable? (action <action>) state) + ((condition action) state)) + +(define-method (perform (action <action>) state) + ((exec action) state)) (define-class <place> (<node-2d>) - (background #:accessor background #:init-keyword #:background)) + (title #:accessor title #:init-keyword #:title #:init-value "Unknown") + (background #:accessor background #:init-keyword #:background) + (actions #:accessor actions #:init-keyword #:actions #:init-value '())) (define-method (on-boot (place <place>)) (attach-to place diff --git a/apple-town-fair/splash.scm b/apple-town-fair/splash.scm index 9fcbd5b..63f90c1 100644 --- a/apple-town-fair/splash.scm +++ b/apple-town-fair/splash.scm @@ -36,16 +36,14 @@ (define-class <splash-mode> (<major-mode>)) (define %text-color (rgb #x181425)) -(define %background-color white) +(define %background-color (rgb #xead4aa)) (define-method (on-enter (mode <splash-mode>)) (let ((scene (parent mode))) (attach-to scene (make <canvas> #:painter - (with-style ((fill-color %background-color)) - (fill - (rectangle (vec2 0.0 0.0) %game-width %game-height)))) + (full-screen-rectangle %background-color)) (make <sprite> #:texture chickadee-image #:position (vec2 (/ %game-width 2.0) diff --git a/apple-town-fair/time-display.scm b/apple-town-fair/time-display.scm index c36618f..e79b0d1 100644 --- a/apple-town-fair/time-display.scm +++ b/apple-town-fair/time-display.scm @@ -22,17 +22,22 @@ #:use-module (chickadee graphics path) #:use-module (chickadee math vector) #:use-module (oop goops) - #:export (<time-display>)) + #:export (<time-display> + where)) (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)) + (where #:accessor where #:init-value "XXXXXXXXXXX" #:observe? #t) + (day #:accessor day #:init-value 0 #:observe? #t) + (time #:accessor time #:init-value 0 #:observe? #t)) (define-method (on-boot (t <time-display>)) (attach-to t (make <canvas> #:name 'background) (make <label> + #:name 'place + #:font monogram-font) + (make <label> #:name 'day #:font monogram-font) (make <label> @@ -44,15 +49,21 @@ (let ((padding 4.0)) (set! (text (& t day)) (day->string (day t))) (set! (text (& t time)) (time->string (time t))) + (set! (text (& t place)) (where t)) (set! (position-x (& t day)) padding) (set! (position-x (& t time)) padding) (set! (position-y (& t time)) padding) + (set! (position-x (& t place)) padding) (place-above (& t time) (& t day) #:padding padding) - (set! (width t) (+ (max (width (& t day)) (width (& t time))) + (place-above (& t day) (& t place) #:padding padding) + (set! (width t) (+ (max (width (& t day)) + (width (& t time)) + (width (& t place))) (* padding 2.0))) (set! (height t) (+ (height (& t day)) (height (& t time)) - (* padding 3.0))) + (height (& t place)) + (* padding 4.0))) (unless (painter (& t background)) (set! (painter (& t background)) (with-style ((fill-color (make-color 1.0 0.0 0.0 0.25))) diff --git a/assets/images/dialog-box.png b/assets/images/dialog-box.png Binary files differnew file mode 100644 index 0000000..c994508 --- /dev/null +++ b/assets/images/dialog-box.png diff --git a/assets/images/dialog-box.xcf b/assets/images/dialog-box.xcf Binary files differnew file mode 100644 index 0000000..7864273 --- /dev/null +++ b/assets/images/dialog-box.xcf diff --git a/assets/images/farm-stand.kra b/assets/images/farm-stand.kra Binary files differnew file mode 100644 index 0000000..e0228a7 --- /dev/null +++ b/assets/images/farm-stand.kra diff --git a/assets/images/farm-stand.png b/assets/images/farm-stand.png Binary files differnew file mode 100644 index 0000000..f7ad288 --- /dev/null +++ b/assets/images/farm-stand.png diff --git a/assets/images/home.kra b/assets/images/home.kra Binary files differindex efab8b8..292f9c6 100644 --- a/assets/images/home.kra +++ b/assets/images/home.kra diff --git a/assets/images/home.png b/assets/images/home.png Binary files differindex fa320a3..e05d305 100644 --- a/assets/images/home.png +++ b/assets/images/home.png |
