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 (define top-left (make-vect
0.0 1.0))
51 (define top-right (make-vect
1.0 1.0))
52 (define bottom-left (make-vect
0.0 0.0))
53 (define bottom-right (make-vect
1.0 0.0))
54
55 (define top (make-segment top-left top-
right))
56 (define left (make-segment top-left bottom-
left))
57 (define right (make-segment top-right bottom-
right))
58 (define bottom (make-segment bottom-left bottom-
right))
59
60 (segment->
painter (list top bottom left right))
61
62 ;;;下同
转载于:https://www.cnblogs.com/tclan126/p/6427013.html
相关资源：数据结构—成绩单生成器
