blob: 9ee7fe98cdd67b8e132abc822c8c34163ded94a3 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
#lang racket
(require "../../shared/pict.rkt")
(require "../../shared/lists.rkt")
(define (outline frame)
(let ((corner
(add-vect
(edge1-frame frame)
(edge2-frame frame)))
(origin (origin-frame frame))
(e1 (edge1-frame frame))
(e2 (edge2-frame frame)))
((segments->painter
(list (make-segment origin e1)
(make-segment e1 corner)
(make-segment corner e2)
(make-segment e2 origin))) frame)))
(paint outline)
(define (x frame)
((segments->painter
(list (make-segment (origin-frame frame)
(add-vect
(edge1-frame frame)
(edge2-frame frame)))
(make-segment (edge1-frame frame)
(edge2-frame frame))))
frame))
(paint x)
(define (midpoint-segment s)
(let ((start (start-segment s))
(end (end-segment s)))
(let ((midpoint
(make-vect
(/ (+ (xcor-vect end) (xcor-vect start)) 2)
(/ (+ (ycor-vect end) (ycor-vect start)) 2))))
midpoint)))
(define (enumerate-corners frame)
(list
(origin-frame frame)
(edge1-frame frame)
(add-vect
(edge1-frame frame)
(edge2-frame frame))
(edge2-frame frame)))
(define (close-line line-points)
(append line-points (list (car line-points))))
(define (enumerate-segments frame)
(map
(lambda (pair)
(make-segment (car pair) (cadr pair)))
(enumerate-windows
(close-line (enumerate-corners frame))
2)))
(define (line-points->segments points)
(map
(lambda (pair)
(make-segment (car pair) (cadr pair)))
(enumerate-windows
points
2)))
(define (diamond frame)
((segments->painter
(line-points->segments
(close-line
(map
midpoint-segment
(enumerate-segments frame)))))
frame))
(paint diamond)
(define (wave frame)
(let ((wave-points
(list
(make-vect 0.24 0)
(make-vect 0.37 0.5)
(make-vect 0.3 0.6)
(make-vect 0.15 0.5)
(make-vect 0 0.7)
(make-vect 0 0.85)
(make-vect 0.15 0.65)
(make-vect 0.35 0.7)
(make-vect 0.4 0.7)
(make-vect 0.3 0.85)
(make-vect 0.36 1)
(make-vect 0.57 1)
(make-vect 0.62 0.855)
(make-vect 0.55 0.7)
(make-vect 0.65 0.7)
(make-vect 1 0.35)
(make-vect 1 0.25)
(make-vect 0.55 0.52)
(make-vect 0.7 0)
(make-vect 0.55 0)
(make-vect 0.45 0.4)
(make-vect 0.34 0))))
((segments->painter
(append
(enumerate-segments frame)
(line-points->segments
(close-line
wave-points)))) frame)))
(paint wave)
|
