L-Systems with shapes

Rendering shapes is a relatively small addition to the L-System code I’ve been implementing over the last few weeks, it consists of a few manual dispatches to drawing code based on the first symbol in a sublist. The immediate alternative is using defgeneric and the common lisp object system, which is probably the correct thing to do.

Pending that major and obvious improvement, this is sufficient for what we have to work with.

(defparameter *line-stroker* (img-genner:static-color-stroker (img-genner:rgb 255 0 0)))
(defparameter *ellipse-stroker* (img-genner:static-color-stroker (img-genner:rgb 0 255 0)))
(defparameter *polygon-stroker* (img-genner:static-color-stroker (img-genner:rgb 200 200 0)))

(defun draw-command(item)
  (case (car item)
    ((line)
     (destructuring-bind (x1 y1 x2 y2) (cdr item)
       (img-genner:stroke-line *image* x1 y1 x2 y2 *line-stroker* ))
     )
    ((ellipse)
     (let ((el (cadr item)))
       (img-genner:fill-ellipse el *image* *ellipse-stroker*)))
    ((polygon)
     (let ((p (cadr item)))
       (img-genner:fill-shape p *image* *polygon-stroker*)))))
(defun iterate-n-then-execute(n tape)
  (loop repeat n
        with stroker = (img-genner:static-color-stroker (img-genner:rgb 255 0 0))
        for state = tape then (run-replacements state)
        do(reset-turtle)
        finally(progn
                 (execute-rules state)
                 (loop for count from 0
                       with total = (length *lines*)
                       for item in (reverse *lines*)
                       for color = (img-genner:static-color-stroker (img-genner:get-random-color))
                       do(draw-command item)
                       do(img-genner:save-image *image* (uiop:process-info-input ffmpeg))
                       do(format t "Finished frame ~a/~a~%" count total)))))

This also requires changing some of the turtle routines I wrote earlier and writing some new supporting ones. Semantically, depositing an ellipse or a polygon doesn’t really map well with going forwards or rotating the heading.

(defun forward(amount line)
  (let ((sx *turtle-x*) (sy *turtle-y*))
    (setf *turtle-x* (+ *turtle-x* (* amount (cos *turtle-angle*)))
          *turtle-y* (+ *turtle-y* (* amount (sin *turtle-angle*))))
    (when line
      (push (list 'line sx sy *turtle-x* *turtle-y*) *lines*))
    )
  )
(defun deposit-ellipse(radius-x radius-y)
  (let ((el (img-genner:make-ellipse *turtle-x* *turtle-y* radius-x radius-y)))
    (img-genner:set-rotation el *turtle-angle*)
    (push (list 'ellipse el) *lines*))

  )
(defun deposit-polygon(n radius)
  (let ((p (img-genner:make-regular-polygon *turtle-x* *turtle-y* n radius)))
    (push (list 'polygon p) *lines*)))

We can demonstrate this with a simple example as below:

(define-rule #\[ (lambda() (push-turtle)) '(#\[))
(define-rule #\] (lambda() (pop-turtle)) '(#\]))
(define-rule '+ (lambda() (turn (deg2rad 25.0))) '(+))
(define-rule '- (lambda() (turn (deg2rad -25.0))) '(-))
(define-rule 'L
    (lambda() (forward 10.0 t)(deposit-polygon 5 5.0))
  '(S ))
(define-rule 'S
    (lambda() (forward 10.0 t))
  '(S #\[ + + S L #\]  #\[ S L #\] - S L))

And we get this deeply lopsided plant out: