summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.dir-locals.el3
-rw-r--r--.gitignore1
-rw-r--r--apple-town-fair/assets.scm4
-rw-r--r--apple-town-fair/dialog-box.scm9
-rw-r--r--apple-town-fair/game.scm355
-rw-r--r--apple-town-fair/menu.scm6
-rw-r--r--apple-town-fair/place.scm11
-rw-r--r--apple-town-fair/save-state.scm24
-rw-r--r--assets/images/common.krabin0 -> 359246 bytes
-rw-r--r--assets/images/common.pngbin0 -> 77610 bytes
-rw-r--r--assets/images/home.krabin282034 -> 361922 bytes
-rw-r--r--assets/images/home.pngbin32886 -> 50907 bytes
-rw-r--r--assets/images/trail.krabin0 -> 504368 bytes
-rw-r--r--assets/images/trail.pngbin0 -> 104887 bytes
14 files changed, 289 insertions, 124 deletions
diff --git a/.dir-locals.el b/.dir-locals.el
index 78f84d5..fb2de2e 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -1,4 +1,5 @@
((scheme-mode
.
((eval . (put 'with-agenda 'scheme-indent-function 1))
- (eval . (put 'repeat 'scheme-indent-function 1)))))
+ (eval . (put 'repeat 'scheme-indent-function 1))
+ (eval . (put 'with-dialog 'scheme-indent-function 1)))))
diff --git a/.gitignore b/.gitignore
index 6e220e4..1f3c373 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,6 +1,7 @@
*~
*.go
*.tar.gz
+*.kra-autosave.kra
/Makefile
/Makefile.in
/aclocal.m4
diff --git a/apple-town-fair/assets.scm b/apple-town-fair/assets.scm
index 8aacf46..3d8136d 100644
--- a/apple-town-fair/assets.scm
+++ b/apple-town-fair/assets.scm
@@ -19,6 +19,8 @@
chickadee-image
dialog-box-image
home-background-image
+ common-background-image
+ trail-background-image
farm-stand-background-image))
(define (scope-datadir file-name)
@@ -38,4 +40,6 @@
(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 common-background-image (image-file "common.png"))
+(define-image trail-background-image (image-file "trail.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
index 0731e72..22565bd 100644
--- a/apple-town-fair/dialog-box.scm
+++ b/apple-town-fair/dialog-box.scm
@@ -35,13 +35,16 @@
#:name 'label
#:rank 1
#:font monogram-font
- #:vertical-align 'top
- #:text (text dialog)))
+ #:vertical-align 'top))
(set! (width dialog) (width (& dialog background)))
(set! (height dialog) (height (& dialog background)))
+ (refresh-label dialog))
+
+(define-method (refresh-label (dialog <dialog-box>))
+ (set! (text (& dialog label)) (text dialog))
(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))))
+ (refresh-label dialog))))
diff --git a/apple-town-fair/game.scm b/apple-town-fair/game.scm
index 13ec3f0..b85c2e8 100644
--- a/apple-town-fair/game.scm
+++ b/apple-town-fair/game.scm
@@ -21,7 +21,7 @@
#: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 save-state)
#:use-module (apple-town-fair time-display)
#:use-module (catbird)
#:use-module (catbird mode)
@@ -32,144 +32,291 @@
#:use-module (chickadee graphics path)
#:use-module (chickadee math)
#:use-module (chickadee math vector)
+ #:use-module (chickadee scripting)
#:use-module (oop goops)
+ #:use-module (srfi srfi-1)
#:export (make-game-scene))
+
+;;;
+;;; Game scene
+;;;
+
(define %time-wake 6)
-(define %time-sleep 21)
+(define %time-sleep 22)
(define %day-start 0)
(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 %money-start 20.0)
-(define-method (make-farm-stand)
- (make <place>
- #:name 'place
- #:title "Farm Stand"
- #:background farm-stand-background-image))
-
-(define-class <game-mode> (<major-mode>)
+(define-class <game> (<scene>)
(story-points #:accessor story-points #:init-keyword #:story-points
#:init-value 0)
- (day #:accessor day #:init-keyword #:day #:init-value 0)
+ (day #:accessor day #:init-keyword #:day #:init-value %day-start)
(time #:accessor time #:init-keyword #:time #:init-value %time-wake)
- (money #:accessor money #:init-keyword #:money #:init-value %start-money)
+ (money #:accessor money #:init-keyword #:money #:init-value %money-start)
(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 <light-overlay>
- #:name 'overlay
- #:rank 8)
- (make <dialog-box>
- #:name 'dialog
- #:rank 9
- #:text "Hello, world!
+(define-method (on-boot (scene <game>))
+ (attach-to scene
+ (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))
- (teleport (& scene time)
- (- %game-width (width (& scene time)))
- (- %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)))
+ (make <time-display>
+ #:name 'time
+ #:rank 9))
+ (teleport (& scene time)
+ (- %game-width (width (& scene time)))
+ (- %game-height (height (& scene time))))
+ (reset-game scene))
+
+(define-method (change-place (scene <game>) (new-place <place>))
+ (let ((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)
+ (advance-clock scene 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))
- (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>))
- (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)))
- (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))
-
-(define-method (quit-game (mode <game-mode>))
- (exit-catbird))
+ #:items (map name (actions new-place))
+ #:position (vec2 8.0 32.0)))))
+
+(define-method (change-time (scene <game>) t)
+ (set! (time scene) (clamp %time-wake %time-sleep t))
+ (set! (time (& scene overlay)) (time scene))
+ (set! (time (& scene time)) (time scene)))
+
+(define-method (change-day (scene <game>) d)
+ (set! (day scene) (clamp %day-start %day-end d))
+ (set! (day (& scene time)) (day scene)))
+
+(define-method (go-to-bed (scene <game>))
+ (if (= (day scene) %day-end)
+ (reset-game scene)
+ (begin
+ (change-time scene %time-wake)
+ (change-day scene (+ (day scene) 1)))))
+
+(define-method (advance-clock (scene <game>) n)
+ (change-time scene (+ (time scene) n))
+ (when (= (time scene) %time-sleep)
+ (go-to-bed scene)))
+
+(define-method (dialog (scene <game>) who str)
+ (let ((node (& scene dialog)))
+ (set! (text node) str)
+ (show node)
+ (yield
+ (lambda (k)
+ (set! (cont (major-mode scene)) k)))))
+
+(define-method (inner-monologue (scene <game>) str)
+ (dialog scene "You" (string-append "> " str)))
+
+(define-method (reset-game (scene <game>))
+ (change-day scene %day-start)
+ (change-time scene %time-wake)
+ (change-place scene (make-home))
+ (set! (story-points scene) 0)
+ (set! (inventory scene) '())
+ (set! (flags scene) '())
+ (set! (money scene) %money-start)
+ (hide (& scene dialog)))
+
+;;;
+;;; Dialog mode
+;;;
+
+(define-class <dialog-mode> (<major-mode>)
+ (cont #:accessor cont #:init-value #f))
+
+(define-method (advance-dialog (mode <dialog-mode>))
+ (let ((k (cont mode)))
+ (and k (k))))
+
+(define-method (switch-to-dialog-mode (scene <game>))
+ (push-major-mode scene (make <dialog-mode>)))
+
+(define-syntax-rule (with-dialog scene body ...)
+ (begin
+ (switch-to-dialog-mode scene)
+ body ...
+ (pop-major-mode scene)))
+
+(bind-input <dialog-mode> (key-press 'return) advance-dialog)
+
+
+;;;
+;;; Places and actions
+;;;
-(define-method (go-to-farm-stand (mode <game-mode>))
- (change-place mode (make-farm-stand)))
+(define-method (home-pet-cat (scene <game>))
+ (with-dialog scene
+ (inner-monologue scene "Chickadee is curled up on a couch cushion.")
+ (inner-monologue scene "You walk up to the couch, and reach down to pet
+her.")
+ (dialog scene "Chickadee" "Meeoooow~ :3")
+ (inner-monologue scene "Chickadee purs loudly.")))
-(define-method (go-home (mode <game-mode>))
- (change-place mode (make-home)))
+(define-method (home-bake-pie (scene <game>))
+ (with-dialog scene
+ (inner-monologue scene "You check the baking cabinet.")
+ (inner-monologue scene "Inside you find flour, sugar, cinnamon, and
+other spices.")
+ (inner-monologue scene "You check the fridge.")
+ (inner-monologue scene "Inside you find butter, but no apples.")
+ (inner-monologue scene "There are no apples on the counter, either.")
+ (inner-monologue scene "It seems an important ingredient is missing...")))
-(define-method (up-selection (mode <game-mode>))
+(define-method (home-carve-pumpkin (scene <game>))
+ (with-dialog scene
+ (inner-monologue scene "You don't have a pumpkin to carve. :(")))
+
+(define-method (home-watch-tv (scene <game>))
+ (with-dialog scene
+ (inner-monologue scene "You go to the living room and turn on the TV.")
+ (dialog scene "TV Person" "... more at 11.")
+ (inner-monologue scene "You turn the TV off.")))
+
+(define-method (home-inspect-garden (scene <game>))
+ (with-dialog scene
+ (inner-monologue scene "You walk over to the vegetable garden.")
+ (inner-monologue scene "There hasn't been a frost yet, but the summer
+vegetables are all done. The tomato vines are
+black and withered.")
+ (inner-monologue scene "The carrots, however, are unfazed by the cold.
+The colder it gets, the sweeter they become as
+they convert starches to sugars to store energy
+for the winter.")
+ (inner-monologue scene "Pick the carrots?")))
+
+(define-method (home-go-to-trail (scene <game>))
+ (change-place scene (make-trail)))
+
+(define-method (home-go-to-common (scene <game>))
+ (change-place scene (make-common)))
+
+(define-method (make-home)
+ (make <place>
+ #:name 'place
+ #:title "Home"
+ #:background home-background-image
+ #:actions (list (make <action>
+ #:name "Pet the cat"
+ #:exec home-pet-cat)
+ (make <action>
+ #:name "Bake an apple pie"
+ #:exec home-bake-pie)
+ (make <action>
+ #:name "Carve a pumpkin"
+ #:exec home-carve-pumpkin)
+ (make <action>
+ #:name "Watch TV"
+ #:exec home-watch-tv)
+ (make <action>
+ #:name "Inspect the garden"
+ #:exec home-inspect-garden)
+ (make <action>
+ #:name "Go to the town common"
+ #:exec home-go-to-common)
+ (make <action>
+ #:name "Go to the trail"
+ #:exec home-go-to-trail))))
+
+(define-method (common-go-home (scene <game>))
+ (change-place scene (make-home)))
+
+(define-method (make-common)
+ (make <place>
+ #:name 'place
+ #:title "Town Common"
+ #:background common-background-image
+ #:actions (list (make <action>
+ #:name "Go home"
+ #:exec common-go-home))))
+
+(define-method (trail-go-to-farm-stand (scene <game>))
+ (change-place scene (make-farm-stand)))
+
+(define-method (trail-go-home (scene <game>))
+ (change-place scene (make-home)))
+
+(define-method (make-trail)
+ (make <place>
+ #:name 'place
+ #:title "Trail"
+ #:background trail-background-image
+ #:actions (list (make <action>
+ #:name "Go to the farm stand"
+ #:exec trail-go-to-farm-stand)
+ (make <action>
+ #:name "Go home"
+ #:exec trail-go-home))))
+
+(define-method (farm-stand-go-to-trail (scene <game>))
+ (change-place scene (make-trail)))
+
+(define-method (make-farm-stand)
+ (make <place>
+ #:name 'place
+ #:title "Farm Stand"
+ #:background farm-stand-background-image
+ #:actions (list (make <action>
+ #:name "Go to the trail"
+ #:exec farm-stand-go-to-trail))))
+
+
+;;;
+;;; Choose action mode
+;;;
+
+(define-class <choose-action-mode> (<major-mode>))
+
+(define-method (advance-clock-once (mode <choose-action-mode>))
+ (advance-clock (parent mode) 1))
+
+(define-method (quit-game (mode <choose-action-mode>))
+ (exit-catbird))
+
+(define-method (up-selection (mode <choose-action-mode>))
(up-selection (& (parent mode) menu) 1))
-(define-method (down-selection (mode <game-mode>))
+(define-method (down-selection (mode <choose-action-mode>))
(down-selection (& (parent mode) menu) 1))
-(define-method (confirm-selection (mode <game-mode>))
- (pk 'chose (selection (& (parent mode) menu))))
+(define-method (confirm-selection (mode <choose-action-mode>))
+ (let* ((scene (parent mode))
+ (place (& scene place))
+ (chosen (selection (& scene menu)))
+ (action (find (lambda (a)
+ (string=? (name a) chosen))
+ (actions place))))
+ (run-script scene
+ (hide (& scene menu))
+ (perform action scene)
+ (hide (& scene dialog))
+ (show (& scene 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)
+(bind-input <choose-action-mode> (key-press 'r) reset-game)
+(bind-input <choose-action-mode> (key-press 'escape) quit-game)
+(bind-input <choose-action-mode> (key-press 'up) up-selection)
+(bind-input <choose-action-mode> (key-press 'down) down-selection)
+(bind-input <choose-action-mode> (key-press 'return) confirm-selection)
(define (make-game-scene)
- (make <scene>
+ (make <game>
#:name 'game
- #:major-mode (make <game-mode>)))
+ #:major-mode (make <choose-action-mode>)))
diff --git a/apple-town-fair/menu.scm b/apple-town-fair/menu.scm
index ad3b893..3ec4b2e 100644
--- a/apple-town-fair/menu.scm
+++ b/apple-town-fair/menu.scm
@@ -75,11 +75,11 @@
(define-method (select-item (menu <menu>) i)
(let* ((i (clamp 0 (- (length (items menu)) 1) i))
- (node (list-ref (item-nodes menu) i)))
+ (nodes (item-nodes menu)))
(set! (selected-item menu) i)
- (when node
+ (unless (null? nodes)
(set! (position-y (& menu highlight))
- (position-y node)))))
+ (position-y (list-ref nodes i))))))
(define-method (selection (menu <menu>))
(let ((node (list-ref (item-nodes menu) (selected-item menu))))
diff --git a/apple-town-fair/place.scm b/apple-town-fair/place.scm
index 2cfb5ed..b96130d 100644
--- a/apple-town-fair/place.scm
+++ b/apple-town-fair/place.scm
@@ -32,14 +32,13 @@
(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))
+ (exec #:accessor exec #:init-keyword #:exec))
-(define-method (performable? (action <action>) state)
- ((condition action) state))
+(define-method (performable? (action <action>) scene)
+ ((condition action) scene))
-(define-method (perform (action <action>) state)
- ((exec action) state))
+(define-method (perform (action <action>) scene)
+ ((exec action) scene))
(define-class <place> (<node-2d>)
(title #:accessor title #:init-keyword #:title #:init-value "Unknown")
diff --git a/apple-town-fair/save-state.scm b/apple-town-fair/save-state.scm
index 2ff27a7..abeb3e6 100644
--- a/apple-town-fair/save-state.scm
+++ b/apple-town-fair/save-state.scm
@@ -14,21 +14,31 @@
;;; along with this program. If not, see
;;; <http://www.gnu.org/licenses/>.
(define-module (apple-town-fair save-state)
+ #:use-module (apple-town-fair common)
#:use-module (catbird config)
#:use-module (oop goops)
#:export (<save-state>
- place
- story-points
+ %day-end
+ %day-start
+ %money-start
+ %time-sleep
+ %time-wake
+ flags
inventory
money
- flags))
+ story-points))
+
+(define %time-wake 6)
+(define %time-sleep 22)
+(define %day-start 0)
+(define %day-end 2)
+(define %money-start 20.0)
(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)
+ (day #:accessor day #:init-keyword #:day #:init-value %day-start)
+ (time #:accessor time #:init-keyword #:time #:init-value %time-wake)
+ (money #:accessor money #:init-keyword #:money #:init-value %money-start)
(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/assets/images/common.kra b/assets/images/common.kra
new file mode 100644
index 0000000..7177a99
--- /dev/null
+++ b/assets/images/common.kra
Binary files differ
diff --git a/assets/images/common.png b/assets/images/common.png
new file mode 100644
index 0000000..e185f0f
--- /dev/null
+++ b/assets/images/common.png
Binary files differ
diff --git a/assets/images/home.kra b/assets/images/home.kra
index 292f9c6..ee7d33a 100644
--- a/assets/images/home.kra
+++ b/assets/images/home.kra
Binary files differ
diff --git a/assets/images/home.png b/assets/images/home.png
index e05d305..0973211 100644
--- a/assets/images/home.png
+++ b/assets/images/home.png
Binary files differ
diff --git a/assets/images/trail.kra b/assets/images/trail.kra
new file mode 100644
index 0000000..cc4f35d
--- /dev/null
+++ b/assets/images/trail.kra
Binary files differ
diff --git a/assets/images/trail.png b/assets/images/trail.png
new file mode 100644
index 0000000..04caf73
--- /dev/null
+++ b/assets/images/trail.png
Binary files differ