Hyphen-breaking line-breaking, tweak RENDER-STRING
This commit is contained in:
parent
a5d4179607
commit
dfcad9cfbd
|
|
@ -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))
|
||||
dialogue-tree))
|
||||
(reduce #'append 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)
|
||||
:max-row (third optimal-layout)
|
||||
:width (second optimal-layout)
|
||||
:char-count progress))))
|
||||
|
||||
|
||||
|
|
|
|||
59
display.lisp
59
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))
|
||||
(width (- max-column x)))
|
||||
(y (getf coords :y)))
|
||||
(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))
|
||||
"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 coords :max-column max-column :char-count (length text)))
|
||||
(defun render-fill-rectangle (matrix char coords width height)
|
||||
(render-string-verbatim
|
||||
matrix
|
||||
(str:unlines
|
||||
(loop for i to height
|
||||
collect (make-string width :initial-element char)))
|
||||
coords)
|
||||
matrix)
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
5
ui.lisp
5
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)) #\-)
|
||||
|
|
|
|||
83
util.lisp
83
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
|
||||
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))))
|
||||
|
||||
;;; ———————————————————————————————————
|
||||
;;; Linewrapping & its helpers
|
||||
;;; ———————————————————————————————————
|
||||
(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 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."
|
||||
|
|
|
|||
Ŝarĝante…
Reference in New Issue