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]))