; ======================================================================
;
; Structure and Interpretation of Computer Programs
; (trial answer to excercises)
;
; 计算机程序的构造和解释(习题试解)
;
; created: code17 08/20/05
; modified:
; (保持内容完整不变前提下，可以任意转载)
; ======================================================================
;; SICP No.2.49
(define (mid v1 v2) (scale-vect 1/2 (add-vect v1 v2)))
(define bl (make-vect 0 0))
(define
br (make-vect 0 1))
(define tl (make-vect 1 0))
(define tr (make-vect 1 1))
(define bm (mid bl br))
(define tm (mid tl tr))
(define lm (mid bl tl))
(define rm (mid br tr))
;; a
(define outline-segments
(list (make-segment bl br) (make-segment br tr)
(make-segment tr tl) (make-segment tl bl)))
(define outline-painter (segments->painter outline-segments))
;; b
(define oppcorner-segments
(list (make-segment bl tr) (make-segment tl br)))
(define oppcorner-painter (segments->painter oppcorner-segments))
;; c
(define diamond-segments
(list (make-segment bm rm) (make-segment rm tm)
(make-segment tm lm) (make-segment lm bm)))
(define diammond-painter (segments->painter diamond-segments))
;;d
(define wave
(let ((p01 (make-vect 0.40 1.00)) (p02 (make-vect 0.60 1.00))
(p03 (make-vect 0.00 0.80)) (p04 (make-vect 0.35 0.80))
(p05 (make-vect 0.65 0.80)) (p06 (make-vect 0.00 0.60))
(p07 (make-vect 0.30 0.60)) (p08 (make-vect 0.40 0.60))
(p09 (make-vect 0.60 0.60)) (p10 (make-vect 0.70 0.60))
(p11 (make-vect 0.20 0.55)) (p12 (make-vect 0.30 0.55))
(p13 (make-vect 0.35 0.50)) (p14 (make-vect 0.65 0.50))
(p15 (make-vect 0.20 0.45)) (p16 (make-vect 1.00 0.40))
(p17 (make-vect 0.50 0.20)) (p18 (make-vect 1.00 0.20))
(p19 (make-vect 0.25 0.00)) (p20 (make-vect 0.40 0.00))
(p21 (make-vect 0.60 0.00)) (p22 (make-vect 0.75 0.00)))
(let ((wave-outline
(list (make-segment p01 p04) (make-segment p04 p08)
(make-segment p07 p11) (make-segment p08 p07)
(make-segment p11 p03) (make-segment p06 p15)
(make-segment p15 p12) (make-segment p12 p13)
(make-segment p13 p19) (make-segment p20 p17)
(make-segment p17 p21) (make-segment p22 p14)
(make-segment p14 p18) (make-segment p16 p10)
(make-segment p10 p09) (make-segment p09 p05)
(make-segment p05 p02))))
(segments->painter wave-outline))))
