tidying

quad/measure-typed.rkt

@@ -6,7 +6,7 @@
                                    (get-text-extent (String (Instance (Class (init-field))) Any . -> . (values Nonnegative-Real Nonnegative-Real Nonnegative-Real Nonnegative-Real))))]
                [make-font ((#:size Nonnegative-Float) (#:style Symbol) (#:weight Symbol) (#:face String) . -> . (Instance (Class (init-field))))])
 (require/typed racket/serialize [serialize (Any . -> . Any)]
-               [deserialize (Any . -> . (HashTable Any Any))])
+               [deserialize (Any . -> . (HashTable (List String String Symbol Symbol) Measurement-Result-Type))])
 (provide measure-text measure-ascent round-float update-text-cache-file load-text-cache-file)
 
 (define precision 4.0)
@@ -15,9 +15,7 @@
 (define dc (new record-dc%))
 (define-type Measurement-Result-Type (List Float Float Float Float))
 (define mrt? (make-predicate Measurement-Result-Type))
-(define-type MMS-Type ((String String) (Symbol Symbol) . ->* . Measurement-Result-Type))
 (define current-text-cache (make-parameter ((inst make-hash (List String String Symbol Symbol) Measurement-Result-Type) '())))
-(define current-text-cache-changed? : (Parameterof Boolean) (make-parameter #f))
 (define current-font-cache (make-parameter ((inst make-hash (List String Symbol Symbol) (Instance (Class (init-field)))) '())))
 
 
@@ -25,6 +23,7 @@
 (define (round-float x)
   (/ (round (* base x)) base))
 
+
 (: get-cache-file-path (-> Path))
 (define (get-cache-file-path) 
   (build-path "font.cache"))
@@ -32,16 +31,14 @@
 
 (: update-text-cache-file (-> Void))
 (define (update-text-cache-file)
-  (when (current-text-cache-changed?)
+  (write-to-file (serialize (current-text-cache)) (get-cache-file-path) #:exists 'replace))
-    (write-to-file (serialize (current-text-cache)) (get-cache-file-path) #:exists 'replace)
-    (current-text-cache-changed? #f)))
 
 
 (:  load-text-cache-file (-> Void))
 (define (load-text-cache-file) 
   (define cache-file-path (get-cache-file-path))
   (current-text-cache (if (file-exists? cache-file-path)
-                          (cast (deserialize (file->value cache-file-path)) (HashTable (List String String Symbol Symbol) Measurement-Result-Type))
+                          (deserialize (file->value cache-file-path))
                           ((inst make-hash (List String String Symbol Symbol) Measurement-Result-Type) '()))))
 
 
@@ -50,27 +47,19 @@
   (hash-ref! (current-font-cache) (list font weight style) (λ() (make-font #:size max-size #:style style #:weight weight #:face font))))
 
 
-(: measure-max-size-base (String String Symbol Symbol . -> . Measurement-Result-Type))
+(: measure-max-size ((String String) (Symbol Symbol) . ->* . Measurement-Result-Type))
-(define (measure-max-size-base text font weight style)
+(define (measure-max-size text font [weight 'normal] [style 'normal])
   (: hash-updater (-> Measurement-Result-Type))
   (define (hash-updater) 
-    (current-text-cache-changed? #t)
+    #;(current-text-cache-changed? #t)
     (define font-instance (get-cached-font font weight style))
     ;; 'combine' boolean only makes a difference for two or more chars, so use (>= (string-length text) 1) for speed
     (define-values (width height descent extra) (send dc get-text-extent text font-instance (>= (string-length text) 1)))
     ;; avoid `map` here because it requires a cast to ensure the type
-    ;; this seems like a bug in TR: doesn't recognize (List Float Float Float Float) as subtype of (Listof Float)
+    ;; this seems like a bug in TR: doesn't recognize (List Float Float Float Float) as subtype of (Listof Float)?
     (list (fl width) (fl height) (fl descent) (fl extra)))
   ((inst hash-ref! (List String String Symbol Symbol) Measurement-Result-Type) (current-text-cache) (list text font weight style) hash-updater))
 
-
-;; rather than use define/caching from the (untyped) sugar/cache, implement the cache "manually"
-(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))))
-
-
 (define-syntax-rule (width x) (first x))
 (define-syntax-rule (height x) (second x))
 (define-syntax-rule (descent x) (third x))
@@ -78,8 +67,8 @@
 
 
 ;; works by taking max size and scaling it down. Allows caching of results.
-(: measure-text ((String Positive-Float String) (Symbol Symbol) . ->* . Float))
+(: measure-text (String Positive-Float String Symbol Symbol . -> . Float))
-(define (measure-text text size font [weight 'normal] [style 'normal])
+(define (measure-text text size font weight style)
   (define raw-width (width (measure-max-size text font weight style)))
   (round-float (/ (* raw-width size) max-size)))