/examples/tendrils/source.scm

 1
 2;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 3
 4;; Original version in NodeBox:
 5;; 
 6;; http://www.nodebox.net/code/index.php/Tendrils
 7
 8;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 9
10(define (tendril pos width)
11
12  (let ((angle (- (random (* 2 pi)) pi))
13        (v 0)
14        (segments '()))
15
16    (let ((grow
17           (lambda (distance curl step)
18
19             (set! pos (pt+ pos (pt (* (cos angle) distance)
20                                    (* (sin angle) distance))))
21
22             (set! v (+ v (random (- step) step)))
23
24             (set! v (* v (+ 0.9 (* curl 0.1))))
25
26             (set! angle (+ angle v))
27
28             (set! segments (cons pos segments))))
29
30          (draw
31           (let ((draw-segment
32                  (lambda (fraction position)
33                    (let ((diameter (inexact (* fraction width))))
34                      (circle position diameter)))))
35             (lambda ()
36               (for-each-with-fraction draw-segment segments))))
37          )
38
39      (vector 'tendril grow draw))))
40
41(define (tendril-grow tendril distance curl step)
42  ((vector-ref tendril 1) distance curl step))
43
44(define (tendril-draw tendril)
45  ((vector-ref tendril 2)))
46
47;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
48
49(define (plant pos tendrils width)
50
51  (let ((tendrils (map (lambda (i)
52                         (tendril pos width))
53                       (iota tendrils))))
54
55    (let ((grow
56           (lambda (distance curl step)
57             (for-each (cut tendril-grow <> distance curl step) tendrils)))
58
59          (draw
60           (lambda ()
61             (for-each tendril-draw tendrils))))
62
63      (vector 'plant grow draw))))
64
65(define (plant-grow plant distance curl step)
66  ((vector-ref plant 1) distance curl step))
67
68(define (plant-draw plant)
69  ((vector-ref plant 2)))
70
71;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
72
73(size 600 600)
74
75(init-nodebox)
76
77(set! *draw*
78      (lambda ()
79        (background 0.12 0.12 0.06)
80        (no-fill)
81        (stroke 1 0.5)
82        (set! *stroke-width* 0.5)
83        (let ((plant (plant (pt (/ *width* 2) (/ *height* 2)) 20 15)))
84          (do-times 200 (lambda (i)
85                          (plant-grow plant 3.0 1.0 0.02)))
86          (plant-draw plant))))
87
88(run-nodebox)
89
90;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
91