1 665c255d 2023-08-04 jrmu (define (right-split painter n)
  2 665c255d 2023-08-04 jrmu   (if (= n 0)
  3 665c255d 2023-08-04 jrmu       painter
  4 665c255d 2023-08-04 jrmu       (let ((smaller (right-split painter (- n 1))))
  5 665c255d 2023-08-04 jrmu 	(beside painter (below smaller smaller)))))
  6 665c255d 2023-08-04 jrmu (define (corner-split painter n)
  7 665c255d 2023-08-04 jrmu   (if (= n 0)
  8 665c255d 2023-08-04 jrmu       painter
  9 665c255d 2023-08-04 jrmu       (let ((up (up-split painter (- n 1)))
 10 665c255d 2023-08-04 jrmu 	    (right (right-split painter (- n 1))))
 11 665c255d 2023-08-04 jrmu 	(let ((top-left (beside up up))
 12 665c255d 2023-08-04 jrmu 	      (bottom-right (below right right))
 13 665c255d 2023-08-04 jrmu 	      (corner (corner-split painter (- n 1))))
 14 665c255d 2023-08-04 jrmu 	  (beside (below painter top-left)
 15 665c255d 2023-08-04 jrmu 		  (below bottom-right corner))))))
 16 665c255d 2023-08-04 jrmu (define (square-limit painter n)
 17 665c255d 2023-08-04 jrmu   (let ((quarter (corner-split painter n)))
 18 665c255d 2023-08-04 jrmu     (let ((half (beside (flip-horiz quarter) quarter)))
 19 665c255d 2023-08-04 jrmu       (below (flip-vert half) half))))
 20 665c255d 2023-08-04 jrmu (define (up-split painter n)
 21 665c255d 2023-08-04 jrmu   (if (= n 0)
 22 665c255d 2023-08-04 jrmu       painter
 23 665c255d 2023-08-04 jrmu       (let ((up (up-split painter (- n 1))))
 24 665c255d 2023-08-04 jrmu 	(below painter (beside up up)))))
 25 665c255d 2023-08-04 jrmu (define (square-of-four tl tr bl br)
 26 665c255d 2023-08-04 jrmu   (lambda (painter)
 27 665c255d 2023-08-04 jrmu     (let ((top (beside (tl painter) (tr painter)))
 28 665c255d 2023-08-04 jrmu 	  (bottom (beside (bl painter) (br painter))))
 29 665c255d 2023-08-04 jrmu       (below bottom top))))
 30 665c255d 2023-08-04 jrmu 
 31 665c255d 2023-08-04 jrmu (define (flipped-pairs painter)
 32 665c255d 2023-08-04 jrmu   (let ((combine4 (square-of-four identity flip-vert
 33 665c255d 2023-08-04 jrmu 				  identity flip-vert)))
 34 665c255d 2023-08-04 jrmu     (combine4 painter)))
 35 665c255d 2023-08-04 jrmu (define (square-limit painter n)
 36 665c255d 2023-08-04 jrmu   (let ((combine4 (square-of-four flip-horiz identity
 37 665c255d 2023-08-04 jrmu 				  rotate180 flip-vert)))
 38 665c255d 2023-08-04 jrmu     (combine4 (corner-split painter n))))
 39 665c255d 2023-08-04 jrmu 
 40 665c255d 2023-08-04 jrmu (define (split op1 op2)
 41 665c255d 2023-08-04 jrmu   (define (split-n painter n)
 42 665c255d 2023-08-04 jrmu     (if (= n 0)
 43 665c255d 2023-08-04 jrmu 	painter
 44 665c255d 2023-08-04 jrmu 	(let ((split-painter (split-n painter (- n 1))))
 45 665c255d 2023-08-04 jrmu 	  (op1 painter (op2 split-painter split-painter)))))
 46 665c255d 2023-08-04 jrmu   split-n)
 47 665c255d 2023-08-04 jrmu 
 48 665c255d 2023-08-04 jrmu (define right-split (split beside below))
 49 665c255d 2023-08-04 jrmu (define up-split (split below beside))
 50 665c255d 2023-08-04 jrmu 
 51 665c255d 2023-08-04 jrmu (define (frame-coord-map frame)
 52 665c255d 2023-08-04 jrmu   (lambda (v)
 53 665c255d 2023-08-04 jrmu     (add-vect
 54 665c255d 2023-08-04 jrmu      (origin-frame frame)
 55 665c255d 2023-08-04 jrmu      (add-vect (scale-vect (xcor-vect v)
 56 665c255d 2023-08-04 jrmu 			   (edge1-frame frame))
 57 665c255d 2023-08-04 jrmu 	       (scale-vect (ycor-vect v)
 58 665c255d 2023-08-04 jrmu 			   (edge2-frame frame))))))
 59 665c255d 2023-08-04 jrmu 
 60 665c255d 2023-08-04 jrmu (define (make-vect xcor ycor)
 61 665c255d 2023-08-04 jrmu   (cons xcor ycor))
 62 665c255d 2023-08-04 jrmu (define (xcor-vect v)
 63 665c255d 2023-08-04 jrmu   (car v))
 64 665c255d 2023-08-04 jrmu (define (ycor-vect v)
 65 665c255d 2023-08-04 jrmu   (cdr v))
 66 665c255d 2023-08-04 jrmu (define (add-vect v1 v2)
 67 665c255d 2023-08-04 jrmu   (make-vect (+ (xcor-vect v1) (xcor-vect v2))
 68 665c255d 2023-08-04 jrmu 	     (+ (ycor-vect v1) (ycor-vect v2))))
 69 665c255d 2023-08-04 jrmu (define (sub-vect v1 v2)
 70 665c255d 2023-08-04 jrmu   (make-vect (- (xcor-vect v1) (xcor-vect v2))
 71 665c255d 2023-08-04 jrmu 	     (- (ycor-vect v1) (ycor-vect v2))))
 72 665c255d 2023-08-04 jrmu (define (scale-vect s v)
 73 665c255d 2023-08-04 jrmu   (make-vect (* s (xcor-vect v))
 74 665c255d 2023-08-04 jrmu 	     (* x (ycor-vect v))))
 75 665c255d 2023-08-04 jrmu 
 76 665c255d 2023-08-04 jrmu ;; Exercise 2.47.  Here are two possible constructors for frames:
 77 665c255d 2023-08-04 jrmu 
 78 665c255d 2023-08-04 jrmu (define (make-frame origin edge1 edge2)
 79 665c255d 2023-08-04 jrmu   (list origin edge1 edge2))
 80 665c255d 2023-08-04 jrmu (define (origin-frame frame)
 81 665c255d 2023-08-04 jrmu   (car frame))
 82 665c255d 2023-08-04 jrmu (define (edge1-frame frame)
 83 665c255d 2023-08-04 jrmu   (cadr frame))
 84 665c255d 2023-08-04 jrmu (define (edge2-frame frame)
 85 665c255d 2023-08-04 jrmu   (caddr frame))
 86 665c255d 2023-08-04 jrmu 
 87 665c255d 2023-08-04 jrmu (define (segments->painter segment-list)
 88 665c255d 2023-08-04 jrmu   (lambda (frame)
 89 665c255d 2023-08-04 jrmu     (for-each
 90 665c255d 2023-08-04 jrmu      (lambda (segment)
 91 665c255d 2023-08-04 jrmu        (draw-line
 92 665c255d 2023-08-04 jrmu 	((frame-coord-map frame) (start-segment segment))
 93 665c255d 2023-08-04 jrmu 	((frame-coord-map frame) (end-segment segment))))
 94 665c255d 2023-08-04 jrmu      segment-list)))
 95 665c255d 2023-08-04 jrmu 
 96 665c255d 2023-08-04 jrmu (define (make-vect xcor ycor)
 97 665c255d 2023-08-04 jrmu (define (xcor-vect v)
 98 665c255d 2023-08-04 jrmu (define (ycor-vect v)
 99 665c255d 2023-08-04 jrmu (define (add-vect v1 v2)
100 665c255d 2023-08-04 jrmu (define (sub-vect v1 v2)
101 665c255d 2023-08-04 jrmu (define (scale-vect s v)
102 665c255d 2023-08-04 jrmu 
103 665c255d 2023-08-04 jrmu 
104 665c255d 2023-08-04 jrmu (define (make-segment start end)
105 665c255d 2023-08-04 jrmu   (list start end))
106 665c255d 2023-08-04 jrmu (define (start-segment segment)
107 665c255d 2023-08-04 jrmu   (car segment))
108 665c255d 2023-08-04 jrmu (define (end-segment segment)
109 665c255d 2023-08-04 jrmu   (cadr segment))