Orienting dialogue to the left or right of entity

This commit is contained in:
Jaidyn Ann 2023-06-20 20:04:13 -05:00
parent 6467d9bec3
commit 82254570b1
5 changed files with 136 additions and 54 deletions

View File

@ -51,6 +51,12 @@
(list :speaker speaker :text text :progress 0))) (list :speaker speaker :text text :progress 0)))
;;; ———————————————————————————————————
;;; Accessors
;;; ———————————————————————————————————
(defun dialogue-speaker (dialogue)
(intern (string-upcase (getf dialogue :speaker))))
@ -100,7 +106,7 @@ should be printed on the screen at any given moment."
(text (getf dialogue :text))) (text (getf dialogue :text)))
(when (and text (when (and text
(< progress (length text))) (< progress (length text)))
(incf (getf dialogue :progress))))) (incf (getf dialogue :progress) 1))))
(defun dialogue-state-update (map dialogue-list) (defun dialogue-state-update (map dialogue-list)
@ -125,14 +131,55 @@ should be printed on the screen at any given moment."
;;; ——————————————————————————————————— ;;; ———————————————————————————————————
;;; Dialogue drawing ;;; Dialogue drawing
;;; ——————————————————————————————————— ;;; ———————————————————————————————————
(defun dialogue-state-draw (matrix dialogue-list) (defun optimal-speech-layout-horizontally (text coords &key (right-p nil) (width 72) (height 20))
(let* ((text-margin (if right-p
(+ (getf coords :x) 3)
0))
(text-width (if right-p
(- width text-margin)
(- (getf coords :x) 3)))
(lines (ignore-errors (:split-string-by-length text text-width))))
(format *error-output* "Margin: ~A Width: ~A Right: ~A" text-margin text-width right-p)
(when (and (> text-width 0)
lines)
(let ((y (:at-least 0 (- (getf coords :y)
(floor (/ (length lines) 2))
1)))
(x (if (and (not right-p)
(eq (length lines) 1))
(- text-width (length text))
text-margin)))
(list (list :x x :y y)
(+ x text-width)
height)))))
(defun optimal-speech-layout (map dialogue &key (width 72) (height 20))
(let* ((speaker-id (dialogue-speaker dialogue))
(direction (🌍:getf-entity-data map speaker-id :direction))
(text (getf dialogue :text))
(coords (🌍:world-coords->screen-coords (🌍:getf-entity-data map speaker-id :coords))))
(optimal-speech-layout-horizontally text coords :right-p 't :width width :height height)))
(defun render-dialogue-block (matrix map dialogue)
(let* ((progress (getf dialogue :progress))
(text (getf dialogue :text))
(optimal-layout (when text (optimal-speech-layout map dialogue))))
(when (and text optimal-layout)
(📋:render-string-partially
matrix text (first optimal-layout)
:max-column (second optimal-layout)
:max-row (third optimal-layout)
:char-count progress))))
(defun dialogue-state-draw (matrix map dialogue-list)
"Draw the dialogue where appropriate. "Draw the dialogue where appropriate.
Helper function for DIALOGUE-STATE." Helper function for DIALOGUE-STATE."
(let ((text (getf (car dialogue-list) :text)) (when (getf (car dialogue-list) :text)
(progress (getf (car dialogue-list) :progress))) (:show-cursor)
(when text (render-dialogue-block matrix map (car dialogue-list))))
(:show-cursor)
(📋:render-string-partially matrix text 0 0 :char-count progress))))
@ -150,6 +197,6 @@ entities as the speakers. Dialogue should be in the format:
:speaker \"papa\" :speaker \"papa\"
...)) ...))
A state-function for use with STATE-LOOP." A state-function for use with STATE-LOOP."
(sleep .02) (sleep .05)
(dialogue-state-draw matrix dialogue) (dialogue-state-draw matrix map dialogue)
(dialogue-state-update map dialogue)) (dialogue-state-update map dialogue))

View File

@ -19,6 +19,7 @@
(ql:quickload '(alexandria assoc-utils cl-charms cl-tiled str)) (ql:quickload '(alexandria assoc-utils cl-charms cl-tiled str))
(load "util.lisp")
(load "input.lisp") (load "input.lisp")
(load "display.lisp") (load "display.lisp")
(load "ui.lisp") (load "ui.lisp")

View File

@ -22,6 +22,7 @@
(:use :cl (:use :cl
:flora-search-aurora.overworld.tiled :flora-search-aurora.overworld.util) :flora-search-aurora.overworld.tiled :flora-search-aurora.overworld.util)
(:export #:overworld-state #:overworld-state-draw (:export #:overworld-state #:overworld-state-draw
#:world-coords->screen-coords
#:getf-entity #:getf-entity-data #:getf-entity #:getf-entity-data
:player)) :player))

70
ui.lisp
View File

@ -73,7 +73,7 @@ A core part of #'menu-state."
'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 (+ x 1) (+ 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.
@ -86,8 +86,8 @@ left-to-right, unless negative — in which case, right-to-left."
(if (and selection (if (and selection
(not (eq selection 0))) (not (eq selection 0)))
(let* ((bar-width (let* ((bar-width
(at-most width (ceiling (* width (* (abs selection) (:at-most width (ceiling (* width (* (abs selection)
.01))))) .01)))))
(bar-start (if (> 0 selection) (- width bar-width) 0))) (bar-start (if (> 0 selection) (- width bar-width) 0)))
(dotimes (i bar-width) (dotimes (i bar-width)
(setf (aref matrix y (+ x bar-start i)) #\=) (setf (aref matrix y (+ x bar-start i)) #\=)
@ -112,7 +112,7 @@ The item list should be an alist of the following format:
(let* ((label (cdr (assoc 'label item))) (let* ((label (cdr (assoc 'label item)))
(selection (or (cdr (assoc 'selection item)) (selection (or (cdr (assoc 'selection item))
0)) 0))
(width (at-most max-item-width (width (:at-most max-item-width
(+ (length label) 2)))) (+ (length label) 2))))
(render-menu-item matrix label x y (render-menu-item matrix label x y
:width width :width width
@ -124,33 +124,41 @@ The item list should be an alist of the following format:
matrix) matrix)
(defun render-string (matrix text x y &key (max-column 72) (max-row 20)) (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. "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 x y :max-column max-column :max-row max-row (render-string-partially matrix text coords :max-column max-column :max-row max-row
:char-count (length text))) :char-count (length text)))
(defun render-string-partially (matrix text x y &key (char-count 0) (max-column 72) (max-row 20)) (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 "Partially render the given string to a matrix of characters. Will render only
a portion of the string, dictated by the CHAR-COUNT. a portion of the string, dictated by the CHAR-COUNT.
See the similar RENDER-STRING function." See the similar RENDER-STRING function."
(let* ((dimensions (array-dimensions matrix)) (let* ((x (getf coords :x))
(max-column (at-most (cadr dimensions) max-column)) (y (getf coords :y))
(max-write-row (at-most (at-most (car dimensions) max-row) (dimensions (array-dimensions matrix))
(floor (/ char-count max-column)))) (max-column (:at-most (cadr dimensions) max-column))
(max-column-at-max-write-row (- char-count (* max-write-row max-column))) (row-width (- max-column x))
(substrings (split-string-by-length text (- 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)) (row 0))
(loop while (and (<= (+ y row) max-row) (loop while (and (<= (+ y row) max-row)
substrings) substrings)
do (cond ((< row max-write-row) do (cond ((< row max-write-row)
(render-line matrix (pop substrings) (render-line matrix (pop substrings)
x (+ y row))) x (+ y row)))
;; At the last line, write only up til the :CHAR-COUNT
((eq row max-write-row) ((eq row max-write-row)
(render-line matrix (subseq (pop substrings) 0 max-column-at-max-write-row) (render-line
x (+ y row))) matrix
(subseq (pop substrings) 0 row-width-at-max-write-row)
x (+ y row)))
('t ('t
(pop substrings))) (pop substrings)))
(incf row))) (incf row)))
@ -251,42 +259,14 @@ That is, 0 for non-selected items and 100 for selected items."
;;; ——————————————————————————————————— ;;; ———————————————————————————————————
;;; Misc. utils ;;; Misc. utils
;;; ——————————————————————————————————— ;;; ———————————————————————————————————
(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))))
(defun at-most (maximum num)
"This function returns at most every hope and dream you've ever had, and at
minimum returns your more pitiful of moments."
(if (> num maximum)
maximum
num))
(defun at-least (minimum num)
"This function returns at least every hope and dream you've ever had, and at
maximum returns your more pitiful of moments."
(if (< num minimum)
minimum
num))
(defun gravitate-toward (goal num delta) (defun gravitate-toward (goal num delta)
"Either add to a number, or subtract from it; whichever brings it closer to zero. "Either add to a number, or subtract from it; whichever brings it closer to zero.
In addition, the resultant value shall not pass zero." In addition, the resultant value shall not pass zero."
(cond (cond
((< num goal) ((< num goal)
(at-most goal (+ num delta))) (:at-most goal (+ num delta)))
((> num goal) ((> num goal)
(at-least goal (- num delta))) (:at-least goal (- num delta)))
('t ('t
goal))) goal)))

53
util.lisp Normal file
View File

@ -0,0 +1,53 @@
;;;; Copyright © 2023, Jaidyn Ann <jadedctrl@posteo.at>
;;;;
;;;; This program is free software: you can redistribute it and/or
;;;; modify it under the terms of the GNU General Public License as
;;;; published by the Free Software Foundation, either version 3 of
;;;; the License, or (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;;; FLORA-SEARCH-AURORA.UI
;;;; Generic menu-making, displaying, and management.
;;;; Let's get to it, we're on a deadline!
(defpackage :flora-search-aurora.util
(:nicknames :fsa.ut :util :)
(:use :cl :assoc-utils)
(:export #:split-string-by-length #:at-least #:at-most))
(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))))
(defun at-least (minimum num)
"This function returns at least every hope and dream you've ever had, and at
maximum returns your more pitiful of moments."
(if (< num minimum)
minimum
num))
(defun at-most (maximum num)
"This function returns at most every hope and dream you've ever had, and at
minimum returns your more pitiful of moments."
(if (> num maximum)
maximum
num))