initial commit
This commit is contained in:
commit
431b0bed4b
35
README.md
Normal file
35
README.md
Normal file
@ -0,0 +1,35 @@
|
|||||||
|
# Lindenmayer Turtle Generator
|
||||||
|
|
||||||
|
draws a lindenmayer system using simple turtle graphics.
|
||||||
|
|
||||||
|
currently very basic, models the following system:
|
||||||
|
|
||||||
|
```
|
||||||
|
# genesis
|
||||||
|
X
|
||||||
|
|
||||||
|
# rules
|
||||||
|
F -> FF
|
||||||
|
X -> X -> F-[[X]+X]+F[+FX]-X
|
||||||
|
```
|
||||||
|
|
||||||
|
is also slow and badly written, ¯\_(ツ)_/¯
|
||||||
|
|
||||||
|
## dependencies
|
||||||
|
|
||||||
|
```
|
||||||
|
raco pkg install htdp-lib
|
||||||
|
raco pkg install pict-lib
|
||||||
|
```
|
||||||
|
|
||||||
|
## running
|
||||||
|
|
||||||
|
> WARNING: will overwrite 'test-plant.png' in working directory
|
||||||
|
|
||||||
|
```
|
||||||
|
racket lindenmayer.rkt
|
||||||
|
```
|
||||||
|
|
||||||
|
## author
|
||||||
|
|
||||||
|
theArborist
|
62
lindenmayer.rkt
Normal file
62
lindenmayer.rkt
Normal file
@ -0,0 +1,62 @@
|
|||||||
|
#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)
|
BIN
test-plant.png
Normal file
BIN
test-plant.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 30 KiB |
Loading…
Reference in New Issue
Block a user