advanceWidth done

pitfall/pitfall/embedded.rkt

@@ -6,7 +6,7 @@
   (super-new)
   (field #;[subset (· this font createSubset)]
          [unicode '((0))]
-         #;[widths (list (send (send (· this font) getGlyph 0) advanceWidth))]
+         [widths (list (send (send (· this font) getGlyph 0) advanceWidth))]
          
          [name (· font postscriptName)]
          [scale (/ 1000 (· font unitsPerEm))]
@@ -44,4 +44,9 @@ For now, we'll just measure width of the characters.
   (check-equal? (· ef ascender) 980)
   (check-equal? (· ef descender) -238)
   (check-equal? (· ef lineGap) 0)
-  (check-equal? (· ef bbox) '(-161 -236 1193 963)))
+  (check-equal? (· ef bbox) '(-161 -236 1193 963))
+  (define H-gid 41)
+  (· ef widths)
+  (check-equal? (send (send (· ef font) getGlyph H-gid) advanceWidth) 738)
+
+  )

pitfall/pitfall/fontkit.rkt

@@ -1,11 +1,15 @@
 #lang pitfall/racket
-(require "freetype-ffi.rkt" ffi/unsafe racket/runtime-path "subset.rkt")
+(require "freetype-ffi.rkt" ffi/unsafe racket/runtime-path "subset.rkt" "glyph.rkt")
 (provide (all-defined-out))
 
 (define-runtime-path charter-path "test/assets/charter.ttf")
 
+;; approximates
+;; https://github.com/devongovett/fontkit/blob/master/src/TTFFont.js
+
 (define-subclass object% (TTFFont filename)
   (super-new)
+  (field [_glyphs (mhash)])
   
   (field [buffer (file->bytes filename)])
 
@@ -33,13 +37,8 @@
    bbox
    createSubset
    has-table?
-   has-cff-table?))
-
-(define (has-table? this tag)
-  (FT_Load_Sfnt_Table (· this ft-face) (tag->int tag) 0 0 0))
-  
-(define (has-cff-table? this)
-  (has-table? this #"CFF "))
+   has-cff-table?
+   getGlyph))
 
 (define/contract (postscriptName this)
   (->m string?)
@@ -72,10 +71,26 @@
 
 (define/contract (createSubset this)
   (->m (is-a?/c Subset))
-  (make-object (if (report (· this has-cff-table?))
+  (make-object (if (· this has-cff-table?)
                    CFFSubset
                    TTFSubset) this))
 
+
+(define (has-table? this tag)
+  (FT_Load_Sfnt_Table (· this ft-face) (tag->int tag) 0 0 0))
+
+  
+(define (has-cff-table? this)
+  (has-table? this #"CFF "))
+
+
+(define/contract (getGlyph this glyph [characters null])
+  ((number?) (list?) . ->*m . object?)
+  (make-object (if (· this has-cff-table?)
+                   CFFGlyph
+                   TTFGlyph) glyph characters this))
+
+
 (define/contract (measure-char-width this char)
   (char? . ->m . number?)
   (define glyph-idx (FT_Get_Char_Index (· this ft-face) (char->integer char)))
@@ -98,6 +113,7 @@
 ;;fontkit.registerFormat(TrueTypeCollection); ;; todo
 ;;fontkit.registerFormat(DFont); ;; todo
 
+
 (define/contract (create filename [postscriptName #f])
   ((string?) ((or/c string? #f)) . ->* . any/c)
   (or

pitfall/pitfall/freetype-ffi.rkt

@@ -91,6 +91,8 @@
    [vertBearingX _FT_Pos]
    [vertBearingY _FT_Pos]
    [vertAdvance _FT_Pos]))
+(provide (struct-out FT_Glyph_Metrics)
+         _FT_Glyph_Metrics _FT_Glyph_Metrics-pointer)
 
 (define-cstruct _FT_Vector
   ([x _FT_Pos]
@@ -241,7 +243,9 @@
                                          -> _FT_UInt))
 
 (define-freetype FT_Load_Glyph (_fun _FT_Face _FT_UInt _FT_Int32
-                                     -> (err : _FT_Error)))
+                                     -> (err : _FT_Error)
+                                     -> (unless (zero? err)
+                                          (error 'FT_Load_Glyph "failed, try using FT_LOAD_NO_RECURSE flag instead"))))
 
 (define-freetype FT_Load_Char (_fun _FT_Face _FT_ULong _FT_Int32
                                     -> (err : _FT_Error)))
@@ -299,6 +303,18 @@
               (FT_BBox-yMin bbox)
               (FT_BBox-xMax bbox)
               (FT_BBox-yMax bbox))) '(-161 -236 1193 963))
+
+  (define H-gid 41)
+  (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)
+
+  (FT_Done_Face face)
   )
 
 

pitfall/pitfall/glyph.rkt

@@ -0,0 +1,68 @@
+#lang pitfall/racket
+(require "freetype-ffi.rkt")
+(provide Glyph CFFGlyph TTFGlyph)
+(module+ test (require rackunit))
+
+#|
+/**
+ * Glyph objects represent a glyph in the font. They have various properties for accessing metrics and
+ * the actual vector path the glyph represents, and methods for rendering the glyph to a graphics context.
+ *
+ * You do not create glyph objects directly. They are created by various methods on the font object.
+ * There are several subclasses of the base Glyph class internally that may be returned depending
+ * on the font format, but they all inherit from this class.
+ */
+|#
+
+
+;; approximates
+;; https://github.com/devongovett/fontkit/blob/master/src/glyph/Glyph.js
+
+(define (is-mark? str)
+  ;; mark classes = Mn Me Mc
+  (regexp-match #px"\\p{Mn}|\\p{Me}|\\p{Mc}" str))
+
+(module+ test
+  (check-true (and (is-mark? "#\u300") #t))
+  (check-false (and (is-mark? "#\u299") #t)))
+
+(define-subclass object% (Glyph id codePoints font)
+  (super-new)
+  (field [_font font]
+         [isMark (andmap is-mark? codePoints)]
+         [isLigature (> (length codePoints) 1)]
+         [_metrics #f])
+
+  (as-methods
+   advanceWidth
+   _getMetrics))
+
+
+(define/contract (advanceWidth this)
+  (->m number?)
+  (hash-ref (_getMetrics this) 'advanceWidth))
+
+
+(define/contract (_getMetrics this)
+  (->m hash?)
+  (unless (· this _metrics)
+    (define face (· this _font ft-face))
+    (FT_Load_Glyph face (· this id) FT_LOAD_NO_RECURSE)
+    (define glyph (FT_FaceRec-glyph face))
+    (define glyph-metrics (FT_GlyphSlotRec-metrics glyph))
+    (set-field! _metrics this (mhash))
+    (hash-set*! (· this _metrics)
+                'advanceWidth (FT_Glyph_Metrics-horiAdvance glyph-metrics)
+                'leftBearing (FT_Glyph_Metrics-horiBearingX glyph-metrics)))
+  (· this _metrics))
+
+
+(define-subclass Glyph (CFFGlyph)
+  (super-new)
+  (error 'cff-glyph-unimplemented))
+
+
+(define-subclass Glyph (TTFGlyph)
+  (super-new)
+
+  )