diff --git a/map.svg b/map.svg
index d652b28..432b498 100644
--- a/map.svg
+++ b/map.svg
@@ -7,14 +7,14 @@
<title>
Floorplan
</title>
- <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"/>
+ <polygon transform="scale(5)" points="0,0 100,0 100,100" fill="green"
+ stroke="red" stroke-width="1"/>
+ <polygon transform="scale(5)" points="10,120 20,110 20,120 10,120"
+ fill="green" stroke="red" stroke-width="1"/>
+ <polygon transform="scale(5)" points="0,110 20,140" fill="green" stroke="red"
+ stroke-width="1"/>
+ <polygon transform="scale(5)" points="5,100 5,105" fill="green" stroke="red"
+ stroke-width="1"/>
+ <polygon transform="scale(5)" points="10,100 5,110" fill="green" stroke="red"
+ stroke-width="1"/>
</svg>
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)))
|
