From: Ramakrishnan Muthukrishnan Date: Wed, 25 Aug 2010 19:35:13 +0000 (+0530) Subject: 2.2.4 in Scheme X-Git-Url: https://git.rkrishnan.org/%5B/%5D%20/uri/%22doc.html/frontends/configuration.txt?a=commitdiff_plain;h=47c998cca118e8ef830ff8397eb7e77707903172;p=sicp.git 2.2.4 in Scheme --- diff --git a/src/sicp/ch2_2.scm b/src/sicp/ch2_2.scm new file mode 100644 index 0000000..8d03232 --- /dev/null +++ b/src/sicp/ch2_2.scm @@ -0,0 +1,44 @@ +#lang scheme + +(require (planet soegaard/sicp:2:1/sicp)) + +(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 (flipped-pairs painter) + (let ((combine4 (square-of-four identity flip-vert + identity flip-vert))) + (combine4 painter))) + +(define (identity x) x) + +(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 up up)) + (bottom-right (below right right)) + (corner (corner-split painter (- n 1)))) + (beside (below painter top-left) + (below bottom-right corner)))))) + +(define (right-split painter n) + (if (= n 0) + painter + (let ((smaller (right-split painter (- n 1)))) + (beside painter (below smaller smaller))))) + +(define (up-split painter n) + (if (= n 0) + painter + (let ((smaller (up-split painter (- n 1)))) + (below painter (beside smaller smaller))))) + +(define (square-limit painter n) + (let ((combine4 (square-of-four flip-horiz identity + rotate180 flip-vert))) + (combine4 (corner-split painter n))))