From 656e122a07b3fb4578c060cdceac527fdfbbd5d7 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 21 Feb 2015 16:00:38 -0800 Subject: [PATCH] measurement-keys --- quad/wrap-typed.rkt | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/quad/wrap-typed.rkt b/quad/wrap-typed.rkt index a1155b53..732b4d28 100644 --- a/quad/wrap-typed.rkt +++ b/quad/wrap-typed.rkt @@ -352,3 +352,20 @@ (define broken-pieces (break-at pieces bps)) ; 5% (map (λ(bp) (compose-line-proc bp measure-quad-proc)) broken-pieces)))) ; 50% +(define width? flonum?) +(define measure? flonum?) +(define (breakpoints? x) (and (list? x) (andmap integer? x))) + +(define/typed (install-measurement-keys p) + (Quad . -> . Quad) + (define basic-width (round-float (apply + ((inst map Flonum Quad) quad-width (cast (quad-list p) (Listof Quad)))))) + (define p-word-break (cast (quad-attr-ref p world:word-break-key #f) Quad)) + (define before-break-width (fl+ basic-width (if p-word-break + (quad-width (word (quad-attrs p-word-break) (cast (quad-attr-ref p-word-break world:before-break-key) QuadListItem))) + 0.0))) + (define no-break-width (fl+ basic-width (if p-word-break + (quad-width (word (quad-attrs p-word-break) (cast (quad-attr-ref p-word-break world:no-break-key) QuadListItem))) + 0.0))) + (quad-attr-set* p 'bb-width before-break-width 'nb-width no-break-width)) + +