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)) (text (getf dialogue :text))
(optimal-layout (when text (optimal-speech-layout map dialogue)))) (optimal-layout (when text (optimal-speech-layout map dialogue))))
(when (and text optimal-layout) (when (and text optimal-layout)
(šŸ“‹:render-string-partially (āœŽ:render-string-partially
matrix text (first optimal-layout) matrix text (first optimal-layout)
:max-column (second optimal-layout) :max-column (second optimal-layout)
:max-row (third 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)) (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 MATRIXā€™es 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 ;;; Misc. utils

View File

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

View File

@ -37,7 +37,7 @@
;;; Inventory loop drawing ;;; Inventory loop drawing
;;; ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€” ;;; ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”
(defun inventory-state-draw (matrix items) (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)) (width (length avatar))
(y (getf screen-coords :y)) (y (getf screen-coords :y))
(x (- (getf screen-coords :x) (floor (/ width 2))))) (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) (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) (x (if (getf entity-plist :facing-right)
(- (getf screen-coords :x) (floor (/ width 2)) 0) (- (getf screen-coords :x) (floor (/ width 2)) 0)
(- (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 x) #\|))
(ignore-errors (setf (aref matrix y (+ width x -1)) (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) (defun matrix-write-datetime (matrix datetime)
(let ((string (game-datetime->string 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 ;;;; FLORA-SEARCH-AURORA.INTERMISSION ā€” CLOCKS
;;;; Some ASCII clock-stuff, for use with INTERMISSIONā€™s clock-rendering. ;;;; Some ASCII clock-stuff, for use with INTERMISSIONā€™s clock-rendering.
(set-dispatch-macro-character #\# #\> #'cl-heredoc:read-heredoc) (in-package :flora-search-aurora.intermission)
;;(in-package :flora-search-aurora.intermission)
;; So that we can do #>eof>strings like this!eof
;; What a wonderful macro! :D
(defparameter *clock-base* (defparameter *clock-base*
" "
--------------- ---------------
/ ________ \\\"\ / ________ \\\"\
/ . / \ ,.\\\"\ / . / \\ ,.\\\"\
ā„ / \ \\\"| ā„ / \\ \\\"|
| | | |\"| | | | |\"|
| ,| () | ,|\"| | ,| () | ,|\"|
|. | | |\"| |. | | |\"|
| \ / , |\"| | \\ / , |\"|
| ,. \________/. |\"| | ,. \\________/. |\"|
| . . . |\"| | . . . |\"|
| .,- ., . . |\"| | .,- ., . . |\"|
| .. . . . . . . |\"| | .. . . . . . . |\"|
|__________________|\"| |__________________|\"|
" ")
)
(defparameter *calendar-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) (defun menu-state-draw (matrix menu-alist)
"Render a menu in menu-alist format to the given matrix. "Render a menu in menu-alist format to the given matrix.
A core part of #'menu-state." A core part of #'menu-state."
(intermission::render-clock-base matrix (list :x 0 :y 0))
(render-menu-strip matrix menu-alist 0 0)) (render-menu-strip matrix menu-alist 0 0))
@ -54,25 +55,13 @@ A core part of #'menu-state."
;;; ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€” ;;; ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”ā€”
;;; Menu display ;;; 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 (defun render-menu-item
(matrix text x y &key (width (+ (length text) 2)) (height 3) (selection 0) (selected nil)) (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 "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 '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 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)) :max-row (- (+ y height) 2))
;; Render the normal top and bottom bars. ;; Render the normal top and bottom bars.
@ -124,47 +113,6 @@ The item list should be an alist of the following format:
matrix) 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 ;;; 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))) (let ((old-position (selected-menu-item-position menu-alist)))
;; The ā€œpolarityā€ (direction of selection) depends on the relative ;; The ā€œpolarityā€ (direction of selection) depends on the relative
;; direction of the previous selection. ;; 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)) (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. ;; 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)) (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) menu-alist)