练习2.48-练习2.51

版权声明:本文为博主原创文章,转载请注明出处,谢谢!

版权声明:本文为博主原创文章,转载请注明出处:http://blog.jerkybible.com/2014/01/22/2014-01-22-练习2.48-练习2.51/

访问原文「练习2.48-练习2.51

1.练习2.48

1
2
3
4
5
6
7
8
(define (make-segment start end)
(cons start end))
(define (start-segment seg)
(car seg))
(define (end-segment seg)
(cdr seg))

2.练习2.49

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
(require (planet "sicp.ss" ("soegaard" "sicp.plt" 2 1)))
(define one 1.0)
(define origin (make-vect 0 0))
(define lower-right (make-vect one 0))
(define upper-left (make-vect 0 one))
(define upper-right (make-vect one one))
(define (outline frame)
((segments->painter (list (make-segment origin lower-right)
(make-segment lower-right upper-right)
(make-segment upper-right upper-left)
(make-segment upper-left origin)))
frame))
(define seg1 (make-segment origin upper-right))
(define seg2 (make-segment upper-left lower-right))
(define (diamond frame)
((segments->painter (list (make-segment (make-vect 0 0.5) (make-vect 0.5 0))
(make-segment (make-vect 0.5 0) (make-vect 0.99 0.5))
(make-segment (make-vect 0.99 0.5) (make-vect 0.5 0.99))
(make-segment (make-vect 0.5 0.99) (make-vect 0 0.5))))
frame))
(define (wave frame)
((segments->painter (list
(make-segment (make-vect 0.4 1.0) ; 头部左上
(make-vect 0.35 0.85))
(make-segment (make-vect 0.35 0.85) ; 头部左下
(make-vect 0.4 0.64))
(make-segment (make-vect 0.4 0.65) ; 左肩
(make-vect 0.25 0.65))
(make-segment (make-vect 0.25 0.65) ; 左手臂上部
(make-vect 0.15 0.6))
(make-segment (make-vect 0.15 0.6) ; 左手上部
(make-vect 0.0 0.85))
(make-segment (make-vect 0.0 0.65) ; 左手下部
(make-vect 0.15 0.35))
(make-segment (make-vect 0.15 0.35) ; 左手臂下部
(make-vect 0.25 0.6))
(make-segment (make-vect 0.25 0.6) ; 左边身体
(make-vect 0.35 0.5))
(make-segment (make-vect 0.35 0.5) ; 左腿外侧
(make-vect 0.25 0.0))
(make-segment (make-vect 0.6 1.0) ; 头部右上
(make-vect 0.65 0.85))
(make-segment (make-vect 0.65 0.85) ; 头部右下
(make-vect 0.6 0.65))
(make-segment (make-vect 0.6 0.65) ; 右肩
(make-vect 0.75 0.65))
(make-segment (make-vect 0.75 0.65) ; 右手上部
(make-vect 1.0 0.3))
(make-segment (make-vect 1.0 0.15) ; 右手下部
(make-vect 0.6 0.5))
(make-segment (make-vect 0.6 0.5) ; 右腿外侧
(make-vect 0.75 0.0))
(make-segment (make-vect 0.4 0.0) ; 左腿内侧
(make-vect 0.5 0.3))
(make-segment (make-vect 0.6 0.0) ; 右腿内侧
(make-vect 0.5 0.3)))
)
frame))

3.练习2.50

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
(define (flip-horiz-my painter)
((transform-painter (make-vect 1.0 0.0)
(make-vect 0.0 0.0)
(make-vect 1.0 1.0))
painter))
(define (contrarotate180 painter)
((transform-painter (make-vect 1.0 1.0)
(make-vect 0.0 1.0)
(make-vect 1.0 0.0))
painter))
(define (contrarotate270 painter)
((transform-painter (make-vect 0.0 1.0)
(make-vect 0.0 0.0)
(make-vect 1.0 1.0))
painter))

4.练习2.51

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
(define (below-my painter1 painter2)
(let ((split-point (make-vect 0.0 0.5)))
(let ((paint-up
((transform-painter (make-vect 0.0 0.0)
(make-vect 1.0 0.0)
split-point)
painter1))
(paint-down
((transform-painter split-point
(make-vect 1.0 0.5)
(make-vect 0.0 1.0))
painter2)))
(lambda (frame)
(paint-up frame)
(paint-down frame)))))
(paint (below-my einstein einstein))
(paint (rotate90 (beside (rotate270 einstein) (rotate270 einstein))))

5.练习2.52

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
(define (wave frame)
((segments->painter (list
(make-segment (make-vect 0.4 1.0) ; 头部左上
(make-vect 0.35 0.85))
(make-segment (make-vect 0.35 0.85) ; 头部左下
(make-vect 0.4 0.64))
(make-segment (make-vect 0.4 0.65) ; 左肩
(make-vect 0.25 0.65))
(make-segment (make-vect 0.25 0.65) ; 左手臂上部
(make-vect 0.15 0.6))
(make-segment (make-vect 0.15 0.6) ; 左手上部
(make-vect 0.0 0.85))
(make-segment (make-vect 0.0 0.65) ; 左手下部
(make-vect 0.15 0.35))
(make-segment (make-vect 0.15 0.35) ; 左手臂下部
(make-vect 0.25 0.6))
(make-segment (make-vect 0.25 0.6) ; 左边身体
(make-vect 0.35 0.5))
(make-segment (make-vect 0.35 0.5) ; 左腿外侧
(make-vect 0.25 0.0))
(make-segment (make-vect 0.6 1.0) ; 头部右上
(make-vect 0.65 0.85))
(make-segment (make-vect 0.65 0.85) ; 头部右下
(make-vect 0.6 0.65))
(make-segment (make-vect 0.6 0.65) ; 右肩
(make-vect 0.75 0.65))
(make-segment (make-vect 0.75 0.65) ; 右手上部
(make-vect 1.0 0.3))
(make-segment (make-vect 1.0 0.15) ; 右手下部
(make-vect 0.6 0.5))
(make-segment (make-vect 0.6 0.5) ; 右腿外侧
(make-vect 0.75 0.0))
(make-segment (make-vect 0.4 0.0) ; 左腿内侧
(make-vect 0.5 0.3))
(make-segment (make-vect 0.6 0.0) ; 右腿内侧
(make-vect 0.5 0.3))
(make-segment (make-vect 0.5 0.75) ; 笑脸左
(make-vect 0.45 0.8))
(make-segment (make-vect 0.5 0.75) ; 笑脸右
(make-vect 0.55 0.8)))
)
frame))
(define (up-split painter n)
(if (= n 0)
painter
(let ((smaller (up-split painter (- n 1))))
(below painter (below smaller smaller)))))
(define (right-split painter n)
(if (= n 0)
painter
(let ((smaller (right-split painter (- n 1))))
(beside painter (below smaller smaller)))))
(define (beside-same-painter painter)
(beside painter painter))
(define (below-same-painter painter)
(below painter painter))
(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-same-painter up))
(bottom-right (below-same-painter right))
(corner (corner-split painter (- n 1))))
(beside (below painter top-left)
(below bottom-right corner))))))
(define (square-list painter n)
(let ((quarter (corner-split (flip-horiz painter) n)))
(let ((half (beside (flip-horiz quarter) quarter)))
(below (flip-vert half) half))))
Jerky Lu wechat
欢迎加入微信公众号