examples/l-systems.ss
```#lang scheme

(require (prefix-in s: scheme))

;;(require (prefix-in s: string))

;;;; Implementation of some L-Systems, described in:
;; http://en.wikipedia.org/wiki/L-system

;; Example 4: Koch curve
;; A variant of the Koch curve which uses only right-angles.
;; variables : F
;; constants : + −
;; start  : F
;; rules  : (F → F+F−F−F+F)
;; Here, F means "draw forward", + means "turn left 90°", and - means "turn right 90°".

(define koch-start "F")
(define koch-rules
'(("F" . "F+F-F-F+F")))

(define (koch-test)
(koch-curve 1 5))
(define (koch-curve stride n)
(let* ([str (apply-rules* koch-rules koch-start n)]
[len (string-length str)])
(define (update-p p d c)
(case c
[(#\F) (+ p d)]
[else p]))
(define (update-d d c)
(case c
[(#\+) (v+pol d 0  pi/2)]
[(#\-) (v+pol d 0 -pi/2)]
[else d]))
(define (koch-curve-aux acc p d i)
(if (= i len)
(cons p acc)
(let* ([c (string-ref str i)]
[p* (update-p p d c)]
[d* (update-d d c)])
(koch-curve-aux (if (point= p p*)
acc
(cons p acc)) ;; Don't repeat points
p* d*
(make-line (koch-curve-aux (list) origin-2d (vpol stride 0) 0))))

;; Example 6: Sierpinski triangle
;; variables : A B
;; constants : + −
;; start  : A
;; rules  : (A → B−A−B), (B → A+B+A)
;; angle  : 60°
(define sierpinski-start "A")
;;Here, A and B both mean "draw forward", + means "turn left by angle", and
;; − means "turn right by angle". The angle changes sign at each iteration
;; so that the base of the triangular shapes are always in the bottom
;; (they would be in the top and bottom, alternatively, otherwise).

;; Wikipedia doesn't explain it well! The angle must be positive if (even? n),
;; negative otherwise.

(define sierpinski-rules
'(("A" . "B-A-B")
("B" . "A+B+A")))

(define (sierpinski-test)
(sierpinski-triangle 1 pi/3 10))
(define (sierpinski-triangle stride angle n)
(let* ([str (apply-rules* sierpinski-rules sierpinski-start n)]
[len (string-length str)]
[ang (if (zero? (remainder n 2)) angle (- 0 angle))])
(define (update-p p d c)
(case c
[(#\A #\B) (+ p d)]
[else p]))
(define (update-d d c)
(case c
[(#\+) (v+pol d 0 ang)]
[(#\-) (v+pol d 0 (- 0 ang))] ;; XXX: Hmm... How should we treat this... can we curry '- ?
[else d]))                    ;; What about consistency?
(define (sierpinski-curve-aux acc p d i)
(if (= i len)
(cons p acc)
(let* ([c (string-ref str i)]
[p* (update-p p d c)]
[d* (update-d d c)])
(sierpinski-curve-aux (if (point= p p*)
acc
(cons p acc)) ;; Don't repeat points
p* d*
(make-line (sierpinski-curve-aux (list) origin-2d (vpol stride 0) 0))))

;; Example 7: Dragon curve
;; The Dragon curve drawn using an L-system.
;; variables : X Y
;; constants : F + −
;; start  : FX
;; rules  : (X → X+YF), (Y → FX-Y)
;; angle  : 90°
(define dragon-start "FX")
(define dragon-rules
'(("X" . "X+YF")
("Y" . "FX-Y")))
;; F means "draw forward", - means "turn left 90°", and + means "turn right 90°".
;; X and Y do not correspond to any drawing action

(define (dragon-test)
(dragon-curve 1 10))
(define (dragon-curve stride n)
(let* ([str (apply-rules* dragon-rules dragon-start n)]
[len (string-length str)])
(define (update-p p d c)
(case c
[(#\F) (+ p d)]
[else p]))
(define (update-d d c)
(case c
[(#\+) (v+pol d 0  pi/2)]
[(#\-) (v+pol d 0 -pi/2)]
[else d]))
(define (dragon-curve-aux acc p d i)
(if (= i len)
(cons p acc)
(let* ([c (string-ref str i)]
[p* (update-p p d c)]
[d* (update-d d c)])
(dragon-curve-aux (if (point= p p*)
acc
(cons p acc)) ;; Don't repeat points
p* d*
(make-line (dragon-curve-aux (list) origin-2d (vpol stride 0) 0))))

;; Example 8: Fractal plant
;; variables : X F
;; constants : + −
;; start  : X
;; rules  : (X → F-[[X]+X]+F[+FX]-X), (F → FF)
;; angle  : 25°

;; (define plant-start "X")
;; (define plant-rules
;;   `(("X" . "F-[[X]+X]+F[+FX]-X")
;;     ("F" . "FF")))

;; (define (plant angle forward-stride n)
;;   (let* ([pos-stack null]
;;          [ang-stack null]
;;          [pts-stack null]
;;          [str (apply-rules* plant-rules plant-start n)]
;;          [len (string-length str)])
;;     (define (plant-aux index)
;;       (if (= index len)
;;           (reverse! pts-stack)
;;        ))
;;     ))

;; General utility functions

;; Apply the rules N times.
(define (apply-rules* rules string n)
(define (apply-rules*-aux str n)
(if (zero? n)
str
(apply-rules*-aux (apply-rules rules str) (sub1 n))))
(apply-rules*-aux string n))

;; Apply the rules once.
(define (apply-rules rules string)
(let ([new ""]
[length (string-length string)])
(define (apply-rules-aux index)
(if (= index length)
new
(let* ([c (string-ref string index)]
[maybe-rule (assoc (s:string c) rules)])
(begin
(if maybe-rule
(set! new (string-append new (cdr maybe-rule)))
(set! new (string-append new (make-string 1 c))))
(apply-rules-aux 0)))

;; Penrose
(define pen-rules
'(("6" . "81++91----71[-81----61]++")
("7" . "+81--91[---61--71]+")
("8" . "-61++71[+++81++91]-")
("9" . "--81++++61[+91++++71]--71")))
(define pen-start "[7]++[7]++[7]++[7]++[7]")

(define (pen-test) (penrose 1 (/ pi 5) 4))
(define (penrose stride angle n)
(let* ([str (apply-rules* pen-rules pen-start n)]
[len (string-length str)]
[pt-stack (list)]
[dr-stack (list)])
(define (update-p p d c)
(case c
[(#\1) (+ p d)]
[(#\[) (set! pt-stack (cons p pt-stack))
p]
[(#\]) (let ([p* (first pt-stack)])
(set! pt-stack (rest pt-stack))
p*)]
[else p]))
(define (update-d d c)
(case c
[(#\+) (v+pol d 0 angle)]
[(#\-) (v+pol d 0 angle)]
[(#\[) (set! dr-stack (cons d dr-stack))
d]
[(#\]) (let ([d* (first dr-stack)])
(set! dr-stack (rest dr-stack))
d*)]
[else d]))
(define (pen-aux acc p d i)
(if (= i len)
(cons p acc)
(let* ([c (string-ref str i)]
[p* (update-p p d c)]
[d* (update-d d c)])
(if (eqv? c #\])
(pen-aux (if (> (length (first acc)) 1)
(cons (list p*) acc)
(cons (list p*) (rest acc)))
p* d*