brick2

quad/measure-typed.rkt

@@ -48,7 +48,7 @@
                           (make-hash '()))))
 
 
-(define-type mms-type ((String String) (Symbol Symbol) . ->* . (Listof Nonnegative-Flonum)))
+(define-type mms-type ((String String) (Symbol Symbol) . ->* . (List Nonnegative-Flonum Nonnegative-Flonum Nonnegative-Flonum Nonnegative-Flonum)))
 (: measure-max-size mms-type)
 (define measure-max-size 
   (cast (make-caching-proc (λ(text font [weight 'normal] [style 'normal])

quad/tests-typed.rkt

@@ -8,3 +8,15 @@
 (check-equal? (flatten-attrs (box '(foo bar)) (hash 'x 10.0)) (apply hash '(foo bar x 10.0)))
 (check-equal? (flatten-attrs (hash 'x -5.0) (hash 'x 10.0)) (apply hash '(x 5.0)))
 (check-equal? (merge-attrs (hash 'x -5.0) (hash 'x 10.0)) (apply hash '(x 10.0)))
+
+(check-equal? (gather-common-attrs (list (box '(foo bar)) (box '(foo bar goo bar zam zino)) (box '(foo bar)))) (list (cons 'foo 'bar)))
+(check-equal? (gather-common-attrs (list (box) (box '(foo bar goo bar zam zino)) (box '(foo bar)))) #f)
+(check-equal? (gather-common-attrs (list (box '(width bar)) (box '(width bar)) (box '(width bar)))) #f)
+
+(define b1 (box '(x 10) "1st" (box '(foo bar) "2nd") "3rd"))
+(define b1-flattened (list (box '(x 10) "1st") (box '(x 10 foo bar) "2nd") (box '(x 10) "3rd")))
+
+(define b3 (box #f (word) (line) (page)))
+(check-true (sequence? b3))
+
+;(check-true (quad= (flatten-quad b1) b1-flattened))

quad/utils-typed.rkt

@@ -25,7 +25,7 @@
                                                      [(quad-attrs? x) (cast x QuadAttrs)]
                                                      [(hashable-list? x) (quadattrs (cast x (Listof Any)))]
                                                      [else ;; something that will have no effect on result 
-                                                      (cast hash QuadAttrs)])) quads-or-attrs-or-lists)))
+                                                      (cast (hash) QuadAttrs)])) quads-or-attrs-or-lists)))
 
 
 ;; flatten merges attributes, but applies special logic suitable to flattening
@@ -58,5 +58,29 @@
 (provide merge-attrs)
 (: merge-attrs ((U Quad QuadAttrs HashableList) * . -> . QuadAttrs))
 (define (merge-attrs . quads-or-attrs-or-lists)
-  (cast (for/hash ([kv-pair (in-list (join-attrs quads-or-attrs-or-lists))])
-      (values (car kv-pair) (cdr kv-pair))) QuadAttrs))
+  (for/hash : QuadAttrs ([kv-pair (in-list (join-attrs quads-or-attrs-or-lists))])
+      (values (car kv-pair) (cdr kv-pair))))
+
+
+
+;; pushes attributes down from parent quads to children, 
+;; resulting in a flat list of quads.
+;; input is often large, so macro allows us to avoid allocation
+#|
+(provide flatten-quad)
+(: flatten-quad (Quad . -> . (Listof Quad)))
+(define (flatten-quad q)
+  (flatten
+   (let loop ([x q][parent #f])
+     (cond       
+       [(quad? x)
+        (let ([x-with-parent-attrs (quad (quad-name x) 
+                                         (flatten-attrs parent x) ; child positioned last so it overrides parent attributes 
+                                         (quad-list x))])
+          (if (empty? (quad-list x))
+              x-with-parent-attrs ; no subelements, so stop here
+              (map (λ(xi) (loop xi x-with-parent-attrs)) (quad-list x))))] ; replace quad with its elements
+       [(string? x) (quad (quad-name parent) (quad-attrs parent) (list x))]))))
+
+
+|#