2023-06-19 08:47:45 -05:00
|
|
|
|
;;;; 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.OVERWORLD
|
|
|
|
|
;;;; All game-functions and data relating to the “overworld” (that is,
|
|
|
|
|
;;;; the primary gameplay, the RPG-ish-ish bits).
|
|
|
|
|
|
|
|
|
|
(defpackage :flora-search-aurora.dialogue
|
2023-06-19 14:43:46 -05:00
|
|
|
|
(:nicknames :fsa.dia :dialogue :💬)
|
2023-06-19 14:56:13 -05:00
|
|
|
|
(:use :cl)
|
2023-06-19 14:43:46 -05:00
|
|
|
|
(:export #:dialogue-state
|
2023-06-19 14:56:13 -05:00
|
|
|
|
#:start-dialogue #:face #:say #:mumble))
|
2023-06-19 08:47:45 -05:00
|
|
|
|
|
|
|
|
|
(in-package :flora-search-aurora.dialogue)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;; ———————————————————————————————————
|
2023-06-21 20:31:29 -05:00
|
|
|
|
;;; Misc. utilities
|
|
|
|
|
;;; ———————————————————————————————————
|
|
|
|
|
(defun pressed-enter-p ()
|
|
|
|
|
"Whether or not the enter/return key has been pressed recently.
|
|
|
|
|
Man, today’s a good day. Well, it wasn’t great, too be honest. Kind of bad,
|
|
|
|
|
I slightly humiliated myself a tiny bit. But wow, I’m having such nice tea!
|
|
|
|
|
Programming with nice tea! What a nice day this is. If you happen to be
|
|
|
|
|
reading this, I hope your day is going well too!
|
|
|
|
|
If not, have some tea on me: I’m paying. =w="
|
|
|
|
|
(and (listen)
|
|
|
|
|
(eq (getf (⌨:normalize-char-plist (⌨:read-char-plist)) :char)
|
|
|
|
|
#\return)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;; ———————————————————————————————————
|
|
|
|
|
;;; Dialogue-generation helpers
|
2023-06-19 08:47:45 -05:00
|
|
|
|
;;; ———————————————————————————————————
|
2023-06-19 14:43:46 -05:00
|
|
|
|
(defun start-dialogue (&rest dialogue-tree)
|
2023-06-19 08:47:45 -05:00
|
|
|
|
(reduce (lambda (a b) (append a b))
|
|
|
|
|
dialogue-tree))
|
|
|
|
|
|
|
|
|
|
|
2023-06-19 14:43:46 -05:00
|
|
|
|
(defun face (speaker face)
|
|
|
|
|
(list
|
|
|
|
|
(list :speaker speaker :face face)))
|
|
|
|
|
|
|
|
|
|
|
2023-06-19 08:47:45 -05:00
|
|
|
|
(defun say (speaker text)
|
|
|
|
|
(list
|
2023-06-19 14:43:46 -05:00
|
|
|
|
(list :speaker speaker :text text :face 'talking-face :progress 0)
|
2023-06-19 08:47:45 -05:00
|
|
|
|
(car (face speaker 'normal-face))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun mumble (speaker text)
|
|
|
|
|
(list
|
2023-06-19 14:43:46 -05:00
|
|
|
|
(list :speaker speaker :text text :progress 0)))
|
2023-06-19 08:47:45 -05:00
|
|
|
|
|
|
|
|
|
|
2023-06-20 20:04:13 -05:00
|
|
|
|
|
|
|
|
|
;;; ———————————————————————————————————
|
|
|
|
|
;;; Accessors
|
|
|
|
|
;;; ———————————————————————————————————
|
|
|
|
|
(defun dialogue-speaker (dialogue)
|
2023-06-21 20:31:29 -05:00
|
|
|
|
"Get the DIALOGUE-speaker’s corresponding identifying symbol.
|
|
|
|
|
Because they’re stored in strings. So we gotta, like, unstringify. Ya dig?"
|
2023-06-20 20:04:13 -05:00
|
|
|
|
(intern (string-upcase (getf dialogue :speaker))))
|
2023-06-19 08:47:45 -05:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;; ———————————————————————————————————
|
|
|
|
|
;;; Dialogue logic
|
|
|
|
|
;;; ———————————————————————————————————
|
|
|
|
|
(defun appropriate-face (map speaker face)
|
2023-06-19 14:43:46 -05:00
|
|
|
|
"Return the face appropriate for the speaker.
|
|
|
|
|
If FACE is a string, used that.
|
|
|
|
|
If FACE is 'TALKING-FACE, then use their talking-face (if they have one).
|
|
|
|
|
If FACE is 'NORMAL-FACE, then use their normal-face (if they’ve got one).
|
|
|
|
|
If FACE is NIL… guess what that does. :^)"
|
2023-06-19 14:56:13 -05:00
|
|
|
|
(let ((talking-face (🌍:getf-entity-data map speaker :talking-face))
|
|
|
|
|
(normal-face (🌍:getf-entity-data map speaker :normal-face)))
|
2023-06-19 08:47:45 -05:00
|
|
|
|
(cond ((and (eq face 'talking-face)
|
|
|
|
|
talking-face)
|
|
|
|
|
talking-face)
|
|
|
|
|
((and (eq face 'normal-face)
|
|
|
|
|
normal-face)
|
|
|
|
|
normal-face)
|
|
|
|
|
((stringp face)
|
|
|
|
|
face))))
|
|
|
|
|
|
|
|
|
|
|
2023-06-19 14:43:46 -05:00
|
|
|
|
(defun update-speaking-face (map dialogue)
|
|
|
|
|
"Given a line (plist) of dialogue, change speaker’s face to either their
|
|
|
|
|
talking-face or the face given by the dialogue."
|
|
|
|
|
(let* ((speaker (intern (string-upcase (getf dialogue :speaker))))
|
|
|
|
|
(new-face (appropriate-face map speaker (getf dialogue :face))))
|
2023-06-19 08:47:45 -05:00
|
|
|
|
;; Replace the face, when appropriate.
|
|
|
|
|
(when new-face
|
2023-06-19 14:56:13 -05:00
|
|
|
|
(setf (🌍:getf-entity-data map speaker :face) new-face))))
|
2023-06-19 14:43:46 -05:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun progress-line-delivery (dialogue)
|
|
|
|
|
"Progress the delivery of a line (plist) of dialogue. That is, increment the
|
|
|
|
|
“said character-count” :PROGRESS, which dictates the portion of the message that
|
|
|
|
|
should be printed on the screen at any given moment."
|
|
|
|
|
(let ((progress (getf dialogue :progress))
|
|
|
|
|
(text (getf dialogue :text)))
|
|
|
|
|
(when (and text
|
|
|
|
|
(< progress (length text)))
|
2023-06-20 20:04:13 -05:00
|
|
|
|
(incf (getf dialogue :progress) 1))))
|
2023-06-19 14:43:46 -05:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun dialogue-state-update (map dialogue-list)
|
2023-06-21 20:31:29 -05:00
|
|
|
|
"The logic/input-processing helper function for DIALOGUE-STATE.
|
|
|
|
|
Progress through the lines of dialogue when the user hits ENTER, etc.
|
|
|
|
|
Returns the state for use with STATE-LOOP, pay attention!"
|
2023-06-19 14:43:46 -05:00
|
|
|
|
(update-speaking-face map (car dialogue-list))
|
|
|
|
|
(progress-line-delivery (car dialogue-list))
|
|
|
|
|
;; Progress to the next line of dialogue as appropriate.
|
2023-06-21 20:31:29 -05:00
|
|
|
|
(let* ((text (getf (car dialogue-list) :text))
|
|
|
|
|
(finished-printing-p (eq (length text)
|
|
|
|
|
(getf (car dialogue-list) :progress)))
|
|
|
|
|
(did-press-enter-p (pressed-enter-p)))
|
|
|
|
|
(cond ((or (not text)
|
|
|
|
|
(and did-press-enter-p finished-printing-p))
|
2023-06-19 08:47:45 -05:00
|
|
|
|
(if (cdr dialogue-list)
|
2023-06-21 20:31:29 -05:00
|
|
|
|
(list :dialogue (cdr dialogue-list) :map map)
|
|
|
|
|
(progn
|
|
|
|
|
(✎:hide-cursor)
|
|
|
|
|
(values nil
|
|
|
|
|
(list :map map)))))
|
|
|
|
|
((and did-press-enter-p (not finished-printing-p))
|
|
|
|
|
(setf (getf (car dialogue-list) :progress) (length text))
|
|
|
|
|
(list :dialogue dialogue-list :map map))
|
2023-06-19 08:47:45 -05:00
|
|
|
|
((cdr dialogue-list)
|
2023-06-19 14:43:46 -05:00
|
|
|
|
(list :dialogue dialogue-list :map map)))))
|
2023-06-19 08:47:45 -05:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;; ———————————————————————————————————
|
|
|
|
|
;;; Dialogue drawing
|
|
|
|
|
;;; ———————————————————————————————————
|
2023-06-21 20:31:29 -05:00
|
|
|
|
(defun optimal-text-placement-horizontally (text coords &key (rightp nil) (width 72) (height 20))
|
|
|
|
|
"Given a horizontal direction (RIGHTP defined or nil) and a focal point COORDS,
|
|
|
|
|
return the parameters of a text-box that can optimally fit the given TEXT in the
|
|
|
|
|
direction specified relative to the focal point. If a legible position can’t be
|
|
|
|
|
found, just give up! Return nil.
|
|
|
|
|
Otherwise, return a list list with the coordinates, max column, and max row — for
|
|
|
|
|
use with RENDER-STRING."
|
2023-06-20 20:43:27 -05:00
|
|
|
|
(let* ((text-x-margin (if rightp
|
|
|
|
|
(+ (getf coords :x) 3)
|
|
|
|
|
0))
|
2023-06-20 22:00:36 -05:00
|
|
|
|
(text-width (…:at-most (floor (* width 3/5)) ;; Not _too_ wide!
|
|
|
|
|
(if rightp
|
|
|
|
|
(- width text-x-margin)
|
|
|
|
|
(- (getf coords :x) 3))))
|
2023-06-20 20:43:27 -05:00
|
|
|
|
(lines (ignore-errors (…:split-string-by-length text text-width)))
|
|
|
|
|
(text-height (length lines)))
|
2023-06-20 22:00:36 -05:00
|
|
|
|
;; When this layout is valid…
|
|
|
|
|
(when (and lines
|
|
|
|
|
(>= height text-height) ;; If the text’ll fit on screen
|
|
|
|
|
(> text-width 10)) ;; If the text is wide enough to be legible
|
2023-06-20 20:04:13 -05:00
|
|
|
|
(let ((y (…:at-least 0 (- (getf coords :y)
|
2023-06-20 22:00:36 -05:00
|
|
|
|
(if (eq (length lines) 1) ;; Align toward the speaker’s face
|
|
|
|
|
1 0)
|
|
|
|
|
(floor (/ (length lines) 2)))))
|
2023-06-20 20:43:27 -05:00
|
|
|
|
(x (if (and (not rightp)
|
2023-06-20 20:04:13 -05:00
|
|
|
|
(eq (length lines) 1))
|
|
|
|
|
(- text-width (length text))
|
2023-06-20 20:43:27 -05:00
|
|
|
|
text-x-margin)))
|
2023-06-20 22:00:36 -05:00
|
|
|
|
(list (list :x x :y y) ;; Coords
|
|
|
|
|
(+ x text-width) ;; Max column
|
|
|
|
|
height))))) ;; Max row
|
2023-06-20 20:43:27 -05:00
|
|
|
|
|
|
|
|
|
|
2023-06-21 20:31:29 -05:00
|
|
|
|
(defun optimal-text-placement-vertically (text coords &key (downp nil) (width 72) (height 20))
|
|
|
|
|
"Given a vertical direction (DOWNP defined or nil) and a focal point COORDS,)
|
|
|
|
|
return the parameters of a text-box that can optimally fit the given TEXT in the
|
|
|
|
|
direction specified relative to the focal point. Return nil if no such placement
|
|
|
|
|
is found, otherwise return a list of the coordinates, max-column, and max-row
|
|
|
|
|
(for use with RENDER-STRING)."
|
2023-06-20 20:43:27 -05:00
|
|
|
|
(let* ((text-y-margin (if downp
|
|
|
|
|
(+ (getf coords :y) 1)
|
|
|
|
|
(- (getf coords :y) 2)))
|
|
|
|
|
(text-height (if downp
|
|
|
|
|
(- height text-y-margin)
|
|
|
|
|
(- text-y-margin 1)))
|
|
|
|
|
(text-width (floor (* width 3/5))) ;; Too wide’s illegible! So ⅗-screen.
|
|
|
|
|
(lines (ignore-errors (…:split-string-by-length text text-width))))
|
2023-06-20 22:00:36 -05:00
|
|
|
|
;; When the text can be printed with this layout…
|
2023-06-20 20:43:27 -05:00
|
|
|
|
(when (and lines (>= text-height (length lines)))
|
|
|
|
|
(let ((y (…:at-least
|
|
|
|
|
0
|
|
|
|
|
(if downp
|
|
|
|
|
text-y-margin
|
|
|
|
|
(- text-y-margin (length lines)))))
|
|
|
|
|
(x (…:at-least
|
|
|
|
|
0
|
|
|
|
|
(- (getf coords :x)
|
|
|
|
|
(if (eq (length lines) 1)
|
|
|
|
|
(floor (/ (length (car lines)) 2))
|
|
|
|
|
(floor (/ text-width 2)))))))
|
|
|
|
|
(list (list :x x :y y) ;; Coords
|
|
|
|
|
(+ x text-width) ;; Max column
|
|
|
|
|
(+ y text-height)))))) ;; Max row
|
2023-06-20 20:04:13 -05:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun optimal-speech-layout (map dialogue &key (width 72) (height 20))
|
2023-06-21 20:31:29 -05:00
|
|
|
|
"Given a line of DIALOGUE and MAP data, return the ideal “text-box” for the
|
|
|
|
|
text. This tries to place the text on the screen without covering up anything
|
|
|
|
|
important, if possible.
|
|
|
|
|
The data returned is a list of the box’es top-left coordinate, max-column,
|
|
|
|
|
and max-row; for use with RENDER-STRING. Like so:
|
|
|
|
|
((:x X :y Y) MAX-COLUMN MAX-ROW)"
|
2023-06-20 20:04:13 -05:00
|
|
|
|
(let* ((speaker-id (dialogue-speaker dialogue))
|
|
|
|
|
(direction (🌍:getf-entity-data map speaker-id :direction))
|
2023-06-20 22:00:36 -05:00
|
|
|
|
(playerp (eq speaker-id 'player))
|
|
|
|
|
(leftp (not (eq direction '🌍:right)))
|
2023-06-20 20:04:13 -05:00
|
|
|
|
(text (getf dialogue :text))
|
|
|
|
|
(coords (🌍:world-coords->screen-coords (🌍:getf-entity-data map speaker-id :coords))))
|
2023-06-21 20:31:29 -05:00
|
|
|
|
;; Ideally, place text-box behind the speaker; otherwise, place it above (NPC) or below (player).
|
|
|
|
|
(or (optimal-text-placement-horizontally text coords :width width :height height
|
2023-06-20 22:00:36 -05:00
|
|
|
|
:rightp leftp)
|
2023-06-21 20:31:29 -05:00
|
|
|
|
(optimal-text-placement-vertically text coords :width width :height height
|
2023-06-20 22:00:36 -05:00
|
|
|
|
:downp playerp)
|
2023-06-21 20:31:29 -05:00
|
|
|
|
;; … Worst-case scenario, just do whatever’ll fit :w:”
|
|
|
|
|
(optimal-text-placement-vertically text coords :width width :height height
|
|
|
|
|
:downp (not playerp))
|
|
|
|
|
(optimal-text-palcement-horizontally text coords :width width :height height
|
|
|
|
|
:rightp (not leftp)))))
|
2023-06-20 20:04:13 -05:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun render-dialogue-block (matrix map dialogue)
|
2023-06-21 20:31:29 -05:00
|
|
|
|
"Render a bit of DIALOGUE to the MATRIX, in an intelligent fashion; that is,
|
|
|
|
|
make it pretty, dang it! >O<
|
|
|
|
|
☆:.。.o(≧▽≦)o.。.:☆"
|
2023-06-20 20:04:13 -05:00
|
|
|
|
(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)
|
2023-06-19 08:47:45 -05:00
|
|
|
|
"Draw the dialogue where appropriate.
|
|
|
|
|
Helper function for DIALOGUE-STATE."
|
2023-06-20 20:04:13 -05:00
|
|
|
|
(when (getf (car dialogue-list) :text)
|
|
|
|
|
(✎:show-cursor)
|
|
|
|
|
(render-dialogue-block matrix map (car dialogue-list))))
|
2023-06-19 08:47:45 -05:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;; ———————————————————————————————————
|
|
|
|
|
;;; Dialogue loop
|
|
|
|
|
;;; ———————————————————————————————————
|
|
|
|
|
(defun dialogue-state (matrix &key dialogue map)
|
2023-06-21 20:31:29 -05:00
|
|
|
|
"Render a bit of DIALOGUE to the screen, using :FLORA-SEARCH-AURORA.OVERWORLD
|
2023-06-19 08:47:45 -05:00
|
|
|
|
entities as the speakers. Dialogue should be in the format:
|
|
|
|
|
((:text \"Hello, papa!\"
|
|
|
|
|
:speaker \"son\" ;; The entity’s ID (if applicable)
|
|
|
|
|
:face \"owo\") ;; If you want their face to change
|
|
|
|
|
(:face \"=w=\" :speaker 'son) ;; change their face back when done talking
|
2023-06-21 20:31:29 -05:00
|
|
|
|
(:text \"My dearest son, it’s been so long~!\"
|
2023-06-19 08:47:45 -05:00
|
|
|
|
:speaker \"papa\"
|
|
|
|
|
...))
|
|
|
|
|
A state-function for use with STATE-LOOP."
|
2023-06-20 20:04:13 -05:00
|
|
|
|
(sleep .05)
|
|
|
|
|
(dialogue-state-draw matrix map dialogue)
|
2023-06-19 14:43:46 -05:00
|
|
|
|
(dialogue-state-update map dialogue))
|
2023-06-20 22:00:36 -05:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; Split a banana in two, bisection-fruit,
|
|
|
|
|
;; Yummy-yummy, toot-toot~ 🎵
|