Implementing L-System examples from the "Algorithmic Beauty of Plants" with Meander

deps.edn

{:paths ["src"]
 :deps {org.clojure/clojure {:mvn/version "1.10.0"}
        org.clojure/clojurescript {:mvn/version "1.10.439"}
        org.clojure/test.check {:mvn/version "0.10.0-alpha3"}
        com.google/clojure-turtle {:mvn/version "0.3.0"}
        meander/delta {:mvn/version "0.0.85"}
        quil/quil {:mvn/version "3.0.0"}}
 :aliases {:test {:extra-paths ["test"]
                  :extra-deps {org.clojure/test.check {:mvn/version "0.10.0-alpha3"}
                               com.cognitect/test-runner {:git/url "https://github.com/healthfinch/test-runner"
                                                          :sha "1d0cb97a14152959cdb7c1e8539a1759a1663f5b"}}
                  :main-opts ["-m" "cognitect.test-runner"]}}}

topiary.clj

(ns topiary.core
  (:require [meander.match.delta :as r.match]
            [meander.strategy.delta :as r]
            [clojure-turtle.core :as turtle]))

;; F Move forward drawing a line.
;; f Move forward without drawing a line.
;; + Turn left by angle δ.
;; - Turn right by angle δ.
;; ( Push turtle state
;; ) Restore turtle state

(defn interpret [d δ instruction]
  (r.match/find instruction
    F
    (turtle/forward d)

    f
    (do (turtle/penup)
        (turtle/forward d)
        (turtle/pendown))

    + 
    (turtle/left δ)

    -
    (turtle/right δ)

    [_ ... :as ?instructions]
    (run!
     (fn [?instruction]
       (interpret d δ ?instruction))
     ?instructions)

    (!instructions ... :as ?block)
    (r.match/match (deref turtle/turtle)
      {:angle ?angle
       :color ?color
       :fill ?fill
       :x ?x
       :y ?y}
      (do (interpret d δ !instructions)
          (if ?fill
            (do (turtle/end-fill)
                (turtle/setxy ?x ?y)
                (turtle/setheading ?angle)
                (turtle/color ?color)
                (turtle/start-fill))
            (do (turtle/setxy ?x ?y)
                (turtle/setheading ?angle)
                (turtle/color ?color)))))))

(defn l-system [s n]
  (if (= n 0)
    identity
    (apply r/pipe (repeat n (r/bottom-up s)))))

(def koch-island
  {:axiom '[F - F - F - F]
   :n 3
   :δ 90
   :productions (r/rewrite
                 F [F - F + F + F F - F - F + F]
                 ?X ?X)})

(def example-a
  {:axiom '[F - F - F - F]
   :n 4
   :δ 90
   :productions (r/rewrite
                 F [F F - F - F - F - F - F + F]
                 ?X ?X)})

(def example-b
  {:axiom '[F - F - F - F]
   :n 4
   :δ 90
   :productions (r/rewrite
                 F [F F - F - F - F - F F]
                 ?X ?X)})

(def example-c
  {:axiom '[F - F - F - F]
   :n 3
   :δ 90
   :productions (r/rewrite
                 F [F F - F + F - F - F F]
                 ?X ?X)})

(def example-d
  {:axiom '[F - F - F - F]
   :n 4
   :δ 90
   :productions (r/rewrite
                 F [F F - F - - F - F]
                 ?X ?X)})

(def example-e
  {:axiom '[F - F - F - F]
   :n 5
   :δ 90
   :productions (r/rewrite
                 F [F - F F - - F - F]
                 ?X ?X)})

(def example-f
  {:axiom '[F - F - F - F]
   :n 4
   :δ 90
   :productions (r/rewrite
                 F [F - F + F - F - F]
                 ?X ?X)})

(def plant-a
  {:axiom 'F
   :n 5
   :δ 25.7
   :productions (r/rewrite
                 F [F (+ F) F (- F) F]
                 ?X ?X)})

(def plant-b
  {:axiom 'F
   :n 5
   :δ 20
   :productions (r/rewrite
                 F [F (+ F) F (- F) (F)]
                 ?X ?X)})

(def plant-c
  {:axiom 'F
   :n 4
   :δ 22.5
   :productions (r/rewrite
                 F [F F - (- F + F + F) + (+ F - F - F)]
                 ?X ?X)})

(def plant-d
  {:axiom 'X
   :n 7
   :δ 20
   :productions (r/rewrite
                 X [F (+ X) F (- X) + X]
                 F [F F]
                 ?X ?X)})

(def plant-e
  {:axiom 'X
   :n 7
   :δ 25.7
   :productions (r/rewrite
                 X [F (+ X) (- X) F X]
                 F [F F]
                 ?X ?X)})

(def plant-f
  {:axiom 'X
   :n 5
   :δ 22.5
   :productions (r/rewrite
                 X [F - ((X) + X) + F (+ F X) - X]
                 F [F F]
                 ?X ?X)})

(def sierpenski-triangle
  {:axiom '[F - G - G]
   :n 6
   :δ 120
   :productions (r/rewrite
                 F [F - G + F + G - F]
                 G [G G]
                 ?X ?X)
   :post-productions (r/rewrite
                      G F
                      ?X ?X)})

(defn make-window 
  ([]
   (make-window 1))
  ([scale]
   (turtle/new-window {:size [(* scale 1024) (* scale 768)]})))

(defn run-specification [specification]
  (let [X specification
        d 3
        n (:n X)
        δ (:δ X)
        system (l-system (:productions X) n)
        system (if-some [post-production (:post-productions X)]
                 (r/pipe system (r/bottom-up post-production))
                 system)]
    (turtle/clean)
    (turtle/home)
    (turtle/setxy 0 -380)
    (interpret d δ (system (:axiom X)))))


(comment (run-specification plant-e))