simple lindenmayer systems
Nevar pievienot vairāk kā 25 tēmas
Tēmai ir jāsākas ar burtu vai ciparu, tā var saturēt domu zīmes ('-') un var būt līdz 35 simboliem gara.
|
- #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)
|