From f342946c70041b249f36ad2a5f1c4499bd732865 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Wed, 8 May 2019 22:02:40 -0700
Subject: [PATCH] replable

---
 quad/qtest/quad-repl.rkt | 23 +++++++++++++++++++++++
 quad/quad/position.rkt   | 11 +++++++++--
 2 files changed, 32 insertions(+), 2 deletions(-)
 create mode 100644 quad/qtest/quad-repl.rkt

diff --git a/quad/qtest/quad-repl.rkt b/quad/qtest/quad-repl.rkt
new file mode 100644
index 00000000..b4f12e47
--- /dev/null
+++ b/quad/qtest/quad-repl.rkt
@@ -0,0 +1,23 @@
+#lang br
+(require quad racket/draw racket/gui)
+(verbose-quad-printing? #t)
+
+(define q1 (make-quad #:size '(20 20)))
+(define q2 (make-quad
+            #:from 'bo
+            #:to 'bi
+            #:size '(15 15)))
+
+  (define target (make-bitmap 800 150)) ; A 30x30 bitmap
+(define (go qs)
+  (define dc (new bitmap-dc% [bitmap target]))
+  (send dc scale 3 3)
+  (send dc translate 3 3)
+
+  (for ([q qs])
+    (define args (append (quad-origin q) (quad-size q)))
+    (send dc draw-rectangle . args)) ; 30 pixels wide and 10 pixels high
+
+  (make-object image-snip% target))
+
+(go (position (list q1 q2)))
diff --git a/quad/quad/position.rkt b/quad/quad/position.rkt
index dd1bedc4..1e4ec3ae 100644
--- a/quad/quad/position.rkt
+++ b/quad/quad/position.rkt
@@ -75,7 +75,14 @@
   ;; don't include shift here: it should be baked into origin calculation
   (pt+ (anchor->local-point q anchor) (quad-origin q)))
 
-(define (position q [ref-src #f])
+(define (position q-or-qs [ref-src #f])
+  (define-values (arg post-proc)
+    (match q-or-qs
+      [(? quad? q) (values q values)]
+      [(list (? quad? qs) ...) (values (make-quad #:elems qs) quad-elems)]))
+  (post-proc (position-one arg ref-src)))
+
+(define (position-one q ref-src)
   ;; recursively calculates coordinates for quad & subquads
   (define ref-pt (cond
                    [(quad? ref-src) (anchor->global-point ref-src (or (quad-from-parent q) (quad-from q)))]
@@ -103,7 +110,7 @@
            (define ref-q (if (or (quad-from-parent this-q) (null? prev-elems))
                              parent-q
                              (car prev-elems)))
-           (loop (cons (position this-q ref-q) prev-elems) rest)]
+           (loop (cons (position-one this-q ref-q) prev-elems) rest)]
           [(cons x rest) (loop (cons x prev-elems) rest)]))))
   (struct-copy quad positioned-q [elems positioned-elems]))