SVG Domain Specifc Language

Introduction
SVG DSL
Drawings!
Conclusion

Introduction

While continuing to make my way through Land of Lisp I got to Chapter 17 covering "Domain Specific Languages". I really enjoyed the opening example that outlined making a DSL to create SVGs in Common Lisp. Once that section was over I wanted to keep exploring the idea and reinforce some of the things I had been reading up until that point. This post is the org mode file I made to continue exploring DSLs, Lisp macros and using the loop macro.

SVG DSL

References

Print XML Tag

This function prints an XML opening or closing tag
It also optionally takes an attribute alist and adds them to the XML tag
This function makes use of two conditional formats, one for the closing forward slash and the other for the attribute list
The attribute alist is flattened into list to make it easy to use the ~{ ~} loop in format
The tag name and the name of attributes are converted to lowercase

(defun print-xml-tag (tag-name &optional attributes closingp)
  "Prints to standard output either an opening tag or a closing
tag. The `closingp' predicate when true indicates it is a closing
tag. The `attributes' argument is an alist of attributes that are part
of the XML tag. Attributes will only be added if it is not a closing
tag."
  (let ((attrs (mapcan (lambda (p)
                         (list (car p) (cdr p)))
                       attributes)))
    (format t "<~a~a~a>"
            (if closingp "/" "")
            (string-downcase tag-name)
            (if (and (not closingp) attrs)
                (format nil "~{ ~a=\"~a\"~}"
                        (loop for i below (length attrs)
                              collect (if (evenp i)
                                          (string-downcase (nth i attrs))
                                          (nth i attrs))))

                ""))))

(with-output-to-string (*standard-output*)
  (print-xml-tag "nav" '((class . "fancy") (style . "float:right;")))
  (fresh-line)
  (princ "  ")
  (print-xml-tag "h1")
  (princ "Hello")
  (print-xml-tag "h1" nil t)
  (fresh-line)
  (print-xml-tag "nav" nil t))

The above code snippet generates the following output:

<nav class="fancy" style="float:right;">
  <h1>Hello</h1>
</nav>

Indenting

I wanted the output XML to be human readable so I needed to make a macro for indenting lines
This macro captures standard output and indents each line by the requested levels
The number of spaces to use to indent is also passed in

(defmacro indent (level spaces &body body)
  "This will capture any lines written to standard output and prepend
the line with the `level' * `spaces' of spaces. Both the `level' and
`spaces' are integers that indicate the amount of indenting that needs
to be done."
  `(let ((indent-spaces (format nil "~{~a~}"
                                (loop for i below (* ,level ,spaces)
                                      collect #\ ))))
     (with-input-from-string
         (s (with-output-to-string (*standard-output*)
              ,@body))
       (do ((line (read-line s nil)
                  (read-line s nil)))
           ((null line))
         (format t "~a~a~%" indent-spaces line)))))

XML Tag Macro

This macro reduces the amount of text you have to type to make an xml tag
It does this by automatically adding the closing tag
It also ensures that the interior body is indented

(defmacro xml-tag (tag-name attributes &body body)
  "This will print an xml tag name `tag-name' with `attributes'. If a
`body' is provided it will be added between the opening and closing
tag. Only items print to standard out will appear in the `body'."
  `(progn (fresh-line)
          (print-xml-tag ',tag-name
                         ,attributes)
          (fresh-line)
          (indent 1 2
            ,@body)
          (fresh-line)
          (print-xml-tag ',tag-name nil t)))

(with-output-to-string (*standard-output*)
  (xml-tag div nil
    (xml-tag div nil
      (xml-tag p nil
        (princ "Hello")))))

The above example outputs the following string:

<div>
  <div>
    <p>
      Hello
    </p>
  </div>
</div>

SVG Macro

The SVG macro takes a width and height and generates an SVG tag

(defmacro svg (w h &body body)
  "This macro generates a SVG tag with width `w' and height `h'."
  `(xml-tag svg (list (cons "xmlns"  "http://www.w3.org/2000/svg")
                      (cons "xmlns:xlink"  "http://www.w3.org/1999/xlink")
                      (cons "width" ,w)
                      (cons "height" ,h)
                      (cons "viewBox" (format nil "0 0 ~d ~d" ,w ,h)))
     ,@body))

(with-output-to-string (*standard-output*)
  (svg 100 50
    (svg 25 25)))

The above example produces the following output:

<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" width="100" height="50">
  <svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" width="25" height="25">
  </svg>
</svg>

Math Helpers

Degrees to Radians

(defun degrees->radians (degrees)
  "Converts the argument `degrees' to radians."
  (* degrees (/ pi 180)))

Center Point of Rect

(defun center-point-of-rect (x y w h)
  "Returns the center point of the rectangle formed by the arguments"
  (cons
   (+ x (/ w 2))
   (+ y (/ h 2))))

Rotate About Point

I wrote this function to be able to apply rotations to path coordinates

(defun rotate-about-point (p1 p2 radians)
  "Returns the rotated `p1' point using point `p2' as the anchor. The
rotation angle is determined by `radians'."
  (let ((p1x (car p1))
        (p1y (cdr p1))
        (p2x (car p2))
        (p2y (cdr p2))
        (cos-theta (cos radians))
        (sin-theta (sin radians)))
    (cons
     (+ (- (* cos-theta (- p1x p2x))
           (* sin-theta (- p1y p2y)))
        p2x)
     (+ (+ (* sin-theta (- p1x p2x))
           (* cos-theta (- p1y p2y)))
        p2y))))

Random Value

This function wraps the random function and makes it easy to add a min or max value
The min value is inclusive the max value is exclusive

(defun random-value (&key min max)
  "Generates a random value between `min' and `max'. `min' is
inclusive and `max' is exclusive."
  (+ min (random (- max min))))

Random Set

This function takes a number that represents the sum of all the random numbers in a set

(defun random-set (&key sum min max)
  "Returns a list of random numbers that add up to `sum'. `min' and
`max' are the inclusive min and exclusive max for each individual
number in the set."
  (loop with x = nil
        with s = sum
        until (= s 0)
        do (progn
             (let ((n (if (< s max)
                          s
                          (random-value :min min :max max))))
               (setf x (append x (list n)))
               (setf s (- s n))))
        finally (return x)))

Random Item From List

(defun random-item (lst &optional distribution)
  "Pick a random item from `lst'. `distribution' is a list of values
between 0 and 1. The length of `distribution' should be the same as
`lst'. For example, if `lst' is '(a b c) a valid `distribution' could
be '(0.5 0.25 0.25). This distribution will cause the random item to
be twice as likely to be 'a' than 'b' or 'c'."
  (when distribution
    (let ((new-lst nil))
      (loop for d in distribution
            for i from 0
            do (loop repeat (* (nth i distribution) 100)
                     do (setf new-lst (append new-lst (list (nth i lst))))))
      (setf lst new-lst)))
  (nth (random (length lst)) lst))

Shapes

Rectangle

The rect function builds the svg tag with optional keyword arguments

(defun rect (&key x y w h
               stroke stroke-w
               fill rotate rotate-anchor)
  "This function prints to standard output a SVG rect tag. All of the
keyword arguments are optional. If included they will be added to the
attribute of the tag. The `stroke' and `fill' arguments accept color
which is a list of 3 integers between 0 - 255. The `rotate' argument
specifcs the angle that rectangle should be rotated in degrees. The
`rotate-anchor' argument specifies the point about which the rotation
should occur. If no `rotate-angle' is supplied and a `rotate' angle is
supplied then the center of the rectangle will be used by default."

  (let ((p1 (cons x y))
        (p2 (cons (+ x w) y))
        (p3 (cons (+ x w) (+ y h)))
        (p4 (cons x (+ y h)))
        (anchor (or rotate-anchor
                    (center-point-of-rect x y w h)))
        (attributes nil))

    (when rotate
      (let ((radians (degrees->radians rotate)))
        (setf p1 (rotate-about-point p1 anchor radians))
        (setf p2 (rotate-about-point p2 anchor radians))
        (setf p3 (rotate-about-point p3 anchor radians))
        (setf p4 (rotate-about-point p4 anchor radians))))

    (setf attributes (append attributes `(("d" . ,(format nil "M~f ~f L~f ~f L~f ~f L~f ~f Z"
                                                          (car p1) (cdr p1)
                                                          (car p2) (cdr p2)
                                                          (car p3) (cdr p3)
                                                          (car p4) (cdr p4))))))
    (when stroke
      (setf attributes (append attributes `(("stroke" . ,(format nil "rgb(~{~a,~a,~a~})" stroke))))))
    (when stroke-w
      (setf attributes (append attributes `(("stroke-width" . ,stroke-w)))))
    (if fill
        (setf attributes (append attributes `(("fill" . ,(format nil "rgb(~{~a,~a,~a~})" fill)))))
        (setf attributes (append attributes '(("fill" . "none")))))
    (xml-tag path attributes)))

Ellipse

This function draws a closed ellipse using an SVG path
I tried my best to make the rotation work properly but I don't think it is always anchored in the center of the ellipse

(defun ellipse (&key cx cy rx ry angle
                  stroke stroke-w fill)
  "Draws a closed ellipse centered at `cx' and `cy'. The x-axis radius
is set with `rx'. The y-axis radius is set with `ry'. The `angle'
argument specifies the rotation in degrees the ellipse should be
tiled. `stroke' and `stroke-w' define the color and width of the
stroke to be applied. The optional `fill' property specifies the fill
color of the ellipse."
  (let* ((adjusted-angle (degrees->radians (- 90 angle)))
         (p1x (- cx (* rx (cos adjusted-angle))))
         (p1y (- (- cy ry)
                 (* ry (sin adjusted-angle))))
         (p2x (+ p1x 0.1))
         (p2y p1y)
         (attributes nil))
    (setf attributes (append attributes `(("d" . ,(format nil "M ~f ~f A ~f ~f ~f ~d ~d ~f ~f Z"
                                                          p1x p1y
                                                          rx ry angle 1 0
                                                          p2x p2y)))))
    (when stroke
      (setf attributes (append attributes `(("stroke" . ,(format nil "rgb(~{~a,~a,~a~})" stroke))))))
    (when stroke-w
      (setf attributes (append attributes `(("stroke-width" . ,stroke-w)))))
    (if fill
        (setf attributes (append attributes `(("fill" . ,(format nil "rgb(~{~a,~a,~a~})" fill)))))
        (setf attributes (append attributes '(("fill" . "none")))))
    (xml-tag path attributes)))

Drawings!

These drawings are a showcase of some of the ideas I had while working on this. They are ordered in the order that I made them.

Square

This basic square was my initial test that everything was working properly with the SVG rendering
I used the stream redirection in Common Lisp to save the stdout to a file
Each drawing will use this technique

(with-open-file (*standard-output* "../assets/square.svg"
                                  :direction :output
                                  :if-exists :supersede)
  (svg 200 200
    (rect :x 50 :y 50 :w 100 :h 100
          :stroke '(0 0 0) :stroke-w 4
          :fill '(255 0 0))))

Rotated Squares

When working on this drawing I wanted to be able to easily rotate a rectangle
Most of the time working on this was spent working on the rotate-about-point function

(with-open-file (*standard-output* "../assets/rotated_squares.svg"
                                   :direction :output
                                   :if-exists :supersede)
  (svg 200 200
    (loop for angle from 0
            to 90 by 30
          do (rect :x 50 :y 50 :w 100 :h 100
                   :stroke '(0 0 0) :stroke-w 2
                   :rotate angle))))

Rectangle Arc

I had in my mind something like the Stack Overflow logo, where you had a stack of rectangles angled
I added to the rect function the ability to specify an arbitrary anchor point for rotation

(with-open-file (*standard-output* "../assets/rectangle_arc.svg"
                                   :direction :output
                                   :if-exists :supersede)
  (let ((x 100)
        (y 150))
    (svg 200 200
      (loop for angle downfrom 0
              to -180 by 15
            do (rect :x x :y y :w 75 :h 8
                     :stroke '(0 0 0) :stroke-w 2
                     :rotate angle
                     :rotate-anchor `(,x . ,(+ y 4)))))))

Spiral Graph

I spent the majority of my time on this one in the ellipse function
I am still not sure I fully understand how the rotation works for the path elliptical arc
I am happy with the result of this but I do think that the rotation is not properly anchored to the center of the ellipse

(with-open-file (*standard-output* "../assets/spiral_graph.svg"
                                   :direction :output
                                   :if-exists :supersede)
  (svg 200 200
    (loop for angle from 0 to 360 by 15
          do (let* ((cx 100)
                    (cy 100)
                    (rx 45)
                    (ry 45))
               (ellipse :cx cx
                        :cy cy
                        :rx rx :ry ry
                        :angle angle
                        :stroke '(128 0 128)
                        :stroke-w 0.5)))))

City Scape

I referenced the skyline in Qbasic game Gorillas
I spent most of the time on this one exploring what all I could do with the loop macro
I also made some fun to implement math functions that helped with random generation
Each time this lisp code is run it generates a new random city scape

(with-open-file (*standard-output* "../assets/cityscape.svg"
                                   :direction :output
                                   :if-exists :supersede)
  (let* ((world-w 600)
         (world-h 300)
         (window-w 5)
         (window-h 10)
         (building-colors '((0 170 173)
                            (173 170 173)
                            (173 0 0)))
         (window-spacing 6)
         (window-colors '((255 255 82)
                          (82 85 82)))
         (widths (random-set :sum world-w :min 30 :max 120)))
    (svg world-w world-h
      (rect :x 0 :y 0 :w world-w :h world-h :fill '(0 0 173))
      (loop for w in widths
            with x = 0
            do (let* ((h (random-value :min 50 :max (- world-h 20)))
                      (y (- world-h h)))
                 (rect :x x :y y :w w :h h
                       :stroke '(0 0 0) :stroke-w 1
                       :fill (random-item building-colors))
                 (loop for y from y to (- world-h
                                          (+ window-h window-spacing))
                       by (+ window-h window-spacing)
                       do (loop for x
                                from x to (- (+ x w)
                                             (+ window-w window-spacing)
                                             window-spacing)
                                by (+ window-w window-spacing)
                                do (rect :x (+ x window-spacing)
                                         :y (+ y window-spacing)
                                         :w window-w :h window-h
                                         :fill (random-item window-colors
                                                            '(0.85 0.15)))))
                 (setf x (+ x w)))))))

Conclusion

While working on this I wanted to make sure that the SVGs that this produces look the same in as many viewers as possible. When I first wanted to add rotation to the rect function I opted to use CSS transforms. This worked great in Firefox but in other viewers like ImageMagick and Inkscape the transform was not applied. The best solution to this problem I could think of was to switch to using the SVG path tag and doing the rotation math in Lisp. This ensured that the SVG looked consistent no matter where you viewed it.

This project was a lot of fun to work on. I always enjoy creating pictures with code. As I continue to learn more about Lisp I am constantly trying to understand the value it can bring to various programming problems. So far I have liked most of what I have learned about Common Lisp. I especially like the loop macro, it is one of the most ergonomic looping iterators I have ever used.

Adam Richardson's Site