From d42fe471ffb2ae6c631b1f9fca72ca157b8d72d3 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Tue, 21 Sep 2021 20:13:14 -0400 Subject: graphics: path: Add right-split, up-split, and corner-split procedures. --- chickadee/graphics/path.scm | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) diff --git a/chickadee/graphics/path.scm b/chickadee/graphics/path.scm index 48e80d9..3b29b19 100644 --- a/chickadee/graphics/path.scm +++ b/chickadee/graphics/path.scm @@ -83,6 +83,9 @@ pad beside below + right-split + up-split + corner-split painter? painter-bounding-box make-empty-canvas @@ -1463,6 +1466,35 @@ (let ((r (painter-bounding-box painter))) (loop rest (max width (rect-width r)) (+ height (rect-height r))))))))) +;; Adapted from Structure and Interpretation of Computer Programs, +;; section 2.2.4. +(define (right-split painter n) + (if (<= n 0) + painter + (let ((smaller (right-split (scale 0.5 painter) (- n 1)))) + (beside (scale (vec2 0.5 1.0) painter) + (below smaller smaller))))) + +(define (up-split painter n) + (if (<= n 0) + painter + (let ((smaller (up-split (scale 0.5 painter) (- n 1)))) + (below (scale (vec2 1.0 0.5) painter) + (beside smaller smaller))))) + +(define (corner-split painter n) + (if (<= n 0) + painter + (let* ((smaller (scale (vec2 0.5 0.5) painter)) + (up (up-split smaller (- n 1))) + (right (right-split smaller (- n 1))) + (up-small (scale (vec2 0.5 1.0) up)) + (right-small (scale (vec2 1.0 0.5) right))) + (beside (below smaller + (beside up-small up-small)) + (below (below right-small right-small) + (corner-split smaller (- n 1))))))) + (define-record-type (%make-canvas matrix compiled-path filled-path-pool stroked-path-pool tesselated-paths) -- cgit v1.2.3