图形语言

mit-scheme里没有直接提供wave和rogers这两个过程，但是DrRacket提供einstein，只需加上开头两行就可使用

#lang racket
(require (planet "sicp.ss"("soegaard""sicp.plt" 2 1)))
(define wave einstein)
(define wave2
  (beside wave (flip-vert wave)))
(define wave4
  (below wave2 wave2))
(define (right-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (right-split painter (- n 1))))
        (beside painter (below smaller smaller)))))
(define (up-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (up-split painter (- n 1))))
        (below painter (beside smaller smaller)))))
(define (corner-split painter n)
  (if (= n 0)
      painter
      (let ((up (up-split painter (- n 1)))
            (right (right-split painter (- n 1))))
        (let ((top-left (beside up up))
              (bottom-right (below right right))
              (corner (corner-split painter (- n 1))))
          (beside (below painter top-left)
                  (below bottom-right corner))))))
(define (square-limit painter n)
  (let ((corner (corner-split painter n)))
    (let ((half (below (flip-vert corner) corner)))
      (beside (flip-horiz half) half))))
;
(define (square-of-four tl tr bl br)
  (lambda (painter)
    (beside (below (bl painter) (tl painter))
            (below (br painter) (tr painter)))))
(define (corner-split2 painter n)
  (square-of-four (lambda (painter) (let ((half (up-split painter (- n 1))))
                                      (beside half half)))))
(define (identity x) x)
(define (flipped-pairs1 painter)
  ((square-of-four identity flip-vert
                  identity flip-vert)
   painter))
;2.45
(define (split step1 step2)
  (lambda (painter n)
    (if (= n 0)
        painter
        (let ((smaller ((split step1 step2) painter (- n 1))))
          (step1 painter
                 (step2 smaller smaller))))))
(define right-split1 (split beside below))
(define up-split1 (split below beside))
;框架
;2.46
(define (make-vect x y)
  (list x y))
(define (xcor-vect v)
  (car v))
(define (ycor-vect v)
  (cadr v))
(define (add-vect u v)
  (make-vect (+ (xcor-vect u) (xcor-vect v))
            (+ (ycor-vect u) (ycor-vect v))))
(define (sub-vect u v)
  (make-vect (- (xcor-vect u) (xcor-vect v))
            (- (ycor-vect u) (ycor-vect v))))
(define (scale-vect scale v)
  (make-vect (* scale (xcor-vect v))
            (* scale (ycor-vect v))))
(define (frame-coord-map frame)
  (lambda (v)
    (add-vect (origin-frame frame)
              (add-vect (scale-vect (xcor-vect v)
                               (edge1-frame frame))
                        (scale-vect (ycor-vect v)
                               (edge2-frame frame))))))
(define (make-frame origin edge1 edge2)
  (link orign edge1 edge2))
(define (orign-frame frame)
  (car frame))
(define (edge1 frame)
  (caddr frame))
(define (edge2 frame)
  (cadr frame))