图形语言

来源:互联网 发布:qq头像透明软件 编辑:程序博客网 时间:2024/05/16 14:39

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