From b26e53c326c951b1a1944f9dfd6a11d1b4098fa3 Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <rekado@elephly.net>
Date: Thu, 19 Jul 2018 06:18:27 +0200
Subject: Break out talking to new procedure.

---
 scenes/game.scm | 152 +++++++++++++++++++++++++++++---------------------------
 1 file changed, 78 insertions(+), 74 deletions(-)

diff --git a/scenes/game.scm b/scenes/game.scm
index 47d1927..ad49505 100644
--- a/scenes/game.scm
+++ b/scenes/game.scm
@@ -332,80 +332,7 @@ you.  I'm sure we will meet again sooner than you expect."
              ;; 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
-                   ;; Select previous message
-                   ((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))
-
-                   ;; Select next message
-                   ((and (not (eq? 'down (selecting-message? player)))
-                         (key-pressed? 'down))
-                    (set! (accepted-messages who)
-                          (append rest (list selected)))
-                    (set! (selecting-message? player) 'down))
-
-                   ;; Submit selected message.
-                   ((and (not (action-held player))
-                         (key-pressed? 'space)
-                         (not (speaking? who)))
-                    (set! (action-held player) #t)
-                    (talk player who message))
-
-                   ;; Dismiss character's text.
-                   ((and (not (action-held player))
-                         (key-pressed? 'space)
-                         (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)))
-                   (for-each (lambda (node)
-                               (when (string-prefix? "dialog" (symbol->string (name node)))
-                                 (detach node)))
-                             (children bubble))
-                   (for-each (lambda (message i)
-                               (match message
-                                 ((message text)
-                                  (when (zero? i)
-                                    (attach bubble
-                                            (make <filled-rect>
-                                              #:name 'dialog-selection-indicator
-                                              #:region (make-rect 0.0 0.0 10 10)
-                                              #:position (vec2 0 40)
-                                              #:color region)))
-                                  (attach bubble (make <label>
-                                                   #:name (symbol-append 'dialog- message)
-                                                   #:font game-font
-                                                   #:text text
-                                                   #:color color
-                                                   #:position (vec2 16.0 (- 40 (* 16.0 i))))))))
-                             messages
-                             (iota (length messages)))))
-
+               (handle-talking player who)
                ;; Always end on #T to avoid passing through to the
                ;; motion branch.
                #t))
@@ -461,6 +388,83 @@ you.  I'm sure we will meet again sooner than you expect."
                           (_ #t))))
                      (_ #t))))))))
 
+(define-method (handle-talking (player <player>) (who <character>))
+  ;; 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)
+    ;; 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
+      ;; Select previous message
+      ((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))
+
+      ;; Select next message
+      ((and (not (eq? 'down (selecting-message? player)))
+            (key-pressed? 'down))
+       (set! (accepted-messages who)
+             (append rest (list selected)))
+       (set! (selecting-message? player) 'down))
+
+      ;; Submit selected message.
+      ((and (not (action-held player))
+            (key-pressed? 'space)
+            (not (speaking? who)))
+       (set! (action-held player) #t)
+       (talk player who message))
+
+      ;; Dismiss character's text.
+      ((and (not (action-held player))
+            (key-pressed? 'space)
+            (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)))
+      (for-each (lambda (node)
+                  (when (string-prefix? "dialog" (symbol->string (name node)))
+                    (detach node)))
+                (children bubble))
+      (for-each (lambda (message i)
+                  (match message
+                    ((message text)
+                     (when (zero? i)
+                       (attach bubble
+                               (make <filled-rect>
+                                 #:name 'dialog-selection-indicator
+                                 #:region (make-rect 0.0 0.0 10 10)
+                                 #:position (vec2 0 40)
+                                 #:color region)))
+                     (attach bubble (make <label>
+                                      #:name (symbol-append 'dialog- message)
+                                      #:font game-font
+                                      #:text text
+                                      #:color color
+                                      #:position (vec2 16.0 (- 40 (* 16.0 i))))))))
+                messages
+                (iota (length messages))))))
+
 (define-method (talk (player <player>) (who <character>) message)
   (let ((bubble (child-ref (parent (parent player)) 'text-bubble)))
     (when (eq? message 'hello)
-- 
cgit v1.2.3