From ec2820390531dd2f49269a16861a88a3986aefb3 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 5 Mar 2015 17:43:30 -0800 Subject: [PATCH] improve typed measurement --- quad/measure-typed.rkt | 30 ++++++++++++++++++++---------- 1 file changed, 20 insertions(+), 10 deletions(-) diff --git a/quad/measure-typed.rkt b/quad/measure-typed.rkt index 7b9fbd1d..c81b60b8 100644 --- a/quad/measure-typed.rkt +++ b/quad/measure-typed.rkt @@ -1,6 +1,8 @@ #lang typed/racket/base (require typed/racket/class) -(require/typed racket/draw [record-dc% (Class (init-field))] +(require/typed racket/draw + [record-dc% (Class (init-field) + (get-text-extent (String (Instance (Class (init-field))) Any . -> . (values Nonnegative-Real Nonnegative-Real Nonnegative-Real Nonnegative-Real))))] [make-font ((#:size Nonnegative-Flonum) (#:style Symbol) (#:weight Symbol) (#:face String) . -> . (Instance (Class (init-field))))]) (require/typed sugar/cache [make-caching-proc (Procedure . -> . Procedure)]) (require/typed racket/serialize [serialize (Any . -> . Any)] @@ -48,15 +50,22 @@ (make-hash '())))) -(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]) - ;((string? string?) (symbol? symbol?) . ->* . number?) - (define font-instance (hash-ref! (current-font-cache) (list font weight style) (λ() (make-font #:size max-size #:style style #:weight weight #:face font)))) - ;; 'combine' boolean only makes a difference for two or more chars - (hash-ref! (current-text-cache) (list text font weight style) (λ() (current-text-cache-changed? #t) - (values->list (send dc get-text-extent text font-instance (>= (string-length text) 1))))))) mms-type)) +(define-type Measurement-Result-Type (List Nonnegative-Flonum Nonnegative-Flonum Nonnegative-Flonum Nonnegative-Flonum)) +(define-type MMS-Type ((String String) (Symbol Symbol) . ->* . Measurement-Result-Type)) + +(: measure-max-size-base MMS-Type) +(define (measure-max-size-base text font [weight 'normal] [style 'normal]) + (define font-instance (cast (hash-ref! (current-font-cache) (list font weight style) (λ() (make-font #:size max-size #:style style #:weight weight #:face font))) (Instance (Class (init-field))))) + ;; 'combine' boolean only makes a difference for two or more chars + (send dc get-text-extent text font-instance (>= (string-length text) 1)) + (cast (hash-ref! (current-text-cache) (list text font weight style) (λ() #;(current-text-cache-changed? #t) + (values->list (send dc get-text-extent text font-instance (>= (string-length text) 1))))) Measurement-Result-Type)) + +(define measure-cache ((inst make-hash (List String String Symbol Symbol) Measurement-Result-Type))) + +(: measure-max-size MMS-Type) +(define (measure-max-size text font [weight 'normal] [style 'normal]) + (hash-ref! measure-cache (list text font weight style) (λ () (measure-max-size-base text font weight style)))) @@ -87,3 +96,4 @@ ;; Native function only accepts integers, so get max-size and scale down to size needed. (define raw-baseline-distance (measure-ascent-max-size text font weight style)) (cast (round-float (/ (* (exact->inexact raw-baseline-distance) (exact->inexact size)) max-size)) Nonnegative-Flonum)) +