63 lines
1.6 KiB
Racket
63 lines
1.6 KiB
Racket
|
#lang racket
|
||
|
|
|
||
|
|
(require graphics/value-turtles)
|
||
|
|
(require file/convertible)
|
||
|
|
|
||
|
|
(define forward 3)
|
||
|
|
(define theta 20)
|
||
|
|
(define generations 6)
|
||
|
|
|
||
|
|
(define (tend sym)
|
||
|
|
(cond
|
||
|
|
[(eq? sym 'F) '(F F)]
|
||
|
|
[(eq? sym 'X) '(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))
|
||
|
|
1))
|
||
|
|
(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 'l) (begin (set! state
|
||
|
|
(cons (turtle-state turtle)
|
||
|
|
state))
|
||
|
|
turtle)]
|
||
|
|
[(eq? op 'r) (restore-turtle-state turtle
|
||
|
|
(begin (let ([s (car state)])
|
||
|
|
(set! state (cdr state))
|
||
|
|
s)))]
|
||
|
|
[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 '(X) generations)])
|
||
|
|
(begin (set! state '())
|
||
|
|
(write-plant (run-turtle plant init-turtle)
|
||
|
|
"test-plant.png"))))
|
||
|
|
|
||
|
|
(test-plant)
|