(ql:quickload 'cl-svg) (defpackage #:inv (:use :cl) (:export #:main)) (in-package :inv) (defmacro define-area-class (name &rest slots) `(defclass ,name () ,(loop for slot in slots collect `(,slot :initarg ,(intern (string-upcase (symbol-name slot)) :keyword) :initform (error "please provide a value for ~a" ',slot) :accessor ,(intern (concatenate 'string (symbol-name name) "-" (symbol-name slot))))))) (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)) (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) (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))) (if area (loop for sub in (area-subs area) do (draw-room-with-subs scene sub (area-x area) (area-y area))))) ; 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 '()) (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"))) (svg:title scene "Floorplan") (draw-room-with-subs scene floorplan 0 0) (with-open-file (s #p"map.svg" :direction :output :if-exists :supersede) (svg:stream-out s scene)))