Simpler and more intelligent line-breaking
✎:RENDER-STRING(-PARTIALLY) now is in a lot better shape! They’ll only line-break on spaces, ain’t that swell?
This commit is contained in:
parent
eaa42ab2d8
commit
a5d4179607
77
display.lisp
77
display.lisp
|
@ -70,6 +70,45 @@ that change between A→B (favouring those in B) — all others are nil."
|
||||||
(make-array '(20 72) :initial-element #\space))
|
(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
|
;;; “Rendering” strings to matrix
|
||||||
|
@ -97,45 +136,21 @@ No word-wrapping is done, even if the line exceeds the MATRIX’es size!"
|
||||||
(str:lines string))))
|
(str:lines string))))
|
||||||
|
|
||||||
|
|
||||||
(defun render-string-partially (matrix text coords &key (char-count 0) (max-column 72) (max-row 20))
|
(defun render-string-partially (matrix text coords &key (char-count 0) (max-column 72))
|
||||||
"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* ((x (getf coords :x))
|
(let* ((x (getf coords :x))
|
||||||
(y (getf coords :y))
|
(y (getf coords :y))
|
||||||
(dimensions (array-dimensions matrix))
|
(width (- max-column x)))
|
||||||
(max-column (…:at-most (cadr dimensions) max-column))
|
(render-string-verbatim
|
||||||
(row-width (- 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)
|
|
||||||
(list :x x :y (+ y row))))
|
|
||||||
;; At the last line, write only up til the :CHAR-COUNT
|
|
||||||
((eq row max-write-row)
|
|
||||||
(render-line
|
|
||||||
matrix
|
matrix
|
||||||
(subseq (pop substrings) 0 row-width-at-max-write-row)
|
(linewrap-string (subseq text 0 char-count) width)
|
||||||
(list :x x :y (+ y row))))
|
coords)))
|
||||||
('t
|
|
||||||
(pop substrings)))
|
|
||||||
(incf row)))
|
|
||||||
matrix)
|
|
||||||
|
|
||||||
|
|
||||||
(defun render-string (matrix text coords &key (max-column 72) (max-row 20))
|
(defun render-string (matrix text coords &key (max-column 72))
|
||||||
"Render the given string to the matrix of characters, character-by-character.
|
"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
|
Will line-break or truncate as appropriate and necessary to not exceed the
|
||||||
positional arguments nor the dimensions of the matrix."
|
positional arguments nor the dimensions of the matrix."
|
||||||
(render-string-partially matrix text coords :max-column max-column :max-row max-row
|
(render-string-partially matrix text coords :max-column max-column :char-count (length text)))
|
||||||
:char-count (length text)))
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
3
ui.lisp
3
ui.lisp
|
@ -62,8 +62,7 @@ A core part of #'menu-state."
|
||||||
of the box will be displayed as selected/highlighted. This percent is from
|
of the box will be displayed as selected/highlighted. This percent is from
|
||||||
left-to-right, unless negative — in which case, right-to-left."
|
left-to-right, unless negative — in which case, right-to-left."
|
||||||
(✎:render-string matrix text (list :x (+ x 1) :y (+ 1 y))
|
(✎:render-string matrix text (list :x (+ x 1) :y (+ 1 y))
|
||||||
:max-column (- (+ x width) 1)
|
:max-column (- (+ x width) 1))
|
||||||
:max-row (- (+ y height) 2))
|
|
||||||
;; Render the normal top and bottom bars.
|
;; Render the normal top and bottom bars.
|
||||||
(dotimes (i width)
|
(dotimes (i width)
|
||||||
(setf (aref matrix y (+ x i)) #\-)
|
(setf (aref matrix y (+ x i)) #\-)
|
||||||
|
|
Ŝarĝante…
Reference in New Issue