From 31b0a07f6a3ea3c37ae39740948f8d6471d8e5a3 Mon Sep 17 00:00:00 2001
From: Walter Lewis <wklew@mailbox.org>
Date: Sun, 20 Oct 2024 19:00:32 -0400
Subject: Add support for polylines in tile maps

Adds support for polylines (unclosed polygons) in tile maps,
which are indicated by `<polyline>...</polyline>`.

Tiled docs: https://doc.mapeditor.org/en/stable/manual/objects/#polylines

Tested on both polygons and polylines using a map I made.
---
 chickadee/graphics/tile-map.scm | 36 +++++++++++++++++++++++++-----------
 1 file changed, 25 insertions(+), 11 deletions(-)

diff --git a/chickadee/graphics/tile-map.scm b/chickadee/graphics/tile-map.scm
index 84213eb..9479e82 100644
--- a/chickadee/graphics/tile-map.scm
+++ b/chickadee/graphics/tile-map.scm
@@ -89,6 +89,9 @@
             polygon?
             polygon-points
 
+            polyline?
+            polyline-points
+
             map-object?
             map-object-id
             map-object-name
@@ -230,6 +233,11 @@
   polygon?
   (points polygon-points))
 
+(define-record-type <polyline>
+  (make-polyline points)
+  polyline?
+  (points polyline-points))
+
 (define-record-type <map-object>
   (%make-map-object id name type shape properties)
   map-object?
@@ -800,15 +808,14 @@ the default ORIENTATION value of 'orthogonal' is supported."
                   (y height))
         (tile-layer-set! layer x y (vector-ref tiles (+ (* y width) x))))
       layer))
-  (define (parse-polygon node pixel-height)
-    (make-polygon
-     (list->vector
-      (map (lambda (s)
-             (match (string-split s #\,)
-               ((x y)
-                (vec2 (string->number x)
-                      (- pixel-height (string->number y))))))
-           (string-split (attr node 'points) #\space)))))
+  (define (parse-points node pixel-height)
+    (list->vector
+     (map (lambda (s)
+            (match (string-split s #\,)
+              ((x y)
+               (vec2 (string->number x)
+                     (- pixel-height (string->number y))))))
+          (string-split (attr node 'points) #\space))))
   (define (parse-object node pixel-height)
     (let* ((id (attr node 'id string->number))
            (name (attr node 'name))
@@ -819,8 +826,15 @@ the default ORIENTATION value of 'orthogonal' is supported."
            (height (attr node 'height string->number))
            (shape (if (and width height)
                       (make-rect x y width height)
-                      (parse-polygon (car ((sxpath '(polygon)) node))
-                                     pixel-height)))
+                      (match ((sxpath '(polygon)) node)
+                        ((polygon . _)
+                         (make-polygon
+                          (parse-points polygon pixel-height)))
+                        (()
+                         (match ((sxpath '(polyline)) node)
+                           ((polyline . _)
+                            (make-polyline
+                             (parse-points polyline pixel-height))))))))
            (properties (map parse-property
                             ((sxpath '(properties property)) node))))
       (%make-map-object id name type shape properties)))
-- 
cgit v1.2.3