update: Handle message selection when talking.

1 files changed, 100 insertions, 46 deletions

diff --git a/scenes/game.scm b/scenes/game.scm
index e8f0e55..c1984e0 100644
--- a/scenes/game.scm
+++ b/scenes/game.scm
@@ -247,19 +247,74 @@ map's object layer."
           (tile-map-layer-ref (asset-ref (tile-map game)) layer)))))
 
 (define-method (update (game <game>) dt)
-  (let ((player (child-ref game 'player)))
-    ;; Stop any motion in a direction when the matching key has just
-    ;; been released.
-    (let ((released (filter key-released? (previous-key-presses player))))
-      (unless (null? released)
-        (walk player released 'stop)))
-
-    (if (talking? player)
-        ;; Stop conversation on ESC.
-        (when (key-pressed? 'escape)
-          (stop-talking player))
-
-        ;; React to current key presses if there is no current dialogue.
+  ;; Keep the player in the centre
+  (let* ((player (child-ref game 'player))
+         (pos (position player)))
+    (move-to game
+             (- 0 (vec2-x pos))
+             (- 0 (vec2-y pos)))
+    (move-to (child-ref game 'top-layer)
+             (- 0 (vec2-x pos))
+             (- 0 (vec2-y pos)))))
+
+(define-method (update (player <player>) dt)
+  ;; Check the action key separately.  We only want to act on a
+  ;; state change, not when the key is held.
+  (when (key-released? 'space)
+    (set! (action-held player) #f))
+
+  (or (and=> (talking? player)
+             ;; Use arrow keys to select a message, hit action key to
+             ;; confirm the selection.
+             (lambda (who)
+               (when (or (and (eq? 'up (selecting-message? player))
+                              (key-released? 'up))
+                         (and (eq? 'down (selecting-message? player))
+                              (key-released? 'down)))
+                 (set! (selecting-message? player) #f))
+
+               (match (accepted-messages who)
+                 ;; Nothing more to say, so just wait for the action key to
+                 ;; be hit to dismiss the dialogue.
+                 (()
+                  (when (and (not (action-held player))
+                             (key-pressed? 'space))
+                    (set! (action-held player) #t)
+                    (stop-talking player)))
+                 ((and ((and (message text) selected) . rest) messages)
+                  (cond
+                   ((and (not (eq? 'up (selecting-message? player)))
+                         (key-pressed? 'up))
+                    (set! (accepted-messages who)
+                          (append (list (last messages))
+                                  (drop-right messages 1)))
+                    (set! (selecting-message? player) 'up))
+                   ((and (not (eq? 'down (selecting-message? player)))
+                         (key-pressed? 'down))
+                    (set! (accepted-messages who)
+                          (append rest (list selected)))
+                    (set! (selecting-message? player) 'down))
+                   ((and (not (action-held player))
+                         (key-pressed? 'space))
+                    (set! (action-held player) #t)
+                    (talk player who message))))
+                 (_ #t))
+
+               ;; TODO: render the messages in the new order.
+
+               ;; Always end on #T to avoid passing through to the
+               ;; motion branch.
+               #t))
+
+      ;; React to current key presses with motion.
+      (begin
+        ;; Stop any motion in a direction when the matching key has just
+        ;; been released.
+        (let ((released (filter key-released? (previous-key-presses player))))
+          (unless (null? released)
+            (walk player released 'stop)))
+
+        ;; Detect newly pressed keys.
         (let ((active (fold (lambda (direction acc)
                               (if (key-pressed? direction)
                                   (cons direction acc)
@@ -269,39 +324,38 @@ map's object layer."
           (if (null? active)
               (walk player '(idle))
               (walk player active))
-          (set! (previous-key-presses player) active)))
-
-    (let* ((pos (position player))
-           (vel (velocity player)))
-      (vec2-add! pos vel)
-      (and=> (collides? player game #:layer "collision")
-             (lambda (obj)
-               (match (map-object-type obj)
-                 ;; Reset when the new position is invalid.
-                 ('obstacle
-                  (vec2-sub! pos vel))
-                 ('action
-                  (when (key-pressed? 'space)
-                    (match (map-object-name obj)
-                      ("enter-house"
-                       (teleport player 560.0 1800.0)
-                       ;; TODO: change music?
-                       (pause-music))
-                      ("exit-house"
-                       (teleport player 620.0 1100.0)
-                       (resume-music))
-                      ("talk-to-reaper"
-                       (talk player (child-ref game 'reaper)))
-                      (_ #t))))
-                 (_ #t))))
-
-      ;; Keep the player in the centre
-      (move-to game
-               (- 0 (vec2-x pos))
-               (- 0 (vec2-y pos)))
-      (move-to (child-ref game 'top-layer)
-               (- 0 (vec2-x pos))
-               (- 0 (vec2-y pos))))))
+          (set! (previous-key-presses player) active))
+
+        ;; Update player position and respond to position-dependent
+        ;; events.
+        (let* ((pos (position player))
+               (vel (velocity player))
+               (game (parent player)))
+          (vec2-add! pos vel)
+          (and=> (collides? player game #:layer "collision")
+                 (lambda (obj)
+                   (match (map-object-type obj)
+                     ;; Reset when the new position is invalid.
+                     ('obstacle
+                      (vec2-sub! pos vel))
+                     ('action
+                      (when (and (not (action-held player))
+                                 (key-pressed? 'space))
+                        (set! (action-held player) #t)
+                        (match (map-object-name obj)
+                          ("enter-house"
+                           (teleport player 560.0 1800.0)
+                           ;; TODO: change music?
+                           (pause-music))
+                          ("exit-house"
+                           (teleport player 620.0 1100.0)
+                           (resume-music))
+                          ("talk-to-reaper"
+                           (let ((reaper (child-ref game 'reaper)))
+                             (unless (equal? (talking? player) reaper)
+                               (talk player reaper 'hello))))
+                          (_ #t))))
+                     (_ #t))))))))
 
 (define-method (talk (player <player>) who)
   (unless (talking? player)