From eaa42ab2d8ec28f73a313e6ef7337f1058968770 Mon Sep 17 00:00:00 2001 From: Jaidyn Ann <10477760+JadedCtrl@users.noreply.github.com> Date: Fri, 30 Jun 2023 13:52:50 -0500 Subject: [PATCH] =?UTF-8?q?Move=20=F0=9F=93=8B:RENDER-STRING*=20&=20?= =?UTF-8?q?=F0=9F=93=8B:RENDER-LINE=20to=20=E2=9C=8E?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Also add new function, ✎:RENDER-STRING-VERBATIM --- dialogue.lisp | 2 +- display.lisp | 68 +++++++++++++++++++++++++++++++++++++++++ flora-search-aurora.asd | 3 ++ inventory.lisp | 2 +- overworld.lisp | 6 ++-- res/clocks.lisp | 26 +++++++--------- ui.lisp | 68 +++++------------------------------------ 7 files changed, 95 insertions(+), 80 deletions(-) diff --git a/dialogue.lisp b/dialogue.lisp index c8f9b1b..4f2c325 100644 --- a/dialogue.lisp +++ b/dialogue.lisp @@ -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) diff --git a/display.lisp b/display.lisp index fa302b9..6dfb163 100644 --- a/display.lisp +++ b/display.lisp @@ -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 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 diff --git a/flora-search-aurora.asd b/flora-search-aurora.asd index 61f052a..413e588 100644 --- a/flora-search-aurora.asd +++ b/flora-search-aurora.asd @@ -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"))) diff --git a/inventory.lisp b/inventory.lisp index b720388..a636db9 100644 --- a/inventory.lisp +++ b/inventory.lisp @@ -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))) diff --git a/overworld.lisp b/overworld.lisp index afdedef..b49abde 100644 --- a/overworld.lisp +++ b/overworld.lisp @@ -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)))) diff --git a/res/clocks.lisp b/res/clocks.lisp index 421884e..392c008 100644 --- a/res/clocks.lisp +++ b/res/clocks.lisp @@ -16,33 +16,29 @@ ;;;; FLORA-SEARCH-AURORA.INTERMISSION β€” CLOCKS ;;;; 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) - -;; 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 @@ | ||\"'' | ||\"'' |___________________|| -" -) +") + diff --git a/ui.lisp b/ui.lisp index 384d253..27903de 100644 --- a/ui.lisp +++ b/ui.lisp @@ -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,27 +55,15 @@ 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)) - :max-column (- (+ x width) 1) - :max-row (- (+ y height) 2)) + (✎: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. (dotimes (i width) (setf (aref matrix y (+ x i)) #\-) @@ -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)