blob: 8b1852310f1fc55ad0fd474a51a9277ce326c4f8 (
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
|
;;;; Under Creative Commons Attribution-ShareAlike 4.0
;;;; International. See
;;;; <https://creativecommons.org/licenses/by-sa/4.0/>.
(define-module (net ricketyspace sicp two three)
#:use-module (net ricketyspace sicp two two)
#:export (rectangle-make
rectangle-make-alt
rectangle-area
rectangle-perimeter))
;;;;
;;;;
;;;; Visual representation of the rectangle.
;;;;
;;;; 3 2
;;;; l2
;;;; +----------------+
;;;; | |
;;;; w2 | | w1 width
;;;; | |
;;;; +----------------+
;;;; start l1
;;;; 0 1
;;;; length
;;;;
;;; Rectangle constructors.
(define (rectangle-make length width start)
(define TYPE 0)
(define p0 start)
(define p1 (make-point (+ (x-point p0) length)
(y-point p0)))
(define p2 (make-point (+ (x-point p0) length)
(+ (y-point p0) width)))
(define p3 (make-point (x-point p0)
(+ (y-point p0) width)))
(list TYPE
(make-segment p0 p1) ;l1
(make-segment p1 p2) ;w1
(make-segment p3 p2) ;l2
(make-segment p0 p3))) ;w2
(define (rectangle-make-alt length width start)
(define TYPE 1)
(list TYPE length width start))
;;; Rectangle selectors.
(define (rectangle-type rect)
(car rect))
(define (rectangle-length rect)
(let ((type (rectangle-type rect))
(l (cadr rect)))
(cond ((= type 0) (- (x-point (end-segment l))
(x-point (start-segment l))))
((= type 1) l)
(else (error "Unknown rectangle type")))))
(define (rectangle-width rect)
(let ((type (rectangle-type rect))
(w (caddr rect)))
(cond ((= type 0) (- (y-point (end-segment w))
(y-point (start-segment w))))
((= type 1) w)
(else (error "Unknown rectangle type")))))
;;; Rectangle utils.
(define (rectangle-area rect)
"Returns area of rectangle RECT"
(* (rectangle-length rect) (rectangle-width rect)))
(define (rectangle-perimeter rect)
"Returns perimeter of rectangle RECT"
(* 2 (+ (rectangle-length rect) (rectangle-width rect))))
|
