blob: ca52e4ef87973a8601b5a0a92b4b3d676d79b5bb (
plain) (
blame)
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
82
83
84
85
86
87
88
89
90
|
#lang sicp
(#%require sicp-pict)
(define (flipped-pairs painter)
(let ((painter2 (beside painter (flip-vert painter))))
(below painter2 painter2)))
(define (right-spilt painter n)
(if (= n 0)
painter
(let ((smaller (right-spilt painter (dec n))))
(beside painter (below smaller smaller)))))
(define (up-split painter n)
(if (= n 0)
painter
(let ((smaller (up-split painter (dec n))))
(below painter (beside smaller smaller)))))
(define (corner-spilt painter n)
(if (= n 0)
painter
(let ((up (up-split painter (dec n)))
(right (right-spilt painter (dec n))))
(let ((top-left (beside up up))
(bottom-right (below right right))
(corner (corner-spilt painter (dec n))))
(beside (below painter top-left)
(below bottom-right corner))))))
(define (square-limit painter n)
(let ((quarter (corner-spilt painter n)))
(let ((half (beside (flip-horiz quarter) quarter)))
(below (flip-vert half) half))))
(define (square-of-four tl tr bl br)
(lambda (painter)
(let ((top (beside (tl painter) (tr painter)))
(bottom (beside (bl painter) (br painter))))
(below bottom top))))
(define (split children-parent children)
(lambda (parent n)
(if (= n 0)
parent
(let ((child ((split children-parent children) parent (dec n))))
(children-parent parent (children child child))))))
(define make-vect cons)
(define xcor-vect car)
(define ycor-vect cdr)
(define (add-vect v1 v2)
(make-vect (+ (xcor-vect v1) (xcor-vect v2))
(+ (ycor-vect v1) (ycor-vect v2))))
(define (sub-vect v1 v2)
(make-vect (- (xcor-vect v1) (xcor-vect v2))
(- (ycor-vect v1) (ycor-vect v2))))
(define (scale-vect s v)
(make-vect (* s (xcor-vect v))
(* s (ycor-vect v))))
(define (make-frame origin edge1 edge2)
(cons origin (cons edge1 edge2)))
(define origin-frame car)
(define edge1-frame cadr)
(define edge2-frame cddr)
(define (outline frame)
(segments->painter (list (make-segment (make-vect 0 0)
(make-vect 1 0))
(make-segment (make-vect 1 0)
(make-vect 1 1))
(make-segment (make-vect 1 1)
(make-vect 0 1))
(make-segment (make-vect 0 1)
(make-vect 0 0)))))
(define (xxx frame)
(segments->painter (list (make-segment (make-vect 0 0)
(make-vect 1 1))
(make-segment (make-vect 1 0)
(make-vect 0 1)))))
(define (diamond frame)
(segments->painter (list (make-segment (make-vect 0.5 0.0)
(make-vect 1.0 0.5))
(make-segment (make-vect 1.0 0.5)
(make-vect 0.5 1.0))
(make-segment (make-vect 0.5 1.0)
(make-vect 0.0 0.5))
(make-segment (make-vect 0.0 0.5)
(make-vect 0.5 0.0)))))
|
