diff options
| -rw-r--r-- | scenes/game.scm | 360 |
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)) |