refac

pitfall/pitfall/fonts.rkt

@@ -2,65 +2,62 @@
 (require
   racket/class
   racket/match
-  racket/contract
-  sugar/unstable/class
-  sugar/unstable/js
   sugar/unstable/dict
   "font-open.rkt")
 (provide fonts-mixin)
 
-(define (fonts-mixin [% mixin-tester%])
+(define (fonts-mixin [% object%])
   (class %
     (super-new)
-    (field [@font-families (mhash)]
+    (field [@font-families (make-hash)]
            [@font-count 0]
            [(@current-font-size current-font-size) 12] ; font state used by text.rkt
            [(@current-font current-font) #f] ; font state used by text.rkt
-           [@registered-fonts (mhash)])
+           [@registered-fonts (make-hash)])
     
     (define/public (font src [size-or-family #f] [maybe-size #f])
-      (match-define (list family size) (match size-or-family
+      (match-define (list family size)
-                                         [(? number?)(list #f size-or-family)]
+        (match size-or-family
-                                         [_ (list size-or-family maybe-size)]))
+          [(? number?) (list #f size-or-family)]
+          [_ (list size-or-family maybe-size)]))
       ;; check registered fonts if src is a string
-      (define cache-key (match src
+      (define cache-key
-                          [(? string?) #:when (hash-has-key? @registered-fonts src)
+        (match src
-                                       (define ck src)
+          [(? string?) #:when (hash-has-key? @registered-fonts src)
-                                       (set! src (· (hash-ref @registered-fonts ck) src))
+                       (define ck src)
-                                       (set! family (· (hash-ref @registered-fonts ck) family))
+                       (set! src (hash-ref (hash-ref @registered-fonts ck) 'src))
-                                       ck]
+                       (set! family (hash-ref (hash-ref @registered-fonts ck) 'family))
-                          [_ (match (or family src)
+                       ck]
-                               [(? string? str) str]
+          [_ (match (or family src)
-                               [_ #false])]))
+               [(? string? str) str]
-
+               [_ #false])]))
+      
       (when size (font-size size))
-      (cond       ;; fast path: check if the font is already in the PDF
+
-        [(hash-ref @font-families cache-key #f)
+      (match (hash-ref @font-families cache-key #f) ; check if the font is already in the PDF
-         => (λ (val) (set! @current-font val))]
+        [(? values val) (set! @current-font val)]
-        [else ;; load the font
+        [_ ; if not, load the font
          (set! @font-count (add1 @font-count))
          (define id (format "F~a" @font-count))
          (set! @current-font (PDFFont-open this src family id))
-         ;; check for existing font familes with the same name already in the PDF
+         ;; check for existing font families with the same name already in the PDF
-         ;; useful if the font was passed as a buffer
+         (match (hash-ref @font-families (get-field name @current-font) #f)
-         (match (hash-ref @font-families (· @current-font name) #f)
            [(? values font) (set! @current-font font)]
            [_ ;; save the font for reuse later
             (when cache-key (hash-set! @font-families cache-key @current-font))
-            (hash-set! @font-families (· @current-font name) @current-font)])])
+            (hash-set! @font-families (get-field name @current-font) @current-font)])])
       this)
 
     (define/public (font-size size)
       (set! @current-font-size size)
       this)
 
-    (define/public (current-line-height [includeGap #f])
+    (define/public (current-line-height [include-gap #f])
-      (send @current-font lineHeight @current-font-size includeGap))
+      (send @current-font lineHeight @current-font-size include-gap))
-
 
     (define/public (register-font name src [family #f])
-      (hash-set! @registered-fonts name
+      (hash-set! @registered-fonts name (make-hash (list (cons 'src src)
-                 (mhash 'src src 'family family))
+                                                         (cons 'family family))))
       this)))