Move 📋:RENDER-STRING* & 📋:RENDER-LINE to ✎

Also add new function, ✎:RENDER-STRING-VERBATIM
This commit is contained in:
Jaidyn Ann 2023-06-30 13:52:50 -05:00
parent e2652abf60
commit eaa42ab2d8
7 changed files with 95 additions and 80 deletions

View File

@ -313,7 +313,7 @@ make it pretty, dang it! >O<
(text (getf dialogue :text))
(optimal-layout (when text (optimal-speech-layout map dialogue))))
(when (and text optimal-layout)
(📋:render-string-partially
(:render-string-partially
matrix text (first optimal-layout)
:max-column (second optimal-layout)
:max-row (third optimal-layout)

View File

@ -70,6 +70,74 @@ that change between A→B (favouring those in B) — all others are nil."
(make-array '(20 72) :initial-element #\space))
;;; ———————————————————————————————————
;;; “Rendering” strings to matrix
;;; ———————————————————————————————————
(defun render-line (matrix text coords)
"Apply a one-line string to the matrix at the given coordinates."
(let ((dims (array-dimensions matrix))
(x (getf coords :x))
(y (getf coords :y)))
(if (and (stringp text)
(> (length text) 0))
(progn
(ignore-errors (setf (aref matrix y x) (char text 0)))
(render-line matrix (subseq text 1)
(list :x (+ x 1) :y y)))
matrix)))
(defun render-string-verbatim (matrix string coords)
"Apply a STRING to a MATRIX at the precise COORDS, preserving newlines.
No word-wrapping is done, even if the line exceeds the MATRIXes size!"
(let ((y (- (getf coords :y) 1))
(x (getf coords :x)))
(mapcar (lambda (line) (:render-line matrix line (list :x x :y (incf y))))
(str:lines string))))
(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* ((x (getf coords :x))
(y (getf coords :y))
(dimensions (array-dimensions matrix))
(max-column (:at-most (cadr dimensions) max-column))
(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
(subseq (pop substrings) 0 row-width-at-max-write-row)
(list :x x :y (+ y row))))
('t
(pop substrings)))
(incf row)))
matrix)
(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 coords :max-column max-column :max-row max-row
:char-count (length text)))
;;; ———————————————————————————————————
;;; Misc. utils

View File

@ -2,6 +2,7 @@
:depends-on ("alexandria" "assoc-utils" "cl-charms" "str")
:build-operation "program-op"
:build-pathname "flora-search-aurora"
:entry-point "flora-search-aurora:main"
:components ((:file "packages")
(:file "util")
@ -9,11 +10,13 @@
(:file "input")
(:file "ui")
(:file "inventory")
(:file "intermission")
(:file "overworld.util")
(:file "overworld")
(:file "dialogue")
(:file "engine")
(:file "flora-search-aurora")
(:file "res/clocks")
(:file "res/maps/casino.tmx")
(:file "res/maps/outdoors.tmx")
(:file "res/maps/flashback-school.tmx")))

View File

@ -37,7 +37,7 @@
;;; Inventory loop drawing
;;; ———————————————————————————————————
(defun inventory-state-draw (matrix items)
(📋:render-string matrix (format nil "~A" items) '(:x 0 :y 0)))
(:render-string matrix (format nil "~A" items) '(:x 0 :y 0)))

View File

@ -333,7 +333,7 @@ alist containing a character (:CHAR) and :X & :Y coordinates."
(width (length avatar))
(y (getf screen-coords :y))
(x (- (getf screen-coords :x) (floor (/ width 2)))))
(📋:render-line matrix avatar x y)))
(:render-line matrix avatar (list :x x :y y))))
(defun matrix-write-entity-head (matrix entity-plist)
@ -345,7 +345,7 @@ alist containing a character (:CHAR) and :X & :Y coordinates."
(x (if (getf entity-plist :facing-right)
(- (getf screen-coords :x) (floor (/ width 2)) 0)
(- (getf screen-coords :x) (floor (/ width 2)) 0))))
(📋:render-line matrix face (+ x 1) y)
(:render-line matrix face (list :x (+ x 1) :y y))
(ignore-errors (setf (aref matrix y x) #\|))
(ignore-errors (setf (aref matrix y (+ width x -1))
#\|))))
@ -381,7 +381,7 @@ alist containing a character (:CHAR) and :X & :Y coordinates."
(defun matrix-write-datetime (matrix datetime)
(let ((string (game-datetime->string datetime)))
(📋:render-line matrix string (- 71 (length string)) 19)))
(:render-line matrix string (list :x (- 71 (length string)) :y 19))))

View File

@ -16,30 +16,26 @@
;;;; FLORA-SEARCH-AURORA.INTERMISSION — CLOCKS
;;;; Some ASCII clock-stuff, for use with INTERMISSIONs clock-rendering.
(set-dispatch-macro-character #\# #\> #'cl-heredoc:read-heredoc)
;;(in-package :flora-search-aurora.intermission)
;; So that we can do #>eof>strings like this!eof
;; What a wonderful macro! :D
(in-package :flora-search-aurora.intermission)
(defparameter *clock-base*
"
---------------
/ ________ \\\"\
/ . / \ ,.\\\"\
/ \ \\\"|
/ . / \\ ,.\\\"\
/ \\ \\\"|
| | | |\"|
| ,| () | ,|\"|
|. | | |\"|
| \ / , |\"|
| ,. \________/. |\"|
| \\ / , |\"|
| ,. \\________/. |\"|
| . . . |\"|
| .,- ., . . |\"|
| .. . . . . . . |\"|
|__________________|\"|
"
)
")
(defparameter *calendar-base*
"
@ -55,6 +51,6 @@
| ||\"''
| ||\"''
|___________________||
"
)
")

64
ui.lisp
View File

@ -40,6 +40,7 @@ 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))
(render-menu-strip matrix menu-alist 0 0))
@ -54,25 +55,13 @@ A core part of #'menu-state."
;;; ———————————————————————————————————
;;; Menu display
;;; ———————————————————————————————————
(defun render-line (matrix text x y)
"Apply a one-line string to the matrix at the given coordinates."
(let ((dims (array-dimensions matrix)))
(if (and (stringp text)
(> (length text) 0))
(progn
(ignore-errors (setf (aref matrix y x) (char text 0)))
(render-line matrix (subseq text 1)
(+ x 1) y))
matrix)))
(defun render-menu-item
(matrix text x y &key (width (+ (length text) 2)) (height 3) (selection 0) (selected nil))
"Render a menu-item that is, text surrounded by a box with an optional
'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 (list :x (+ x 1) :y (+ 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.
@ -124,47 +113,6 @@ The item list should be an alist of the following format:
matrix)
(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 coords :max-column max-column :max-row max-row
:char-count (length text)))
(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* ((x (getf coords :x))
(y (getf coords :y))
(dimensions (array-dimensions matrix))
(max-column (:at-most (cadr dimensions) max-column))
(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)
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 row-width-at-max-write-row)
x (+ y row)))
('t
(pop substrings)))
(incf row)))
matrix)
;;; ———————————————————————————————————
;;; Menu logic
@ -224,13 +172,13 @@ That is, 0 for non-selected items and 100 for selected items."
(let ((old-position (selected-menu-item-position menu-alist)))
;; The “polarity” (direction of selection) depends on the relative
;; direction of the previous selection.
(setf (aget (nth position menu-alist) 'selection)
(setf (assoc-utils:aget (nth position menu-alist) 'selection)
(if (< old-position position) 10 -10))
(setf (aget (nth position menu-alist) 'selected) 't)
(setf (assoc-utils:aget (nth position menu-alist) 'selected) 't)
;; Likewise for the previously-selected item.
(setf (aget (nth old-position menu-alist) 'selection)
(setf (assoc-utils:aget (nth old-position menu-alist) 'selection)
(if (< old-position position) -90 90))
(setf (aget (nth old-position menu-alist) 'selected) nil))
(setf (assoc-utils:aget (nth old-position menu-alist) 'selected) nil))
menu-alist)