Movement between map-chunks by walking off-screen

This commit is contained in:
Jaidyn Ann 2023-06-13 18:10:15 -05:00
parent 7f77c4b887
commit f492aa6dba
2 changed files with 62 additions and 54 deletions

View File

@ -33,7 +33,7 @@
(defun overworld-state
(matrix &key (map-path nil) (map (load-map-chunks map-path))
(entities-alist
'((player . (:x 0 :y 0 :face "uwu" :direction right)))))
'((player :coords (:x 1 :y 1) :face "uwu" :direction right))))
"Render the given map to the matrix and take user-input for one frame.
A state-function for use with STATE-LOOP."
(sleep .02)
@ -41,11 +41,13 @@ A state-function for use with STATE-LOOP."
(overworld-state-update map entities-alist))
(defun overworld-state-draw (matrix map entities-alist)
(defun overworld-state-draw (matrix map entities)
"Draw the overworld map to the given matrix.
A core part of OVERWORLD-STATE."
(matrix-write-tiled-map-chunk matrix map 0 0)
(matrix-write-entities matrix entities-alist))
(let* ((player-data (cdr (assoc 'player entities)))
(chunk (getf (world-coords->screen-coords (getf player-data :coords)) :chunk)))
(matrix-write-tiled-map-chunk matrix map chunk)
(matrix-write-entities matrix entities)))
(defun overworld-state-update (map entities-alist)
@ -82,15 +84,15 @@ Returns parameters to be used in the next invocation of OVERWORLD-STATE."
(when (> x 0)
(setf (getf entity-plist :direction) 'right))
(move-entity-to entity entities-alist
:x (+ x (getf entity-plist :x))
:y (+ y (getf entity-plist :y)))))
:x (+ x (getf (getf entity-plist :coords) :x))
:y (+ y (getf (getf entity-plist :coords) :y)))))
(defun move-entity-to (entity entities-alist &key (x 0) (y 0))
"Move the given entity to the given coordinates."
(let ((entity-plist (cdr (assoc entity entities-alist))))
(setf (getf entity-plist :x) x)
(setf (getf entity-plist :y) y)))
(setf (getf (getf entity-plist :coords) :x) x)
(setf (getf (getf entity-plist :coords) :y) y)))
@ -101,28 +103,28 @@ Returns parameters to be used in the next invocation of OVERWORLD-STATE."
(let ((cells (mapcar #'cl-tiled:layer-cells
(cl-tiled:map-layers (cl-tiled:load-map map-file)))))
(collect-items-into-groups
(car cells)
(cdar cells) ;; Only take the first layer, for now!
(lambda (cell)
(apply #'coords->symbol (map-chunk-of-tiled-cell cell))))))
(getf (world-coords->screen-coords (tiled-cell-world-coords cell))
:chunk)))))
(defun matrix-write-tiled-map-chunk (matrix map-alist x y
(defun matrix-write-tiled-map-chunk (matrix map-alist chunk
&key (chunk-width 72) (chunk-height 20))
(mapcar (lambda (cell)
(matrix-write-tiled-cell matrix cell
:x-offset (* x chunk-width)
:y-offset (* y chunk-height)))
(cdr (assoc (coords->symbol x y) map-alist))))
(matrix-write-tiled-cell matrix cell))
(cdr (assoc chunk map-alist))))
(defun matrix-write-tiled-cell (matrix cell &key (x-offset 0) (y-offset 0))
(defun matrix-write-tiled-cell (matrix cell)
"Set a matrice's (2d array's) element corresponding to
a Tiled cell's character-value, using it's column and row."
(setf (aref matrix
(- (cl-tiled:cell-row cell) y-offset)
(- (cl-tiled:cell-column cell) x-offset))
(tiled-tile-character
(cl-tiled:cell-tile cell))))
(let ((coords (world-coords->screen-coords (tiled-cell-world-coords cell))))
(setf (aref matrix
(getf coords :y)
(getf coords :x))
(tiled-tile-character
(cl-tiled:cell-tile cell)))))
(defun tiled-tile-character (tile)
@ -135,16 +137,20 @@ with 15 characters-per-line."
32)))
(defun map-chunk-of-tiled-cell (cell &key (chunk-width 72) (chunk-height 20))
"Given a Tiled cell, return a corresponding map chunk it resides in."
(map-chunk-of-coords (cl-tiled:cell-column cell)
(cl-tiled:cell-row cell)
:chunk-width chunk-width :chunk-height chunk-height))
(defun tiled-cell-world-coords (cell)
(list :x (cl-tiled:cell-column cell) :y (cl-tiled:cell-row cell)))
(defun map-chunk-of-coords (x y &key (chunk-width 72) (chunk-height 20))
"Given a pair of coordinates, return the map chunk they reside within."
(list (floor (/ x chunk-width)) (floor (/ y chunk-height))))
(defun world-coords->screen-coords (world-coords &key (chunk-width 72) (chunk-height 20))
(let* ((chunk-x (floor (/ (getf world-coords :x)
chunk-width)))
(chunk-y (floor (/ (getf world-coords :y)
chunk-height)))
(x (- (getf world-coords :x) (* chunk-x chunk-width)))
(y (- (getf world-coords :y) (* chunk-y chunk-height))))
(list :x x
:y y
:chunk (coords->symbol chunk-x chunk-y))))
(defun coords->symbol (x y)
@ -162,34 +168,37 @@ with 15 characters-per-line."
(defun matrix-write-entities (matrix entities-alist)
"Draw all entities from an alist of entities to the matrix."
(mapcar (lambda (entity-assoc)
(matrix-write-entity matrix (cdr entity-assoc)))
;; (ignore-errors
(matrix-write-entity matrix (cdr entity-assoc)))
entities-alist))
(defun matrix-write-entity (matrix entity-plist)
"Render an entity-plist to the matrix."
(let ((x (getf entity-plist :x))
(y (getf entity-plist :y))
(face (getf entity-plist :face)))
(setf (aref matrix y x) #\|)
(setf (aref matrix y (+ (length face) x 1))
#\|)
(let* ((screen-coords (world-coords->screen-coords (getf entity-plist :coords)))
(x (getf screen-coords :x))
(y (getf screen-coords :y))
(face (getf entity-plist :face)))
(ignore-errors (setf (aref matrix y x) #\|))
(ignore-errors (setf (aref matrix y (+ (length face) x 1))
#\|))
(render-line matrix face (+ x 1) y)
(matrix-write-entity-legs matrix entity-plist)))
(defun matrix-write-entity-legs (matrix entity-plist)
"Draw an entity's legs — a surprisingly in-depth task!"
(let ((x (getf entity-plist :x))
(y (+ (getf entity-plist :y) 1))
(width (+ (length (getf entity-plist :face)) 2))
(direction (getf entity-plist :direction)))
(let* ((screen-coords (world-coords->screen-coords (getf entity-plist :coords)))
(x (getf screen-coords :x))
(y (+ (getf screen-coords :y) 1))
(width (+ (length (getf entity-plist :face)) 2))
(direction (getf entity-plist :direction)))
(cond ((eq direction 'right)
(setf (aref matrix y (+ x 1)) #\|)
(setf (aref matrix y (+ x 2)) #\|))
(ignore-errors (setf (aref matrix y (+ x 1)) #\|))
(ignore-errors (setf (aref matrix y (+ x 2)) #\|)))
((eq direction 'left)
(setf (aref matrix y (+ x width -2)) #\|)
(setf (aref matrix y (+ x width -3)) #\|)))))
(ignore-errors (setf (aref matrix y (+ x width -2)) #\|))
(ignore-errors (setf (aref matrix y (+ x width -3)) #\|))))))

19
ui.lisp
View File

@ -19,7 +19,7 @@
(defpackage :flora-search-aurora.ui
(:use :cl :flora-search-aurora.display :flora-search-aurora.input :assoc-utils)
(:export #:menu-state #:render-menu-strip :label :selection :selected))
(:export #:menu-state #:render-line :label :selection :selected))
(in-package :flora-search-aurora.ui)
@ -54,14 +54,14 @@ A core part of #'menu-state."
;;; ———————————————————————————————————
(defun render-line (matrix text x y)
"Apply a one-line string to the matrix at the given coordinates."
(if (and (stringp text)
(> (length text) 0))
(progn
(setf (aref matrix y x)
(char text 0))
(render-line matrix (subseq text 1)
(+ x 1) y))
matrix))
(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
@ -73,7 +73,6 @@ left-to-right, unless negative — in which case, right-to-left."
(render-string matrix text (+ x 1) (+ 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)) #\-)