cleaner

pitfall/fontkit/cvt_.rkt

@@ -6,9 +6,9 @@ approximates
 https://github.com/mbutterick/fontkit/blob/master/src/tables/cvt.js
 |#
 
-(define-subclass Struct (Rcvt))
+(define-subclass Struct (Rcvt_))
 
-(define cvt (make-object Rcvt
+(define cvt_ (make-object Rcvt_
                (dictify
                 'controlValues (+Array int16be))))
 
@@ -25,8 +25,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/cvt.js
  (check-equal? table-bytes (peek-bytes len offset ip))
  (define ds (+DecodeStream (peek-bytes len offset ip)))
  (define cvt-array '(20 43 83 0 16 -218 0 481 11 671 18 736 8))
- (check-equal? (hash-ref (send cvt decode ds) 'controlValues) cvt-array)
+ (check-equal? (hash-ref (send cvt_ decode ds) 'controlValues) cvt-array)
  (define es (+EncodeStream))
- (send cvt encode es (mhash 'controlValues cvt-array))
+ (send cvt_ encode es (mhash 'controlValues cvt-array))
  (check-equal? (send es dump) table-bytes)
  )

pitfall/fontkit/directory.rkt

@@ -10,9 +10,9 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/directory.js
 (define-subclass Struct (RTableEntry)
   (define/override (preEncode this-val stream)
     (when (eq? (hash-ref this-val 'tag) 'cvt)
-        (hash-set! this-val 'tag '|cvt |))))
+      (hash-set! this-val 'tag '|cvt |))))
 
-(define TableEntry (+RTableEntry
+(define TableEntry (+Struct
                     (dictify 'tag (+String 4)
                              'checkSum uint32be
                              'offset uint32be
@@ -24,12 +24,21 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/directory.js
       (bytes-append bstr (make-bytes (- 4 mod) 0))
       bstr))
 
+(define (symbol-replace sym this that)
+  (string->symbol (string-replace (symbol->string sym) this that)))
+
+(define (escape-tag tag)
+  (symbol-replace (if (string? tag) (string->symbol tag) tag) " " "_"))
+
+(define (unescape-tag tag)
+  (symbol-replace (if (string? tag) (string->symbol tag) tag) "_" " "))
+
 (define-subclass Struct (RDirectory)
   (define/override (process this-res stream)
     ;; in `restructure` `process` method, `res` is aliased as `this`
     (define new-tables-val (mhash))
     (for ([table (in-list (· this-res tables))])
-         (hash-set! new-tables-val (string->symbol (string-trim (· table tag))) table))
+         (hash-set! new-tables-val (escape-tag (· table tag)) table))
     (hash-set! this-res 'tables new-tables-val))
 
   (define/override (preEncode this-val stream)
@@ -41,9 +50,9 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/directory.js
           #:unless (hash-has-key? table-header-hash i))
          (hash-set! table-header-hash i
                     (let/cc k
-                              (hash-set! offset-ks i k)
-                              (mhash
-                               'tag tag))))
+                      (hash-set! offset-ks i k)
+                      (mhash
+                       'tag (unescape-tag tag)))))
 
     (define table-headers (for/list ([i (in-range (length (hash-keys table-header-hash)))])
                                     (hash-ref table-header-hash i)))
@@ -52,7 +61,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/directory.js
     (define data-hash (mhash))
     (for/fold ([current-offset table-header-size])
               ([(table-header i) (in-indexed table-headers)])
-      (define tag (· table-header tag))
+      (define tag (escape-tag (· table-header tag)))
       (define bstr (hash-ref! data-hash i
                               (λ ()
                                 (define es (+EncodeStream))
@@ -64,7 +73,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/directory.js
       (cond
         [(hash-ref offset-ks i #f) => (λ (k) (hash-remove! offset-ks i)
                                         (k (mhash
-                                            'tag (· table-header tag)
+                                            'tag (unescape-tag (· table-header tag))
                                             'checkSum 0
                                             'offset current-offset
                                             'length (bytes-length bstr))))]

pitfall/fontkit/font.rkt

@@ -282,6 +282,5 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
  (define subset (make-object TTFSubset f))
  (define es (+EncodeStream))
  (send subset encode es)
- (define ds (+DecodeStream (send es dump)))
- (send Directory decode ds)
+ (check-equal? (send es dump) (file->bytes "subsetfont.rktd"))
  )

pitfall/fontkit/subset.rkt

@@ -90,7 +90,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js
                 'hhea hhea
                 'loca (· this loca)
                 'maxp maxp
-                'cvt (send (· this font) _getTable 'cvt)
+                'cvt_ (send (· this font) _getTable 'cvt_)
                 'prep (send (· this font) _getTable 'prep)
                 'glyf (· this glyf)
                 'hmtx (· this hmtx)

pitfall/fontkit/tables.rkt

@@ -9,4 +9,4 @@
                     (test-module (require (submod TABLE-ID-STRING test) ...))
                     (define ID (make-hasheq (map cons (list 'TABLE-ID ...) (list TABLE-ID ...)))))))
 
-(define-table-decoders table-codecs maxp hhea head loca prep fpgm hmtx cvt glyf)
+(define-table-decoders table-codecs maxp hhea head loca prep fpgm hmtx cvt_ glyf)