sicp
view painting/2.49.scm @ 131:5c4be40d9cfe
Polynomial package and 2.87, 2.88.
| author | Dmitry Dzhus <dima@sphinx.net.ru> |
|---|---|
| date | Tue Oct 06 21:30:19 2009 +0400 (5 months ago) |
| parents | 1fe149ef1213 |
| children |
line source
1 (load "2.46.scm")
2 (load "2.47.scm")
3 (load "2.48.scm")
4 (load "cairo.scm")
6 (define (frame-coord-map frame)
7 (lambda (vector)
8 (add-vect
9 (origin frame)
10 (add-vect
11 (scale-vect (edge1 frame) (x-vect vector))
12 (scale-vect (edge2 frame) (y-vect vector))))))
14 ;; Fun(ky)ctional painter production!
15 (define (segments->painter segment-list)
16 (lambda (frame)
17 (lambda (drawing)
18 (if (null? segment-list)
19 drawing
20 (((segments->painter (cdr segment-list))
21 frame)
22 ((draw-segment
23 (let ((segment (car segment-list)))
24 (make-segment
25 ((frame-coord-map frame) (start-segment segment))
26 ((frame-coord-map frame) (end-segment segment)))))
27 drawing))))))
29 (define stroke-border
30 (segments->painter
31 (make-path
32 (make-vect 0 0)
33 (make-vect 1 0)
34 (make-vect 1 1)
35 (make-vect 0 1)
36 (make-vect 0 0))))
38 (define draw-cross
39 (segments->painter
40 (list
41 (make-segment (make-vect 0 0)
42 (make-vect 1 1))
43 (make-segment (make-vect 1 0)
44 (make-vect 0 1)))))
46 (define rhombus
47 (segments->painter
48 (make-path
49 (make-vect 0 0.5)
50 (make-vect 0.5 0)
51 (make-vect 1 0.5)
52 (make-vect 0.5 1)
53 (make-vect 0 0.5))))
55 (define wave
56 (segments->painter
57 (make-path
58 (make-vect 0 0.75)
59 (make-vect 0.50 0.25)
60 (make-vect 0.75 0.75)
61 (make-vect 1 0.25))))