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