next: troubleshoot ft metrics on otf

5 years ago · eddbc30382
parent 93be8eda04
commit eddbc30382
5 changed files with 105 additions and 68 deletions
--- a/fontland/fontland/glyph.rkt
+++ b/fontland/fontland/glyph.rkt
@ -1,4 +1,4 @@
-#lang racket/base
+#lang debug racket/base
 (require sugar/unstable/dict
         "unsafe/freetype.rkt"
         "table-stream.rkt"
@ -38,11 +38,12 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/Glyph.js
    (FT_Load_Glyph face (glyph-id g) FT_LOAD_NO_RECURSE)
    (define glyph (FT_FaceRec-glyph face))
    (define ft-glyph-metrics (FT_GlyphSlotRec-metrics glyph))
+    #R (FT_Glyph_Metrics->list ft-glyph-metrics)
    (set-glyph-metrics! g (mhash))
    (hash-set*! (glyph-metrics g)
                'advanceWidth (FT_Glyph_Metrics-horiAdvance ft-glyph-metrics)
                'leftBearing (FT_Glyph_Metrics-horiBearingX ft-glyph-metrics)))
-  (glyph-metrics g))
+  #R (glyph-metrics g))

 (define (+ttf-glyph . args)
  (apply +glyph #:constructor ttf-glyph args))
--- a/fontland/fontland/struct.rkt
+++ b/fontland/fontland/struct.rkt
@ -21,4 +21,6 @@

 (struct ttf-glyph glyph () #:transparent)

-(struct cff-glyph glyph () #:transparent)
+(struct cff-glyph glyph ([usedGsubrs #:auto] [usedSubrs #:auto])
+  #:transparent
+  #:auto-value (make-hash))
--- a/fontland/fontland/subset.rkt
+++ b/fontland/fontland/subset.rkt
@ -10,7 +10,8 @@
         fontland/glyph
         fontland/ttf-glyph
         xenomorph
-         racket/dict)
+         racket/dict
+         fontland/table/cff/cff-font)

 (provide subset +subset
         ttf-subset +ttf-subset
@ -77,22 +78,40 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/CFFSubset.js
 (define (subsetCharstrings this)
  (set-cff-subset-charstrings! this null)
  (define gsubrs (make-hash))
-  #;(for ([gid (in-list (subset-glyphs this))])
-       (define new-string (getCharString (cff-subset-cff this) gid))
-       (set-cff-subset-charstrings! this (cons new-string (cff-subset-charstrings this))))
-  (error 'subsetCharStrings-unfinished))
-
-(define (cff-subset-encode ss port)
-  ;; ss = this
-  ;; port = stream
-  (subsetCharstrings ss)
+  (for ([gid (in-list (subset-glyphs this))])
+       (set-cff-subset-charstrings!
+        this
+        (append (cff-subset-charstrings this)
+                (list (getCharString (cff-subset-cff this) gid))))
+
+       #R gid
+       (define glyph (get-glyph (subset-font this) gid))
+       (define path (hash-ref glyph 'path)) ;; this causes the glyph to be parsed
+
+       (for ([subr (in-list (hash-ref glyph '_usedGsubrs))])
+            (hash-set! gsubrs subr #true)))
+
+  (set-cff-subset-gsubrs! this (subsetSubrs (hash-ref (cff-subset-cff this) 'globalSubrIndex gsubrs))))
+
+(define (subsetSubrs this subrs used)
+  (for/list ([(subr i) (in-indexed subrs)])
+            (cond
+              [(list-ref used i)
+               (peek-bytes (hash-ref subr 'length)
+                           (hash-ref subr 'offset)
+                           (hash-ref (cff-subset-cff this) 'stream))]
+              [else (bytes 11)])))
+           
+  
+(define (cff-subset-encode this stream)
+  (subsetCharstrings this)
  (error 'cff-subset-encode-unfinished))

 #;(module+ test
-  (require "font.rkt" "helper.rkt")
-  (define otf (open-font (path->string fira-otf-path)))
-  (define cffss (+cff-subset otf))
-  cffss)
+    (require "font.rkt" "helper.rkt")
+    (define otf (open-font (path->string fira-otf-path)))
+    (define cffss (+cff-subset otf))
+    cffss)

 #|
 approximates
--- a/fontland/fontland/table/cff/cff-font.rkt
+++ b/fontland/fontland/table/cff/cff-font.rkt
@ -1,6 +1,6 @@
 #lang debug racket/base
 (require racket/class racket/match racket/list xenomorph "cff-top.rkt")
-(provide CFFFont)
+(provide (all-defined-out))

 #|
 approximates
@ -35,6 +35,10 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFFont.js

 (define CFFFont (make-object CFFFont%))

+(define (getCharString cff-font glyph-id)
+  (define glyph-record (list-ref (hash-ref (hash-ref cff-font 'topDict) 'CharStrings) glyph-id))
+  (peek-bytes (hash-ref glyph-record 'length) (hash-ref glyph-record 'offset) (hash-ref cff-font 'stream)))
+

 (module+ test
  (require rackunit racket/serialize racket/stream fontland/helper)
@ -83,4 +87,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFFont.js
  (check-equal? (hash-ref private 'BlueScale) 0.037)
  (check-equal? (hash-ref private 'BlueShift) 7)
  (check-equal? (hash-ref private 'ExpansionFactor) 0.06)
+  (check-equal?
+   (for/list ([h (in-list (take (hash-ref top-dict 'CharStrings) 100))])
+             (hash-ref h 'offset))
+   '(83610 83750 83753 83755 83776 83778 83810 83858 83890 83951 84023 84046 84068 84096 84132 84169 84233 84270 84292 84322 84380 84411 84439 84478 84498 84547 84575 84679 84711 84751 84784 84823 84919 84956 84964 84978 85011 85013 85101 85188 85300 85302 85396 85398 85407 85422 85436 85451 85547 85561 85587 85647 85784 85790 85824 85864 85933 85935 85960 85970 85972 86003 86027 86091 86106 86161 86176 86228 86238 86253 86273 86288 86347 86363 86385 86401 86423 86463 86496 86511 86541 86568 86578 86594 86627 86651 86680 86731 86733 86766 86769 86861 86887 86900 86919 86986 87017 87061 87098 87108))
  )
--- a/fontland/fontland/unsafe/freetype.rkt
+++ b/fontland/fontland/unsafe/freetype.rkt
@ -1,4 +1,4 @@
-#lang racket/base
+#lang debug racket/base
 (require ffi/unsafe
         ffi/unsafe/define
         racket/draw/private/libs)
@ -92,6 +92,7 @@
   [vertBearingY _FT_Pos]
   [vertAdvance _FT_Pos]))
 (provide (struct-out FT_Glyph_Metrics)
+         FT_Glyph_Metrics->list
         _FT_Glyph_Metrics _FT_Glyph_Metrics-pointer)

 (define-cstruct _FT_Vector
@ -344,10 +345,11 @@
                                    -> (err : _FT_Error)))

 (define+provide FT_KERNING_UNSCALED 2)
-(define+provide FT_LOAD_DEFAULT 0)
-(define+provide FT_LOAD_RENDER (expt 2 2))
-(define+provide FT_LOAD_LINEAR_DESIGN (expt 2 13))
-(define+provide FT_LOAD_NO_RECURSE (expt 2 10))
+(define+provide FT_LOAD_DEFAULT #x0)
+(define+provide FT_LOAD_RENDER (arithmetic-shift 1 2))
+(define+provide FT_LOAD_LINEAR_DESIGN (arithmetic-shift 1 13))
+(define+provide FT_LOAD_NO_RECURSE (arithmetic-shift 1 10))
+(define+provide FT_LOAD_NO_SCALE (arithmetic-shift 1 0))



@ -394,51 +396,56 @@
 (module+ test
  (require rackunit)
  (define ft-library (FT_Init_FreeType))
-  (define face (FT_New_Face ft-library "../assets/charter.ttf"))
-  (check-equal? (FT_Get_Postscript_Name face) "Charter")
-  (check-equal? (FT_FaceRec-units_per_EM face) 1000)
-  (check-true (FT_Load_Sfnt_Table face (tag->int #"cmap") 0 0 0))
-  (check-false (FT_Load_Sfnt_Table face (tag->int #"zzap") 0 0 0))
-  (check-true (cpointer? (FT_Get_Sfnt_Table face 'ft_sfnt_hhea)))
-  (define charter-hhea-table (cast (FT_Get_Sfnt_Table face 'ft_sfnt_hhea) _pointer _FT_HoriHeader-pointer))
-  (check-equal? (FT_HoriHeader-ascent charter-hhea-table) 980)
-  (check-equal? (FT_HoriHeader-descent charter-hhea-table) -238)
-  (check-equal? (FT_HoriHeader-lineGap charter-hhea-table) 0)
-  (check-equal?
-   (let ([bbox (FT_FaceRec-bbox face)])
-     (list (FT_BBox-xMin bbox)
-           (FT_BBox-yMin bbox)
-           (FT_BBox-xMax bbox)
-           (FT_BBox-yMax bbox))) '(-161 -236 1193 963))
-
-  (define H-gid (FT_Get_Char_Index face 72))
-  (FT_Load_Glyph face H-gid FT_LOAD_NO_RECURSE)
-  ; want bearingX (lsb) and advanceX (advance width)
-  (define g (FT_FaceRec-glyph face))
-  (define metrics (FT_GlyphSlotRec-metrics g))
-  (define bearingX (FT_Glyph_Metrics-horiBearingX metrics))
-  (check-equal? bearingX 33)
-  (define advanceX (FT_Glyph_Metrics-horiAdvance metrics))
-  (check-equal? advanceX 738)
-
-  (define charter-post-table (cast (FT_Get_Sfnt_Table face 'ft_sfnt_post) _pointer _FT_TT_Postscript-pointer))
-  (check-equal? (FT_TT_Postscript-italicAngle charter-post-table) 0)
-  (check-equal? (FT_TT_Postscript-underlinePosition charter-post-table) -178) ; -207 + 1/2 of thickness = -207 + 29
-  (check-equal? (FT_TT_Postscript-underlineThickness charter-post-table) 58)
-
-  (define os2-table (cast (FT_Get_Sfnt_Table face 'ft_sfnt_os2) _pointer _FT_TT_OS2-pointer))
-  (check-equal? (FT_TT_OS2-fsType os2-table) #b1000)
-  (check-equal? (FT_TT_OS2-yStrikeoutSize os2-table) 61)
-  (check-equal? (FT_TT_OS2-yStrikeoutPosition os2-table) 240)
-
-  (check-equal? (FT_panose->list (FT_TT_OS2-panose os2-table)) '(2 0 5 3 6 0 0 2 0 4))
-
-  (check-equal? (FT_TT_OS2-sTypoAscender os2-table) 762)
-  (check-equal? (FT_TT_OS2-sTypoDescender os2-table) -238)
-  (check-equal? (FT_TT_OS2-sCapHeight os2-table) 671)
-  (check-equal? (FT_TT_OS2-sxHeight os2-table) 481)
-
-  (FT_Done_Face face)
+  (define (test-face face-str)
+    (define face (FT_New_Face ft-library face-str))
+    (check-equal? (FT_Get_Postscript_Name face) "Charter")
+    (check-equal? (FT_FaceRec-units_per_EM face) 1000)
+    (check-true (FT_Load_Sfnt_Table face (tag->int #"cmap") 0 0 0))
+    (check-false (FT_Load_Sfnt_Table face (tag->int #"zzap") 0 0 0))
+    (check-true (cpointer? (FT_Get_Sfnt_Table face 'ft_sfnt_hhea)))
+    (define charter-hhea-table (cast (FT_Get_Sfnt_Table face 'ft_sfnt_hhea) _pointer _FT_HoriHeader-pointer))
+    (check-equal? (FT_HoriHeader-ascent charter-hhea-table) 980)
+    (check-equal? (FT_HoriHeader-descent charter-hhea-table) -238)
+    (check-equal? (FT_HoriHeader-lineGap charter-hhea-table) 0)
+    (check-equal?
+     (let ([bbox (FT_FaceRec-bbox face)])
+       (list (FT_BBox-xMin bbox)
+             (FT_BBox-yMin bbox)
+             (FT_BBox-xMax bbox)
+             (FT_BBox-yMax bbox))) '(-161 -236 1193 963))
+
+    (define H-gid (FT_Get_Char_Index face 72))
+    (FT_Load_Glyph face H-gid FT_LOAD_NO_RECURSE)
+    ; want bearingX (lsb) and advanceX (advance width)
+    (define g (FT_FaceRec-glyph face))
+    (define metrics (FT_GlyphSlotRec-metrics g))
+    #R (FT_Glyph_Metrics->list metrics)
+    (define bearingX (FT_Glyph_Metrics-horiBearingX metrics))
+    (check-equal? bearingX 33)
+    (define advanceX (FT_Glyph_Metrics-horiAdvance metrics))
+    (check-equal? advanceX 738)
+
+    (define charter-post-table (cast (FT_Get_Sfnt_Table face 'ft_sfnt_post) _pointer _FT_TT_Postscript-pointer))
+    (check-equal? (FT_TT_Postscript-italicAngle charter-post-table) 0)
+    (check-equal? (FT_TT_Postscript-underlinePosition charter-post-table) -178) ; -207 + 1/2 of thickness = -207 + 29
+    (check-equal? (FT_TT_Postscript-underlineThickness charter-post-table) 58)
+
+    (define os2-table (cast (FT_Get_Sfnt_Table face 'ft_sfnt_os2) _pointer _FT_TT_OS2-pointer))
+    (check-equal? (FT_TT_OS2-fsType os2-table) #b1000)
+    (check-equal? (FT_TT_OS2-yStrikeoutSize os2-table) 61)
+    (check-equal? (FT_TT_OS2-yStrikeoutPosition os2-table) 240)
+
+    (check-equal? (FT_panose->list (FT_TT_OS2-panose os2-table)) '(2 0 5 3 6 0 0 2 0 4))
+
+    (check-equal? (FT_TT_OS2-sTypoAscender os2-table) 762)
+    (check-equal? (FT_TT_OS2-sTypoDescender os2-table) -238)
+    (check-equal? (FT_TT_OS2-sCapHeight os2-table) 671)
+    (check-equal? (FT_TT_OS2-sxHeight os2-table) 481)
+
+    (FT_Done_Face face))
+
+  (test-face "../assets/charter.ttf")
+  (test-face "../assets/charter.otf")
  )