lift

quad/quad/break.rkt

@@ -11,7 +11,7 @@
 (define (distance q)
   (hash-ref! distance-cache (cond
                               [(quad? q)
-                               (hash-ref (get-field attrs q) 'id q)]
+                               (hash-ref (quad-attrs q) 'id q)]
                               [(symbol? q) q])
              (λ ()
                (cond
@@ -84,9 +84,9 @@
           (cleanup-wraplist wraps)
           (if break-after? (list break-val) empty)))
 
-(define (nonprinting-at-start? x) (if (quad? x) (not (send x printable? 'start)) #t))
-(define (nonprinting-at-end? x) (if (quad? x) (not (send x printable? 'end)) #t))
-(define (nonprinting-in-middle-soft-break? x) (and (quad? x) (not (send x printable?)) (soft-break? x)))
+(define (nonprinting-at-start? x) (if (quad? x) (not (printable? x 'start)) #t))
+(define (nonprinting-at-end? x) (if (quad? x) (not (printable? x 'end)) #t))
+(define (nonprinting-in-middle-soft-break? x) (and (quad? x) (not (printable? x)) (soft-break? x)))
 
 (define (wrap-append partial wrap)
   (match/values
@@ -110,19 +110,19 @@
                         (define last-wrap (wrap-append #false (wrap-append next-wrap-tail next-wrap-head)))
                         (define finished-wraps
                           (for/list ([wrap (in-list (cons last-wrap wraps))])
-                                    (match wrap
-                                      [(list (? nonprinting-at-end?)) wrap] ; matches break signals
-                                      ;; pieces will have been accumulated in reverse order
-                                      ;; thus beginning of list represents the end of the wrap
-                                      [(list (? (conjoin soft-break? nonprinting-at-end?)) ... rest ...)
-                                       (finish-wrap-proc (reverse rest))])))
+                            (match wrap
+                              [(list (? nonprinting-at-end?)) wrap] ; matches break signals
+                              ;; pieces will have been accumulated in reverse order
+                              ;; thus beginning of list represents the end of the wrap
+                              [(list (? (conjoin soft-break? nonprinting-at-end?)) ... rest ...)
+                               (finish-wrap-proc (reverse rest))])))
                         (add-between finished-wraps (list break-val))))
             ([i (in-naturals)]
              #:break (empty? qs))
     (match-define (cons q other-qs) qs)
     (debug-report q 'next-q)
     (define at-start? (not current-dist))
-    (define dist (if (and (quad? q) (send q printable?)) (distance q) 0))
+    (define dist (if (and (quad? q) (printable? q)) (distance q) 0))
     (define would-overflow? (and current-dist (> (+ dist current-dist) target-size)))
     (cond
       [(and at-start? (soft-break? q) (nonprinting-at-start? q))
@@ -179,45 +179,41 @@
                other-qs)])))
 
 
-(define q-zero (class quad% (super-new) (inherit-field size) (set! size (pt 0 0))))
-(define q-one (class quad% (super-new) (inherit-field size) (set! size (pt 1 1))))
+(define q-zero (q #:size (pt 0 0)))
+(define q-one (q #:size (pt 1 1) #:printable #t))
 
-(define x (quad #:type q-one null #\x))
-(define zwx (quad #:type q-zero #\z))
-(define hyph (quad #:type q-one #\-))
-(define shy (quad #:type
-                  (class q-one (super-new)
-                    (define/override (printable? [sig #f])
-                      (case sig
-                        [(end) #t]
-                        [else #f])))
-                  #\-))
-(define a (quad #:type q-one #\a))
-(define b (quad #:type q-one #\b))
-(define c (quad #:type q-one #\c))
-(define d (quad #:type q-one #\d))
-(define sp (quad #:type
-                 (class q-one (super-new)
-                   (define/override (printable? [sig #f])
-                     (case sig
-                       [(start end) #f]
-                       [else #t])))
-                 #\space))
-(define br (quad #:type
-                 (class q-zero (super-new)
-                   (define/override (printable? [sig #f]) #false))
-                 #\newline))
-(define soft-break? (λ (q) (and (quad? q) (memv (car (get-field elems q)) '(#\space #\-)))))
+(define x (struct-copy quad q-one [elems '(#\x)]))
+(define zwx (struct-copy quad q-zero [elems '(#\z)]))
+(define hyph (struct-copy quad q-one [elems '(#\-)]))
+(define shy (struct-copy quad q-one
+                         [printable (λ ([sig #f])
+                                      (case sig
+                                        [(end) #t]
+                                        [else #f]))]
+                         [elems '(#\-)]))
+(define a (struct-copy quad q-one [elems '(#\a)]))
+(define b (struct-copy quad q-one [elems '(#\b)]))
+(define c (struct-copy quad q-one [elems '(#\c)]))
+(define d (struct-copy quad q-one [elems '(#\d)]))
+(define sp (struct-copy quad q-one
+                        [printable (λ ([sig #f])
+                                     (case sig
+                                       [(start end) #f]
+                                       [else #t]))]
+                        [elems '(#\space)]))
+(define br (struct-copy quad q-one
+                        [printable (λ ([sig #f]) #f)]
+                        [elems '(#\newline)]))
+(define soft-break? (λ (q) (and (quad? q) (memv (car (quad-elems q)) '(#\space #\-)))))
 
 (define (linewrap xs size [debug #f])
   (break xs size debug
          #:break-val 'lb
-         #:hard-break-proc (λ (q) (and (quad? q) (memv (car (get-field elems q)) '(#\newline))))
+         #:hard-break-proc (λ (q) (and (quad? q) (memv (car (quad-elems q)) '(#\newline))))
          #:soft-break-proc soft-break?))
 
-(require rackunit)
-
 (module+ test
+  (require rackunit)
   (test-case
    "chars"
    (check-equal? (linewrap (list) 1) null)  
@@ -231,171 +227,167 @@
    (check-equal? (linewrap (list x x x x x) 10) (list x x x x x))))
 
 (module+ test
-    (test-case
-     "chars and spaces"
-     (check-equal? (linewrap (list a sp b) 1) (list a 'lb b))
-     (check-equal? (linewrap (list a b sp c) 2) (list a b 'lb c))
-     (check-equal? (linewrap (list a sp b) 3) (list a sp b))
-     (check-equal? (linewrap (list a sp b c) 3) (list a 'lb b c))))
+  (test-case
+   "chars and spaces"
+   (check-equal? (linewrap (list a sp b) 1) (list a 'lb b))
+   (check-equal? (linewrap (list a b sp c) 2) (list a b 'lb c))
+   (check-equal? (linewrap (list a sp b) 3) (list a sp b))
+   (check-equal? (linewrap (list a sp b c) 3) (list a 'lb b c))))
   
 (module+ test
-    (test-case
-     "leading & trailing spaces"
-     (check-equal? (linewrap (list sp x) 2) (list x))
-     (check-equal? (linewrap (list x sp) 2) (list x))
-     (check-equal? (linewrap (list sp x sp) 2) (list x))
-     (check-equal? (linewrap (list sp sp x sp sp) 2) (list x))
-     (check-equal? (linewrap (list sp sp x sp sp x sp) 1) (list x 'lb x))))
+  (test-case
+   "leading & trailing spaces"
+   (check-equal? (linewrap (list sp x) 2) (list x))
+   (check-equal? (linewrap (list x sp) 2) (list x))
+   (check-equal? (linewrap (list sp x sp) 2) (list x))
+   (check-equal? (linewrap (list sp sp x sp sp) 2) (list x))
+   (check-equal? (linewrap (list sp sp x sp sp x sp) 1) (list x 'lb x))))
 
 (module+ test
-    (test-case
-     "hard hyphens"
-     (check-equal? (linewrap (list hyph) 1) (list hyph))
-     (check-equal? (linewrap (list hyph hyph) 1) (list hyph 'lb hyph))
-     (check-equal? (linewrap (list hyph hyph) 2) (list hyph hyph))
-     (check-equal? (linewrap (list hyph hyph hyph) 2) (list hyph hyph 'lb hyph))
-     (check-equal? (linewrap (list x hyph) 1) (list x 'lb hyph))
-     (check-equal? (linewrap (list a b hyph c d) 1) (list a 'lb b 'lb hyph 'lb c 'lb d))
-     (check-equal? (linewrap (list a b hyph c d) 2) (list a b 'lb hyph c 'lb d))
-     (check-equal? (linewrap (list a b hyph c d) 3) (list a b hyph 'lb c d))
-     (check-equal? (linewrap (list x x hyph x x) 4) (list x x hyph 'lb x x))
-     (check-equal? (linewrap (list x x hyph x x) 5) (list x x hyph x x))))
+  (test-case
+   "hard hyphens"
+   (check-equal? (linewrap (list hyph) 1) (list hyph))
+   (check-equal? (linewrap (list hyph hyph) 1) (list hyph 'lb hyph))
+   (check-equal? (linewrap (list hyph hyph) 2) (list hyph hyph))
+   (check-equal? (linewrap (list hyph hyph hyph) 2) (list hyph hyph 'lb hyph))
+   (check-equal? (linewrap (list x hyph) 1) (list x 'lb hyph))
+   (check-equal? (linewrap (list a b hyph c d) 1) (list a 'lb b 'lb hyph 'lb c 'lb d))
+   (check-equal? (linewrap (list a b hyph c d) 2) (list a b 'lb hyph c 'lb d))
+   (check-equal? (linewrap (list a b hyph c d) 3) (list a b hyph 'lb c d))
+   (check-equal? (linewrap (list x x hyph x x) 4) (list x x hyph 'lb x x))
+   (check-equal? (linewrap (list x x hyph x x) 5) (list x x hyph x x))))
 
 (module+ test
-    (test-case
-     "soft hyphens"
-     (check-equal? (linewrap (list shy) 1) (list))
-     (check-equal? (linewrap (list shy shy) 2) (list))
-     (check-equal? (linewrap (list shy shy shy) 2) (list))
-     (check-equal? (linewrap (list x shy) 1) (list x))
-     (check-equal? (linewrap (list x shy shy shy shy) 1) (list x))
-     ;; todo: degenerate cases
-     ;(check-equal? (linewrap (list x x shy x x) 1) (list x 'lb x 'lb x 'lb x))
-     ;(check-equal? (linewrap (list x x shy x x) 2) (list x x 'lb x x))
-     (check-equal? (linewrap (list x x shy x x) 3) (list x x shy 'lb x x))
-     ;; todo: doesn't work with class
-     #;(check-equal? (linewrap (list x x shy x x) 4) (list x x x x))
-     (check-equal? (linewrap (list x x shy x x) 5) (list x x x x))
-     (check-equal? (linewrap (list x x shy x sp x) 4) (list x x x 'lb x))))
+  (test-case
+   "soft hyphens"
+   (check-equal? (linewrap (list shy) 1) (list))
+   (check-equal? (linewrap (list shy shy) 2) (list))
+   (check-equal? (linewrap (list shy shy shy) 2) (list))
+   (check-equal? (linewrap (list x shy) 1) (list x))
+   (check-equal? (linewrap (list x shy shy shy shy) 1) (list x))
+   ;; todo: degenerate cases that don't work without continuations
+   ;(check-equal? (linewrap (list x x shy x x) 1) (list x 'lb x 'lb x 'lb x))
+   ;(check-equal? (linewrap (list x x shy x x) 2) (list x x 'lb x x))
+   (check-equal? (linewrap (list x x shy x x) 3) (list x x shy 'lb x x))
+   (check-equal? (linewrap (list x x shy x x) 4) (list x x x x))
+   (check-equal? (linewrap (list x x shy x x) 5) (list x x x x))
+   (check-equal? (linewrap (list x x shy x sp x) 4) (list x x x 'lb x))))
 
 (module+ test
-    (test-case
-     "zero width nonbreakers"
-     (check-equal? (linewrap (list sp zwx) 2) (list zwx))
-     (check-equal? (linewrap (list zwx sp) 2) (list zwx))
-     (check-equal? (linewrap (list sp zwx sp) 2) (list zwx))
-     (check-equal? (linewrap (list sp sp zwx sp sp) 2) (list zwx))
-     (check-equal? (linewrap (list sp sp zwx sp sp zwx sp) 2) (list zwx sp sp zwx))))
+  (test-case
+   "zero width nonbreakers"
+   (check-equal? (linewrap (list sp zwx) 2) (list zwx))
+   (check-equal? (linewrap (list zwx sp) 2) (list zwx))
+   (check-equal? (linewrap (list sp zwx sp) 2) (list zwx))
+   (check-equal? (linewrap (list sp sp zwx sp sp) 2) (list zwx))
+   (check-equal? (linewrap (list sp sp zwx sp sp zwx sp) 2) (list zwx sp sp zwx))))
 
 (module+ test
-    (test-case
-     "hard breaks"
-     (check-equal? (linewrap (list br) 2) (list)) ;; only insert a break if it's between things
-     (check-equal? (linewrap (list a br b) 2) (list a 'lb b))
-     (check-equal? (linewrap (list a b br) 2) (list a b))
-     (check-equal? (linewrap (list a b br br) 2) (list a b))
-     (check-equal? (linewrap (list x br x x) 3) (list x 'lb x x))
-     (check-equal? (linewrap (list x x br x) 3) (list x x 'lb x))
-     (check-equal? (linewrap (list x x x x) 3) (list x x x 'lb x))
-     (check-equal? (linewrap (list x x x sp x x) 2) (list x x 'lb x 'lb x x))
-     (check-equal? (linewrap (list x x x sp x x) 3) (list x x x 'lb x x))))
+  (test-case
+   "hard breaks"
+   (check-equal? (linewrap (list br) 2) (list)) ;; only insert a break if it's between things
+   (check-equal? (linewrap (list a br b) 2) (list a 'lb b))
+   (check-equal? (linewrap (list a b br) 2) (list a b))
+   (check-equal? (linewrap (list a b br br) 2) (list a b))
+   (check-equal? (linewrap (list x br x x) 3) (list x 'lb x x))
+   (check-equal? (linewrap (list x x br x) 3) (list x x 'lb x))
+   (check-equal? (linewrap (list x x x x) 3) (list x x x 'lb x))
+   (check-equal? (linewrap (list x x x sp x x) 2) (list x x 'lb x 'lb x x))
+   (check-equal? (linewrap (list x x x sp x x) 3) (list x x x 'lb x x))))
 
 (module+ test
-    (test-case
-     "hard breaks and spurious spaces"
-     (check-equal? (linewrap (list a sp sp sp br b) 2) (list a 'lb b))
-     (check-equal? (linewrap (list x sp br sp sp x x sp) 3) (list x 'lb x x))
-     (check-equal? (linewrap (list sp sp x x sp sp br sp sp sp x) 3) (list x x 'lb x))
-     (check-equal? (linewrap (list a sp b sp sp br sp c) 3) (list a sp b 'lb c))
-     (check-equal? (linewrap (list x x x x) 3) (list x x x 'lb x))
-     (check-equal? (linewrap (list x x x sp x x) 2) (list x x 'lb x 'lb x x))
-     (check-equal? (linewrap (list x x x sp x x) 3) (list x x x 'lb x x))))
+  (test-case
+   "hard breaks and spurious spaces"
+   (check-equal? (linewrap (list a sp sp sp br b) 2) (list a 'lb b))
+   (check-equal? (linewrap (list x sp br sp sp x x sp) 3) (list x 'lb x x))
+   (check-equal? (linewrap (list sp sp x x sp sp br sp sp sp x) 3) (list x x 'lb x))
+   (check-equal? (linewrap (list a sp b sp sp br sp c) 3) (list a sp b 'lb c))
+   (check-equal? (linewrap (list x x x x) 3) (list x x x 'lb x))
+   (check-equal? (linewrap (list x x x sp x x) 2) (list x x 'lb x 'lb x x))
+   (check-equal? (linewrap (list x x x sp x x) 3) (list x x x 'lb x x))))
 
 (define (visual-wrap str int [debug #f])
-    (apply string (for/list ([b (in-list (linewrap (for/list ([atom (atomize str)])
-                                                             (apply quad #:type q-one (get-field attrs atom)
-                                                                    (get-field elems atom))) int debug))])
-                            (cond
-                              [(quad? b) (car (get-field elems b))]
-                              [else #\|]))))
-
+  (apply string (for/list ([b (in-list (linewrap (for/list ([atom (atomize str)])
+                                                   (struct-copy quad q-one
+                                                                [attrs (quad-attrs atom)]
+                                                                [elems (quad-elems atom)])) int debug))])
+                  (cond
+                    [(quad? b) (car (quad-elems b))]
+                    [else #\|]))))
 (module+ test
-    (test-case
-     "visual breaks"
-     (check-equal? (visual-wrap "My dog has fleas" 1) "M|y|d|o|g|h|a|s|f|l|e|a|s")
-     (check-equal? (visual-wrap "My dog has fleas" 2) "My|do|g|ha|s|fl|ea|s")
-     (check-equal? (visual-wrap "My dog has fleas" 3) "My|dog|has|fle|as")
-     (check-equal? (visual-wrap "My dog has fleas" 4) "My|dog|has|flea|s")
-     (check-equal? (visual-wrap "My dog has fleas" 5) "My|dog|has|fleas")
-     (check-equal? (visual-wrap "My dog has fleas" 6) "My dog|has|fleas")
-     (check-equal? (visual-wrap "My dog has fleas" 7) "My dog|has|fleas")
-     (check-equal? (visual-wrap "My dog has fleas" 8) "My dog|has|fleas")
-     (check-equal? (visual-wrap "My dog has fleas" 9) "My dog|has fleas")
-     (check-equal? (visual-wrap "My dog has fleas" 10) "My dog has|fleas")
-     (check-equal? (visual-wrap "My dog has fleas" 11) "My dog has|fleas")
-     (check-equal? (visual-wrap "My dog has fleas" 12) "My dog has|fleas")
-     (check-equal? (visual-wrap "My dog has fleas" 13) "My dog has|fleas")
-     (check-equal? (visual-wrap "My dog has fleas" 14) "My dog has|fleas")
-     (check-equal? (visual-wrap "My dog has fleas" 15) "My dog has|fleas")
-     (check-equal? (visual-wrap "My dog has fleas" 16) "My dog has fleas")))
-
+  (test-case
+   "visual breaks"
+   (check-equal? (visual-wrap "My dog has fleas" 1) "M|y|d|o|g|h|a|s|f|l|e|a|s")
+   (check-equal? (visual-wrap "My dog has fleas" 2) "My|do|g|ha|s|fl|ea|s")
+   (check-equal? (visual-wrap "My dog has fleas" 3) "My|dog|has|fle|as")
+   (check-equal? (visual-wrap "My dog has fleas" 4) "My|dog|has|flea|s")
+   (check-equal? (visual-wrap "My dog has fleas" 5) "My|dog|has|fleas")
+   (check-equal? (visual-wrap "My dog has fleas" 6) "My dog|has|fleas")
+   (check-equal? (visual-wrap "My dog has fleas" 7) "My dog|has|fleas")
+   (check-equal? (visual-wrap "My dog has fleas" 8) "My dog|has|fleas")
+   (check-equal? (visual-wrap "My dog has fleas" 9) "My dog|has fleas")
+   (check-equal? (visual-wrap "My dog has fleas" 10) "My dog has|fleas")
+   (check-equal? (visual-wrap "My dog has fleas" 11) "My dog has|fleas")
+   (check-equal? (visual-wrap "My dog has fleas" 12) "My dog has|fleas")
+   (check-equal? (visual-wrap "My dog has fleas" 13) "My dog has|fleas")
+   (check-equal? (visual-wrap "My dog has fleas" 14) "My dog has|fleas")
+   (check-equal? (visual-wrap "My dog has fleas" 15) "My dog has|fleas")
+   (check-equal? (visual-wrap "My dog has fleas" 16) "My dog has fleas")))
 
 (define (pagewrap xs size [debug #f])
   (break xs size debug
          #:break-val 'pb
          #:break-before? #t
-         #:hard-break-proc (λ (x) (and (quad? x) (memv (car (get-field elems x)) '(#\page))))
+         #:hard-break-proc (λ (x) (and (quad? x) (memv (car (quad-elems x)) '(#\page))))
          #:soft-break-proc (λ (x) (eq? x 'lb))))
-(define pbr (quad #:type (class quad% (super-new) (inherit-field size) (set! size #false)) #\page))
+(define pbr (q #:size #false #:elems '(#\page)))
 
 (module+ test
-    (test-case
-     "soft page breaks"
-     (check-equal? (pagewrap null 2) '(pb))
-     (check-equal? (pagewrap (list x) 2) (list 'pb x))
-     (check-equal? (pagewrap (list x x) 2) (list 'pb x x))
-     (check-equal? (pagewrap (list x x x) 1) (list 'pb x 'pb x 'pb x))
-     (check-equal? (pagewrap (list x x x) 2) (list 'pb x x 'pb x))
-     (check-equal? (pagewrap (list x x x) 3) (list 'pb x x x))
-     (check-equal? (pagewrap (list x x x) 4) (list 'pb x x x))
-     (check-equal? (pagewrap (list x 'lb x x) 2) (list 'pb x 'pb x x))))
+  (test-case
+   "soft page breaks"
+   (check-equal? (pagewrap null 2) '(pb))
+   (check-equal? (pagewrap (list x) 2) (list 'pb x))
+   (check-equal? (pagewrap (list x x) 2) (list 'pb x x))
+   (check-equal? (pagewrap (list x x x) 1) (list 'pb x 'pb x 'pb x))
+   (check-equal? (pagewrap (list x x x) 2) (list 'pb x x 'pb x))
+   (check-equal? (pagewrap (list x x x) 3) (list 'pb x x x))
+   (check-equal? (pagewrap (list x x x) 4) (list 'pb x x x))
+   (check-equal? (pagewrap (list x 'lb x x) 2) (list 'pb x 'pb x x))))
 
 (module+ test
-    (test-case
-     "hard page breaks"
-     (check-equal? (pagewrap (list x pbr x x) 2) (list 'pb x 'pb x x))
-     (check-equal? (pagewrap (list x pbr x x) 1) (list 'pb x 'pb x 'pb x))
-     (check-equal? (pagewrap (list x pbr pbr x x) 1) (list 'pb x 'pb 'pb x 'pb x))
-     (check-equal? (pagewrap (list x pbr pbr x x) 2) (list 'pb x 'pb 'pb x x))
-     (check-equal? (pagewrap (list 'lb x 'lb 'lb pbr 'lb x x 'lb) 2) (list 'pb x 'pb x x))))
+  (test-case
+   "hard page breaks"
+   (check-equal? (pagewrap (list x pbr x x) 2) (list 'pb x 'pb x x))
+   (check-equal? (pagewrap (list x pbr x x) 1) (list 'pb x 'pb x 'pb x))
+   (check-equal? (pagewrap (list x pbr pbr x x) 1) (list 'pb x 'pb 'pb x 'pb x))
+   (check-equal? (pagewrap (list x pbr pbr x x) 2) (list 'pb x 'pb 'pb x x))
+   (check-equal? (pagewrap (list 'lb x 'lb 'lb pbr 'lb x x 'lb) 2) (list 'pb x 'pb x x))))
 
 (module+ test
-    (test-case
-     "composed line breaks and page breaks"
-     (check-equal? (pagewrap (linewrap null 1) 2) '(pb) )
-     (check-equal? (pagewrap (linewrap (list x) 1) 2) (list 'pb x))
-     (check-equal? (pagewrap (linewrap (list x x x) 1) 2) (list 'pb x 'lb x 'pb x))
-     (check-equal? (pagewrap (linewrap (list x x x) 2) 2) (list 'pb x x 'pb x))
-     (check-equal? (pagewrap (linewrap (list x x x) 2) 1) (list 'pb x 'pb x 'pb x))))
+  (test-case
+   "composed line breaks and page breaks"
+   (check-equal? (pagewrap (linewrap null 1) 2) '(pb) )
+   (check-equal? (pagewrap (linewrap (list x) 1) 2) (list 'pb x))
+   (check-equal? (pagewrap (linewrap (list x x x) 1) 2) (list 'pb x 'lb x 'pb x))
+   (check-equal? (pagewrap (linewrap (list x x x) 2) 2) (list 'pb x x 'pb x))
+   (check-equal? (pagewrap (linewrap (list x x x) 2) 1) (list 'pb x 'pb x 'pb x))))
 
-(define slug% (class quad% (super-new)))
-(define (slug . xs) (make-object slug% (hasheq) xs))
+(define (slug . xs) (q #:attrs (hasheq) #:elems xs))
 (define (linewrap2 xs size [debug #f])
   (break xs size debug
          #:break-val 'lb
-         #:hard-break-proc (λ (q) (and (quad? q) (memv (car (get-field elems q)) '(#\newline))))
+         #:hard-break-proc (λ (q) (and (quad? q) (memv (car (quad-elems q)) '(#\newline))))
          #:soft-break-proc soft-break?
          #:finish-wrap-proc (λ (pcs) (list (apply slug pcs)))))
 
-(module+ test
-    (test-case
-     "hard breaks and spurious spaces with slugs"
-     (check-equal? (linewrap2 (list a sp sp sp br b) 2) (list (slug a) 'lb (slug b)))
-     (check-equal? (linewrap2 (list x sp br sp sp x x sp) 3) (list (slug x) 'lb (slug x x)))
-     (check-equal? (linewrap2 (list sp sp x x sp sp br sp sp sp x) 3) (list (slug x x) 'lb (slug x)))
-     (check-equal? (linewrap2 (list a sp b sp sp br sp c) 3) (list (slug a sp b) 'lb (slug c)))
-     (check-equal? (linewrap2 (list x x x x) 3) (list (slug x x x) 'lb (slug x)))
-     (check-equal? (linewrap2 (list x x x sp x x) 2) (list (slug x x) 'lb (slug x) 'lb (slug x x)))
-     (check-equal? (linewrap2 (list x x x sp x x) 3) (list (slug x x x) 'lb (slug x x)))))
+#;(module+ test
+  (test-case
+   "hard breaks and spurious spaces with slugs"
+   (check-equal? (linewrap2 (list a sp sp sp br b) 2) (list (slug a) 'lb (slug b)))
+   (check-equal? (linewrap2 (list x sp br sp sp x x sp) 3) (list (slug x) 'lb (slug x x)))
+   (check-equal? (linewrap2 (list sp sp x x sp sp br sp sp sp x) 3) (list (slug x x) 'lb (slug x)))
+   (check-equal? (linewrap2 (list a sp b sp sp br sp c) 3) (list (slug a sp b) 'lb (slug c)))
+   (check-equal? (linewrap2 (list x x x x) 3) (list (slug x x x) 'lb (slug x)))
+   (check-equal? (linewrap2 (list x x x sp x x) 2) (list (slug x x) 'lb (slug x) 'lb (slug x x)))
+   (check-equal? (linewrap2 (list x x x sp x x) 3) (list (slug x x x) 'lb (slug x x)))))
 
-#;(time-avg 100 (void (visual-wrap "The make-object procedure creates a new object with by-position initialization arguments, the new form creates a new object with by-name initialization arguments, and the instantiate form creates a new object with both by-position and by-name initialization arguments. All fields in the newly created object are initially bound to the special #<undefined> value (see Void). Initialization variables with default value expressions (and no provided value) are also initialized to #<undefined>. After argument values are assigned to initialization variables, expressions in field clauses, init-field clauses with no provided argument, init clauses with no provided argument, private field definitions, and other expressions are evaluated. Those expressions are evaluated as they appear in the class expression, from left to right. Sometime during the evaluation of the expressions, superclass-declared initializations must be evaluated once by using the super-make-object procedure, super-new form, or super-instantiate form. By-name initialization arguments to a class that have no matching initialization variable are implicitly added as by-name arguments to a super-make-object, super-new, or super-instantiate invocation, after the explicit arguments. If multiple initialization arguments are provided for the same name, the first (if any) is used, and the unused arguments are propagated to the superclass. (Note that converted by-position arguments are always placed before explicit by-name arguments.) The initialization procedure for the object% class accepts zero initialization arguments; if it receives any by-name initialization arguments, then exn:fail:object exception is raised. If the end of initialization is reached for any class in the hierarchy without invoking the superclass’s initialization, the exn:fail:object exception is raised. Also, if superclass initialization is invoked more than once, the exn:fail:object exception is raised. Fields inherited from a superclass are not initialized until the superclass’s initialization procedure is invoked. In contrast, all methods are available for an object as soon as the object is created; the overriding of methods is not affected by initialization (unlike objects in C++)." 35)))

quad/quad/position.rkt

@@ -9,7 +9,6 @@
 (define (pt- . pts) (apply map - pts))
 (define point? (list/c number? number?))
 
-
 (define valid-anchors '(nw n ne w c e sw s se bi bo))
 
 (define (valid-anchor? anchor)
@@ -27,14 +26,14 @@
 
 (define ascender-cache (make-hash))
 (define (ascender q)
-  (define p (hash-ref (get-field attrs q) 'font "Courier"))
+  (define p (hash-ref (quad-attrs q) 'font "Courier"))
   (unless p
     (error 'ascender-no-font-key))
   (hash-ref! ascender-cache p (λ () (font-ascent (get-font p)))))
 
 (define units-cache (make-hash))
 (define (units-per-em q)
-  (define p (hash-ref (get-field attrs q) 'font "Courier"))
+  (define p (hash-ref (quad-attrs q) 'font "Courier"))
   (unless p
     (error 'units-per-em-no-font-key))
   (hash-ref! units-cache p (λ () (font-units-per-em (get-font p)))))
@@ -42,7 +41,7 @@
 (define (fontsize q)
   ;; this needs to not default to 0
   ;; needs parameter with default font size
-  (define val (hash-ref (get-field attrs q) 'fontsize (λ () (error 'no-font-size))))
+  (define val (hash-ref (quad-attrs q) 'fontsize (λ () (error 'no-font-size))))
   ((if (number? val) values string->number) val))
 
 (define (vertical-baseline-offset q)
@@ -58,7 +57,7 @@
       [( w) '(0 0.5)] [(c) '(0.5 0.5)] [( e) '(1 0.5)]
       [(sw) '(0 1  )] [(s) '(0.5 1  )] [(se) '(1 1  )]
       [(bi) '(0 0  )]                  [(bo) '(1 0  )]))
-  (match-define (list x y) (send q size))
+  (match-define (list x y) (size q))
   (pt (coerce-int (* x x-fac))
       (coerce-int (+ (* y y-fac) (if (memq anchor '(bi bo)) (vertical-baseline-offset q) 0)))))
 
@@ -66,97 +65,101 @@
   ;; calculate absolute location of inner-point
   ;; based on current origin and point type.
   ;; include offset, because it's intended to adjust inner 
-  (pt+ (get-field origin q) (anchor->local-point q (or (get-field inner q) (get-field in q))) (get-field offset q)))
+  (pt+ (quad-origin q) (anchor->local-point q (or (quad-inner q) (quad-in q))) (quad-offset q)))
 
 (define (in-point q)
   ;; calculate absolute location of in-point
   ;; based on current origin and point type.
   ;; don't include offset, so location is on bounding box
-  (pt+ (get-field origin q) (anchor->local-point q (get-field in q))))
+  (pt+ (quad-origin q) (anchor->local-point q (quad-in q))))
 
 (define (out-point q)
   ;; calculate absolute location of out-point
   ;; based on current origin and point type.
   ;; don't include offset, so location is on bounding box
-  (pt+ (get-field origin q) (anchor->local-point q (get-field out q))))
+  (pt+ (quad-origin q) (anchor->local-point q (quad-out q))))
 
 (define (position q [previous-end-pt #f])
   ;; recursively calculates coordinates for quad & subquads
   ;; based on starting origin point
-  (set-field! origin q (if previous-end-pt
-                           (pt- previous-end-pt (in-point q))
-                           (in-point q)))
+  (set-quad-origin! q (if previous-end-pt
+                          (pt- previous-end-pt (in-point q))
+                          (in-point q)))
   (for/fold ([pt (inner-point q)])
-            ([q (in-list (get-field elems q))]
+            ([q (in-list (quad-elems q))]
              #:when (quad? q))
     (out-point (position q pt)))
   q)
 
 (module+ test
   (require rackunit)
-  #;(test-case
-     "origins"
-     (define size (pt 10 10))
-     (define orig (pt 5 5))
-     (check-equal? (get-field origin q (position (quad (hasheq 'in 'nw 'size size)) orig)) (pt 5 5))
-     (check-equal? (get-field origin q (position (quad (hasheq 'in 'n 'size size)) orig)) (pt 0 5))
-     (check-equal? (get-field origin q (position (quad (hasheq 'in 'ne 'size size)) orig)) (pt -5 5))
-     (check-equal? (get-field origin q (position (quad (hasheq 'in 'e 'size size)) orig)) (pt -5 0))
-     (check-equal? (get-field origin q (position (quad (hasheq 'in 'se 'size size)) orig)) (pt -5 -5))
-     (check-equal? (get-field origin q (position (quad (hasheq 'in 's 'size size)) orig)) (pt 0 -5))
-     (check-equal? (get-field origin q (position (quad (hasheq 'in 'sw 'size size)) orig)) (pt 5 -5))
-     (check-equal? (get-field origin q (position (quad (hasheq 'in 'w 'size size)) orig)) (pt 5 0)))
-
-  #;(test-case
-     "in points"
-     (check-equal? (in-point (quad (hasheq 'in 'nw 'size '(10 10) 'origin '(5 5)))) (pt 5 5))
-     (check-equal? (in-point (quad (hasheq 'in 'n 'size '(10 10) 'origin '(5 5)))) (pt 10 5))
-     (check-equal? (in-point (quad (hasheq 'in 'ne 'size '(10 10) 'origin '(5 5)))) (pt 15 5))
-     (check-equal? (in-point (quad (hasheq 'in 'w 'size '(10 10) 'origin '(5 5)))) (pt 5 10))
-     (check-equal? (in-point (quad (hasheq 'in 'c 'size '(10 10) 'origin '(5 5)))) (pt 10 10))
-     (check-equal? (in-point (quad (hasheq 'in 'e 'size '(10 10) 'origin '(5 5)))) (pt 15 10))
-     (check-equal? (in-point (quad (hasheq 'in 'sw 'size '(10 10) 'origin '(5 5)))) (pt 5 15))
-     (check-equal? (in-point (quad (hasheq 'in 's 'size '(10 10) 'origin '(5 5)))) (pt 10 15))
-     (check-equal? (in-point (quad (hasheq 'in 'se 'size '(10 10) 'origin '(5 5)))) (pt 15 15)))
-
-  #;(test-case
-     "out points"
-     (check-equal? (out-point (quad (hasheq 'out 'nw 'size '(10 10) 'origin '(5 5)))) (pt 5 5))
-     (check-equal? (out-point (quad (hasheq 'out 'n 'size '(10 10) 'origin '(5 5)))) (pt 10 5))
-     (check-equal? (out-point (quad (hasheq 'out 'ne 'size '(10 10) 'origin '(5 5)))) (pt 15 5))
-     (check-equal? (out-point (quad (hasheq 'out 'w 'size '(10 10) 'origin '(5 5)))) (pt 5 10))
-     (check-equal? (out-point (quad (hasheq 'out 'c 'size '(10 10) 'origin '(5 5)))) (pt 10 10))
-     (check-equal? (out-point (quad (hasheq 'out 'e 'size '(10 10) 'origin '(5 5)))) (pt 15 10))
-     (check-equal? (out-point (quad (hasheq 'out 'sw 'size '(10 10) 'origin '(5 5)))) (pt 5 15))
-     (check-equal? (out-point (quad (hasheq 'out 's 'size '(10 10) 'origin '(5 5)))) (pt 10 15))
-     (check-equal? (out-point (quad (hasheq 'out 'se 'size '(10 10) 'origin '(5 5)))) (pt 15 15)))
-
-  #;(test-case
-     "inner points"
-     (define size '(20 20))
-     (define orig '(10 10))
-     (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 'nw)) orig)) (pt 10 10))
-     (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 'n)) orig)) (pt 20 10))
-     (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 'ne)) orig)) (pt 30 10))
-     (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 'e)) orig)) (pt 30 20))
-     (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 'se)) orig)) (pt 30 30))
-     (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 's)) orig)) (pt 20 30))
-     (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 'sw)) orig)) (pt 10 30))
-     (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 'w)) orig)) (pt 10 20)))
-
-  #;(test-case
-     "inner points with offsets"
-     (define size (pt 10 10))
-     (define orig (pt 0 0))
-     (define off (pt (random 100) (random 100)))
-     (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 'nw 'offset off)) orig)) (pt+ '(0 0) off))
-     (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 'n 'offset off)) orig)) (pt+ '(5 0) off))
-     (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 'ne 'offset off)) orig)) (pt+ '(10 0) off))
-     (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 'e 'offset off)) orig)) (pt+ '(10 5) off))
-     (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 'se 'offset off)) orig)) (pt+ '(10 10) off))
-     (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 's 'offset off)) orig)) (pt+ '(5 10) off))
-     (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 'sw 'offset off)) orig)) (pt+ '(0 10) off))
-     (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 'w 'offset off)) orig)) (pt+ '(0 5) off)))
+  (test-case
+   "origins"
+   (define size (pt 10 10))
+   (define orig (pt 5 5))
+   (check-equal? (quad-origin (position (q #:in 'nw #:size size) orig)) (pt 5 5))
+   (check-equal? (quad-origin (position (q #:in 'n #:size size) orig)) (pt 0 5))
+   (check-equal? (quad-origin (position (q #:in 'ne #:size size) orig)) (pt -5 5))
+   (check-equal? (quad-origin (position (q #:in 'e #:size size) orig)) (pt -5 0))
+   (check-equal? (quad-origin (position (q #:in 'se #:size size) orig)) (pt -5 -5))
+   (check-equal? (quad-origin (position (q #:in 's #:size size) orig)) (pt 0 -5))
+   (check-equal? (quad-origin (position (q #:in 'sw #:size size) orig)) (pt 5 -5))
+   (check-equal? (quad-origin (position (q #:in 'w #:size size) orig)) (pt 5 0)))
+
+  (test-case
+   "in points"
+   (define size '(10 10))
+   (define origin '(5 5))
+   (check-equal? (in-point (q #:in 'nw #:size size #:origin origin)) (pt 5 5))
+   (check-equal? (in-point (q #:in 'n #:size size #:origin origin)) (pt 10 5))
+   (check-equal? (in-point (q #:in 'ne #:size size #:origin origin)) (pt 15 5))
+   (check-equal? (in-point (q #:in 'w #:size size #:origin origin)) (pt 5 10))
+   (check-equal? (in-point (q #:in 'c #:size size #:origin origin)) (pt 10 10))
+   (check-equal? (in-point (q #:in 'e #:size size #:origin origin)) (pt 15 10))
+   (check-equal? (in-point (q #:in 'sw #:size size #:origin origin)) (pt 5 15))
+   (check-equal? (in-point (q #:in 's #:size size #:origin origin)) (pt 10 15))
+   (check-equal? (in-point (q #:in 'se #:size size #:origin origin)) (pt 15 15)))
+
+  (test-case
+   "out points"
+   (define size (pt 10 10))
+   (define origin (pt 5 5))
+   (check-equal? (out-point (q #:out 'nw #:size size #:origin origin)) (pt 5 5))
+   (check-equal? (out-point (q #:out 'n #:size size #:origin origin)) (pt 10 5))
+   (check-equal? (out-point (q #:out 'ne #:size size #:origin origin)) (pt 15 5))
+   (check-equal? (out-point (q #:out 'w #:size size #:origin origin)) (pt 5 10))
+   (check-equal? (out-point (q #:out 'c #:size size #:origin origin)) (pt 10 10))
+   (check-equal? (out-point (q #:out 'e #:size size #:origin origin)) (pt 15 10))
+   (check-equal? (out-point (q #:out 'sw #:size size #:origin origin)) (pt 5 15))
+   (check-equal? (out-point (q #:out 's #:size size #:origin origin)) (pt 10 15))
+   (check-equal? (out-point (q #:out 'se #:size size #:origin origin)) (pt 15 15)))
+
+  (test-case
+   "inner points"
+   (define size '(20 20))
+   (define orig '(10 10))
+   (check-equal? (inner-point (position (q #:size size #:inner 'nw) orig)) (pt 10 10))
+   (check-equal? (inner-point (position (q #:size size #:inner 'n) orig)) (pt 20 10))
+   (check-equal? (inner-point (position (q #:size size #:inner 'ne) orig)) (pt 30 10))
+   (check-equal? (inner-point (position (q #:size size #:inner 'e) orig)) (pt 30 20))
+   (check-equal? (inner-point (position (q #:size size #:inner 'se) orig)) (pt 30 30))
+   (check-equal? (inner-point (position (q #:size size #:inner 's) orig)) (pt 20 30))
+   (check-equal? (inner-point (position (q #:size size #:inner 'sw) orig)) (pt 10 30))
+   (check-equal? (inner-point (position (q #:size size #:inner 'w) orig)) (pt 10 20)))
+
+  (test-case
+   "inner points with offsets"
+   (define size (pt 10 10))
+   (define orig (pt 0 0))
+   (define off (pt (random 100) (random 100)))
+   (check-equal? (inner-point (position (q #:size size #:inner 'nw #:offset off) orig)) (pt+ '(0 0) off))
+   (check-equal? (inner-point (position (q #:size size #:inner 'n #:offset off) orig)) (pt+ '(5 0) off))
+   (check-equal? (inner-point (position (q #:size size #:inner 'ne #:offset off) orig)) (pt+ '(10 0) off))
+   (check-equal? (inner-point (position (q #:size size #:inner 'e #:offset off) orig)) (pt+ '(10 5) off))
+   (check-equal? (inner-point (position (q #:size size #:inner 'se #:offset off) orig)) (pt+ '(10 10) off))
+   (check-equal? (inner-point (position (q #:size size #:inner 's #:offset off) orig)) (pt+ '(5 10) off))
+   (check-equal? (inner-point (position (q #:size size #:inner 'sw #:offset off) orig)) (pt+ '(0 10) off))
+   (check-equal? (inner-point (position (q #:size size #:inner 'w #:offset off) orig)) (pt+ '(0 5) off)))
 
   #;(test-case
      "folding positions"
@@ -172,21 +175,21 @@
                          (unit '(origin (2 2) out se)
                                (unit '(origin (2 2))) (unit '(origin (3 2))) (unit '(origin (4 2))))))))
 
+(module+ test
+  (require racket/runtime-path fontland/font)
+  (define-runtime-path fira "fira.ttf")
 
-(require racket/runtime-path fontland/font)
-(define-runtime-path fira "fira.ttf")
-
-(define q1 (quad (list 'in 'bi 'out 'bo 'size '(10 10) 'font fira 'fontsize 12)))
-(define q2 (quad (list 'in 'bi 'out 'bo 'size '(10 10) 'font fira 'fontsize 24)))
-(define q3 (quad (list 'in 'bi 'out 'bo 'size '(10 10) 'font fira 'fontsize 6)))
-#;(position (quad #f q1 q2 q3))
+  (define q1 (q (list 'in 'bi 'out 'bo 'size '(10 10) 'font fira 'fontsize 12)))
+  (define q2 (q (list 'in 'bi 'out 'bo 'size '(10 10) 'font fira 'fontsize 24)))
+  (define q3 (q (list 'in 'bi 'out 'bo 'size '(10 10) 'font fira 'fontsize 6)))
+  (position (q #f q1 q2 q3)))
 
 
 #;(module+ test
     (require rackunit)
-    (define q (quad (list 'in 'bi 'out 'bo 'size '(10 10) 'font fira 'fontsize 12)))
+    (define q (q (list 'in 'bi 'out 'bo 'size '(10 10) 'font fira 'fontsize 12)))
     (check-equal? (ascender q) 935)
     (check-equal? (units-per-em q) 1000)
-    (define ascender-scaled (* (/ (ascender q) (units-per-em q)) (hash-ref (get-field attrs q) 'fontsize) 1.0))
+    (define ascender-scaled (* (/ (ascender q) (units-per-em q)) (hash-ref (quad-attrs q) 'fontsize) 1.0))
     (check-equal? (in-point q) (list 0 ascender-scaled))
     (check-equal? (out-point q) (list 10 ascender-scaled)))

quad/quad/quad.rkt

@@ -1,10 +1,18 @@
 #lang debug racket/base
-(require racket/struct racket/dict racket/match)
+(require racket/struct racket/promise racket/dict racket/match)
 (provide (all-defined-out))
 (module+ test (require rackunit))
 
+(define (size q)
+  (match (quad-size q)
+    [(? procedure? proc) (proc q)]
+    [(? promise? prom) (force prom)]
+    [val val]))
+
 (define (printable? q [signal #f])
-  ((quad-printable q) q signal))
+  (match (quad-printable q)
+    [(? procedure? proc) (proc signal)]
+    [val val]))
 
 (define (draw q [surface #f])
   ((quad-draw q) q surface))
@@ -12,27 +20,30 @@
 (define (hashes-equal? h1 h2)
   (and (= (length (hash-keys h1)) (length (hash-keys h2)))
        (for/and ([(k v) (in-hash h1)])
-                (and (hash-has-key? h2 k) (equal? (hash-ref h2 k) v)))))
+         (and (hash-has-key? h2 k) (equal? (hash-ref h2 k) v)))))
 
 (define (quad=? q1 q2 recur?)
   (and
    ;; exclude attrs from initial comparison
-   (andmap equal? (cdr (struct->list q1)) (cdr (struct->list q2)))
+   (for/and ([getter (in-list (list quad-elems quad-size quad-in quad-out quad-inner
+                              quad-offset quad-origin quad-printable
+                              quad-pre-draw quad-post-draw quad-draw))])
+     (equal? (getter q1) (getter q2)))
    ;; and compare them key-by-key
    (hashes-equal? (quad-attrs q1) (quad-attrs q2))))
 
 (struct quad (attrs
               elems
+              size
               in
               out
               inner
               offset
               origin
-              size
               printable
               pre-draw
               post-draw
-              draw) #:transparent #:mutable
+              draw) #:mutable
   #:methods gen:equal+hash
   [(define equal-proc quad=?)
    (define (hash-proc h recur) (equal-hash-code h))
@@ -40,49 +51,56 @@
 
 (define (default-printable [sig #f]) #f)
 
-;; todo: convert immutable hashes to mutable on input?
-(define make-quad
-  (match-lambda*
-    [(list (== #false) elems ...) elems (apply make-quad (make-hasheq) elems)]
-    [(list (? hash? attrs) elems ...)
-  ;; why 'nw and 'ne as defaults for in and out points:
-  ;; if size is '(0 0), 'nw and 'ne are the same point,
-  ;; and everything piles up at the origin
-  ;; if size is otherwise, the items don't pile up (but rather lay out in a row)
-  (define in 'nw)
-  (define out 'ne)
-  (define inner #f)
-  (define offset '(0 0))
-  (define origin '(0 0))
-  (define size '(0 0))
-  (define printable default-printable)
-  (define pre-draw void)
-  (define post-draw void)
-  (define (draw q surface)
-    ((quad-pre-draw q) q surface)
-    (for-each (λ (qi) ((quad-draw qi) qi surface)) (quad-elems q))
-    ((quad-post-draw q) q surface))
-  (quad (or attrs (make-hasheq))
-        elems
-        in
-        out
-        inner
-        offset
-        origin
-        size
-        printable
-        pre-draw
-        post-draw
-        draw)]
-    [(list (? dict? assocs) elems ...) assocs (apply make-quad (make-hasheq assocs) elems)]
-    [(list elems ...) (apply make-quad #f elems)]))
+(define (default-draw q surface)
+  ((quad-pre-draw q) q surface)
+  (for-each (λ (qi) ((quad-draw qi) qi surface)) (quad-elems q))
+  ((quad-post-draw q) q surface))
 
+;; why 'nw and 'ne as defaults for in and out points:
+;; if size is '(0 0), 'nw and 'ne are the same point,
+;; and everything piles up at the origin
+;; if size is otherwise, the items don't pile up (but rather lay out in a row)
+
+
+;; todo: convert immutable hashes to mutable on input?
+(define (make-quad 
+         #:attrs [attrs (make-hasheq)]
+         #:elems [elems null]
+         #:size [size '(0 0)]
+         #:in [in 'nw]
+         #:out [out 'ne]
+         #:inner [inner #f]
+         #:offset [offset '(0 0)]
+         #:origin [origin '(0 0)]
+         #:printable [printable default-printable]
+         #:pre-draw [pre-draw void]
+         #:post-draw [post-draw void]
+         #:draw [draw default-draw]
+         . args)
+  (match args
+    [(list (== #false) elems ...) (make-quad #:elems elems)]
+    [(list (? hash? attrs) elems ...) (make-quad #:attrs attrs #:elems elems)]
+    [(list (? dict? assocs) elems ...) assocs (make-quad #:attrs (make-hasheq assocs) #:elems elems)]
+    [(list elems ..1) (make-quad #:elems elems)]
+    [null (quad attrs
+                elems
+                size
+                in
+                out
+                inner
+                offset
+                origin
+                printable
+                pre-draw
+                post-draw
+                draw)]))
+  
 (define q make-quad)
 
 (module+ test
-  (define q1 (make-quad #f '(#\H #\e #\l #\o)))
-  (define q2 (make-quad #f '(#\H #\e #\l #\o)))
-  (define q3 (make-quad #f '(#\H #\e #\l)))
+  (define q1 (q #f #\H #\e #\l #\o))
+  (define q2 (q #f #\H #\e #\l #\o))
+  (define q3 (q #f #\H #\e #\l))
   (check-true (equal? q1 q1))
   (check-true (equal? q1 q2))
   (check-false (equal? q1 q3))