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))