blob: 9fb2a3eeebed2958616806f072d81776b21b3b45 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
|
(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)))
|
