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.

flora-search-aurora.lisp

@@ -187,6 +187,10 @@
                             :face "=w=~"))))
 
 
+(defun bruh-trigger (&optional map)
+  (print "YAAAAAAA"))
+
+
 
 ;;; ———————————————————————————————————
 ;;; Destitute Gambler arc

overworld.lisp

@@ -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)))))))
 
 
 

overworld.tiled.lisp

@@ -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)
+(defun tiled-rectangle-p (tiled-obj)
-  "Convert a Tiled cell into a cell plist."
+  "Whether or not a Tiled object is a valid rectangle."
-  (list :coords (list :x (cl-tiled:cell-column tiled-cell)
+  (and (> (cl-tiled:rect-width tiled-obj) 0)
-                      :y (cl-tiled:cell-row tiled-cell))
+       (> (cl-tiled:rect-height tiled-obj) 0)))
-        :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-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)
+            :coords (tiled-coords->world-coords (cl-tiled:object-x tiled-obj)
-                                     (cl-tiled:map-tile-width tiled-map)))
+                                                (cl-tiled:object-y tiled-obj)
-                        :y (floor (/ (cl-tiled:object-y tiled-obj)
+                                                tiled-map)
-                                     (cl-tiled:map-tile-height 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))

res/casino.tmx

@@ -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>