graphics: path: Add right-split, up-split, and corner-split procedures.

1 files changed, 32 insertions, 0 deletions

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 <canvas>
   (%make-canvas matrix compiled-path filled-path-pool stroked-path-pool
                 tesselated-paths)