summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRicardo Wurmus <rekado@elephly.net>2024-01-30 13:49:09 +0100
committerRicardo Wurmus <rekado@elephly.net>2024-01-30 13:49:09 +0100
commit49449aba4dea047c24877d319ccf58d173725a77 (patch)
treee1161d3be562d9ac59c0db80269a0c54cf68a6b7
parent4e4593c6c6c79e9ac15f55461a4a13c8c9bd7888 (diff)
game: Fix talk interactions.HEADmain
This concludes, I think, the migration effort to the then-latest version of Chickadee.
-rw-r--r--scenes/game.scm360
1 files changed, 293 insertions, 67 deletions
diff --git a/scenes/game.scm b/scenes/game.scm
index a9235aa..0f983a5 100644
--- a/scenes/game.scm
+++ b/scenes/game.scm
@@ -1,5 +1,5 @@
;;; The Inevitable Game
-;;; Copyright © 2018, 2021 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2018, 2021, 2023 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This program is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
@@ -23,7 +23,7 @@
#:use-module (chickadee math easings)
#:use-module (chickadee math rect)
#:use-module (chickadee math vector)
- #:use-module ((chickadee graphics color) #:select (make-color))
+ #:use-module ((chickadee graphics color) #:select (make-color red))
#:use-module (chickadee graphics text)
#:use-module (chickadee graphics path)
#:use-module (chickadee graphics sprite)
@@ -49,6 +49,8 @@
(load-bitmap-font "assets/fonts/good_neighbors_starling.xml"))
(define-asset music
(load-audio "assets/sounds/birds.ogg" #:mode 'stream))
+(define-asset error-sample
+ (load-audio "assets/sounds/error.ogg"))
(define location
(let ((positions
@@ -72,12 +74,19 @@ map's positions layer."
(define fade-box-fill (make-color 0 0 0 1.0))
(define agenda (make-agenda))
-(define last-player-position
+(define *last-player-position*
(location "player"))
(define *player-previous-keys* (list))
+(define *player-talking?* #false)
+(define *player-wants-to-stop-talking?* #false)
+(define *player-resume-messages* (list))
(define *player* #false)
(define *reaper* #false)
+(define *world* (list *player* *reaper*))
(define *layers* #false)
+(define *action-key* 'space)
+(define *current-message* #false)
+
(define grid (make-grid 16))
(define player-grid-x-offset 8)
(define player-grid-y-offset 0)
@@ -85,6 +94,230 @@ map's positions layer."
(define *background-music* #false)
+(define dialog-box
+ (with-style
+ ((fill-color (make-color 0 0 0 0.5)))
+ (fill (rectangle (vec2 0.0 0.0) %width 80))))
+(define dialog-selection-indicator
+ (translate (vec2 0 65)
+ (with-style
+ ((fill-color red))
+ (fill (rectangle (vec2 0.0 0.0) 5 10)))))
+
+(define* (render-text text #:key (y-offset 0))
+ "Split TEXT into lines according to the game font dimensions and
+draw the lines to the screen. Return the number of lines."
+ (let ((lines (arrange-text text (asset-ref game-font)
+ #:margin 4.0)))
+ (for-each (lambda (line i)
+ (draw-text line
+ (vec2 4.0
+ (- 65 y-offset (* %line-height i)))
+ #:font (asset-ref game-font)))
+ lines (iota (length lines)))
+ (length lines)))
+
+(define (render-messages messages)
+ "Print all messages. Each message is split into lines, so this
+procedure keeps track of the vertical offset so far. It returnes the
+total number of lines printed."
+ (fold (lambda (message n lines-so-far)
+ (match message
+ ((message text . flags)
+ (let ((lines-printed
+ (render-text text
+ #:y-offset
+ (+ (* n %message-margin)
+ (* lines-so-far %line-height)))))
+ (+ lines-so-far lines-printed)))))
+ 0 ; no lines printed yet
+ messages
+ (iota (length messages))))
+
+(define (available-messages)
+ "Return the messages that the player can choose from in the current
+conversation."
+ (let ((who *player-talking?*))
+ (cond
+ ((or (not who)
+ *player-wants-to-stop-talking?*) '())
+ ((assoc-ref *player-resume-messages* (name who)) => list)
+ (else (accepted-messages who)))))
+
+(define (start-talking who)
+ (unless (equal? *player-talking?* who)
+ (set! *player-talking?* who)
+ (match (available-messages)
+ (()
+ ;; nothing to say! Play error sound.
+ (audio-play (asset-ref error-sample))
+ (stop-talking))
+ (_ #true))))
+
+(define (stop-talking)
+ (when *player-talking?*
+ (change-sprite-animation *player-talking?* 'idle)
+ (set! *player-talking?* #false)
+ (set! *player-wants-to-stop-talking?* #false)
+ #true))
+
+(define (talk who message flags)
+ "Send MESSAGE to WHO and display the response. FLAGS contain the
+#:resume message."
+ ;; Delete remembered resume point if it exists, because we want
+ ;; to only use them once.
+ (when (assoc-ref *player-resume-messages* (name who))
+ (set! *player-resume-messages*
+ (acons (name who) #false
+ *player-resume-messages*)))
+ (and=> (member #:resume flags)
+ (match-lambda
+ ((#:resume (and (message text) pair))
+ (set! *player-resume-messages*
+ (acons (name who) pair
+ *player-resume-messages*))
+ (set! (accepted-messages who) (list message))
+ (set! *player-wants-to-stop-talking?* #true))))
+ (match (assoc-ref (conversations who) message)
+ ((text next)
+ (set! (speaking? who) #true)
+ (set! *player-talking?* who)
+ ;; Display new message.
+ (set! *current-message* text)
+ ;; Record continuations.
+ (set! (accepted-messages who) next)
+ (change-sprite-animation who 'talk))
+ ;; This should never happen, because there should always be a
+ ;; conversation matching a message.
+ (oops (pk 'oops #t))))
+
+
+(define* (fade direction #:key
+ (duration 0.5))
+ (apply tween duration
+ (append (case direction
+ ((out) '(0.0 1.0))
+ ((in) '(1.0 0.0)))
+ (list
+ (lambda (alpha)
+ (set! fade-box-fill
+ (make-color 0 0 0 alpha)))))))
+
+(define (handle-movement player active released)
+ "Process movement keys by updating character animation and
+position."
+ ;; If the player has released any direction key stop animating
+ ;; movement in that direction.
+ (unless (null? released)
+ (walk player released 'stop))
+
+ ;; If the player still presses any direction key, animate movement
+ ;; in those directions.
+ (walk player (match active
+ (() '(idle))
+ (_ active)))
+
+ ;; Update player position and respond to position-dependent
+ ;; events.
+ (let ((vel (velocity player)))
+ (unless (and (zero? (vec2-x vel))
+ (zero? (vec2-y vel)))
+ (vec2-copy! (position player) *last-player-position*)
+ (vec2-add! (position player) vel)
+
+ ;; We use the grid position here to keep the initial
+ ;; collision offset.
+ (let* ((grid-position (grid-rect-ref grid 'player))
+ (planned-grid-position
+ (vec2+ (vec2 (rect-left grid-position)
+ (rect-bottom grid-position))
+ vel)))
+ (grid-move grid 'player planned-grid-position
+ (lambda (a b)
+ ;; TODO: only slide if this is an obstacle
+ slide)))
+ (let ((corrected-position (grid-rect-ref grid 'player)))
+ (set! (position player)
+ (vec2- (vec2 (rect-left corrected-position)
+ (rect-bottom corrected-position))
+ (vec2 player-grid-x-offset
+ player-grid-y-offset)))))))
+
+(define (handle-talking keys)
+ "Handle keyboard input when in a dialog with another character."
+ (match keys
+ ((key . rest)
+ (let ((who *player-talking?*))
+ ;; Use arrow keys to select a message, hit action key to
+ ;; confirm the selection.
+ (match (available-messages)
+ ;; Nothing more to say, so just wait for the action key to
+ ;; be hit to dismiss the dialogue.
+ (()
+ (when (eq? *action-key* key)
+ (set! (speaking? who) #false)
+ (stop-talking)))
+ ((and ((and (message text . flags) selected) . rest) messages)
+ (cond
+ ;; Select previous message
+ ((eq? 'up key)
+ (set! (accepted-messages who)
+ (append (list (last messages))
+ (drop-right messages 1))))
+
+ ;; Select next message
+ ((eq? 'down key)
+ (set! (accepted-messages who)
+ (append rest (list selected))))
+
+ ;; Submit selected message.
+ ((and (eq? *action-key* key)
+ (not (speaking? who)))
+ (talk who message flags))
+
+ ;; Dismiss character's text.
+ ((and (eq? *action-key* key)
+ (speaking? who))
+ (set! (speaking? who) #false)
+ (change-sprite-animation who 'pause))))
+ (_ (pk 'this-should-never-happen #t)))))
+ ;; Noting to be done here
+ (_ #true)))
+
+(define (teleport target-position)
+ "Teleport the player to TARGET-POSITION."
+ (vec2-copy! target-position (position *player*))
+ (vec2-copy! target-position *last-player-position*)
+ (grid-move grid 'player
+ (vec2+ (vec2 player-grid-x-offset
+ player-grid-y-offset)
+ target-position)
+ (const #true)))
+
+(define (handle-action)
+ "The action key was pressed and released. Do something based on the
+kind of action item the player intersects with."
+ (let ((player-grid-position (grid-rect-ref grid 'player)))
+ (and=> (find (lambda (action-item)
+ (rect-intersects? (cdr action-item) player-grid-position))
+ (assoc-ref *layers* "actions"))
+ (lambda (action-item)
+ (match (map-object-name (first action-item))
+ ("enter-house"
+ (fade 'out)
+ ;; TODO: switch music
+ (teleport (location "house"))
+ (fade 'in))
+ ("exit-house"
+ (fade 'out)
+ ;; TODO: switch music
+ (teleport (location "exited-house"))
+ (fade 'in))
+ ("talk-to-reaper"
+ (start-talking *reaper*))
+ (_ (pk 'action action-item)))))))
+
+
(define (load-scene)
(set! *background-music*
(make-source #:audio (asset-ref music)
@@ -130,75 +363,52 @@ map's positions layer."
(rect-height r))))
(assoc-ref *layers* "collision"))
- (with-agenda
- agenda
- (spawn-script
- (lambda ()
- (wait-until (any key-pressed? '(escape)))
-
- ;; Fade out
- (tween 2 0.0 1.0
- (lambda (alpha)
- (set! fade-box-fill
- (make-color 0 0 0 alpha))))
- (throw 'switch-scene
- (@ (scenes death) scene))))
- (spawn-script
- (lambda ()
- (forever
- (sleep 1)
- ;; Stop any motion in a direction when the matching key has just
- ;; been released.
- (let ((released (filter key-released? *player-previous-keys*)))
- (unless (null? released)
- (walk *player* released 'stop)))
-
- ;; Detect newly pressed keys.
- (let ((active (filter key-pressed? '(left right up down))))
- (walk *player* (match active
- (() '(idle))
- (_ active)))
- (set! *player-previous-keys* active))
-
- ;; Update player position and respond to position-dependent
- ;; events.
- (let ((vel (velocity *player*)))
- (vec2-copy! world-position last-world-position)
- (vec2-add! world-position vel)
-
- ;; TODO
- ;; ;; Reset when the new position is invalid.
- ;; (when (collides? player game "collision")
- ;; (vec2-sub! pos vel))
- ;; (and=> (collides? player game (items game))
- ;; ;; TODO: do something to the item
- ;; (match-lambda
- ;; (() #f)
- ;; (items (pk items))))
- ))))
-
- ;; Handle background noise fade in
- (spawn-script
- (lambda ()
- (tween 2 0.0 1.0
- (lambda (a)
- (set-source-volume! *background-music* a))
- #:ease ease-out-sine)))
-
- ;; Fade in
- (script
- (tween 1 1.0 0.0
- (lambda (alpha)
- (set! fade-box-fill
- (make-color 0 0 0 alpha))))))
- (current-agenda agenda))
+ (let ((agenda (make-agenda)))
+ (with-agenda agenda
+ (spawn-script
+ (lambda ()
+ (wait-until (any key-pressed? '(escape)))
+
+ ;; Fade out
+ (fade 'out #:duration 2)
+ (throw 'switch-scene
+ (@ (scenes death) scene))))
+
+ ;; Handle keyboard input
+ (spawn-script
+ (lambda ()
+ (forever
+ (let ((active (filter key-pressed? '(space left right up down)))
+ (released (filter key-released? *player-previous-keys*)))
+ (set! *player-previous-keys* active)
+
+ (if *player-talking?*
+ (handle-talking released)
+ (begin
+ (when (member *action-key* released)
+ (handle-action))
+ (handle-movement *player*
+ (delete *action-key* active)
+ (delete *action-key* released)))))
+ (sleep 0.01))))
+
+ ;; Handle background noise fade in
+ (spawn-script
+ (lambda ()
+ (tween 5 0.0 1.0
+ (lambda (a)
+ (set-source-volume! *background-music* a))
+ #:ease ease-out-sine)))
+
+ (script (fade 'in #:duration 1)))
+ (current-agenda agenda)))
(define (draw-scene alpha)
(define player-render-position
- (vec2 (round (lerp (vec2-x last-player-position)
+ (vec2 (round (lerp (vec2-x *last-player-position*)
(vec2-x (position *player*))
alpha))
- (round (lerp (vec2-y last-player-position)
+ (round (lerp (vec2-y *last-player-position*)
(vec2-y (position *player*))
alpha))))
@@ -235,6 +445,22 @@ map's positions layer."
#:camera camera
#:layers (list 3))
+ ;; Text bubble for dialog
+ (when *player-talking?*
+ (let ((who *player-talking?*))
+ (if (speaking? who)
+ (begin
+ (draw-canvas (make-canvas dialog-box))
+ (when *current-message*
+ (render-text *current-message*)))
+ (begin
+ ;; Show the dialog selector when it's the player's turn to
+ ;; speak.
+ (draw-canvas (make-canvas
+ (superimpose dialog-box
+ dialog-selection-indicator)))
+ (render-messages (available-messages))))))
+
;; Vignette
(draw-sprite (asset-ref vignette-image) (vec2 0 0))