Orienting dialogue to the left or right of entity

dialogue.lisp

@@ -51,6 +51,12 @@
    (list :speaker speaker :text text :progress 0)))
 
 
+
+;;; ———————————————————————————————————
+;;; Accessors
+;;; ———————————————————————————————————
+(defun dialogue-speaker (dialogue)
+  (intern (string-upcase (getf dialogue :speaker))))
 
 
 
@@ -100,7 +106,7 @@ should be printed on the screen at any given moment."
         (text (getf dialogue :text)))
     (when (and text
                (< progress (length text)))
-      (incf (getf dialogue :progress)))))
+      (incf (getf dialogue :progress) 1))))
 
 
 (defun dialogue-state-update (map dialogue-list)
@@ -125,14 +131,55 @@ should be printed on the screen at any given moment."
 ;;; ———————————————————————————————————
 ;;; Dialogue drawing
 ;;; ———————————————————————————————————
-(defun dialogue-state-draw (matrix dialogue-list)
+(defun optimal-speech-layout-horizontally (text coords &key (right-p nil) (width 72) (height 20))
+  (let* ((text-margin (if right-p
+                          (+ (getf coords :x) 3)
+                          0))
+         (text-width (if right-p
+                         (- width text-margin)
+                         (- (getf coords :x) 3)))
+         (lines (ignore-errors (…:split-string-by-length text text-width))))
+    (format *error-output* "Margin: ~A Width: ~A Right: ~A" text-margin text-width right-p)
+    (when (and (> text-width 0)
+               lines)
+      (let ((y (…:at-least 0 (- (getf coords :y)
+                                (floor (/ (length lines) 2))
+                                1)))
+            (x (if (and (not right-p)
+                        (eq (length lines) 1))
+                   (- text-width (length text))
+                   text-margin)))
+        (list (list :x x :y y)
+              (+ x text-width)
+              height)))))
+
+
+(defun optimal-speech-layout (map dialogue &key (width 72) (height 20))
+  (let* ((speaker-id (dialogue-speaker dialogue))
+         (direction (🌍:getf-entity-data map speaker-id :direction))
+         (text (getf dialogue :text))
+         (coords (🌍:world-coords->screen-coords (🌍:getf-entity-data map speaker-id :coords))))
+    (optimal-speech-layout-horizontally text coords :right-p 't :width width :height height)))
+
+
+(defun render-dialogue-block (matrix map dialogue)
+  (let* ((progress (getf dialogue :progress))
+         (text (getf dialogue :text))
+         (optimal-layout (when text (optimal-speech-layout map dialogue))))
+    (when (and text optimal-layout)
+      (📋:render-string-partially
+       matrix text (first optimal-layout)
+       :max-column (second optimal-layout)
+       :max-row (third optimal-layout)
+       :char-count progress))))
+
+
+(defun dialogue-state-draw (matrix map dialogue-list)
   "Draw the dialogue where appropriate.
 Helper function for DIALOGUE-STATE."
-  (let ((text (getf (car dialogue-list) :text))
+  (when (getf (car dialogue-list) :text)
-        (progress (getf (car dialogue-list) :progress)))
+    (✎:show-cursor)
-    (when text
+    (render-dialogue-block matrix map (car dialogue-list))))
-      (✎:show-cursor)
-      (📋:render-string-partially matrix text 0 0 :char-count progress))))
 
 
 
@@ -150,6 +197,6 @@ entities as the speakers. Dialogue should be in the format:
     :speaker \"papa\"
    ...))
 A state-function for use with STATE-LOOP."
-  (sleep .02)
+  (sleep .05)
-  (dialogue-state-draw matrix dialogue)
+  (dialogue-state-draw matrix map dialogue)
   (dialogue-state-update map dialogue))

flora-search-aurora.lisp

@@ -19,6 +19,7 @@
 
 (ql:quickload '(alexandria assoc-utils cl-charms cl-tiled str))
 
+(load "util.lisp")
 (load "input.lisp")
 (load "display.lisp")
 (load "ui.lisp")

overworld.lisp

@@ -22,6 +22,7 @@
   (:use :cl
    :flora-search-aurora.overworld.tiled :flora-search-aurora.overworld.util)
   (:export #:overworld-state #:overworld-state-draw
+           #:world-coords->screen-coords
            #:getf-entity #:getf-entity-data
            :player))
 

ui.lisp

@@ -73,7 +73,7 @@ A core part of #'menu-state."
 'selected' form. If selected is a non-zero number below 100, then that percent
 of the box will be displayed as selected/highlighted. This percent is from
 left-to-right, unless negative — in which case, right-to-left."
-  (render-string matrix text (+ x 1) (+ 1 y)
+  (render-string matrix text (list :x (+ x 1) :y (+ 1 y))
                  :max-column (- (+ x width) 1)
                  :max-row (- (+ y height) 2))
   ;; Render the normal top and bottom bars.
@@ -86,8 +86,8 @@ left-to-right, unless negative — in which case, right-to-left."
   (if (and selection
            (not (eq selection 0)))
       (let* ((bar-width
-               (at-most width (ceiling (* width (* (abs selection)
+               (…:at-most width (ceiling (* width (* (abs selection)
-                                                   .01)))))
+                                                     .01)))))
              (bar-start (if (> 0 selection) (- width bar-width) 0)))
         (dotimes (i bar-width)
           (setf (aref matrix y (+ x bar-start i)) #\=)
@@ -112,7 +112,7 @@ The item list should be an alist of the following format:
        (let* ((label (cdr (assoc 'label item)))
               (selection (or (cdr (assoc 'selection item))
                              0))
-              (width (at-most max-item-width
+              (width (…:at-most max-item-width
                               (+ (length label) 2))))
          (render-menu-item matrix label x y
                            :width width
@@ -124,33 +124,41 @@ The item list should be an alist of the following format:
   matrix)
 
 
-(defun render-string (matrix text x y &key (max-column 72) (max-row 20))
+(defun render-string (matrix text coords &key (max-column 72) (max-row 20))
   "Render the given string to the matrix of characters, character-by-character.
 Will line-break or truncate as appropriate and necessary to not exceed the
 positional arguments nor the dimensions of the matrix."
-  (render-string-partially matrix text x y :max-column max-column :max-row max-row
+  (render-string-partially matrix text coords :max-column max-column :max-row max-row
                            :char-count (length text)))
 
 
-(defun render-string-partially (matrix text x y &key (char-count 0) (max-column 72) (max-row 20))
+(defun render-string-partially (matrix text coords &key (char-count 0) (max-column 72) (max-row 20))
   "Partially render the given string to a matrix of characters. Will render only
 a portion of the string, dictated by the CHAR-COUNT.
 See the similar RENDER-STRING function."
-  (let* ((dimensions (array-dimensions matrix))
+  (let* ((x (getf coords :x))
-         (max-column (at-most (cadr dimensions) max-column))
+         (y (getf coords :y))
-         (max-write-row (at-most (at-most (car dimensions) max-row)
+         (dimensions (array-dimensions matrix))
-                                 (floor (/ char-count max-column))))
+         (max-column (…:at-most (cadr dimensions) max-column))
-         (max-column-at-max-write-row (- char-count (* max-write-row max-column)))
+         (row-width (- max-column x))
-         (substrings (split-string-by-length text (- max-column x)))
+         (max-write-row (…:at-most (…:at-most (car dimensions) max-row)
+                                   (floor (/ char-count row-width))))
+         (row-width-at-max-write-row
+           (…:at-most row-width
+                      (- char-count (* max-write-row row-width))))
+         (substrings (…:split-string-by-length text row-width))
          (row 0))
     (loop while (and (<= (+ y row) max-row)
                      substrings)
           do (cond ((< row max-write-row)
                     (render-line matrix (pop substrings)
                                  x (+ y row)))
+                   ;; At the last line, write only up til the :CHAR-COUNT
                    ((eq row max-write-row)
-                    (render-line matrix (subseq (pop substrings) 0 max-column-at-max-write-row)
+                    (render-line
-                                 x (+ y row)))
+                     matrix
+                     (subseq (pop substrings) 0 row-width-at-max-write-row)
+                     x (+ y row)))
                    ('t
                     (pop substrings)))
              (incf row)))
@@ -251,42 +259,14 @@ That is, 0 for non-selected items and 100 for selected items."
 ;;; ———————————————————————————————————
 ;;; Misc. utils
 ;;; ———————————————————————————————————
-(defun split-string-by-length (string line-length &key (substrings '()))
-  "Given a string, split it into a list of substrings all with lengths
-equal or lower to the given length."
-  (if (> (length string) line-length)
-      (split-string-by-length
-       (subseq string line-length)
-       line-length
-       :substrings (append substrings
-                           `(,(subseq string 0 line-length))))
-      (append substrings `(,string))))
-
-
-(defun at-most (maximum num)
-  "This function returns at most every hope and dream you've ever had, and at
-minimum returns your more pitiful of moments."
-  (if (> num maximum)
-      maximum
-      num))
-
-
-(defun at-least (minimum num)
-  "This function returns at least every hope and dream you've ever had, and at
-maximum returns your more pitiful of moments."
-  (if (< num minimum)
-      minimum
-      num))
-
-
 (defun gravitate-toward (goal num delta)
   "Either add to a number, or subtract from it; whichever brings it closer to zero.
 In addition, the resultant value shall not “pass” zero."
   (cond
     ((< num goal)
-     (at-most goal (+ num delta)))
+     (…:at-most goal (+ num delta)))
     ((> num goal)
-     (at-least goal (- num delta)))
+     (…:at-least goal (- num delta)))
     ('t
      goal)))
 

util.lisp

@@ -0,0 +1,53 @@
+;;;; Copyright © 2023, Jaidyn Ann <jadedctrl@posteo.at>
+;;;;
+;;;; This program is free software: you can redistribute it and/or
+;;;; modify it under the terms of the GNU General Public License as
+;;;; published by the Free Software Foundation, either version 3 of
+;;;; the License, or (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;;; FLORA-SEARCH-AURORA.UI
+;;;; Generic menu-making, displaying, and management.
+;;;; Let's get to it, we're on a deadline!
+
+(defpackage :flora-search-aurora.util
+  (:nicknames :fsa.ut :util :…)
+  (:use :cl :assoc-utils)
+  (:export #:split-string-by-length #:at-least #:at-most))
+
+(in-package :flora-search-aurora.util)
+
+
+(defun split-string-by-length (string line-length &key (substrings '()))
+  "Given a string, split it into a list of substrings all with lengths
+equal or lower to the given length."
+  (if (> (length string) line-length)
+      (split-string-by-length
+       (subseq string line-length)
+       line-length
+       :substrings (append substrings
+                           `(,(subseq string 0 line-length))))
+      (append substrings `(,string))))
+
+
+(defun at-least (minimum num)
+  "This function returns at least every hope and dream you've ever had, and at
+maximum returns your more pitiful of moments."
+  (if (< num minimum)
+      minimum
+      num))
+
+
+(defun at-most (maximum num)
+  "This function returns at most every hope and dream you've ever had, and at
+minimum returns your more pitiful of moments."
+  (if (> num maximum)
+      maximum
+      num))