studying cmap

pitfall/fontkit/font.rkt

@@ -209,6 +209,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
 ;; provides a much more advanced mapping supporting AAT and OpenType shaping.
 (define/contract (glyphsForString this string)
   (string? . ->m . (listof (is-a?/c Glyph)))
+  (report string 'glyphs-for-string)
 
   ;; todo: make this handle UTF-16 with surrogate bytes
   ;; for now, just use UTF-8
@@ -221,7 +222,9 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
 ;; Does not perform any advanced substitutions (there is no context to do so).
 (define/contract (glyphForCodePoint this codePoint)
   (index? . ->m . (is-a?/c Glyph))
+  (report codePoint 'glyphs-for-codepoint-cp)
   (define glyph-idx (FT_Get_Char_Index (· this ft-face) codePoint))
+  (report glyph-idx 'glyphs-for-codepoint-idx)
   (send this getGlyph glyph-idx (list codePoint)))
 
 

pitfall/fontkit/freetype-ffi.rkt

@@ -352,6 +352,11 @@
 (define-freetype FT_Get_Sfnt_Table (_fun _FT_Face _FT_Gettable_Sfnt_Tag
                                          -> (p : (_cpointer/null 'table-ptr))
                                          -> (or p (error 'sfnt-table-not-loaded))))
+
+(define-freetype FT_Select_Charmap (_fun _FT_Face _FT_Encoding
+                                          -> (err : _FT_Error)
+                                          -> (and (zero? err) #t)))
+
 (provide tag->int)
 (define (tag->int tag)
   (define signed? #f)
@@ -361,7 +366,7 @@
 (module+ test
   (require rackunit)
   (define ft-library (FT_Init_FreeType))
-  (define face (FT_New_Face ft-library "test/assets/charter.ttf" 0))
+  (define face (FT_New_Face ft-library "../pitfall/test/assets/charter.ttf" 0))
   (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))

pitfall/fontkit/layout-engine.rkt

@@ -2,6 +2,11 @@
 (require "script.rkt" "glyph.rkt" "glyphrun.rkt" "glyph-position.rkt")
 (provide LayoutEngine)
 
+#|
+approximates
+https://github.com/mbutterick/fontkit/blob/master/src/layout/LayoutEngine.js
+|#
+
 (define-subclass object% (LayoutEngine font)
   (field [unicodeLayoutEngine #f]
          [kernProcessor #f]
@@ -13,7 +18,7 @@
           (cond
             [(· this font has-morx-table?) (error 'morx-layout-unimplemented)]
             [(or (· this font has-gsub-table?) (· this font has-gpos-table?))
-             (error 'ot-layout-unimplemented)]
+             (displayln 'warning:ot-layout-unimplemented) #f]
             [else #f])])
 
   (as-methods

pitfall/fontkit/subset.rkt

@@ -25,6 +25,7 @@ https://github.com/devongovett/fontkit/blob/master/src/subset/Subset.js
 (define/contract (includeGlyph this glyph)
   ((or/c object? index?) . ->m . index?)
   (let ([glyph (if (object? glyph) (· glyph id) glyph)])
+    (report* glyph (· this mapping))
     (hash-ref! (· this mapping) glyph
                (λ ()
                  ;; put the new glyph at the end of `glyphs`,

pitfall/fontkit/ttfglyph.rkt

@@ -16,29 +16,31 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/TTFGlyph.js
                              'yMax int16be)))
 
 ;; Flags for simple glyphs
-(match-define (list ON_CURVE
-                    X_SHORT_VECTOR
-                    Y_SHORT_VECTOR
-                    REPEAT
-                    SAME_X
-                    SAME_Y)
-  (map (curry expt 2) (range 6)))
+(define-macro (define-flag-series . IDS)
+  #`(match-define (list . IDS) (map (curry expt 2) (range #,(length (syntax->list #'IDS))))))
+
+;; Flags for simple glyphs
+(define-flag-series ON_CURVE
+  X_SHORT_VECTOR
+  Y_SHORT_VECTOR
+  REPEAT
+  SAME_X
+  SAME_Y)
 
 ;; Flags for composite glyphs
-(match-define (list ARG_1_AND_2_ARE_WORDS    
-                    ARGS_ARE_XY_VALUES       
-                    ROUND_XY_TO_GRID         
-                    WE_HAVE_A_SCALE
-                    ___NO-FLAG___
-                    MORE_COMPONENTS          
-                    WE_HAVE_AN_X_AND_Y_SCALE 
-                    WE_HAVE_A_TWO_BY_TWO     
-                    WE_HAVE_INSTRUCTIONS     
-                    USE_MY_METRICS           
-                    OVERLAP_COMPOUND         
-                    SCALED_COMPONENT_OFFSET  
-                    UNSCALED_COMPONENT_OFFSET)
-  (map (curry expt 2) (range 13)))
+(define-flag-series ARG_1_AND_2_ARE_WORDS    
+  ARGS_ARE_XY_VALUES       
+  ROUND_XY_TO_GRID         
+  WE_HAVE_A_SCALE
+  __EMPTY-FLAG___
+  MORE_COMPONENTS          
+  WE_HAVE_AN_X_AND_Y_SCALE 
+  WE_HAVE_A_TWO_BY_TWO     
+  WE_HAVE_INSTRUCTIONS     
+  USE_MY_METRICS           
+  OVERLAP_COMPOUND         
+  SCALED_COMPONENT_OFFSET  
+  UNSCALED_COMPONENT_OFFSET)
 
 ;; Represents a point in a simple glyph
 (define-subclass object% (Point onCurve endContour [x 0] [y 0])
@@ -52,8 +54,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/TTFGlyph.js
          [scaleX 1]
          [scaleY 1]
          [scale01 0]
-         [scale10 0])
-  )
+         [scale10 0]))
 
 ;; Represents a TrueType glyph.
 (define-subclass Glyph (TTFGlyph)
@@ -65,6 +66,12 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/TTFGlyph.js
 
   ;; Parses a single glyph coordinate
   (define/public (_parseGlyphCoord stream prev short same)
+    (unless (DecodeStream? stream)
+      (raise-argument-error '_parseGlyphCoord "DecodeStream" stream))
+    (unless (number? prev)
+      (raise-argument-error '_parseGlyphCoord "number" prev))
+    (unless (and (boolean? short) (boolean? same))
+      (raise-argument-error '_parseGlyphCoord "booleans" (list short same)))
     (+ prev (if short 
                 ((if (not same) - +) (send uint8 decode stream))
                 (if same 0 (send int16be decode stream)))))
@@ -73,28 +80,20 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/TTFGlyph.js
   ;; Decodes the glyph data into points for simple glyphs,
   ;; or components for composite glyphs
   (define/public (_decode)
-    (define offsets (hash-ref (send _font _getTable 'loca) 'offsets))
-    (define glyfPos (list-ref offsets id))
-    (define nextPos (list-ref offsets (add1 id)))
+    (define offsets (· (send _font _getTable 'loca) offsets))
+    (match-define (list glyfPos nextPos) (take (drop offsets id) 2))
 
     ;; Nothing to do if there is no data for this glyph
-    (cond
-      [(= glyfPos nextPos) #f]
-      [else
-       (define stream (send _font _getTableStream 'glyf))
-       (send stream pos (+ (send stream pos) glyfPos))
-       (define startPos (· stream pos))
-
-       (define glyph (send GlyfHeader decode stream))
-
-       (let ([contour-count (· glyph numberOfContours)])
-         (cond
-           [(positive? contour-count)
-            (_decodeSimple glyph stream)]
-           [(negative? contour-count)
-            (_decodeComposite glyph stream startPos)]))
-
-       glyph]))
+    (and (not (= glyfPos nextPos))
+         (let ()
+           (define stream (send _font _getTableStream 'glyf))
+           (send stream pos (+ (send stream pos) glyfPos))
+           (define startPos (· stream pos))
+           (define glyph (send GlyfHeader decode stream))
+           (match (· glyph numberOfContours)
+             [(? positive?) (_decodeSimple glyph stream)]
+             [(? negative?) (_decodeComposite glyph stream startPos)])
+           glyph)))
 
   (define/public (_decodeSimple glyph stream)
     (unless (hash? glyph)
@@ -105,49 +104,31 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/TTFGlyph.js
 
     ;; this is a simple glyph
     (hash-set! glyph 'points empty)
-
     (define endPtsOfContours (send (+Array uint16be (· glyph numberOfContours)) decode stream))
-    
     (hash-set! glyph 'instructions (send (+Array uint8be uint16be) decode stream))
-
-    (define numCoords (add1 (list-ref endPtsOfContours (sub1 (length endPtsOfContours)))))
+    (define numCoords (add1 (last endPtsOfContours)))
 
     (define flags
-      (reverse
-       (for/fold ([flags empty])
-                 ([i (in-naturals)]
-                  #:break (= (length flags) numCoords))
-         (define flag (send uint8 decode stream))
-         
-         ;; check for repeat flag
-         (define repeated-flags
-           (cond
-             [(not (zero? (bitwise-and flag REPEAT)))
-              (define count (send uint8 decode stream))
-              (make-list count flag)]
-             [else empty]))
-        
-         (append repeated-flags (cons flag flags)))))
-
-    (define glyph-points (mhash))
-    (for ([(flag i) (in-indexed flags)])
-      (define point (+Point (zero? (bitwise-and flag ON_CURVE)) (and (index-of endPtsOfContours i) #t) 0 0))
-      (hash-set! glyph-points i point))
-
-    (for/fold ([px 0])
-              ([(flag i) (in-indexed flags)])
-      (define next-px (_parseGlyphCoord stream px (bitwise-and flag X_SHORT_VECTOR) (bitwise-and flag SAME_X)))
-      (set-field! x (hash-ref glyph-points i) next-px)
-      next-px)
-
-    (for/fold ([py 0])
-              ([(flag i) (in-indexed flags)])
-      (define next-py (_parseGlyphCoord stream py (bitwise-and flag Y_SHORT_VECTOR) (bitwise-and flag SAME_Y)))
-      (set-field! y (hash-ref glyph-points i) next-py)
-      next-py)
-
-    ;; skip variations shit
-    )
+      (for*/lists (flags)
+                  ([i (in-naturals)]
+                   #:break (= (length flags) numCoords)
+                   [flag (in-value (send uint8 decode stream))]
+                   [count (in-range (add1 (if (not (zero? (bitwise-and flag REPEAT)))
+                                              (send uint8 decode stream)
+                                              0)))])
+                  flag))
+
+    (match-define-values
+     (points _ _)
+     (for/fold ([points empty] [px 0] [py 0])
+               ([(flag i) (in-indexed flags)])
+       (define point (+Point (zero? (bitwise-and flag ON_CURVE)) (and (index-of endPtsOfContours i) #t) 0 0))
+       (define next-px (_parseGlyphCoord stream px (not (zero? (bitwise-and flag X_SHORT_VECTOR))) (not (zero? (bitwise-and flag SAME_X)))))
+       (define next-py (_parseGlyphCoord stream py (not (zero? (bitwise-and flag Y_SHORT_VECTOR))) (not (zero? (bitwise-and flag SAME_Y)))))
+       (set-field! x point next-px)
+       (set-field! y point next-py)
+       (values (cons point points) next-px next-py)))
+    (hash-set! glyph 'points (reverse points)))
 
   (define/public (_decodeComposite glyph stream [offset 0])
     ;; this is a composite glyph
@@ -185,11 +166,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/TTFGlyph.js
                     (set-field! scale01 component (read-fixed14 stream))
                     (set-field! scale10 component (read-fixed14 stream))
                     (set-field! scaleY component (read-fixed14 stream))])
-                 
                  component))
-
-    haveInstructions
-    ))
+    haveInstructions))
         
 
 (define (bytes->fixed14 b1 b2)

pitfall/pitfall/alltest.rkt

@@ -12,7 +12,7 @@
            pitfall/test/test09
            pitfall/test/test10
            pitfall/test/test11
-           pitfall/test/test12
-           pitfall/test/test13
+           pitfall/test/test12 ; ttf subset
+           pitfall/test/test13 ; subset with composites
            pitfall/page-test
            (submod pitfall/zlib test)))

pitfall/pitfall/embedded.rkt

@@ -45,8 +45,10 @@ For now, we'll just measure width of the characters.
 (define/contract (encode this text [features #f])
   ((string?) ((or/c list? #f)) . ->*m .
              (list/c (listof string?) (listof (is-a?/c GlyphPosition))))
-  (define glyphRun (send (· this font) layout text features))
+  (define glyphRun (send (· this font) layout (report text) features))
   (define glyphs (· glyphRun glyphs))
+  (for ([g (in-list glyphs)])
+    (report (· g id)))
   (define positions (· glyphRun positions))
   (define-values (subset-idxs new-positions)
     (for/lists (idxs posns)
@@ -74,7 +76,6 @@ For now, we'll just measure width of the characters.
   (when isCFF
     (hash-set! (· fontFile payload) 'Subtype "CIDFontType0C"))
 
-  #;(send (send (· this subset) encodeStream) pipe fontFile)
   (send fontFile end (send (send (· this subset) encodeStream) dump))
 
   (define familyClass (let ([val (if (send (· this font) has-table? 'OS/2)

pitfall/pitfall/test/test14.rkt

@@ -0,0 +1,27 @@
+#lang pitfall/pdftest
+
+(define-runtime-path ttf-path "assets/Tahoma.ttf")
+
+(define (proc doc)
+  ;; Register a font name for use later
+  (send doc registerFont "the-font" (path->string ttf-path))
+
+  ;; Set the font, draw some text
+  (send* doc
+    [font "the-font"]
+    [fontSize 25]
+    [text "H" 100 100 (hash 'width #f)]))
+
+;; test against non-subsetted font version
+(define-runtime-path this "test14rkt.pdf")
+(make-doc this #f proc #:test #f)
+
+#;(define-runtime-path that "test14crkt.pdf")
+#;(make-doc that #t proc #:test #f)
+
+#;(module+ test
+  (define doc (make-object PDFDocument))
+  (send doc registerFont "Charter" (path->string charter-path))
+  (send* doc [font "Charter"])
+  (send doc pipe (open-output-string))
+  (send doc end))