From ed886f8f51071ff7ef5515468a39b02109fa0cae Mon Sep 17 00:00:00 2001
From: Emile <git@emile.space>
Date: Wed, 24 Apr 2024 23:08:17 +0200
Subject: well, did a big refactor, now using "poly" and plotting by hand

---
 rooms.lisp | 57 ++++++++++++++++++++++++++++++++++++++-------------------
 1 file changed, 38 insertions(+), 19 deletions(-)

(limited to 'rooms.lisp')

diff --git a/rooms.lisp b/rooms.lisp
index 7155a2e..84a9e81 100644
--- a/rooms.lisp
+++ b/rooms.lisp
@@ -12,38 +12,52 @@
                                                             "-"
                                                             (symbol-name slot)))))))
 
-(define-area-class area name x y width height subs)
+(define-area-class area name points subs)
 
-(defmacro square (name x y width height &optional subs)
-   `(make-instance 'area :name ,name :x ,x :y ,y :width ,width :height ,height :subs ,subs))
+(defmacro poly (name &key points subs)
+   `(make-instance 'area :name ,name :points ,points :subs ,subs))
 
 (defmethod print-object ((obj area) out)
   (print-unreadable-object (obj out :type t)
-    (format out "name:~s x:~d y:~d subs:~d"
-            (area-name obj) (area-x obj) (area-y obj) (length (area-subs obj)))))
+    (format out "name:~s points:~a subs:~d"
+            (area-name obj) (area-points obj) (length (area-subs obj)))))
 
-(defun draw-room-with-subs (scene area offset-x offset-y &key scale)
+(defun draw-room-with-subs (&key scene area offset-x offset-y scale)
   (if area
       (svg:transform (svg:scale scale)
         (svg:draw scene
-            (:rect :x (+ offset-x (area-x area))
-                   :y (+ offset-y (area-y area))
-                   :width (area-width area)
-                   :height (area-height area)
-                   :fill "none" :stroke "red" :stroke-width 1))))
+            (:polygon
+             :points (format nil "~{~A~^ ~}"
+                       (mapcar
+                        (lambda (point)
+                          (format nil "~A,~A" (first point) (second point)))
+                        (mapcar
+                         (lambda (coord)
+                           (list
+                            (+ (first coord) offset-x)
+                            (+ (second coord) offset-y)))
+                         (area-points area))))
+             :fill "green"
+             :stroke "red"
+             :stroke-width 1))))
+
   (if area
       (loop for sub in (area-subs area)
-            do (draw-room-with-subs scene sub
-                                    (area-x area) (area-y area) :scale scale))))
+            do (draw-room-with-subs
+                :scene scene
+                :area sub
+                :offset-x (first (first (area-points area)))
+                :offset-y (first (second (area-points area)))
+                :scale scale))))
 
 ; define the floorplan here
 ; do note: sub-room locations are relative to their parent
 (defparameter floorplan
-  (square "main" 5 5 100 50
-      (list (square "room-1" 0 0 60 20 '())
-            (square "room-2" 0 10 20 40 '())
-            (square "room-3" 5 0 5 5 '())
-            (square "room-4" 10 0 5 10 '()))))
+  (poly "main" :points '((0 0) (100 0) (100 100 (0 200) (0 0)))
+                 :subs (list (poly "room-1" :points '((10 20) (20 10) (20 20) (10 20)) :subs '())
+                             (poly "room-2" :points '((0 10) (20 40)) :subs '())
+                             (poly "room-3" :points '((5 0) (5 5)) :subs '())
+                             (poly "room-4" :points '((10 0) (5 10)) :subs '()))))
 
 (defparameter floorplan (macroexpand-1
                          (with-open-file (in "floorplan.lisp") (read in))))
@@ -51,6 +65,11 @@
 (let ((scene (svg:make-svg-toplevel 'svg:svg-1.1-toplevel :height 1000 :width 1000
                                                           :viewbox "0 0 1000 1000")))
   (svg:title scene "Floorplan")
-  (draw-room-with-subs scene floorplan 0 0 :scale 5)
+  (draw-room-with-subs
+   :scene scene
+   :area floorplan
+   :offset-x 0
+   :offset-y 0
+   :scale 5)
   (with-open-file (s #p"map.svg" :direction :output :if-exists :supersede)
     (svg:stream-out s scene))) 
-- 
cgit 1.4.1