diff options
| -rw-r--r-- | map.svg | 20 | ||||
| -rw-r--r-- | rooms.lisp | 57 |
2 files changed, 48 insertions, 29 deletions
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))) |
