blob: aa46f3c869c3447b50dedbbbe57ffe0ace2b44e8 (
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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
#lang racket
(provide
make-vect
xcor-vect
ycor-vect
add-vect
sub-vect
scale-vect
test-vect
origin-frame
edge1-frame
edge2-frame
test-frame
make-segment
start-segment
end-segment
paint
segments->painter
transform-painter
beside
einstein
flip-horiz
flip-vert
<-rotate180
<-rotate270
enumerate-corners
enumerate-segments
close-line
line-points->segments
up-split
right-split
below
square-of-four)
(require sicp-pict "lists.rkt")
(define (xcor-vect v)
(vector-xcor v))
(define (ycor-vect v)
(vector-ycor v))
(define (add-vect . v)
(make-vect
(fold-right + 0 (map xcor-vect v))
(fold-right + 0 (map ycor-vect v))))
(define (sub-vect . v)
(let ((xcors (map xcor-vect v))
(ycors (map ycor-vect v)))
(make-vect
(- (car xcors) (fold-right + 0 (cdr xcors)))
(- (car ycors) (fold-right + 0 (cdr ycors))))))
(define (scale-vect s v)
(make-vect (* s (xcor-vect v))
(* s (ycor-vect v))))
(define test-vect (make-vect 1 2))
(define (origin-frame frame)
(frame-origin frame))
(define (edge1-frame frame)
(frame-edge1 frame))
(define (edge2-frame frame)
(frame-edge2 frame))
(define test-frame (make-frame
(make-vect 1 2)
(make-vect 2 4)
(make-vect 3 6)))
(define (start-segment s)
(segment-start s))
(define (end-segment s)
(segment-end s))
(define (flip-horiz painter)
(transform-painter
painter
(make-vect 1 0)
(make-vect 0 0)
(make-vect 1 1)))
(define (flip-vert painter)
(transform-painter
painter
(make-vect 0 1)
(make-vect 1 1)
(make-vect 0 0)))
(define (<-rotate180 painter)
(flip-horiz (flip-vert painter)))
(define (<-rotate270 painter)
(transform-painter
painter
(make-vect 0 1)
(make-vect 0 0)
(make-vect 1 1)))
(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 (right-split painter n)
(if (= n 0)
painter
(let ((smaller (right-split painter (- n 1))))
(beside smaller (below smaller smaller)))))
(define (up-split painter n)
(if (= n 0)
painter
(let ((smaller (up-split painter (- n 1))))
(below smaller (beside smaller smaller)))))
(define (square-of-four tl tr bl br)
(lambda (painter)
(let ((t (beside (tl painter) (tr painter)))
(b (beside (bl painter) (br painter))))
(below b t))))
|
