diff --git a/quad/wrap-typed.rkt b/quad/wrap-typed.rkt index e1696a04..0275431c 100644 --- a/quad/wrap-typed.rkt +++ b/quad/wrap-typed.rkt @@ -220,3 +220,48 @@ (quad-attr-set q world:width-key (fl+ (overhang-width q-left) (overhang-width q-right))) q))] [else exploded-line-quads])) + + +;; ultimately every line is filled to fit the whole measure. +;; spacers are used to soak up extra space left over in a line. +;; depending on where the spacers are inserted, different formatting effects are achieved. +;; e.g., left / right / centered / justified. +(define/typed (insert-spacers-in-line line [alignment-override #f]) + ((Quad) ((Option Symbol)) . ->* . Quad) + ;; important principle: avoid peeking into quad-list to get attributes. + ;; because non-attributed quads may be added. + ;; here, we know that common attributes are hoisted into the line. + ;; so rely on line attributes to get horiz alignment. + (define key-to-use (if (and (last-line? line) (quad-has-attr? line world:horiz-alignment-last-line-key)) + world:horiz-alignment-last-line-key + world:horiz-alignment-key)) + + (define horiz-alignment (or alignment-override (quad-attr-ref line key-to-use (world:horiz-alignment-default)))) + (define default-spacer (spacer)) + (define-values (before middle after) (case horiz-alignment + [(left) (values #f #f default-spacer)] + [(right) (values default-spacer #f #f)] + [(center) (values default-spacer #f default-spacer)] + [(justified justify) (values #f default-spacer #f)] + [else (values #f #f #f)])) + + (define/typed (copy-with-attrs q attr-source) + (Quad Quad . -> . Quad) + (define keys-to-ignore '(width)) ; width will be determined during fill routine + (define filtered-hash (cast (and (quad-attrs attr-source) + (foldl (λ(k [ht : HashTableTop]) (hash-remove ht k)) (quad-attrs attr-source) keys-to-ignore)) QuadAttrs)) + (quad (quad-name q) (merge-attrs filtered-hash q) (quad-list q))) + + + #| + + (quad (quad-name line) (quad-attrs line) (flatten (let ([qs : (Listof Quad) (quad-list line)]) + `(,@(if before (copy-with-attrs before (first qs)) null) + + ,@(map (λ(q) (if (and middle (takes-justification-space? q)) + (let ([interleaver (copy-with-attrs middle q)]) + (list interleaver q interleaver)) + q)) qs) + ,@(if after (copy-with-attrs after (last qs)) null))))) +|# + line)