Add `move` directive to dialogues — for moving! :D
This commit is contained in:
parent
c7c0ed6d65
commit
b617e92aba
|
@ -21,7 +21,7 @@
|
||||||
(:nicknames :fsa.dia :dialogue :💬)
|
(:nicknames :fsa.dia :dialogue :💬)
|
||||||
(:use :cl)
|
(:use :cl)
|
||||||
(:export #:dialogue-state
|
(:export #:dialogue-state
|
||||||
#:start-dialogue #:face #:say #:mumble))
|
#:start-dialogue #:face #:say #:mumble #:move))
|
||||||
|
|
||||||
(in-package :flora-search-aurora.dialogue)
|
(in-package :flora-search-aurora.dialogue)
|
||||||
|
|
||||||
|
@ -67,6 +67,11 @@ If not, have some tea on me: I’m paying. =w="
|
||||||
(list :speaker speaker :text text :progress 0)))
|
(list :speaker speaker :text text :progress 0)))
|
||||||
|
|
||||||
|
|
||||||
|
(defun move (speaker world-coords)
|
||||||
|
(list
|
||||||
|
(list :speaker speaker :coords world-coords)))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;;; ———————————————————————————————————
|
;;; ———————————————————————————————————
|
||||||
;;; Accessors
|
;;; Accessors
|
||||||
|
@ -100,8 +105,8 @@ If FACE is NIL… guess what that does. :^)"
|
||||||
|
|
||||||
|
|
||||||
(defun update-speaking-face (map dialogue)
|
(defun update-speaking-face (map dialogue)
|
||||||
"Given a line (plist) of dialogue, change speaker’s face to either their
|
"Given a line (plist) of DIALOGUE, change speaker’s face to either their
|
||||||
talking-face or the face given by the dialogue."
|
talking-face or the face given by the DIALOGUE."
|
||||||
(let* ((speaker (intern (string-upcase (getf dialogue :speaker))))
|
(let* ((speaker (intern (string-upcase (getf dialogue :speaker))))
|
||||||
(new-face (appropriate-face map speaker (getf dialogue :face))))
|
(new-face (appropriate-face map speaker (getf dialogue :face))))
|
||||||
;; Replace the face, when appropriate.
|
;; Replace the face, when appropriate.
|
||||||
|
@ -110,7 +115,7 @@ talking-face or the face given by the dialogue."
|
||||||
|
|
||||||
|
|
||||||
(defun progress-line-delivery (dialogue)
|
(defun progress-line-delivery (dialogue)
|
||||||
"Progress the delivery of a line (plist) of dialogue. That is, increment the
|
"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
|
“said character-count” :PROGRESS, which dictates the portion of the message that
|
||||||
should be printed on the screen at any given moment."
|
should be printed on the screen at any given moment."
|
||||||
(let ((progress (getf dialogue :progress))
|
(let ((progress (getf dialogue :progress))
|
||||||
|
@ -120,6 +125,32 @@ should be printed on the screen at any given moment."
|
||||||
(incf (getf dialogue :progress) 1))))
|
(incf (getf dialogue :progress) 1))))
|
||||||
|
|
||||||
|
|
||||||
|
(defun progress-movement (map dialogue)
|
||||||
|
"Move the entity by one tile in the targeted position — that is, the
|
||||||
|
coordinates listed in the DIALOGUE’s :COORDS property. … If applicable, ofc."
|
||||||
|
(let* ((speaker (dialogue-speaker dialogue))
|
||||||
|
(target-coords (getf dialogue :coords))
|
||||||
|
(speaker-coords (🌍:getf-entity-data map speaker :coords))
|
||||||
|
(finished-moving-p (if target-coords (…:plist= speaker-coords target-coords) 't)))
|
||||||
|
(when (not finished-moving-p)
|
||||||
|
(🌍:move-entity
|
||||||
|
map speaker
|
||||||
|
:x (cond ((< (getf target-coords :x) (getf speaker-coords :x)) -1)
|
||||||
|
((> (getf target-coords :x) (getf speaker-coords :x)) 1)
|
||||||
|
('t 0))
|
||||||
|
:y (cond ((< (getf target-coords :y) (getf speaker-coords :y)) -1)
|
||||||
|
((> (getf target-coords :y) (getf speaker-coords :y)) 1)
|
||||||
|
('t 0))))
|
||||||
|
finished-moving-p))
|
||||||
|
|
||||||
|
|
||||||
|
(defun finished-printing-p (dialogue)
|
||||||
|
"Whether or not a line of dialogue has been completely printed to the screen."
|
||||||
|
(or (not (getf dialogue :text))
|
||||||
|
(eq (length (getf dialogue :text))
|
||||||
|
(getf dialogue :progress))))
|
||||||
|
|
||||||
|
|
||||||
(defun dialogue-state-update (map dialogue-list)
|
(defun dialogue-state-update (map dialogue-list)
|
||||||
"The logic/input-processing helper function for DIALOGUE-STATE.
|
"The logic/input-processing helper function for DIALOGUE-STATE.
|
||||||
Progress through the lines of dialogue when the user hits ENTER, etc.
|
Progress through the lines of dialogue when the user hits ENTER, etc.
|
||||||
|
@ -127,22 +158,34 @@ Returns the state for use with STATE-LOOP, pay attention!"
|
||||||
(update-speaking-face map (car dialogue-list))
|
(update-speaking-face map (car dialogue-list))
|
||||||
(progress-line-delivery (car dialogue-list))
|
(progress-line-delivery (car dialogue-list))
|
||||||
;; Progress to the next line of dialogue as appropriate.
|
;; Progress to the next line of dialogue as appropriate.
|
||||||
(let* ((text (getf (car dialogue-list) :text))
|
(let* ((dialogue (car dialogue-list))
|
||||||
(finished-printing-p (eq (length text)
|
(text (getf dialogue :text))
|
||||||
(getf (car dialogue-list) :progress)))
|
(did-press-enter-p (pressed-enter-p))
|
||||||
(did-press-enter-p (pressed-enter-p)))
|
(did-finish-printing-p (finished-printing-p dialogue))
|
||||||
(cond ((or (not text)
|
(did-finish-moving-p (progress-movement map dialogue)))
|
||||||
(and did-press-enter-p finished-printing-p))
|
;; Only show the cursor when rendering text!
|
||||||
|
(if did-finish-moving-p
|
||||||
|
(✎:show-cursor)
|
||||||
|
(✎:hide-cursor))
|
||||||
|
(cond
|
||||||
|
;; When enter’s hit and most everything is done (rendering text, etc),
|
||||||
|
;; progress the dialogue.
|
||||||
|
((or (and did-press-enter-p did-finish-printing-p did-finish-moving-p)
|
||||||
|
(and (not text) did-finish-moving-p))
|
||||||
(if (cdr dialogue-list)
|
(if (cdr dialogue-list)
|
||||||
(list :dialogue (cdr dialogue-list) :map map)
|
(list :dialogue (cdr dialogue-list) :map map)
|
||||||
(progn
|
(progn
|
||||||
(✎:hide-cursor)
|
(✎:hide-cursor)
|
||||||
(values nil
|
(values nil
|
||||||
(list :map map)))))
|
(list :map map)))))
|
||||||
((and did-press-enter-p (not finished-printing-p))
|
;; Allow interupting text-printing to end it!
|
||||||
|
((and did-press-enter-p (not did-finish-printing-p))
|
||||||
(setf (getf (car dialogue-list) :progress) (length text))
|
(setf (getf (car dialogue-list) :progress) (length text))
|
||||||
(list :dialogue dialogue-list :map map))
|
(list :dialogue dialogue-list :map map))
|
||||||
((cdr dialogue-list)
|
;; If no input, keep steady!
|
||||||
|
((or (not did-finish-printing-p)
|
||||||
|
(not did-finish-moving-p)
|
||||||
|
(cdr dialogue-list))
|
||||||
(list :dialogue dialogue-list :map map)))))
|
(list :dialogue dialogue-list :map map)))))
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -45,7 +45,8 @@
|
||||||
(lambda (matrix &key (map map)
|
(lambda (matrix &key (map map)
|
||||||
(dialogue (💬:start-dialogue
|
(dialogue (💬:start-dialogue
|
||||||
(💬:say "literary-girl" "Blah blah, testing. A multi-lined one. For real! jjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjj akls djlaks jdlaksj dlakjsd")
|
(💬:say "literary-girl" "Blah blah, testing. A multi-lined one. For real! jjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjj akls djlaks jdlaksj dlakjsd")
|
||||||
(💬:say "player" "ktp ktp jes jes?"))))
|
(💬:say "player" "ktp ktp jes jes?")
|
||||||
|
(💬:move "player" '(:x 30 :y 10)))))
|
||||||
(🌍:overworld-state-draw matrix map)
|
(🌍:overworld-state-draw matrix map)
|
||||||
(💬:dialogue-state matrix :map map :dialogue dialogue)))
|
(💬:dialogue-state matrix :map map :dialogue dialogue)))
|
||||||
|
|
||||||
|
|
|
@ -24,33 +24,12 @@
|
||||||
(:export #:overworld-state #:overworld-state-draw
|
(:export #:overworld-state #:overworld-state-draw
|
||||||
#:world-coords->screen-coords
|
#:world-coords->screen-coords
|
||||||
#:getf-entity #:getf-entity-data
|
#:getf-entity #:getf-entity-data
|
||||||
|
#:move-entity-to #:move-entity
|
||||||
:left :right
|
:left :right
|
||||||
:player))
|
:player))
|
||||||
|
|
||||||
(in-package :flora-search-aurora.overworld)
|
(in-package :flora-search-aurora.overworld)
|
||||||
|
|
||||||
|
|
||||||
;;; ———————————————————————————————————
|
|
||||||
;;; Misc. utility
|
|
||||||
;;; ———————————————————————————————————
|
|
||||||
(defun every-other-element (list)
|
|
||||||
"Collect every-other-element of a list. E.g., (1 2 3 4) → (1 3)."
|
|
||||||
(when list
|
|
||||||
(cons (car list)
|
|
||||||
(every-other-element (cddr list)))))
|
|
||||||
|
|
||||||
|
|
||||||
(defun plist= (a b &key (test #'eql))
|
|
||||||
"Return whether or not two property lists are equal, by comparing values of each pair.
|
|
||||||
Uses the keys of plist a."
|
|
||||||
(let ((keys (every-other-element a)))
|
|
||||||
(loop for key in keys
|
|
||||||
do (when (not (apply test (list (getf a key)
|
|
||||||
(getf b key))))
|
|
||||||
(return nil))
|
|
||||||
finally (return 't))))
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;;; ———————————————————————————————————
|
;;; ———————————————————————————————————
|
||||||
;;; Accessors
|
;;; Accessors
|
||||||
|
@ -86,7 +65,7 @@ Uses the keys of plist a."
|
||||||
"Return a list of entities near the given entity — that is, within touching-distance."
|
"Return a list of entities near the given entity — that is, within touching-distance."
|
||||||
(remove-if
|
(remove-if
|
||||||
(lambda (test-entity)
|
(lambda (test-entity)
|
||||||
(plist= (cdr entity)
|
(…:plist= (cdr entity)
|
||||||
(cdr test-entity)))
|
(cdr test-entity)))
|
||||||
(entities-near-coords (getf (cdr entity) :coords)
|
(entities-near-coords (getf (cdr entity) :coords)
|
||||||
(+ (length (getf (cdr entity) :face)) 2)
|
(+ (length (getf (cdr entity) :face)) 2)
|
||||||
|
@ -98,7 +77,7 @@ Uses the keys of plist a."
|
||||||
(let ((chunk (world-coords-chunk coords)))
|
(let ((chunk (world-coords-chunk coords)))
|
||||||
(member 't (cdr (assoc chunk map-chunks))
|
(member 't (cdr (assoc chunk map-chunks))
|
||||||
:test (lambda (ignored cell)
|
:test (lambda (ignored cell)
|
||||||
(plist= (getf cell :coords) coords)))))
|
(…:plist= (getf cell :coords) coords)))))
|
||||||
|
|
||||||
|
|
||||||
(defun walkable-tile-p (map x y)
|
(defun walkable-tile-p (map x y)
|
||||||
|
@ -123,24 +102,26 @@ Returns parameters to be used in the next invocation of OVERWORLD-STATE."
|
||||||
(let* ((input (⌨:normalize-char-plist (⌨:read-char-plist))))
|
(let* ((input (⌨:normalize-char-plist (⌨:read-char-plist))))
|
||||||
(cond
|
(cond
|
||||||
;; Interacting with nearby characters/entities
|
;; Interacting with nearby characters/entities
|
||||||
((plist= input '(:modifier nil :char #\return))
|
((…:plist= input '(:modifier nil :char #\return))
|
||||||
(let* ((player (getf-entity map 'player))
|
(let* ((player (getf-entity map 'player))
|
||||||
(interactee (car (entities-near-entity player (gethash :entities map))))
|
(interactee (car (entities-near-entity player (gethash :entities map))))
|
||||||
(interaction (getf (cdr interactee) :interact)))
|
(interaction (getf (cdr interactee) :interact)))
|
||||||
(if interaction
|
(if interaction
|
||||||
(apply (intern (string-upcase interaction)) (list map))
|
(apply (intern (string-upcase interaction)) (list map))
|
||||||
(list :map map))))
|
(list :map map))))
|
||||||
|
;; The pause-menu…
|
||||||
|
;; ((plist = input '(:modifier nil :char #\Esc)))
|
||||||
;; Simple up-down-left-right movements
|
;; Simple up-down-left-right movements
|
||||||
((plist= input '(:modifier nil :char #\→))
|
((…:plist= input '(:modifier nil :char #\→))
|
||||||
(move-entity map 'player :x 1)
|
(move-entity map 'player :x 1)
|
||||||
(list :map map))
|
(list :map map))
|
||||||
((plist= input '(:modifier nil :char #\←))
|
((…:plist= input '(:modifier nil :char #\←))
|
||||||
(move-entity map 'player :x -1)
|
(move-entity map 'player :x -1)
|
||||||
(list :map map))
|
(list :map map))
|
||||||
((plist= input '(:modifier nil :char #\↑))
|
((…:plist= input '(:modifier nil :char #\↑))
|
||||||
(move-entity map 'player :y -1)
|
(move-entity map 'player :y -1)
|
||||||
(list :map map))
|
(list :map map))
|
||||||
((plist= input '(:modifier nil :char #\↓))
|
((…:plist= input '(:modifier nil :char #\↓))
|
||||||
(move-entity map 'player :y 1)
|
(move-entity map 'player :y 1)
|
||||||
(list :map map))
|
(list :map map))
|
||||||
('t
|
('t
|
||||||
|
|
20
util.lisp
20
util.lisp
|
@ -20,7 +20,7 @@
|
||||||
(defpackage :flora-search-aurora.util
|
(defpackage :flora-search-aurora.util
|
||||||
(:nicknames :fsa.ut :util :…)
|
(:nicknames :fsa.ut :util :…)
|
||||||
(:use :cl :assoc-utils)
|
(:use :cl :assoc-utils)
|
||||||
(:export #:split-string-by-length #:at-least #:at-most))
|
(:export #:split-string-by-length #:plist= #:at-least #:at-most))
|
||||||
|
|
||||||
(in-package :flora-search-aurora.util)
|
(in-package :flora-search-aurora.util)
|
||||||
|
|
||||||
|
@ -37,6 +37,24 @@ equal or lower to the given length."
|
||||||
(append substrings `(,string))))
|
(append substrings `(,string))))
|
||||||
|
|
||||||
|
|
||||||
|
(defun every-other-element (list)
|
||||||
|
"Collect every-other-element of a list. E.g., (1 2 3 4) → (1 3)."
|
||||||
|
(when list
|
||||||
|
(cons (car list)
|
||||||
|
(every-other-element (cddr list)))))
|
||||||
|
|
||||||
|
|
||||||
|
(defun plist= (a b &key (test #'eql))
|
||||||
|
"Return whether or not two property lists are equal, by comparing values of each pair.
|
||||||
|
Uses the keys of plist a."
|
||||||
|
(let ((keys (every-other-element a)))
|
||||||
|
(loop for key in keys
|
||||||
|
do (when (not (apply test (list (getf a key)
|
||||||
|
(getf b key))))
|
||||||
|
(return nil))
|
||||||
|
finally (return 't))))
|
||||||
|
|
||||||
|
|
||||||
(defun at-least (minimum num)
|
(defun at-least (minimum num)
|
||||||
"This function returns at least every hope and dream you've ever had, and at
|
"This function returns at least every hope and dream you've ever had, and at
|
||||||
maximum returns your more pitiful of moments."
|
maximum returns your more pitiful of moments."
|
||||||
|
|
Ŝarĝante…
Reference in New Issue