1 (define (right-split painter n)
2   (if (= n 0)
3       painter
4       (let ((smaller (right-split painter (- n 1))))
5 	(beside painter (below smaller smaller)))))
6 (define (corner-split painter n)
7   (if (= n 0)
8       painter
9       (let ((up (up-split painter (- n 1)))
10 	    (right (right-split painter (- n 1))))
11 	(let ((top-left (beside up up))
12 	      (bottom-right (below right right))
13 	      (corner (corner-split painter (- n 1))))
14 	  (beside (below painter top-left)
15 		  (below bottom-right corner))))))
16 (define (square-limit painter n)
17   (let ((quarter (corner-split painter n)))
18     (let ((half (beside (flip-horiz quarter) quarter)))
19       (below (flip-vert half) half))))
20 (define (up-split painter n)
21   (if (= n 0)
22       painter
23       (let ((up (up-split painter (- n 1))))
24 	(below painter (beside up up)))))
25 (define (square-of-four tl tr bl br)
26   (lambda (painter)
27     (let ((top (beside (tl painter) (tr painter)))
28 	  (bottom (beside (bl painter) (br painter))))
29       (below bottom top))))
30 
31 (define (flipped-pairs painter)
32   (let ((combine4 (square-of-four identity flip-vert
33 				  identity flip-vert)))
34     (combine4 painter)))
35 (define (square-limit painter n)
36   (let ((combine4 (square-of-four flip-horiz identity
37 				  rotate180 flip-vert)))
38     (combine4 (corner-split painter n))))
39 
40 (define (split op1 op2)
41   (define (split-n painter n)
42     (if (= n 0)
43 	painter
44 	(let ((split-painter (split-n painter (- n 1))))
45 	  (op1 painter (op2 split-painter split-painter)))))
46   split-n)
47 
48 (define right-split (split beside below))
49 (define up-split (split below beside))
50 
51 (define (frame-coord-map frame)
52   (lambda (v)
53     (add-vect
54      (origin-frame frame)
55      (add-vect (scale-vect (xcor-vect v)
56 			   (edge1-frame frame))
57 	       (scale-vect (ycor-vect v)
58 			   (edge2-frame frame))))))
59 
60 (define (make-vect xcor ycor)
61   (cons xcor ycor))
62 (define (xcor-vect v)
63   (car v))
64 (define (ycor-vect v)
65   (cdr v))
66 (define (add-vect v1 v2)
67   (make-vect (+ (xcor-vect v1) (xcor-vect v2))
68 	     (+ (ycor-vect v1) (ycor-vect v2))))
69 (define (sub-vect v1 v2)
70   (make-vect (- (xcor-vect v1) (xcor-vect v2))
71 	     (- (ycor-vect v1) (ycor-vect v2))))
72 (define (scale-vect s v)
73   (make-vect (* s (xcor-vect v))
74 	     (* x (ycor-vect v))))
75 
76 ;; Exercise 2.47.  Here are two possible constructors for frames:
77 
78 (define (make-frame origin edge1 edge2)
79   (list origin edge1 edge2))
80 (define (origin-frame frame)
81   (car frame))
82 (define (edge1-frame frame)
83   (cadr frame))
84 (define (edge2-frame frame)
85   (caddr frame))
86 
87 (define (segments->painter segment-list)
88   (lambda (frame)
89     (for-each
90      (lambda (segment)
91        (draw-line
92 	((frame-coord-map frame) (start-segment segment))
93 	((frame-coord-map frame) (end-segment segment))))
94      segment-list)))
95 
96 (define (make-vect xcor ycor)
97 (define (xcor-vect v)
98 (define (ycor-vect v)
99 (define (add-vect v1 v2)
100 (define (sub-vect v1 v2)
101 (define (scale-vect s v)
102 
103 
104 (define (make-segment start end)
105   (list start end))
106 (define (start-segment segment)
107   (car segment))
108 (define (end-segment segment)
109   (cadr segment))
110 
111 (segments->painter
112  (list (make-segment (make-vector 0.0 0.0) (make-vector 1.0 0.0))
113        (make-segment (make-vector 1.0 0.0) (make-vector 1.0 1.0))
114        (make-segment (make-vector 1.0 1.0) (make-vector 0.0 1.0))
115        (make-segment (make-vector 0.0 1.0) (make-vector 0.0 0.0))))
116 (segments->painter
117  (list (make-segment (make-vector 0.0 0.0) (make-vector 1.0 1.0))
118        (make-segment (make-vector 0.0 1.0) (make-vector 1.0 0.0))))
119 (segments->painter
120  (list (make-segment (make-vector 0.5 0.0) (make-vector 1.0 0.5))
121        (make-segment (make-vector 1.0 0.5) (make-vector 0.5 1.0))
122        (make-segment (make-vector 0.5 1.0) (make-vector 0.0 0.5))
123        (make-segment (make-vector 0.0 0.5) (make-vector 0.5 0.0))))
124 (segments->painter
125  (list (make-segment (make-vector 0.5 0.0) (make-vector 1.0 0.5))
126        (make-segment (make-vector 1.0 0.5) (make-vector 0.5 1.0))
127        (make-segment (make-vector 0.5 1.0) (make-vector 0.0 0.5))
128        (make-segment (make-vector 0.0 0.5) (make-vector 0.5 0.0))))
129 
130 ;; last one is too much trouble
131 
132 (define (transform-painter painter origin corner1 corner2)
133   (lambda (frame)
134     (let ((m (frame-coord-map frame)))
135       (let ((new-origin (m origin)))
136 	(painter
137 	 (make-frame new-origin
138 		     (sub-vect (m corner1) new-origin)
139 		     (sub-vect (m corner2) new-origin)))))))
140 (define (flip-vert painter)
141   (transform-painter painter
142 		     (make-vect 0.0 1.0)
143 		     (make-vect 1.0 1.0)
144 		     (make-vect 0.0 0.0)))
145 (define (shrink-to-upper-right painter)
146   (transform-painter painter
147 		     (make-vect 0.5 0.5)
148 		     (make-vect 1.0 0.5)
149 		     (make-vect 0.5 1.0)))
150 (define (rotate90 painter)
151   (transform-painter painter
152 		     (make-vect 1.0 0.0)
153 		     (make-vect 1.0 1.0)
154 		     (make-vect 0.0 0.0)))
155 (define (squash-inwards painter)
156   (transform-painter painter
157 		     (make-vect 0.0 0.0)
158 		     (make-vect 0.65 0.35)
159 		     (make-vect 0.35 0.65)))
160 (define (beside painter1 painter2)
161   (let ((split-point (make-vect 0.5 0.0)))
162     (let ((paint-left
163 	   (transform-painter painter1
164 			      (make-vect 0.0 0.0)
165 			      split-point
166 			      (make-vect 0.0 1.0)))
167 	  (paint-right 
168 	   (transform-painter painter2
169 			      split-point
170 			      (make-vect 1.0 0.0)
171 			      (make-vect 0.5 1.0))))
172       (lambda (frame)
173 	(paint-left frame)
174 	(paint-right frame)))))
175 
176 ;; Exercise 2.50.  Define the transformation flip-horiz, which flips painters horizontally, and transformations that rotate painters counterclockwise by 180 degrees and 270 degrees. 
177 
178 (define (flip-horiz painter)
179   (transform-painter painter
180 		     (make-vector 1.0 0.0)
181 		     (make-vector 0.0 0.0)
182 		     (make-vector 1.0 1.0)))
183 
184 (define (rotate180 painter)
185   (transform-painter painter
186 		     (make-vector 1.0 1.0)
187 		     (make-vector 0.0 1.0)
188 		     (make-vector 1.0 0.0)))
189 
190 (define (rotate270 painter)
191   (transform-painter painter
192 		     (make-vector 1.0 0.0)
193 		     (make-vector 1.0 1.0)
194 		     (make-vector 0.0 0.0)))
195 
196 ;; Exercise 2.51.  Define the below operation for painters. Below takes two painters as arguments. The resulting painter, given a frame, draws with the first painter in the bottom of the frame and with the second painter in the top. Define below in two different ways -- first by writing a procedure that is analogous to the beside procedure given above, and again in terms of beside and suitable rotation operations (from exercise 2.50). 
197 
198 (define (below bottom top)
199   (lambda (frame)
200     (let ((split-point (make-vector 0.0 0.5)))
201       (bot-transform (transform-painter bottom
202 					(make-vector 0.0 0.0)
203 					(make-vector 1.0 0.0)
204 					split-point))
205       (top-transform (transform-painter top
206 					split-point
207 					(make-vector 1.0 0.5)
208 					(make-vector 0.0 1.0)))
209       (bottom frame)
210       (top frame))))
211 (define (below bottom top)
212   (rotate90 (beside (rotate270 bottom) (rotate270 top))))
213 
214 (define (below painter1 painter2)
215   (let* ( (split-point (make-vect 0.0 0.5))
216 	  (paint-up
217 	   (transform-painter painter2
218 
219 ;;  Exercise 2.52.  Make changes to the square limit of wave shown in figure 2.9 by working at each of the levels described above. In particular:
220 
221 ;; c.  Modify the version of square-limit that uses square-of-four so as to assemble the corners in a different pattern. (For example, you might make the big Mr. Rogers look outward from each corner of the square.) 
222 
223 (define (square-limit painter n)
224   (let ((combine4 (square-of-four identity flip-horiz
225 				  flip-vert (compose flip-vert flip-horiz)))) 
226 ;;rotate180
227     (combine4 (corner-split painter n))))
228