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