From 488552adf119aba2d8082dfeb66f632a62144ff1 Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <rekado@elephly.net>
Date: Thu, 19 Jul 2018 06:03:56 +0200
Subject: Render texts, support dismissing and submitting.

---
 scenes/game.scm | 85 ++++++++++++++++++++++++++++++++++++++++++++++++++-------
 1 file changed, 75 insertions(+), 10 deletions(-)

diff --git a/scenes/game.scm b/scenes/game.scm
index 4adf765..4f9f2ab 100644
--- a/scenes/game.scm
+++ b/scenes/game.scm
@@ -47,6 +47,7 @@
 (define-class <character> (<node-2d>)
   (conversations #:accessor conversations #:init-keyword #:conversations)
   (accepted-messages #:accessor accepted-messages #:init-form '(hello))
+  (speaking? #:accessor speaking? #:init-form #f)
   (velocity #:getter velocity #:init-form (vec2 0.0 0.0))
   (walk-speed #:accessor walk-speed #:init-form 0.8)
   (direction #:accessor direction #:init-form '(idle))
@@ -282,24 +283,63 @@ map's object layer."
                     (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))
+                         (key-pressed? 'space)
+                         (speaking? who))
                     (set! (action-held player) #t)
-                    (talk player who message))))
+                    (set! (speaking? who) #f))))
                  (_ #t))
 
-               ;; TODO: render the messages in the new order.
+               ;; 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)))))
 
                ;; Always end on #T to avoid passing through to the
                ;; motion branch.
@@ -356,11 +396,31 @@ map's object layer."
                           (_ #t))))
                      (_ #t))))))))
 
-(define-method (talk (player <player>) who)
-  (unless (talking? player)
-    (let ((bubble (child-ref (parent (parent player)) 'text-bubble)))
+(define-method (talk (player <player>) (who <character>) message)
+  (let ((bubble (child-ref (parent (parent player)) 'text-bubble)))
+    (when (eq? message 'hello)
       (set! (visible? bubble) #t))
-    (set! (talking? player) who)))
+
+    (set! (talking? player) who)
+
+    ;; Send message, display text, record possible continuations
+    (match (assoc-ref (conversations who) message)
+      ((text next)
+       (set! (speaking? who) #t)
+       (for-each (lambda (node)
+                   (when (string-prefix? "dialog" (symbol->string (name node)))
+                     (detach node)))
+                 (children bubble))
+       ;; TODO: split text
+       (attach bubble (make <label>
+                        #:name 'dialog
+                        #:font game-font
+                        #:text text
+                        #:position (vec2 16.0 40)))
+       (set! (accepted-messages who) next))
+      ;; This should never happen, because there should always be a
+      ;; conversation matching a message.
+      (oops (pk 'oops #t)))))
 
 (define-method (stop-talking (player <player>))
   (when (talking? player)
@@ -420,9 +480,14 @@ map's object layer."
     (make <node-2d>
       #:children
       (list game
-            (make <filled-rect>
+            (make <node-2d>
               #:name 'text-bubble
-              #:region (make-rect 0.0 0.0 %width 50)
               #:position (vec2 0 0)
               #:visible? #f
-              #:color (make-color 0 0 0 0.5))))))
+              #:children
+              (list (make <filled-rect>
+                      #:name 'text-bubble-box
+                      #:region (make-rect 0.0 0.0 %width 50)
+                      #:position (vec2 0 0)
+                      #:rank -10 ; background
+                      #:color (make-color 0 0 0 0.5))))))))
-- 
cgit v1.2.3