sicp

sicp sandbox.
git clone git://git.ricketyspace.net/sicp.git
Log | Files | Refs

commit 0cb7345537c7fb0537fa2f6108414ca7bf0fed73
parent 47a191e56e0cea10269dd6ff5a80242814f1463f
Author: rsiddharth <s@ricketyspace.net>
Date:   Sat, 16 Jun 2018 23:57:16 +0000

net: Add (net ricketyspace sicp two three).

* net/ricketyspace/sicp/two/three.scm: New file.

Diffstat:
net/ricketyspace/sicp/two/three.scm | 80+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 80 insertions(+), 0 deletions(-)

diff --git a/net/ricketyspace/sicp/two/three.scm 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))))