summary refs log tree commit diff
diff options
context:
space:
mode:
authorEmile <git@emile.space>2024-04-22 21:34:41 +0200
committerEmile <git@emile.space>2024-04-22 21:34:41 +0200
commitac19d94fbbb0d330c89fdb1225188e0600d9ae49 (patch)
treec7e73070a2deb35cb044f1277550dbed5b93ba1c
parenteb72773edb8a09d0f04dfef0a96d83e6a35e3178 (diff)
Renamed some macros, applied some scaling
The are macro has been renamed to area-macro, are was just a weird
name, although I'd like to find a better name as it will be quite
cumbersome to write in the definition of the floorplan. Possibly
`a` or so?
-rw-r--r--map.svg24
-rw-r--r--rooms.lisp34
2 files changed, 31 insertions, 27 deletions
diff --git a/map.svg b/map.svg
index 7d47f2d..d652b28 100644
--- a/map.svg
+++ b/map.svg
@@ -1,20 +1,20 @@
 <?xml version="1.0" standalone="no"?>
 <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" 
   "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
-<svg viewbox="0 0 200 200" width="200" height="200" version="1.1" id="toplevel"
-    xmlns="http://www.w3.org/2000/svg"
+<svg viewbox="0 0 1000 1000" width="1000" height="1000" version="1.1"
+    id="toplevel" xmlns="http://www.w3.org/2000/svg"
     xmlns:xlink="http://www.w3.org/1999/xlink">
   <title>
     Floorplan
   </title>
-  <rect x="5" y="5" width="100" height="50" fill="none" stroke="black"
-        stroke-width="1"/>
-  <rect x="5" y="5" width="20" height="20" fill="none" stroke="black"
-        stroke-width="1"/>
-  <rect x="5" y="15" width="20" height="40" fill="none" stroke="black"
-        stroke-width="1"/>
-  <rect x="10" y="5" width="5" height="5" fill="none" stroke="black"
-        stroke-width="1"/>
-  <rect x="15" y="5" width="5" height="10" fill="none" stroke="black"
-        stroke-width="1"/>
+  <rect transform="scale(5)" x="5" y="5" width="100" height="50" fill="none"
+        stroke="red" stroke-width="1"/>
+  <rect transform="scale(5)" x="5" y="5" width="60" height="20" fill="none"
+        stroke="red" stroke-width="1"/>
+  <rect transform="scale(5)" x="5" y="15" width="20" height="40" fill="none"
+        stroke="red" stroke-width="1"/>
+  <rect transform="scale(5)" x="10" y="5" width="5" height="5" fill="none"
+        stroke="red" stroke-width="1"/>
+  <rect transform="scale(5)" x="15" y="5" width="5" height="10" fill="none"
+        stroke="red" stroke-width="1"/>
 </svg>
diff --git a/rooms.lisp b/rooms.lisp
index 9fb2a3e..0ce109b 100644
--- a/rooms.lisp
+++ b/rooms.lisp
@@ -14,39 +14,43 @@
 
 (define-area-class area name x y width height subs)
 
-(defmacro are (name x y width height &optional subs)
-  `(make-instance 'area :name ,name :x ,x :y ,y :width ,width :height ,height :subs ,subs))
+(defmacro area-macro (name x y width height &optional subs)
+   `(make-instance 'area :name ,name :x ,x :y ,y :width ,width :height ,height :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)))))
 
-(defun draw-room-with-subs (scene area offset-x offset-y)
+(defun draw-room-with-subs (scene area offset-x offset-y &key scale)
   (if area
-      (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 "black" :stroke-width 1)))
+      (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))))
   (if area
       (loop for sub in (area-subs area)
             do (draw-room-with-subs scene sub
-                                    (area-x area) (area-y area)))))
+                                    (area-x area) (area-y area) :scale scale))))
 
 ; define the floorplan here
 ; do note: sub-room locations are relative to their parent
 (defparameter floorplan
   (are "main" 5 5 100 50
-      (list (are "room-1" 0 0 20 20 '())
+      (list (are "room-1" 0 0 60 20 '())
             (are "room-2" 0 10 20 40 '())
             (are "room-3" 5 0 5 5 '())
             (are "room-4" 10 0 5 10 '()))))
 
-(let ((scene (svg:make-svg-toplevel 'svg:svg-1.1-toplevel :height 200 :width 200
-                                                          :viewbox "0 0 200 200")))
+(defparameter floorplan (macroexpand-1
+                         (with-open-file (in "floorplan.lisp") (read in))))
+
+(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)
+  (draw-room-with-subs scene floorplan 0 0 :scale 5)
   (with-open-file (s #p"map.svg" :direction :output :if-exists :supersede)
-    (svg:stream-out s scene)))
+    (svg:stream-out s scene)))