hhea table, linegap, bbox

pitfall/pitfall/embedded.rkt

@@ -4,11 +4,16 @@
 
 (define-subclass PDFFont (EmbeddedFont document font id)
   (super-new)
-  (field [subset (· this font createSubset)]
+  (field #;[subset (· this font createSubset)]
+         [unicode '((0))]
+         #;[widths (list (send (send (· this font) getGlyph 0) advanceWidth))]
+         
          [name (· font postscriptName)]
          [scale (/ 1000 (· font unitsPerEm))]
          [ascender (* (· font ascent) scale)]
-         [descender (* (· font descent) scale)])
+         [descender (* (· font descent) scale)]
+         [lineGap (* (· font lineGap) scale)]
+         [bbox (· font bbox)])
 
   (as-methods
    widthOfString
@@ -37,4 +42,6 @@ For now, we'll just measure width of the characters.
   (define ef (make-object EmbeddedFont #f f #f))
   (check-equal? (send ef widthOfString "f" 1000) 321.0)
   (check-equal? (· ef ascender) 980)
-  (check-equal? (· ef descender) -238))
+  (check-equal? (· ef descender) -238)
+  (check-equal? (· ef lineGap) 0)
+  (check-equal? (· ef bbox) '(-161 -236 1193 963)))

pitfall/pitfall/fontkit.rkt

@@ -1,5 +1,5 @@
 #lang pitfall/racket
-(require "freetype-ffi.rkt" racket/runtime-path)
+(require "freetype-ffi.rkt" ffi/unsafe racket/runtime-path "subset.rkt")
 (provide (all-defined-out))
 
 (define-runtime-path charter-path "test/assets/charter.ttf")
@@ -29,7 +29,17 @@
    unitsPerEm
    ascent
    descent
-   createSubset))
+   lineGap
+   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 "))
 
 (define/contract (postscriptName this)
   (->m string?)
@@ -47,11 +57,24 @@
   (->m number?)
   (FT_FaceRec-descender (· this ft-face)))
 
-(define/contract (createSubset this)
-  (->m object?)
-(void)
-  )
+(define/contract (lineGap this)
+  (->m number?)
+  (define hhea-table (cast (FT_Get_Sfnt_Table (· this ft-face) 'ft_sfnt_hhea) _pointer _FT_HoriHeader-pointer))
+  (FT_HoriHeader-lineGap hhea-table))
 
+(define/contract (bbox this)
+  (->m any/c)
+  (let ([bbox (FT_FaceRec-bbox (· this ft-face))])
+    (list (FT_BBox-xMin bbox)
+          (FT_BBox-yMin bbox)
+          (FT_BBox-xMax bbox)
+          (FT_BBox-yMax bbox))))
+
+(define/contract (createSubset this)
+  (->m (is-a?/c Subset))
+  (make-object (if (report (· this has-cff-table?))
+                   CFFSubset
+                   TTFSubset) this))
 
 (define/contract (measure-char-width this char)
   (char? . ->m . number?)
@@ -99,4 +122,10 @@
   (check-equal? (· f unitsPerEm) 1000)
   (check-equal? (· f ascent) 980)
   (check-equal? (· f descent) -238)
-  (check-equal? (measure-string f "f" (· f unitsPerEm)) 321.0))
+  (check-equal? (measure-string f "f" (· f unitsPerEm)) 321.0)
+  (check-false (· f has-cff-table?))
+  (check-equal? (· f lineGap) 0)
+  (· f createSubset)
+  
+
+  )

pitfall/pitfall/freetype-ffi.rkt

@@ -79,6 +79,8 @@
    [yMin _FT_Pos]
    [xMax _FT_Pos]
    [yMax _FT_Pos]))
+(provide (struct-out FT_BBox)
+         _FT_BBox _FT_BBox-pointer)
 
 (define-cstruct _FT_Glyph_Metrics
   ([width _FT_Pos]
@@ -200,6 +202,16 @@
 (provide (struct-out FT_FaceRec)
          _FT_FaceRec _FT_FaceRec-pointer)
 
+(define _FT_Sfnt_Tag _FT_ULong)
+
+(define-cstruct _FT_HoriHeader
+  ([version _FT_Long]
+   [ascent _FT_Short]
+   [descent _FT_Short]
+   [lineGap _FT_Short]))
+(provide (struct-out FT_HoriHeader)
+         _FT_HoriHeader _FT_HoriHeader-pointer)
+
 (define _full-path
   (make-ctype _path
               path->complete-path
@@ -240,14 +252,29 @@
 (define+provide FT_LOAD_LINEAR_DESIGN (expt 2 13))
 (define+provide FT_LOAD_NO_RECURSE (expt 2 10))
 
+
+
 (define-freetype FT_Get_Postscript_Name (_fun _FT_Face -> _string))
 
-(define-freetype FT_Load_Sfnt_Table (_fun _FT_Face _FT_ULong _FT_Long
-                                          (buffer : (_ptr o _FT_Byte))
-                                          (len : (_ptr o _FT_ULong))
+(define-freetype FT_Load_Sfnt_Table (_fun _FT_Face _FT_Sfnt_Tag _FT_Long
+                                          (buffer : (_ptr io _FT_Byte))
+                                          (len : (_ptr io _FT_ULong))
                                           -> (err : _FT_Error)
-                                          -> (and (zero? err) (list buffer len))))
+                                          -> (and (zero? err) #t)))
 
+
+(define+provide _FT_Gettable_Sfnt_Tag (_enum '(ft_sfnt_head = 0
+                                                            ft_sfnt_maxp
+                                                            ft_sfnt_os2
+                                                            ft_sfnt_hhea
+                                                            ft_sfnt_vhea
+                                                            ft_sfnt_post
+                                                            ft_sfnt_pclt)))
+
+(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))))
+(provide tag->int)
 (define (tag->int tag)
   (define signed? #f)
   (define big-endian? #t)
@@ -259,8 +286,19 @@
   (define face (FT_New_Face ft-library "test/assets/charter.ttf" 0))
   (check-equal? (FT_Get_Postscript_Name face) "Charter")
   (check-equal? (FT_FaceRec-units_per_EM face) 1000)
-  (FT_Load_Sfnt_Table face (tag->int #"cmap") 0)
-
+  (check-true (FT_Load_Sfnt_Table face (tag->int #"cmap") 0 0 0))
+  (check-false (FT_Load_Sfnt_Table face (tag->int #"zzap") 0 0 0))
+  (check-true (cpointer? (FT_Get_Sfnt_Table face 'ft_sfnt_hhea)))
+  (define charter-hhea-table (cast (FT_Get_Sfnt_Table face 'ft_sfnt_hhea) _pointer _FT_HoriHeader-pointer))
+  (check-equal? (FT_HoriHeader-ascent charter-hhea-table) 980)
+  (check-equal? (FT_HoriHeader-descent charter-hhea-table) -238)
+  (check-equal? (FT_HoriHeader-lineGap charter-hhea-table) 0)
+  (check-equal?
+   (let ([bbox (FT_FaceRec-bbox face)])
+        (list (FT_BBox-xMin bbox)
+              (FT_BBox-yMin bbox)
+              (FT_BBox-xMax bbox)
+              (FT_BBox-yMax bbox))) '(-161 -236 1193 963))
   )
 
 

pitfall/pitfall/subset.rkt

@@ -0,0 +1,15 @@
+#lang pitfall/racket
+(provide Subset CFFSubset TTFSubset)
+
+(define-subclass object% (Subset)
+  (super-new))
+
+
+(define-subclass Subset (CFFSubset font)
+  (super-new)
+  (error 'cff-subset-unimplemented))
+
+
+(define-subclass Subset (TTFSubset font)
+  (super-new)
+  (error 'ttf-subset-unimplemented))

pitfall/pitfall/test/test12.rkt

@@ -19,7 +19,7 @@
 #;(define-runtime-path that "test12crkt.pdf")
 #;(make-doc that #t proc #:test #f)
 
-(module+ test
+#;(module+ test
   (define doc (make-object PDFDocument))
   (send doc registerFont "Charter" (path->string charter-path))
   (send* doc [font "Charter"])