summaryrefslogtreecommitdiff
path: root/scenes
diff options
context:
space:
mode:
authorRicardo Wurmus <rekado@elephly.net>2018-07-19 06:03:56 +0200
committerRicardo Wurmus <rekado@elephly.net>2018-07-27 17:15:45 +0200
commit488552adf119aba2d8082dfeb66f632a62144ff1 (patch)
tree70aaa64df3d908104c18daf2def5393879df3194 /scenes
parentbe038a73ec9bad4cbb2b4dc7fb5f75c7c6166c38 (diff)
Render texts, support dismissing and submitting.
Diffstat (limited to 'scenes')
-rw-r--r--scenes/game.scm85
1 files 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))))))))