lindenmayer/lindenmayer.rkt

#lang racket

(require graphics/value-turtles)
(require file/convertible)

(define start '(X))
(define forward 4)
(define theta 20)
(define generations 7)
(define thick 8)

(define (tend sym)
  (cond
    [(eq? sym 'F) '(F F)]
    [(eq? sym 'X) '(d F m l l X r p X r p F l p F X r m X)]
    [else `(,sym)]))

(define (season plant)
  (foldr append '()
         (map tend plant)))

(define (grow seed years)
  (if (<= years 0)
      seed
      (grow (season seed) (- years 1))))

(define init-turtle
  (set-pen-width (turtles 600 800 300 400 (/ pi -2))
                 thick))
(define state '())

(define (step-turtle op turtle)
  (cond
    [(eq? op 'F) (draw forward turtle)]
    [(eq? op 'm) (turn theta turtle)]
    [(eq? op 'p) (turn (* -1 theta) turtle)]
    [(eq? op 'u) (set-pen-width turtle
                   (+ 1 (turtles-pen-width turtle)))]
    [(eq? op 'd) (set-pen-width turtle
                   (- (turtles-pen-width turtle) 1))]
    [(eq? op 'l) (begin (set! state
                              (cons (turtle-state turtle)
                                    state))
                        (set! thick
                              (cons (turtles-pen-width turtle)
                                    thick))
                        turtle)]
    [(eq? op 'r) (let ([s (car state)]
                       [t (car thick)])
                   (begin 
                     (set! state (cdr state))
                     (set! thick (cdr thick))
                     (set-pen-width
                       (restore-turtle-state turtle s)
                       t)))]
    [else turtle]))

(define (run-turtle plant turtle)
  (if (null? plant)
    turtle
    (run-turtle (cdr plant)
                (step-turtle (car plant) turtle))))

(define (write-plant turtle filename)
  (let ([file (open-output-file filename #:exists 'replace)]
        [pict (convert (turtles-pict turtle) 'png-bytes)])
    (write-bytes pict file)))

(define (test-plant)
  (let ([plant (grow start generations)])
    (begin (set! state '())
           (write-plant (run-turtle plant init-turtle)
                        "test-plant.png"))))

(test-plant)