summaryrefslogtreecommitdiffstats
path: root/net/ricketyspace
diff options
context:
space:
mode:
Diffstat (limited to 'net/ricketyspace')
-rw-r--r--net/ricketyspace/sicp/two/three.scm80
1 files changed, 80 insertions, 0 deletions
diff --git a/net/ricketyspace/sicp/two/three.scm b/net/ricketyspace/sicp/two/three.scm
new file mode 100644
index 0000000..8b18523
--- /dev/null
+++ b/net/ricketyspace/sicp/two/three.scm
@@ -0,0 +1,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))))