Simplify conversation system by using different methods.

1 files changed, 100 insertions, 86 deletions

diff --git a/scenes/game.scm b/scenes/game.scm
index 3ab3512..7182beb 100644
--- a/scenes/game.scm
+++ b/scenes/game.scm
@@ -192,21 +192,42 @@ given MAX-WIDTH.  Return a list of lines."
              (- 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)
-               (handle-talking player who)
+               ;; Render the player messages in the selected order.
+               (unless (speaking? who)
+                 (let ((bubble (child-ref (parent (parent player)) 'text-bubble))
+                       (messages (accepted-messages who)))
+                   (clear-messages bubble)
+                   (fold (lambda (message n lines)
+                           (match message
+                             ((message text . flags)
+                              (when (zero? n)
+                                (attach bubble
+                                        (make <filled-rect>
+                                          #:name 'dialog-selection-indicator
+                                          #:region (make-rect 0.0 0.0 10 10)
+                                          #:position (vec2 0 40)
+                                          #:color region)))
+                              (+ lines
+                                 (render-text bubble text
+                                              #:suffix message
+                                              #:y-offset
+                                              (+ (* n %message-margin)
+                                                 (* lines %line-height)))))))
+                         0
+                         messages
+                         (iota (length messages)))))
                ;; Always end on #T to avoid passing through to the
                ;; motion branch.
                #t))
 
-      ;; React to current key presses with motion.
+      ;; React to current key presses with motion.  We don't use the
+      ;; on-key-press handler here, because it does not seem to behave
+      ;; right when two keys are pressed at the same time (e.g. left
+      ;; and up).
       (begin
         ;; Stop any motion in a direction when the matching key has just
         ;; been released.
@@ -232,115 +253,100 @@ given MAX-WIDTH.  Return a list of lines."
                (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 (handle-talking (player <player>) (who <character>))
+          ;; Reset when the new position is invalid.
+          (when (collides? player game #:layer "collision")
+            (vec2-sub! pos vel))))))
+
+(define-method (on-key-press (player <player>) key modifiers repeat?)
+  (when (eq? key 'q)
+    (switch-scene (root-node) (death)))
+  (let ((who (talking? player)))
+    (cond
+     ((and (not who) (eq? 'space key))
+      (handle-action player))
+     ((and who (not repeat?))
+      (handle-talking player key)))))
+
+(define (handle-action player)
+  "Check if the PLAYER is on any region of the map where an action can
+be executed; if so, perform the action."
+  (let ((game (parent player)))
+    (and=> (collides? player game #:layer "actions")
+           (lambda (obj)
+             (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"
+                (start-talking player
+                               (child-ref game 'reaper)))
+               (_ #t))))))
+
+(define (handle-talking player key)
+  (define who (talking? player))
   ;; Use arrow keys to select a message, hit action key to
   ;; confirm the selection.
-  (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)
+  (match (cond
+          ((wants-to-stop-talking? player) '())
+          ((assoc-ref (resume-messages player) (name who)) => list)
+          (else (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)
+     (when (eq? 'space key)
+       (set! (speaking? who) #f)        ; TODO?
        (stop-talking player)))
-    ((and ((and (message text) selected) . rest) messages)
+    ((and ((and (message text . flags) selected) . rest) messages)
      (cond
       ;; Select previous message
-      ((and (not (eq? 'up (selecting-message? player)))
-            (key-pressed? 'up))
+      ((eq? 'up key)
        (set! (accepted-messages who)
              (append (list (last messages))
                      (drop-right messages 1)))
        (set! (selecting-message? player) 'up))
 
       ;; Select next message
-      ((and (not (eq? 'down (selecting-message? player)))
-            (key-pressed? 'down))
+      ((eq? 'down key)
        (set! (accepted-messages who)
              (append rest (list selected)))
        (set! (selecting-message? player) 'down))
 
       ;; Submit selected message.
-      ((and (not (action-held player))
-            (key-pressed? 'space)
+      ((and (eq? 'space key)
             (not (speaking? who)))
-       (set! (action-held player) #t)
+       ;; Delete remembered resume point if it exists, because we want
+       ;; to only use them once.
+       (when (assoc-ref (resume-messages player) (name who))
+         (set! (resume-messages player)
+               (acons (name who) #f
+                      (resume-messages player))))
+       (and=> (member #:resume flags)
+              (match-lambda
+                ((#:resume (and (message text) pair))
+                 (set! (resume-messages player)
+                       (acons (name who) pair
+                              (resume-messages player)))
+                 (set! (accepted-messages who) (list message))
+                 (set! (wants-to-stop-talking? player) #t))))
        (talk player who message))
 
       ;; Dismiss character's text.
-      ((and (not (action-held player))
-            (key-pressed? 'space)
+      ((and (eq? 'space key)
             (speaking? who))
-       (set! (action-held player) #t)
        (set! (speaking? who) #f))))
-    (_ #t))
-
-  ;; Render the messages in the new order once the
-  ;; character's text has been dismissed.
-  (unless (speaking? who)
-    (let ((bubble (child-ref (parent (parent player)) 'text-bubble))
-          (messages (accepted-messages who)))
-      (clear-messages bubble)
-      (fold (lambda (message n lines)
-              (match message
-                ((message text)
-                 (when (zero? n)
-                   (attach bubble
-                           (make <filled-rect>
-                             #:name 'dialog-selection-indicator
-                             #:region (make-rect 0.0 0.0 10 10)
-                             #:position (vec2 0 40)
-                             #:color region)))
-                 (+ lines
-                    (render-text bubble text
-                                 #:suffix message
-                                 #:y-offset
-                                 (+ (* n %message-margin)
-                                    (* lines %line-height)))))))
-            0
-            messages
-            (iota (length messages))))))
+    (_ (pk 'this-should-never-happen #t))))
 
 (define-method (talk (player <player>) (who <character>) message)
+  "Send MESSAGE to WHO and display the response."
   (let ((bubble (child-ref (parent (parent player)) 'text-bubble)))
-    (when (not (talking? player))
-      (set! (visible? bubble) #t))
-
     (match (assoc-ref (conversations who) message)
       ((text next)
-       (set! (talking? player) who)
        (set! (speaking? who) #t)
+       (set! (talking? player) who)
 
        ;; Clear any shown messages.
        (clear-messages bubble)
@@ -354,10 +360,18 @@ given MAX-WIDTH.  Return a list of lines."
       ;; conversation matching a message.
       (oops (pk 'oops #t)))))
 
+(define-method (start-talking (player <player>) (who <character>))
+  (unless (equal? (talking? player) who)
+    (let ((bubble (child-ref (parent (parent player)) 'text-bubble)))
+      (clear-messages bubble)
+      (set! (visible? bubble) #t))
+    (set! (talking? player) who)))
+
 (define-method (stop-talking (player <player>))
   (when (talking? player)
     (set! (visible? (child-ref (parent (parent player)) 'text-bubble)) #f)
-    (set! (talking? player) #f)))
+    (set! (talking? player) #f)
+    (set! (wants-to-stop-talking? player) #f)))
 
 (define* (render-text bubble text #:key (y-offset 0) (suffix '-text))
   "Fill the bubble with lines of text.  Return the number of lines."