more

fontland/fontland/cff-glyph.rkt

@@ -0,0 +1,79 @@
+#lang debug racket/base
+(require (for-syntax)
+         fontland/struct
+         fontland/table-stream
+         fontland/table/cff/cff-font
+         fontland/path)
+(provide (all-defined-out))
+
+#|
+approximates
+https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
+|#
+
+(define (bias this s)
+  (cond
+    [(< (length s) 1240) 107]
+    [(< (length s) 33900) 1131]
+    [else 32768]))
+
+(define (getPath this)
+  (define stream (ttf-font-port (glyph-font this)))
+  (define pos (pos stream))
+
+  (define cff (get-table (glyph-font this) 'CFF_))
+  (define str (list-ref (hash-ref (hash-ref cff 'topDict) 'CharStrings) (glyph-id this)))
+  (define end (+ (hash-ref str 'offset) (hash-ref str 'length)))
+
+  (define path (Path))
+  (define stack null)
+  (define trans null)
+
+  (define width #false)
+  (define nStems 0)
+  (define x 0)
+  (define y 0)
+  (define usedGsubrs (cff-glyph-_usedGsubrs this))
+  (define usedSubrs (cff-glyph-_usedSubrs this))
+  (define open #false)
+
+  (define gsubrs (hash-ref cff 'globalSubrIndex null))
+  (define gsubrsBias (bias this gsubrs))
+
+  (define privateDict (privateDictForGlyph cff (glyph-id this)))
+  (define subrs (hash-ref privateDict 'Subrs null))
+  (define subrsBias (bias this subrs))
+
+  ;; skip variations shit
+  #;(define vstore (and (hash-ref* cff 'topDict 'vstore)
+                        (hash-ref* cff 'topDict 'vstore)))
+  #;(define vsindex (hash-ref privateDict 'vsindex))
+  #;(define variationProcessor )
+
+  (define-syntax-rule (shift ID)
+    (begin0
+      (car ID)
+      (set! ID (cdr ID))))
+
+  (define (checkWidth)
+    (unless width
+      (set! width (+ (shift stack) (hash-ref privateDict 'nominalWidthX)))))
+
+  (define (parseStems)
+    (unless (odd? (length stack))
+      (checkWidth))
+
+    (set! nStems (+ nStems (arithmetic-shift (length stack) -1)))
+    (set! stack null)
+    (length stack))
+
+  (define (moveTo x y)
+    (when open
+      (path-closePath path))
+    (path-moveTo path x y)
+    (set! open #true))
+                      
+  (define (parse)
+    (error 'parse-unfinished))
+  
+  (error 'getpath-unfinished))

fontland/fontland/path.rkt

@@ -0,0 +1,45 @@
+#lang debug racket
+(require sugar/unstable/dict
+         (for-syntax racket/syntax))
+(provide (all-defined-out))
+
+#|
+approximates
+https://github.com/mbutterick/fontkit/blob/master/src/glyph/Path.js
+|#
+
+#|
+/**
+ * Path objects are returned by glyphs and represent the actual
+ * vector outlines for each glyph in the font. Paths can be converted
+ * to SVG path data strings, or to functions that can be applied to
+ * render the path to a graphics context.
+ */
+|#
+
+(struct Path$ (commands _bbox _cbox) #:transparent #:mutable)
+
+(define (Path [commands null] [_bbox #false] [_cbox #false])
+  (Path$ commands _bbox _cbox))
+
+(define-syntax (define-command stx)
+  (syntax-case stx ()
+    [(_ COMMAND)
+     (with-syntax [(ID (format-id #'COMMAND (format "path-~a" (syntax-e #'COMMAND))))]
+     #'(define (ID this . args)
+         (set-Path$-_bbox! this #false)
+         (set-Path$-_cbox! this #false)
+         (set-Path$-commands! this
+                              (append
+                               (Path$-commands this)
+                               (list
+                                (dictify
+                                 'command 'COMMAND
+                                 'args args))))
+         this))]))
+
+(define-command moveTo)
+(define-command lineTo)
+(define-command quadraticCurveTo)
+(define-command bezierCurveTo)
+(define-command closePath)

fontland/fontland/struct.rkt

@@ -21,6 +21,12 @@
 
 (struct ttf-glyph glyph () #:transparent)
 
-(struct cff-glyph glyph ([_usedGsubrs #:auto] [_usedSubrs #:auto])
-  #:transparent
-  #:auto-value (make-hash))
+; glyphs = list of glyph ids in the subset
+; mapping = of glyph ids to indexes in glyphs
+(struct subset (font glyphs mapping) #:transparent #:mutable)
+
+(struct cff-subset subset (cff strings charstrings gsubrs) #:transparent #:mutable)
+
+(struct cff-glyph glyph ([path #:auto] [_usedGsubrs #:auto] [_usedSubrs #:auto])
+  #:transparent #:mutable
+  #:auto-value #f)

fontland/fontland/subset.rkt

@@ -9,6 +9,7 @@
          "struct.rkt"
          fontland/glyph
          fontland/ttf-glyph
+         fontland/cff-glyph
          xenomorph
          racket/dict
          fontland/table/cff/cff-font
@@ -36,10 +37,6 @@ approximates
 https://github.com/mbutterick/fontkit/blob/master/src/subset/Subset.js
 |#
 
-; glyphs = list of glyph ids in the subset
-; mapping = of glyph ids to indexes in glyphs
-(struct subset (font glyphs mapping) #:transparent #:mutable)
-
 (define (+subset font [glyphs empty] [mapping (mhash)])
   (define ss (subset font glyphs mapping))
   (subset-add-glyph! ss 0)
@@ -67,7 +64,6 @@ approximates
 https://github.com/mbutterick/fontkit/blob/master/src/subset/CFFSubset.js
 |#
 
-(struct cff-subset subset (cff strings charstrings gsubrs) #:transparent #:mutable)
 
 (define (+cff-subset font [glyphs empty] [mapping (mhash)]
                      [cff (get-table font 'CFF_)]
@@ -96,8 +92,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/CFFSubset.js
              (list (getCharString (cff-subset-cff this) gid))))
 
     (define glyph (get-glyph (subset-font this) gid))
-    ;; apparently path parsing is not necessary?
-    #;(define path (hash-ref glyph 'path)) ;; this causes the glyph to be parsed
+    (unless (cff-glyph-path glyph)
+      (set-cff-glyph-path! glyph (getPath glyph))) ;; this causes the glyph to be parsed
 
     (for ([subr (in-hash-keys #R (cff-glyph-_usedGsubrs glyph))])
       (hash-set! gsubrs subr #true)))

fontland/fontland/table/cff/cff-font.rkt

@@ -17,7 +17,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFFont.js
     (super-new)
 
     (augride [@decode decode])
-    (define (@decode stream parent _)
+    (define (@decode stream parent . _)
       (define cff-font (make-hasheq))
       (hash-set! cff-font 'stream stream)
           
@@ -55,6 +55,43 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFFont.js
   (pos (hash-ref cff-font 'stream) (hash-ref glyph-record 'offset))
   (read-bytes (hash-ref glyph-record 'length) (hash-ref cff-font 'stream)))
 
+(define (fdForGlyph this gid)
+  (cond
+    [(not (hash-has-key? (hash-ref this 'topDict) 'FDSelect))
+     #false]
+    [else
+     (match (hash-ref* this 'topDict 'FDSelect 'version)
+       [0 (list-ref (hash-ref* this 'topDict 'FDSelect) gid)]
+       [(or 3 4)
+        (define ranges (hash-ref* this 'topDict 'FDSelect 'ranges))
+        (define low 0)
+        (define high (sub1 (length (ranges))))
+
+        (let loop ()
+          (when (<= low high)
+            (define mid (arithmetic-shift (+ low high) -1))
+            (cond
+              [(< gid (hash-ref (list-ref ranges mid) 'first))
+               (set! high (sub1 mid))]
+              [(and (< mid high) (> gid (hash-ref (list-ref ranges (add1 mid)) 'first)))
+               (set! low (add1 mid))]
+              [else (hash-ref (list-ref ranges mid) 'fd)])
+            (loop)))]
+       [default (error 'unknown-select-version)])]))
+
+(define (privateDictForGlyph this gid)
+  (cond
+    [(and (hash-has-key? this 'topDict)
+          (hash-has-key? (hash-ref this 'topDict) 'FDSelect))
+     (define fd (fdForGlyph this gid))
+     (if (list-ref (hash-ref* this 'topDict 'FDArray) fd)
+         (hash-ref (list-ref (hash-ref* 'topDict 'FDArray) fd) 'Private)
+         #false)]
+    [(< (hash-ref this 'version) 2)
+     (hash-ref* this 'topDict 'Private)]
+    [else
+     (hash-ref (list-ref (hash-ref* this 'topDict 'FDArray) 0) 'Private)]))
+
 
 (module+ test
   (require rackunit racket/serialize racket/stream fontland/helper)