SICP_2.48-2.49

 1 #lang sicp
 2 
 3 (#%require sicp-pict)
 4 
 5 (define (make-vect a b)
 6   (cons a b))
 7 
 8 (define (xcor-vect v)
 9   (car v))
10 
11 (define (ycor-vect v)
12   (cdr v))
13 
14 (define (add-vect v1 v2)
15   (make-vect (+ (xcor-vect v1)
16                 (xcor-vect v2))
17              (+ (ycor-vect v1)
18                 (ycor-vect v2))))
19 
20 (define (sub-vect v1 v2)
21   (make-vect (- (xcor-vect v1)
22                 (xcor-vect v2))
23              (- (ycor-vect v1)
24                 (ycor-vect v2))))
25 
26 (define (scale-vect s v1)
27   (make-vect (* s (xcor-vect v1))
28              (* s (ycor-vect v1))))
29 
30 ;;;;;;;;;;;;;;;;;;;2.48
31 (define (make-segment start end)
32   (make-vect start end))
33 
34 (define (start-segment segment)
35   (car segment))
36 
37 (define (end-segment segment)
38   (cdr segment))
39 
40 ;;;;;;;;;;;;;;;;;;;2.49
41 (define (segment->painter segment-list)
42   (lambda (frame)
43     (for-each
44      (lambda (segment)
45        (draw-line
46         ((frame-coord-map frame) (start-segment segment))
47         ((frame-coord-map frame) (end-segment segmnet))))
48      segment-list)))
49 
50 
51 (define segment-list1 (list
52                        (make-segment (make-vect (cons 0 0)
53                                                 (cons 0 0))
54                                      (make-vect (cons 0 0)
55                                                 (cons 1 0)))
56                        (make-segment (make-vect (cons 0 0)
57                                                 (cons 1 0))
58                                      (make-vect (cons 0 0)
59                                                 (cons 1 1)))
60                        (make-segment (make-vect (cons 0 0)
61                                                 (cons 1 1))
62                                      (make-vect (cons 0 0)
63                                                 (cons 0 1)))
64                        (make-segment (make-vect (cons 0 0)
65                                                 (cons 0 1))
66                                      (make-vect (cons 0 0)
67                                                 (cons 0 0)))))
68 
69 (define segment-list2 (list
70                        (make-segment (make-vect (cons 0 0)
71                                                 (cons 0 0))
72                                      (make-vect (cons 0 0)
73                                                 (cons 1 1)))
74                        (make-segment (make-vect (cons 0 0)
75                                                 (cons 1 0))
76                                      (make-vect (cons 0 0)
77                                                 (cons 0 1)))))
78 
79 (define segment-list3 (list
80                         (make-segment (make-vect (cons 0 0)
81                                                  (cons (/ 1 2) 0))
82                                       (make-vect (cons 0 0)
83                                                  (cons 1 (/ 1 2))))
84                         (make-segment (make-vect (cons 0 0)
85                                                  (cons 1 (/ 1 2)))
86                                       (make-vect (cons 0 0)
87                                                  (cons (/ 1 2) 1)))
88                         (make-segment (make-vect (cons 0 0)
89                                                  (cons (/ 1 2) 1))
90                                       (make-vect (cons 0 0)
91                                                  (cons 0 (/ 1 2))))
92                         (make-segment (make-vect (cons 0 0)
93                                                  (cons 0 (/ 1 2)))
94                                       (make-vect (cons 0 0)
95                                                  (cons (/ 1 2) 0)))))
96 ;;;wave 略