Support for events triggered by moving to point
That is, a new “Trigger” Tiled object-type has been made, which is just a rectangle with an associated function. If the rectangle is stepped upon (uwu step on me owo), the function is triggered. Y’know, standard RPG stuffs.
This commit is contained in:
parent
1c2a371b38
commit
b61739aa24
|
|
@ -187,6 +187,10 @@
|
|||
:face "=w=~"))))
|
||||
|
||||
|
||||
(defun bruh-trigger (&optional map)
|
||||
(print "YAAAAAAA"))
|
||||
|
||||
|
||||
|
||||
;;; ———————————————————————————————————
|
||||
;;; Destitute Gambler arc
|
||||
|
|
|
|||
|
|
@ -30,6 +30,19 @@
|
|||
|
||||
(in-package :flora-search-aurora.overworld)
|
||||
|
||||
|
||||
;;; ———————————————————————————————————
|
||||
;;; Misc. Utils
|
||||
;;; ———————————————————————————————————
|
||||
(defun within-rectangle (point top-left-corner bottom-right-corner)
|
||||
"With three coordinate plists, determine whether or not POINT resides within a
|
||||
rectangle as defined by its TOP-LEFT-CORNER & BOTTOM-RIGHT-CORNER."
|
||||
(and (<= (getf point :x) (getf bottom-right-corner :x))
|
||||
(>= (getf point :x) (getf top-left-corner :x))
|
||||
(<= (getf point :y) (getf bottom-right-corner :y))
|
||||
(>= (getf point :y) (getf top-left-corner :y))))
|
||||
|
||||
|
||||
|
||||
;;; ———————————————————————————————————
|
||||
;;; Accessors
|
||||
|
|
@ -72,6 +85,7 @@
|
|||
entities
|
||||
:y-radius 4)))
|
||||
|
||||
|
||||
(defun cell-at-world-coords-p (map-chunks coords)
|
||||
"Return whether or not there is a cell at the given coordinates."
|
||||
(let ((chunk (world-coords-chunk coords)))
|
||||
|
|
@ -141,6 +155,14 @@ Returns parameters to be used in the next invocation of OVERWORLD-STATE."
|
|||
:y (+ y (getf coords :y)))))
|
||||
|
||||
|
||||
(defun trigger-at-coords (map world-coords)
|
||||
(let ((chunk (world-coords-chunk world-coords)))
|
||||
(loop for trigger in (cdr (assoc chunk (gethash :triggers map)))
|
||||
do (when (within-rectangle world-coords
|
||||
(getf trigger :coords) (getf trigger :bottom-coords))
|
||||
(return trigger)))))
|
||||
|
||||
|
||||
(defun move-entity-to (map entity &key (x 0) (y 0))
|
||||
"Move the given entity to the given coordinates."
|
||||
(let ((old-chunk (world-coords-chunk (getf-entity-data map entity :coords)))
|
||||
|
|
@ -157,7 +179,13 @@ Returns parameters to be used in the next invocation of OVERWORLD-STATE."
|
|||
(cdr (getf-entity map entity)))
|
||||
;; Delete it from the old list…
|
||||
(alexandria:deletef (assoc-utils:aget (gethash :entities map) old-chunk) entity
|
||||
:test (lambda (id alist) (eq id (car alist)))))))
|
||||
:test (lambda (id alist) (eq id (car alist)))))
|
||||
;; If moving the player-character, check for triggers! (Traps)
|
||||
(when (eq entity 'player)
|
||||
(let ((trigger (trigger-at-coords map (list :x x :y y))))
|
||||
(if (and trigger (getf trigger :function))
|
||||
(apply (intern (string-upcase (getf trigger :function)))
|
||||
(list map)))))))
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -30,67 +30,94 @@
|
|||
;;; Misc. utility
|
||||
;;; ———————————————————————————————————
|
||||
(defun collect-items-into-groups (list key-function &key (groups '()))
|
||||
"Given a LIST of items and a function categorizing an individual item
|
||||
"Given a LIST of items and a KEY-FUNCTION categorizing an individual item
|
||||
(returning a “category” symbol for any given item), return an sorted
|
||||
associative list."
|
||||
associative list built upon GROUPS.
|
||||
If NIL is returned from KEY-FUNCTION, the given item is thrown out."
|
||||
(loop for item in list
|
||||
do (let ((key (apply key-function (list item))))
|
||||
(when key
|
||||
(setf (assoc-utils:aget groups key)
|
||||
(append (assoc-utils:aget groups key)
|
||||
(list item)))))
|
||||
(list item))))))
|
||||
groups)
|
||||
|
||||
|
||||
(defun tiled-coords->world-coords (x y tiled-map)
|
||||
"Given X & Y coordinates with a parsed Tiled map, return the appropriate
|
||||
character-scale world coordinates in plist form."
|
||||
(list :x (floor (/ x (cl-tiled:map-tile-width tiled-map)))
|
||||
:y (floor (/ y (cl-tiled:map-tile-height tiled-map)))))
|
||||
|
||||
|
||||
|
||||
;;; ———————————————————————————————————
|
||||
;;; Tile-layer parsing (graphics)
|
||||
;;; Object-layer (Persons/Triggers)
|
||||
;;; ———————————————————————————————————
|
||||
(defun tiled-cell->cell (tiled-cell)
|
||||
"Convert a Tiled cell into a cell plist."
|
||||
(list :coords (list :x (cl-tiled:cell-column tiled-cell)
|
||||
:y (cl-tiled:cell-row tiled-cell))
|
||||
:char (tile-character (cl-tiled:cell-tile tiled-cell))))
|
||||
|
||||
|
||||
(defun tile-layer-chunks (layer &optional (chunks '()))
|
||||
"Given a Tiled tile-layer (that is, graphics of the map), parse it into an
|
||||
alist of Tiled cell “chunks”."
|
||||
(let ((cells (mapcar #'tiled-cell->cell (cl-tiled:layer-cells layer))))
|
||||
(collect-items-into-groups
|
||||
cells
|
||||
(lambda (cell)
|
||||
(world-coords-chunk (getf cell :coords)))
|
||||
:groups chunks)))
|
||||
(defun tiled-rectangle-p (tiled-obj)
|
||||
"Whether or not a Tiled object is a valid rectangle."
|
||||
(and (> (cl-tiled:rect-width tiled-obj) 0)
|
||||
(> (cl-tiled:rect-height tiled-obj) 0)))
|
||||
|
||||
|
||||
(defun tiled-object->entity (tiled-obj tiled-map)
|
||||
"Convert a Tiled object into an entity plist."
|
||||
(let ((properties (cl-tiled:properties tiled-obj)))
|
||||
(when (not (tiled-rectangle-p tiled-obj))
|
||||
(list (intern (string-upcase (gethash "id" properties)))
|
||||
:coords (list :x (floor (/ (cl-tiled:object-x tiled-obj)
|
||||
(cl-tiled:map-tile-width tiled-map)))
|
||||
:y (floor (/ (cl-tiled:object-y tiled-obj)
|
||||
(cl-tiled:map-tile-height tiled-map))))
|
||||
:coords (tiled-coords->world-coords (cl-tiled:object-x tiled-obj)
|
||||
(cl-tiled:object-y tiled-obj)
|
||||
tiled-map)
|
||||
:face (gethash "normal_face" properties)
|
||||
:normal-face (gethash "normal_face" properties)
|
||||
:talking-face (gethash "talking_face" properties)
|
||||
:interact (gethash "interact" properties)
|
||||
:direction (if (gethash "facing_right" properties)
|
||||
'right
|
||||
'left))))
|
||||
'left)))))
|
||||
|
||||
|
||||
|
||||
(defun tiled-object->trigger (tiled-obj tiled-map)
|
||||
"Convert a Tiled object into a “trigger” plist. That is, a rectangle with
|
||||
a :FUNCTION to be triggered when it’s stepped upon."
|
||||
(when (tiled-rectangle-p tiled-obj)
|
||||
(let ((obj-x (cl-tiled:object-x tiled-obj))
|
||||
(obj-y (cl-tiled:object-y tiled-obj))
|
||||
(obj-width (cl-tiled:rect-width tiled-obj))
|
||||
(obj-height (cl-tiled:rect-height tiled-obj)))
|
||||
(list
|
||||
:coords (tiled-coords->world-coords obj-x obj-y tiled-map)
|
||||
:width obj-width
|
||||
:height obj-height
|
||||
:bottom-coords (tiled-coords->world-coords (+ obj-x obj-width) (+ obj-y obj-height) tiled-map)
|
||||
:function (gethash "function" (cl-tiled:properties tiled-obj))))))
|
||||
|
||||
|
||||
(defun object-layer-entities (layer &optional (entity-chunks '()))
|
||||
"Convert all objects in an object layer into entity plists."
|
||||
"Convert all point objects in an object layer into entity plists."
|
||||
(let ((entities (mapcar (lambda (object) (tiled-object->entity object (cl-tiled:layer-map layer)))
|
||||
(layer-objects layer))))
|
||||
(collect-items-into-groups
|
||||
entities
|
||||
(lambda (entity)
|
||||
(world-coords-chunk (getf (cdr entity) :coords)))
|
||||
(when entity
|
||||
(world-coords-chunk (getf (cdr entity) :coords))))
|
||||
:groups entity-chunks)))
|
||||
|
||||
|
||||
(defun object-layer-triggers (layer &optional (trigger-chunks '()))
|
||||
"Convert all rectangle objects in an object layer into trigger plists."
|
||||
(let ((triggers (mapcar (lambda (object) (tiled-object->trigger object (cl-tiled:layer-map layer)))
|
||||
(layer-objects layer))))
|
||||
(collect-items-into-groups
|
||||
triggers
|
||||
(lambda (trigger)
|
||||
(when trigger
|
||||
(world-coords-chunk (getf trigger :coords))))
|
||||
:groups trigger-chunks)))
|
||||
|
||||
|
||||
|
||||
;;; ———————————————————————————————————
|
||||
;;; Tile-layer parsing (graphics)
|
||||
|
|
@ -151,6 +178,7 @@ with 15 characters-per-line."
|
|||
(top-tiles '())
|
||||
(bump-map '())
|
||||
(entities '())
|
||||
(triggers '())
|
||||
(hash (make-hash-table)))
|
||||
(mapcar (lambda (layer)
|
||||
(typecase layer
|
||||
|
|
@ -162,10 +190,12 @@ with 15 characters-per-line."
|
|||
(setf top-tiles (tile-layer-chunks layer top-tiles))
|
||||
(setf tile-chunks (tile-layer-chunks layer tile-chunks))))
|
||||
(cl-tiled.data-types:object-layer
|
||||
(setf triggers (object-layer-triggers layer triggers))
|
||||
(setf entities (object-layer-entities layer entities)))))
|
||||
(cl-tiled:map-layers (cl-tiled:load-map map-file)))
|
||||
(setf (gethash :tiles hash) tile-chunks)
|
||||
(setf (gethash :top-tiles hash) top-tiles)
|
||||
(setf (gethash :bump-map hash) bump-map)
|
||||
(setf (gethash :entities hash) entities)
|
||||
(setf (gethash :triggers hash) triggers)
|
||||
hash))
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<map version="1.10" tiledversion="1.10.1" orientation="orthogonal" renderorder="left-down" width="72" height="41" tilewidth="17" tileheight="17" infinite="0" nextlayerid="7" nextobjectid="6">
|
||||
<map version="1.10" tiledversion="1.10.1" orientation="orthogonal" renderorder="left-down" width="72" height="41" tilewidth="17" tileheight="17" infinite="0" nextlayerid="7" nextobjectid="10">
|
||||
<tileset firstgid="1" source="font.tsx"/>
|
||||
<layer id="4" name="Background" width="72" height="41">
|
||||
<data encoding="csv">
|
||||
|
|
@ -192,5 +192,19 @@
|
|||
</properties>
|
||||
<point/>
|
||||
</object>
|
||||
<object id="6" name="Bartender" type="Person" x="110" y="128.667">
|
||||
<properties>
|
||||
<property name="facing_right" type="bool" value="false"/>
|
||||
<property name="id" value="casino-bartender"/>
|
||||
<property name="interact" value="casino-bartender-interact"/>
|
||||
<property name="normal_face" value="uvu~"/>
|
||||
</properties>
|
||||
<point/>
|
||||
</object>
|
||||
<object id="8" name="BRUH" type="Trigger" x="233.333" y="240" width="78" height="47.3333">
|
||||
<properties>
|
||||
<property name="function" value="bruh-trigger"/>
|
||||
</properties>
|
||||
</object>
|
||||
</objectgroup>
|
||||
</map>
|
||||
|
|
|
|||
Ŝarĝante…
Reference in New Issue