trudge

pitfall/fontkit/font.rkt

@@ -12,13 +12,13 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
 ;; This is the base class for all SFNT-based font formats in fontkit.
 ;;  It supports TrueType, and PostScript glyphs, and several color glyph formats.
 (define-subclass object% (TTFFont stream)
-  (when stream (unless (input-port? stream)
-                 (raise-argument-error 'TTFFont "input port" stream)))
-  (unless (member (peek-bytes 4 0 stream) (list #"true" #"OTTO" (bytes 0 1 0 0)))
+  (when stream (unless (DecodeStream? stream)
+                 (raise-argument-error 'TTFFont "DecodeStream" stream)))
+  (unless (member (peek-bytes 4 0 (get-field _port  stream)) (list #"true" #"OTTO" (bytes 0 1 0 0)))
     (raise 'probe-fail))
   
   ;; skip variationCoords
-  (field [_directoryPos (port-position stream)]
+  (field [_directoryPos (send stream pos)]
          [_tables (mhash)] ; holds decoded tables (loaded lazily)
          [_glyphs (mhash)]
          [_layoutEngine #f])
@@ -31,16 +31,24 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
       (raise-argument-error '_getTable "table that exists in font" table-tag))
     (hash-ref! _tables table-tag (_decodeTable table-tag))) ; get table from cache, load if not there
 
+  (define/public (_getTableStream tag)
+    (define table (hash-ref (· this directory tables) tag))
+    (cond
+      [table
+       (send stream pos (· table offset))
+       stream]
+      [else #f]))
+
   (define/public (_decodeTable table-tag)
     (define table-decoder (hash-ref table-codecs table-tag
                                     (λ () (raise-argument-error '_decodeTable "decodable table" table-tag))))
     (define offset (· (hash-ref (· directory tables) table-tag) offset))
     (define len (· (hash-ref (· directory tables) table-tag) length))
-    (set-port-position! stream 0)
-    (send table-decoder decode (+DecodeStream (peek-bytes len offset stream)) this length))
+    (send stream pos 0)
+    (send table-decoder decode (+DecodeStream (peek-bytes len offset (get-field _port stream))) this length))
 
   (define/public (_decodeDirectory)
-    (set! directory (directory-decode stream (mhash '_startOffset 0)))
+    (set! directory (send Directory decode stream (mhash '_startOffset 0)))
     directory)
   
   (field [ft-library (FT_Init_FreeType)])
@@ -206,7 +214,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
   ;; for now, just use UTF-8
   (define codepoints (map char->integer (string->list string)))
   (for/list ([cp (in-list codepoints)])
-            (send this glyphForCodePoint cp)))
+    (send this glyphForCodePoint cp)))
 
 
 ;; Maps a single unicode code point to a Glyph object.
@@ -229,7 +237,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
   (string? number? . ->m . number?)
   (/ (* size
         (for/sum ([c (in-string str)])
-                 (measure-char-width this c))) (· this unitsPerEm)))
+          (measure-char-width this c))) (· this unitsPerEm)))
 
 
 ;; Register font formats
@@ -255,11 +263,11 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
                 ;; rather than use a `probe` function,
                 ;; just try making a font with each format and see what happens
                 [font (in-value (with-handlers ([(curry eq? 'probe-fail) (λ (exn) #f)])
-                                  (make-object format (open-input-bytes buffer))))]
+                                  (make-object format (+DecodeStream buffer))))]
                 #:when font)
-               (if postscriptName
-                   (send font getFont postscriptName) ; used to select from collection files like TTC
-                   font))
+     (if postscriptName
+         (send font getFont postscriptName) ; used to select from collection files like TTC
+         font))
    (error 'fontkit:create "unknown font format")))
 
 

pitfall/fontkit/subset.rkt

@@ -52,15 +52,38 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js
   )
 
 (define/contract (_addGlyph this gid)
-  (index? . ->m . void?)
+  (index? . ->m . index?)
 
   (define glyph (send (· this font) getGlyph gid))
-  (report glyph)
   (define glyf (send glyph _decode))
 
   ;; get the offset to the glyph from the loca table
-  (define curOffset (list-ref (hash-ref (send (· this font) _getTable 'loca) 'offsets) gid))
-  (unfinished))
+  (define loca (send (· this font) _getTable 'loca))
+  (define curOffset (list-ref (· loca offsets) gid))
+  (define nextOffset (list-ref (· loca offsets) (add1 gid)))
+
+  (define stream (send (· this font) _getTableStream 'glyf))
+  (send stream pos (+ (send stream pos) curOffset))
+
+  (define buffer (send stream readBuffer (- nextOffset curOffset)))
+
+  ;; 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))))
+  ;; skip variation shit
+
+  (push-end-field! glyf this buffer)
+  (hash-update! (get-field loca this) 'offsets (λ (os) (append os (list (get-field offset this)))))
+
+  (hash-update! (get-field hmtx this) 'metrics (λ (ms) (append ms
+                                                               (mhash 'advance (· glyph advanceWidth)
+                                                                      'bearing (· (send glyph _getMetrics) leftBearing)))))
+
+  (increment-field! offset this (bytes-length buffer))
+  (sub1 (length (· this glyf))))
 
 ;; tables required by PDF spec:
 ;; head, hhea, loca, maxp, cvt, prep, glyf, hmtx, fpgm
@@ -76,8 +99,9 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js
 
   ;; include all the glyphs used in the document
   (for ([gid (in-list (· this glyphs))])
-       (send this _addGlyph gid))
+    (send this _addGlyph gid))
 
+  (report (· this glyphs) 'glyphs-added)
   (define maxp (cloneDeep (send (· this font) _getTable 'maxp)))
   (hash-set! maxp 'numGlyphs (length (· this glyf)))
 
@@ -89,6 +113,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js
   (hash-set! head 'indexToLocFormat (· this loca version))
   
   (define hhea (cloneDeep (send (· this font) _getTable 'hhea)))
+  (report (· this hmtx metrics))
   (hash-set! hhea 'numberOfMetrics (length (· this hmtx metrics)))
 
   ;; todo: final encoding of directory, with all tables.

pitfall/fontkit/ttfglyph.rkt

@@ -69,22 +69,26 @@
     (define glyfPos (list-ref offsets id))
     (define nextPos (list-ref offsets (add1 id)))
 
+    (report* glyfPos nextPos)
+
     ;; Nothing to do if there is no data for this glyph
-    (unless (= glyfPos nextPos)
-      (define stream (send _font _getTableStream 'glyf))
-      (increment-field! pos stream glyfPos)
-      (define startPos (· stream pos))
+    (cond
+      [(= glyfPos nextPos) #f]
+      [else
+       (define stream (send _font _getTableStream 'glyf))
+       (increment-field! pos stream glyfPos)
+       (define startPos (· stream pos))
 
-      (define glyph (send GlyfHeader decode stream))
+       (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)]))
+       (let ([contour-count (· glyph numberOfContours)])
+         (cond
+           [(positive? contour-count)
+            (_decodeSimple glyph stream)]
+           [(negative? contour-count)
+            (_decodeComposite glyph stream startPos)]))
 
-      glyph))
+       glyph]))
 
   (define/public (_decodeSimple glyph stream)
     (unless (RGlyfHeader? glyph)
@@ -118,7 +122,26 @@
         
          (append repeated-flags (cons flag flags)))))
 
-    (unfinished))
+    (define glyph-points (mhash))
+    (for ([(flag i) (in-indexed flags)])
+      (define point (+Point (zero? (bitwise-and flag ON_CURVE)) (>= (index-of endPtsOfContours i) 0) 0 0))
+      (hash-set! glyph-points i point))
+
+    (for/fold ([px 0])
+              ([(flag i) (in-indexed flags)])
+      (define px (_parseGlyphCoord stream px (bitwise-and flag X_SHORT_VECTOR) (bitwise-and flag SAME_X)))
+      (hash-set! (hash-ref glyph-points i) 'x px)
+      px)
+
+    (for/fold ([py 0])
+              ([(flag i) (in-indexed flags)])
+      (define py (_parseGlyphCoord stream py (bitwise-and flag Y_SHORT_VECTOR) (bitwise-and flag SAME_Y)))
+      (hash-set! (hash-ref glyph-points i) 'y py)
+      py)
+
+    ;; skip variations shit
+    (error 'kabomm)
+    )
 
   (define/public (_decodeComposite glyph stream [offset 0])
     (unfinished)))