next: addGlyph

pitfall/fontkit/charter-directory.rktd

@@ -1,32 +1,33 @@
 ((3)
-                 0
+  0
-                 ()
+  ()
-                 0
+  0
-                 ()
+  ()
-                 ()
+  ()
-                 (h
+  (h
-                  !
+   !
-                  ()
+   ()
-                  (tag u . "\u0000\u0001\u0000\u0000")
+   (tag u . "\u0000\u0001\u0000\u0000")
-                  (rangeShift . 96)
+   (rangeShift . 96)
-                  (searchRange . 128)
+   (data)
-                  (numTables . 14)
+   (searchRange . 128)
-                  (entrySelector . 3)
+   (numTables . 14)
-                  (tables
+   (tables
-                   h
+    h
-                   !
+    !
-                   (equal)
+    (equal)
-                   (loca h ! () (tag u . "loca") (offset . 38692) (checkSum . 2795817194) (length . 460))
+    (loca h ! () (tag u . "loca") (offset . 38692) (checkSum . 2795817194) (length . 460))
-                   (glyf h ! () (tag u . "glyf") (offset . 4620) (checkSum . 1143629849) (length . 34072))
+    (OS/2 h ! () (tag u . "OS/2") (offset . 360) (checkSum . 2351070438) (length . 96))
-                   (OS/2 h ! () (tag u . "OS/2") (offset . 360) (checkSum . 2351070438) (length . 96))
+    (glyf h ! () (tag u . "glyf") (offset . 4620) (checkSum . 1143629849) (length . 34072))
-                   (hhea h ! () (tag u . "hhea") (offset . 292) (checkSum . 132056097) (length . 36))
+    (hhea h ! () (tag u . "hhea") (offset . 292) (checkSum . 132056097) (length . 36))
-                   (post h ! () (tag u . "post") (offset . 41520) (checkSum . 1670855689) (length . 514))
+    (post h ! () (tag u . "post") (offset . 41520) (checkSum . 1670855689) (length . 514))
-                   (cvt h ! () (tag u . "cvt ") (offset . 4592) (checkSum . 10290865) (length . 26))
+    (cvt_ h ! () (tag u . "cvt ") (offset . 4592) (checkSum . 10290865) (length . 26))
-                   (VDMX h ! () (tag u . "VDMX") (offset . 1372) (checkSum . 1887795202) (length . 1504))
+    (VDMX h ! () (tag u . "VDMX") (offset . 1372) (checkSum . 1887795202) (length . 1504))
-                   (prep h ! () (tag u . "prep") (offset . 4512) (checkSum . 490862356) (length . 78))
+    (prep h ! () (tag u . "prep") (offset . 4512) (checkSum . 490862356) (length . 78))
-                   (maxp h ! () (tag u . "maxp") (offset . 328) (checkSum . 50135594) (length . 32))
+    (maxp h ! () (tag u . "maxp") (offset . 328) (checkSum . 50135594) (length . 32))
-                   (hmtx h ! () (tag u . "hmtx") (offset . 456) (checkSum . 3982043058) (length . 916))
+    (hmtx h ! () (tag u . "hmtx") (offset . 456) (checkSum . 3982043058) (length . 916))
-                   (cmap h ! () (tag u . "cmap") (offset . 2876) (checkSum . 1723761408) (length . 1262))
+    (cmap h ! () (tag u . "cmap") (offset . 2876) (checkSum . 1723761408) (length . 1262))
-                   (name h ! () (tag u . "name") (offset . 39152) (checkSum . 2629707307) (length . 2367))
+    (name h ! () (tag u . "name") (offset . 39152) (checkSum . 2629707307) (length . 2367))
-                   (head h ! () (tag u . "head") (offset . 236) (checkSum . 4281190895) (length . 54))
+    (head h ! () (tag u . "head") (offset . 236) (checkSum . 4281190895) (length . 54))
-                   (fpgm h ! () (tag u . "fpgm") (offset . 4140) (checkSum . 106535991) (length . 371)))))
+    (fpgm h ! () (tag u . "fpgm") (offset . 4140) (checkSum . 106535991) (length . 371)))
+   (entrySelector . 3)))

pitfall/fontkit/charter-italic-directory.rktd

@@ -9,19 +9,19 @@
    ()
    (tag u . "\u0000\u0001\u0000\u0000")
    (rangeShift . 96)
+   (data)
    (searchRange . 128)
    (numTables . 14)
-   (entrySelector . 3)
    (tables
     h
     !
     (equal)
     (loca h ! () (tag u . "loca") (offset . 37392) (checkSum . 46801904) (length . 460))
-    (glyf h ! () (tag u . "glyf") (offset . 4620) (checkSum . 2099535230) (length . 32772))
     (OS/2 h ! () (tag u . "OS/2") (offset . 360) (checkSum . 2367847603) (length . 96))
+    (glyf h ! () (tag u . "glyf") (offset . 4620) (checkSum . 2099535230) (length . 32772))
     (hhea h ! () (tag u . "hhea") (offset . 292) (checkSum . 113838023) (length . 36))
     (post h ! () (tag u . "post") (offset . 40280) (checkSum . 1671576585) (length . 514))
-    (cvt h ! () (tag u . "cvt ") (offset . 4592) (checkSum . 9307818) (length . 26))
+    (cvt_ h ! () (tag u . "cvt ") (offset . 4592) (checkSum . 9307818) (length . 26))
     (VDMX h ! () (tag u . "VDMX") (offset . 1372) (checkSum . 1905948947) (length . 1504))
     (prep h ! () (tag u . "prep") (offset . 4512) (checkSum . 776081685) (length . 78))
     (maxp h ! () (tag u . "maxp") (offset . 328) (checkSum . 50135583) (length . 32))
@@ -29,4 +29,5 @@
     (cmap h ! () (tag u . "cmap") (offset . 2876) (checkSum . 1723761408) (length . 1262))
     (name h ! () (tag u . "name") (offset . 37852) (checkSum . 2313429994) (length . 2427))
     (head h ! () (tag u . "head") (offset . 236) (checkSum . 4275817075) (length . 54))
-    (fpgm h ! () (tag u . "fpgm") (offset . 4140) (checkSum . 106535991) (length . 371)))))
+    (fpgm h ! () (tag u . "fpgm") (offset . 4140) (checkSum . 106535991) (length . 371)))
+   (entrySelector . 3)))

pitfall/fontkit/cvt_.rkt

@@ -16,8 +16,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/cvt.js
 (test-module
  (define ip (open-input-file charter-path))
  (define dir (deserialize (read (open-input-file charter-directory-path))))
- (define offset (· dir tables cvt offset))
+ (define offset (· dir tables cvt_ offset))
- (define len (· dir tables cvt length))
+ (define len (· dir tables cvt_ length))
  (check-equal? offset 4592)
  (check-equal? len 26)
  (set-port-position! ip 0)

pitfall/fontkit/directory.rkt

@@ -7,10 +7,6 @@
 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 |))))
 
 (define TableEntry (+Struct
                     (dictify 'tag (+String 4)
@@ -19,82 +15,66 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/directory.js
                              'length uint32be)))
 
 (define (pad-to-32bit bstr)
-  (define mod (modulo (bytes-length bstr) 4))
+  (define op (open-output-bytes))
-  (if (positive? mod)
+  (write-bytes bstr op)
-      (bytes-append bstr (make-bytes (- 4 mod) 0))
+  (file-position op (* (ceiling (/ (file-position op) 4)) 4))
-      bstr))
+  (get-output-bytes op))
-
+
+(test-module
+ (check-equal? (pad-to-32bit #"") #"")
+ (check-equal? (pad-to-32bit #"1") #"1\0\0\0")
+ (check-equal? (pad-to-32bit #"12") #"12\0\0")
+ (check-equal? (pad-to-32bit #"123") #"123\0")
+ (check-equal? (pad-to-32bit #"1234") #"1234"))
+
+;; for stupid tags like 'cvt '
 (define (symbol-replace sym this that)
-  (string->symbol (string-replace (symbol->string sym) this that)))
+  (string->symbol (string-replace (if (string? sym) sym (symbol->string sym)) this that)))
-
+(define (escape-tag tag) (symbol-replace tag " " "_"))
-(define (escape-tag tag)
+(define (unescape-tag tag) (symbol-replace 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 (escape-tag (· table tag)) table))
     (hash-set! this-res 'tables new-tables-val))
 
   (define/override (preEncode this-val stream)
-    
+    (define preamble-length 12)
-    (define offset-ks (mhash))
+    (define table-header-size (+ preamble-length
-    (define table-header-hash (mhash))
+                                 (* (length (hash-keys (· this-val tables))) (send TableEntry size))))
-    (for ([(tag table) (in-hash (· this-val tables))]
+
-          [i (in-naturals)]
+    (define-values (table-headers table-datas)
-          #:unless (hash-has-key? table-header-hash i))
+      (for/lists (ths tds)
-         (hash-set! table-header-hash i
+                 ([(tag table) (in-hash (· this-val tables))])
-                    (let/cc k
+
-                      (hash-set! offset-ks i k)
+                 (define table-data
-                      (mhash
+                   (let ([es (+EncodeStream)])
-                       'tag (unescape-tag tag)))))
+                     (send (hash-ref table-codecs tag) encode es table)
-
+                     (send es dump)))
-    (define table-headers (for/list ([i (in-range (length (hash-keys table-header-hash)))])
+
-                                    (hash-ref table-header-hash i)))
+                 (define table-header (mhash
-    (define table-header-size (+ 12 (* (length table-headers) (send TableEntry size))))
+                                       'tag (unescape-tag tag)
-
+                                       'checkSum 0
-    (define data-hash (mhash))
+                                       'offset (+ table-header-size (apply + (map bytes-length tds)))
-    (for/fold ([current-offset table-header-size])
+                                       'length (bytes-length table-data)))
-              ([(table-header i) (in-indexed table-headers)])
+
-      (define tag (escape-tag (· table-header tag)))
+                 (define table-data-padded (pad-to-32bit table-data))
-      (define bstr (hash-ref! data-hash i
+                 (values table-header table-data-padded)))
-                              (λ ()
+
-                                (define es (+EncodeStream))
-                                (define tag-codec (hash-ref table-codecs tag (λ () (raise-argument-error 'directory:preEncode "valid table tag" tag))))
-                                (send tag-codec encode es (hash-ref (· this-val tables) tag))
-                                (send es dump))))
-      (define 32-bit-bstr (pad-to-32bit bstr))
-
-      (cond
-        [(hash-ref offset-ks i #f) => (λ (k) (hash-remove! offset-ks i)
-                                        (k (mhash
-                                            'tag (unescape-tag (· table-header tag))
-                                            'checkSum 0
-                                            'offset current-offset
-                                            'length (bytes-length bstr))))]
-        [else
-         (+ (bytes-length 32-bit-bstr) current-offset)]))
-    
-    (hash-set! this-val 'data (for/list ([i (in-range (length (hash-keys data-hash)))])
-                                        (pad-to-32bit (hash-ref data-hash i))))
 
     (define numTables (length table-headers))
     (define searchRange (* (floor (log (/ numTables (log 2)))) 16))
-    (define entrySelector (floor (/ searchRange (log 2))))
-    (define rangeShift (- (* numTables 16) searchRange))
     
     (hash-set*! this-val
                 'tag "true"
                 'numTables numTables
                 'tables table-headers
                 'searchRange searchRange
-                'entrySelector rangeShift
+                'entrySelector (floor (/ searchRange (log 2)))
-                'rangeShift rangeShift)))
+                'rangeShift (- (* numTables 16) searchRange)
+                'data table-datas)))
       
 
 (define Directory (+RDirectory
@@ -113,10 +93,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/directory.js
 (define (directory-decode ip [options (mhash)])
   (send Directory decode (+DecodeStream (port->bytes ip))))
 
-#;(test-module
+(test-module
-   (define ip (open-input-file charter-path))
+ (define ip (open-input-file charter-path))
-   (define decoded-dir (deserialize (read (open-input-file charter-directory-path))))
+ (define decoded-dir (deserialize (read (open-input-file charter-directory-path))))
-   (check-equal? (directory-decode ip) decoded-dir)
+ (check-equal? (directory-decode ip) decoded-dir)
-   (define es (+EncodeStream))
+ )
-   ;(send Directory encode es decoded-dir)
-   )

pitfall/fontkit/font.rkt

@@ -282,5 +282,6 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
  (define subset (make-object TTFSubset f))
  (define es (+EncodeStream))
  (send subset encode es)
+ #;(with-output-to-file "subsetfont.rktd" (λ () (display (send es dump)) ))
  (check-equal? (send es dump) (file->bytes "subsetfont.rktd"))
  )

pitfall/fontkit/subset.rkt

@@ -51,7 +51,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js
   
   )
 
-(define-stub-go _addGlyph)
+(define (_addGlyph . xs)
+  (void))
 
 ;; tables required by PDF spec:
 ;; head, hhea, loca, maxp, cvt, prep, glyf, hmtx, fpgm
@@ -97,7 +98,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js
                 'fpgm (send (· this font) _getTable 'fpgm)
                 )))
 
-  #;(report* (bytes-length (send stream dump)) (send stream dump))
+  (report* (bytes-length (send stream dump)))
   
   (void)
   )

pitfall/fontkit/tables.rkt

@@ -1,7 +1,7 @@
 #lang fontkit/racket
 (provide (all-defined-out))
 
-(define-macro (define-table-decoders ID TABLE-ID ...)
+(define-macro (define-table-codecs ID TABLE-ID ...)
   (with-pattern ([(TABLE-ID-STRING ...) (pattern-case-filter #'(TABLE-ID ...)
                                                         [STX (datum->syntax caller-stx (format "~a.rkt" (syntax->datum #'STX)))])]) 
                 #'(begin
@@ -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-codecs table-codecs maxp hhea head loca prep fpgm hmtx cvt_ glyf)