76 lines
2.1 KiB
Racket
76 lines
2.1 KiB
Racket
#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)
|