From ac19d94fbbb0d330c89fdb1225188e0600d9ae49 Mon Sep 17 00:00:00 2001 From: Emile Date: Mon, 22 Apr 2024 21:34:41 +0200 Subject: 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? --- rooms.lisp | 34 +++++++++++++++++++--------------- 1 file changed, 19 insertions(+), 15 deletions(-) (limited to 'rooms.lisp') 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))) -- cgit 1.4.1