SICP学习笔记 2.2.4 实例：一个图形语言

    练习2.44

(define (up-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (up-split painter (- n 1))))
	      (below painter (beside smaller smaller)))))

   

    练习2.45

(define (split p1 p2)
  (lambda (painter)
    (let ((new (p2 painter painter)))
      (p1 painter new))))

 

    练习2.46

(define (make-vect x y)
  (cons x y))
(define (xcor-vect vect)
  (car vect))
(define (ycor-vect vect)
  (cdr vect))

(define (add-vect vect1 vect2)
  (make-vect (+ (xcor-vect vect1) (xcor-vect vect2))
	           (+ (ycor-vect vect1) (ycor-vect vect2))))
(define (sub-vect vect1 vect2)
  (make-vect (- (xcor-vect vect1) (xcor-vect vect2))
	           (- (ycor-vect vect1) (ycor-vect vect2))))
(define (scale-vect s vect)
  (make-vect (* s (xcor-vect vect))
             (* s (ycor-vect vect))))

 

    练习2.47

;; 针对list方式
(define (make-frame origin edge1 edge2)
  (list origin edge1 edge2))
(define (origin-frame frame)
  (car frame))
(define (edge1-frame frame)
  (car (cdr frame)))
(define (edge2-frame frame)
  (car (cdr (cdr frame))))
  
;; 只对cons方式
(define (make-frame origin edge1 edge2)
  (cons origin (cons edge1 edge2)))
(define (origin-frame frame)
  (car frame))
(define (edge1-frame frame)
  (car (cdr frame)))
(define (edge2-frame frame)
  (cdr (cdr frame)))

 

    练习2.48

(define (make-segment s-vect e-vect)
  (cons s-vect e-vect))
(define (start-segment segment)
  (car segment))
(define (end-segment segment)
  (cdr segment))

 

    练习2.49

(define outline-segments
  (list 
    (make-segment (make-vect 0 0) (make-vect 0 1))
	  (make-segment (make-vect 0 1) (make-vect 1 1))
	  (make-segment (make-vect 1 1) (make-vect 1 0))
	  (make-segment (make-vect 1 0) (make-vect 0 0))))
(define outline-painter (segments-painter outline-segments))

(define diagonal-segments
  (list 
    (make-segment (make-vect 0 0) (make-vect 1 1))
	  (make-segment (make-vect 0 1) (make-vect 1 0))))
(define diagonal-painter (segments-painter diagonal-segments))

(define diamonds-segments
  (list 
    (make-segment (make-vect 0.0 0.5) (make-vect 0.5 1.0))
	  (make-segment (make-vect 0.5 1.0) (make-vect 1.0 0.5))
	  (make-segment (make-vect 1.0 0.5) (make-vect 0.5 0.0))
	  (make-segment (make-vect 0.5 0.0) (make-vect 0.0 0.5))))
(define diamonds-painter (segments-painter diamonds-segments))

 

    练习2.50

(define (flip-horiz painter)
  (transform-painter painter
		     (make-vect 1.0 0.0)
		     (make-vect 0.0 0.0)
		     (make-vect 1.0 1.0)))
		     
(define (rotate180 painter)
  (transform-painter painter
		     (make-vect 1.0 1.0)
		     (make-vect 0.0 1.0)
		     (make-vect 1.0 0.0)))
		     
(define (rotate270 painter)
  (transform-painter painter
		     (make-vect 1.0 0.0)
		     (make-vect 1.0 1.0)
		     (make-vect 0.0 0.0)))
		     

 

    练习2.51

(define (below painter1 painter2)
  (let ((split-point (make-vect 0.0 0.5)))
    (let ((paint-up
	   (transform-painter painter2
			      (make-vect 0.0 0.0)
			      (make-vect 1.0 0.0)
			      split-point))
	  (paint-down
	   (transform-painter painter1
			      split-point
			      (make-vect 1.0 0.5)
			      (make-vect 0.0 1.0))))
      (lambda (frame)
	(paint-up frame)
	(paint-down frame)))))

(define (below painter1 painter2)
  (rotate90 (beside (rotate270 painter1) (rotate270 painter2))))

 

    练习2.52

;; 暂无