subset with composites

pitfall/fontkit/subset.rkt

@@ -71,10 +71,12 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js
 
   ;; if it is a compound glyph, include its components
   (when (and glyf (negative? (· glyf numberOfContours)))
-    (set! buffer (+Buffer buffer))
     (for ([component (in-list (· glyf components))])
-      (define gid (includeGlyph (· component glyphID)))
-      (send buffer writUInt16BE gid (send component pos))))
+      (define gid (send this includeGlyph (· component glyphID)))
+      (define es (+EncodeStream))
+      (send uint16be encode es gid)
+      (bytes-copy! buffer (· component pos) (send es dump))))
+  
   ;; skip variation shit
 
   (push-end-field! glyf this buffer)
@@ -83,7 +85,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js
 
   (hash-update! (get-field hmtx this) 'metrics (λ (ms) (append ms
                                                                (list (mhash 'advance (· glyph advanceWidth)
-                                                                      'bearing (· (send glyph _getMetrics) leftBearing))))))
+                                                                            'bearing (· (send glyph _getMetrics) leftBearing))))))
 
   (increment-field! offset this (bytes-length buffer))
   (sub1 (length (· this glyf))))
@@ -101,7 +103,11 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js
   (set-field! hmtx this (mhash 'metrics empty 'bearings empty))
 
   ;; include all the glyphs used in the document
-  (for ([gid (in-list (· this glyphs))])
+  ;; not using `in-list` because we need to support adding more
+  ;; glyphs to the array as component glyphs are discovered & enqueued
+  (for ([idx (in-naturals)]
+        #:break (= idx (length (· this glyphs))))
+    (define gid (list-ref (· this glyphs) idx))
     (send this _addGlyph gid))
 
   (define maxp (cloneDeep (send (· this font) _getTable 'maxp)))

pitfall/fontkit/ttfglyph.rkt

@@ -28,7 +28,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/TTFGlyph.js
 (match-define (list ARG_1_AND_2_ARE_WORDS    
                     ARGS_ARE_XY_VALUES       
                     ROUND_XY_TO_GRID         
-                    WE_HAVE_A_SCALE          
+                    WE_HAVE_A_SCALE
+                    ___NO-FLAG___
                     MORE_COMPONENTS          
                     WE_HAVE_AN_X_AND_Y_SCALE 
                     WE_HAVE_A_TWO_BY_TWO     
@@ -37,7 +38,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/TTFGlyph.js
                     OVERLAP_COMPOUND         
                     SCALED_COMPONENT_OFFSET  
                     UNSCALED_COMPONENT_OFFSET)
-  (map (curry expt 2) (range 12)))
+  (map (curry expt 2) (range 13)))
 
 ;; Represents a point in a simple glyph
 (define-subclass object% (Point onCurve endContour [x 0] [y 0])
@@ -149,6 +150,52 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/TTFGlyph.js
     )
 
   (define/public (_decodeComposite glyph stream [offset 0])
-    (unfinished)))
+    ;; this is a composite glyph
+    (hash-set! glyph 'components empty)
+    (define haveInstructions #f)
+    (define flags MORE_COMPONENTS)
+
+    (hash-set! glyph 'components
+               (for/list ([i (in-naturals)]
+                          #:break (zero? (bitwise-and flags MORE_COMPONENTS)))
+                 (set! flags (send uint16be decode stream))
+                 (define gPos (- (send stream pos) offset))
+                 (define glyphID (send uint16be decode stream))
+                 (unless haveInstructions
+                   (set! haveInstructions (not (zero? (bitwise-and flags WE_HAVE_INSTRUCTIONS)))))
+
+                 (match-define
+                   (list dx dy)
+                   (let ([decoder (if (not (zero? (bitwise-and flags ARG_1_AND_2_ARE_WORDS))) int16be int8)])
+                     (list (send decoder decode stream) (send decoder decode stream))))
+
+                 (define component (+Component glyphID dx dy))
+                 (set-field! pos component gPos)
+
+                 (cond
+                   [(not (zero? (bitwise-and flags WE_HAVE_A_SCALE)))
+                    (define scale (read-fixed14 stream))
+                    (set-field! scaleX component scale)
+                    (set-field! scaleY component scale)]
+                   [(not (zero? (bitwise-and flags WE_HAVE_AN_X_AND_Y_SCALE)))
+                    (set-field! scaleX component (read-fixed14 stream))
+                    (set-field! scaleY component (read-fixed14 stream))]
+                   [(not (zero? (bitwise-and flags WE_HAVE_A_TWO_BY_TWO)))
+                    (set-field! scaleX component (read-fixed14 stream))
+                    (set-field! scale01 component (read-fixed14 stream))
+                    (set-field! scale10 component (read-fixed14 stream))
+                    (set-field! scaleY component (read-fixed14 stream))])
+                 
+                 component))
+
+    haveInstructions
+    ))
         
-    
+
+(define (bytes->fixed14 b1 b2)
+  (/ (+ (* b1 (expt 2 8)) b2) (expt 2 14) 1.0))
+  
+(define (read-fixed14 stream)
+  (define b1 (send uint8 decode stream))
+  (define b2 (send uint8 decode stream))
+  (bytes->fixed14 b1 b2))

pitfall/pitfall/test/test13.coffee

@@ -0,0 +1,23 @@
+PDFDocument = require 'pdfkit'
+fs = require 'fs'
+
+make = (doc) -> 
+
+  # Register a font name for use later
+  doc.registerFont('Charter', 'assets/charter.ttf')
+
+  # Set the font, draw some text
+  doc.font('Charter')
+     .fontSize(25)
+     .text('Åcçénts äre în', 100, 100, {width: false})
+                 
+  doc.end()
+
+
+doc = new PDFDocument({compress: no})
+doc.pipe(fs.createWriteStream('test13.pdf'))
+make doc
+
+#doc = new PDFDocument({compress: yes})
+#doc.pipe(fs.createWriteStream('test12c.pdf'))
+#make doc

pitfall/pitfall/test/test13.rkt

@@ -0,0 +1,27 @@
+#lang pitfall/pdftest
+
+(define-runtime-path charter-path "assets/charter.ttf")
+
+(define (proc doc)
+  ;; Register a font name for use later
+  (send doc registerFont "Charter" (path->string charter-path))
+
+  ;; Set the font, draw some text
+  (send* doc
+    [font "Charter"]
+    [fontSize 25]
+    [text "Åcçénts äre în" 100 100 (hash 'width #f)]))
+
+;; test against non-subsetted font version
+(define-runtime-path this "test13rkt.pdf")
+(make-doc this #f proc)
+
+(define-runtime-path that "test13crkt.pdf")
+(make-doc that #t proc #:pdfkit #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))

pitfall/restructure/stream.rkt

@@ -80,8 +80,8 @@ https://github.com/mbutterick/restructure/blob/master/src/DecodeStream.coffee
     (set-port-position! _port current-position)
     bs)
 
-  (define/public-final (readUInt8)
-    (read 1))
+  (define/public-final (readUInt8) (read 1))
+  (define/public-final (readInt8) (read 1))
 
   (define/public-final (read count)
     (unless (index? count)