Hyphen-breaking line-breaking, tweak RENDER-STRING

dialogue.lisp

@@ -40,8 +40,7 @@ If not, have some tea on me: I’m paying. =w="
 ;;; Dialogue-generation helpers
 ;;; ———————————————————————————————————
 (defun start-dialogue (&rest dialogue-tree)
-  (reduce (lambda (a b) (append a b))
+  (reduce #'append dialogue-tree))
-          dialogue-tree))
 
 
 (defun face (speaker face &optional (talking-face nil))
@@ -230,8 +229,9 @@ use with RENDER-STRING."
                               (if rightp
                                   (- width text-x-margin)
                                   (- (getf coords :x) 3))))
-         (lines (ignore-errors (…:split-string-by-length text text-width)))
+         (lines (ignore-errors (str:lines (…:linewrap-string text text-width))))
          (text-height (length lines)))
+    (format *error-output* "HEIGHT: ~A WIDTH ~A LINES: ~A~%" text-height text-width lines)
     ;; When this layout is valid…
     (when (and lines
                (>= height text-height) ;; If the text’ll fit on screen
@@ -245,7 +245,7 @@ use with RENDER-STRING."
                    (- text-width (length text))
                    text-x-margin)))
        (list (list :x x :y y) ;; Coords
-             (+ x text-width) ;; Max column
+             text-width ;;(+ x text-width) ;; Max column
              height)))))      ;; Max row
 
 
@@ -262,7 +262,8 @@ is found, otherwise return a list of the coordinates, max-column, and max-row
                           (- height text-y-margin)
                           (- text-y-margin 1)))
          (text-width (floor (* width 3/5))) ;; Too wide’s illegible! So ⅗-screen.
-         (lines (ignore-errors (…:split-string-by-length text text-width))))
+         (lines (ignore-errors (str:lines (…:linewrap-string text text-width)))))
+    (format *error-output* "HEIGHT: ~A WIDTH ~A LINES: ~A~%" text-height text-width lines)
     ;; When the text can be printed with this layout…
     (when (and lines (>= text-height (length lines)))
       (let ((y (…:at-least
@@ -277,7 +278,7 @@ is found, otherwise return a list of the coordinates, max-column, and max-row
                         (floor (/ (length (car lines)) 2))
                         (floor (/ text-width 2)))))))
         (list (list :x x :y y)       ;; Coords
-              (+ x text-width)       ;; Max column
+              text-width ;;(+ x text-width)       ;; Max column
               (+ y text-height)))))) ;; Max row
 
 
@@ -311,12 +312,18 @@ make it pretty, dang it! >O<
 ☆:.｡.o(≧▽≦)o.｡.:☆"
   (let* ((progress (getf dialogue :progress))
          (text (getf dialogue :text))
-         (optimal-layout (when text (optimal-speech-layout map dialogue))))
+         (optimal-layout (when text (optimal-speech-layout map dialogue)))
+         (coords (car optimal-layout)))
     (when (and text optimal-layout)
-      (✎:render-string-partially
+      (format *error-output* "~A~%" optimal-layout)
+;;      (✎:render-fill-rectangle matrix #\space
+;;                               (list :x (- (getf coords :x) 1)
+;;                                     :y (- (getf coords :y) 1)
+;;                               (- (second optimal-layout) (getf coords :x) -2)
+;;                               (- (third optimal-layout) (getf coords :y) -2))
+      (✎:render-string
        matrix text (first optimal-layout)
-       :max-column (second optimal-layout)
+       :width (second optimal-layout)
-       :max-row (third optimal-layout)
        :char-count progress))))
 
 

display.lisp

@@ -70,45 +70,6 @@ that change between A→B (favouring those in B) — all others are nil."
   (make-array '(20 72) :initial-element #\space))
 
 
-(defun search-all (subseq sequence &key (start 0))
-  "Given a SUBSEQ to search for within a SEQUENCE, return every instance of
-SUBSEQ in SEQUENCE."
-  (let ((matches '()))
-    (loop while (setf start (search subseq sequence :start2 start))
-          do (progn (pushnew start matches)
-                    (incf start)))
-    (reverse matches))) ;; So they’re in ascending order!
-
-
-(defun closest-below (num number-list)
-  "Given a NUMBER-LIST, return a descending list of member numbers below NUM."
-  (sort
-   (remove-if-not (lambda (a) (and (numberp a) (<= a num))) number-list)
-   #'>))
-
-
-(defun linewrap-string (string width)
-  "Break a STRING into several lines, each one no larger than WIDTH. Only replaces
-spaces with newlines; no more, no less. Don’t choose too small a WIDTH, or else
-you might be in trouble!"
-  (let ((spaces (search-all " " string))
-        (index width))
-    (loop while (< index (length string))
-          do (progn (setf index (car (closest-below index spaces)))
-                    (setf (elt string index) #\newline)
-                    (incf index width)))
-    string))
-
-
-(defun string-dimensions (string)
-  "Given a linewrapped STRING, return the minimum width and minimum height (in
-characters) for a rectangle that might contain the entirety of the string.
-  (WIDTH HEIGHT)"
-  (let ((lines (str:lines string)))
-    (list (sort (mapcar #'length lines) #'<) ;; Width
-          (count lines)))) ;; Height
-
-
 
 ;;; ———————————————————————————————————
 ;;; “Rendering” strings to matrix
@@ -136,21 +97,23 @@ No word-wrapping is done, even if the line exceeds the MATRIX’es size!"
             (str:lines string))))
 
 
-(defun render-string-partially (matrix text coords &key (char-count 0) (max-column 72))
+(defun render-string (matrix text coords &key (char-count (length text)) (width 35))
   (let* ((x (getf coords :x))
-         (y (getf coords :y))
+         (y (getf coords :y)))
-         (width (- max-column x)))
     (render-string-verbatim
      matrix
-     (linewrap-string (subseq text 0 char-count) width)
+     (…:linewrap-string (subseq text 0 char-count) width)
      coords)))
 
 
-(defun render-string (matrix text coords &key (max-column 72))
+(defun render-fill-rectangle (matrix char coords width height)
-  "Render the given string to the matrix of characters, character-by-character.
+  (render-string-verbatim
-Will line-break or truncate as appropriate and necessary to not exceed the
+   matrix
-positional arguments nor the dimensions of the matrix."
+   (str:unlines
-  (render-string-partially matrix text coords :max-column max-column :char-count (length text)))
+    (loop for i to height
+          collect (make-string width :initial-element char)))
+   coords)
+  matrix)
 
 
 

packages.lisp

@@ -18,7 +18,7 @@
 (defpackage :flora-search-aurora.util
   (:nicknames :fsa.utl :util :…)
   (:use :cl)
-  (:export #:split-string-by-length
+  (:export #:linewrap-string #:fit-lines
            #:plist=
            #:incf-0
            #:at-least #:at-most
@@ -40,6 +40,7 @@
   (:use :cl)
   (:export #:make-screen-matrix #:print-screen-matrix #:matrix-delta
            #:render-line #:render-string #:render-string-verbatim #:render-string-partially
+           #:render-fill-rectangle
            #:hide-cursor #:show-cursor #:clear-screen))
 
 (defpackage :flora-search-aurora.ui

ui.lisp

@@ -40,7 +40,8 @@ A state-function for use with the #'state-loop."
 (defun menu-state-draw (matrix menu-alist)
   "Render a menu in menu-alist format to the given matrix.
 A core part of #'menu-state."
-  (intermission::render-clock-base matrix (list :x 0 :y 0))
+  ;;  (intermission::render-clock-base matrix (list :x 0 :y 0))
+  (✎:render-string matrix "daddy is dead anmd I hate him" '(:x 20 :y 10) :width 15 :char-count 18)
   (render-menu-strip matrix menu-alist 0 0))
 
 
@@ -62,7 +63,7 @@ A core part of #'menu-state."
 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 (list :x (+ x 1) :y (+ 1 y))
-                   :max-column (- (+ x width) 1))
+                   :width width) ;; (- (+ x width) 1))
   ;; Render the normal top and bottom bars.
   (dotimes (i width)
     (setf (aref matrix y (+ x i)) #\-)

util.lisp

@@ -19,19 +19,72 @@
 
 (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
+;;; Linewrapping & its helpers
-equal or lower to the given length."
+;;; ———————————————————————————————————
-  (if (> (length string) line-length)
+(defun search-all (subseq sequence &key (start 0))
-      (split-string-by-length
+  "Given a SUBSEQ to search for within a SEQUENCE, return every instance of
-       (subseq string line-length)
+SUBSEQ in SEQUENCE."
-       line-length
+  (let ((matches '()))
-       :substrings (append substrings
+    (loop while (setf start (search subseq sequence :start2 start))
-                           `(,(subseq string 0 line-length))))
+          do (progn (pushnew start matches)
-      (append substrings `(,string))))
+                    (incf start)))
+    (reverse matches))) ;; So they’re in ascending order!
 
 
+(defun closest-below (num number-list)
+  "Given a NUMBER-LIST, return a descending list of member numbers below NUM."
+  (sort
+   (remove-if-not (lambda (a) (and (numberp a) (<= a num))) number-list)
+   #'>))
+
+
+(defun string-dimensions (string)
+  "Given a linewrapped STRING, return the minimum width and minimum height (in
+characters) for a rectangle that might contain the entirety of the string.
+  (WIDTH HEIGHT)"
+  (let ((lines (str:lines string)))
+    (list (sort (mapcar #'length lines) #'<) ;; Width
+          (count lines)))) ;; Height
+
+
+(defun fit-lines (string width &key (alignment :center))
+  "Fit each line of a STING into a specific WIDTH, with ALIGNMENT to a specific
+side (either :CENTER, :LEFT, or :RIGHT)."
+  (str:unlines
+   (mapcar (lambda (line)
+             (str:fit width line :pad-side alignment))
+           (str:lines string))))
+
+
+(defun linewrap-string (string width)
+  "Break a STRING into several lines, each one no larger than WIDTH. Uses
+newlines and hypens (to break long words) as necessary."
+  (let ((spaces (append '(0) (search-all " " string)))
+        (index width))
+    (loop while (< index (length string))
+          do (let ((closest-space (car (closest-below index spaces)))
+                   (old-index (- index width)))
+               (if (or (<= closest-space old-index)
+                       (> closest-space index))
+                   ;; Break up long words with a hyphen
+                   (return
+                     (linewrap-string
+                      (str:insert "- " (- index 1)
+                                  (str:replace-all (string #\newline) " " string))
+                      width))
+                   ;; Replace eligible spaces with newlines uwu
+                   (progn
+                     (setf (elt string closest-space) #\newline)
+                     (setf index (+ closest-space width)))))
+         finally (return string))))
+
+
+
+;;; ———————————————————————————————————
+;;; Listic affairs
+;;; ———————————————————————————————————
 (defun every-other-element (list)
   "Collect every-other-element of a list. E.g., (1 2 3 4) → (1 3)."
   (when list
@@ -50,6 +103,10 @@ Uses the keys of plist a."
           finally (return 't))))
 
 
+
+;;; ———————————————————————————————————
+;;; Numeric affairs
+;;; ———————————————————————————————————
 (defmacro incf-0 (place &optional (Δ 1))
   "INCF the given PLACE, if it’s a number. If not a number, then set it to zero."
   `(if (numberp ,place)
@@ -73,6 +130,10 @@ minimum returns your more pitiful of moments."
       num))
 
 
+
+;;; ———————————————————————————————————
+;;; Linguistic affirs
+;;; ———————————————————————————————————
 (defun langcode->keysym (str)
   "Given a language’s code (es/cz/it/etc.), return a corresponding key symbol,
 if the language is among the supported. Otherwise, nil."