scheme的画家问题

本节是一个语言实例,通过一种图形语言展示数据抽象和闭包。
我们对一副图像(或者说画)的操作很难涉及到图像内部的东西,因此我们可以将这副图像视作一个过程,我们在不对该过程本身进行操作情况下也可以影响该过程。
练习2.44

点击查看代码
;在原有图像上方生成两个一样的图像
(define (up-split painter n)
    (if (= n 0)
        painter
        (let ((smaller (up-solit painter (- n 1))))
            (below painter (besider smaller smaller)))))
练习2.46
点击查看代码
(define (make-vect xcor ycor)
    (cons xcor ycor))
(define (add-vect v1 v2)
    (cons ( + (car v1) (car v2))
          ( + (cdr v1) (cdr v2))))
(define (sub-vect v1 v2)
    (cons ( - (car v1) (car v2))
          ( - (cdr v1) (cdr v2))))
(define (scale-vect s v1)
    (cons ( * s (car v1))
          ( * s (cdr v1))))
练习2.47
点击查看代码
(define (make-frame-1 origin edge1 edge2)
    (list origin edge1 edge2))
(define (origin-frame frame)
    (car frame))
(define (edge1-frame frame)
    (cadr frame))
(define (edge2-frame frame)
    (cadr (cdr frame)))

练习2.48

点击查看代码
(define (make-segment start end)
    (cons start end))
(define (start-segment s)
    (car s))
(define (end-segment s)
    (cdr s))
练习2.49
点击查看代码
(define frame-painter
    (segments->painter list (make-segment (make-vect 0 0)(make-vect 0 1))
          (make-segment (make-vect 0 0)(make-vect 1 0))
          (make-segment (make-vect 0 1)(make-vect 1 1))
          (make-segment (make-vect 1 0)(make-vect 1 1))))
(define cross-painter
    (list (make-segment (make-vect 0 0)(make-vect 1 1))
          (make-segment (make-vect 0 1)(make-vect 1 0))))
(define diamond-painter
    (segments->painter list 
          (make-segment (make-vect 0 0.5)(make-vect 0.5 1))
          (make-segment (make-vect 0.5 1)(make-vect 1 0.5))
          (make-segment (make-vect 0.5 0)(make-vect 1 0.5))
          (make-segment (make-vect 0.5 0)(make-vect 0 0.5))))

练习2.51

点击查看代码
(define (below painter1 painter2)
    (let ((spilt-point (make-vect 0.0 0.5)))
        (let ((paint-up
                (transform-painter painter1
                                    spilt-pointer
                                    (make-vect 1.0 0.5)
                                    (make-vect 0.0 1.0)))
               (paint-down
                (transform-painter painter2
                                    (make-vect 0.0 0.0)
                                    spilt-pointer
                                    (make-vect 0.0 1.0))))
            (lambda(frame) (paint-up frame)(paint-down frame)))))
(define (beside-2 painter1 painter2)
     (rotate90 (beside (rotate270 painter1) (rotate270 painter2))))

练习2.52 强健设计的语言层次(分层设计) a)给wave加上一个笑脸 wave写起来太麻烦了,我选择放过他 b)修改corner-split的构造模式 原有的:
点击查看代码
(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 (corner-split painter n)
    (if (= n 0)
        painter
        (let ((up (up-split painter (- n 1)))
              (right (right-split painter (- n 1)))
              (corner (corner-split painter (- n 1))))
            (beside (below painter up)
                    (below right corner)))))

c) 修改square-limit,换一种使用square-of-four的方式,以另一种不同模式组合起各个角区。

点击查看代码
(define (square-of-four tl tr bl br)
    (lambda (painter)
        (let ((top (beside (tl painter) (tr painter))))
             ((bottom (beside (bl painter) (br painter))))
            (below bottom top))))
(define (square-limit painter n)
    (let ((combine4 (square-of-four idenity flip-horiz
                                    flip-vert rotate180)))
        (combine4 (corner-split painter n))))
posted @ 2025-12-25 12:39  檐上落白luckin  阅读(4)  评论(0)    收藏  举报