From c86e2cea360dc57da4de100c70924f9f2ed2da69 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 29 May 2017 23:37:23 -0700 Subject: [PATCH] hhea table, linegap, bbox --- pitfall/pitfall/embedded.rkt | 13 +++++++-- pitfall/pitfall/fontkit.rkt | 43 ++++++++++++++++++++++----- pitfall/pitfall/freetype-ffi.rkt | 50 ++++++++++++++++++++++++++++---- pitfall/pitfall/subset.rkt | 15 ++++++++++ pitfall/pitfall/test/test12.rkt | 2 +- 5 files changed, 106 insertions(+), 17 deletions(-) create mode 100644 pitfall/pitfall/subset.rkt diff --git a/pitfall/pitfall/embedded.rkt b/pitfall/pitfall/embedded.rkt index 4cbe82c8..fb3205b5 100644 --- a/pitfall/pitfall/embedded.rkt +++ b/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)) \ No newline at end of file + (check-equal? (· ef descender) -238) + (check-equal? (· ef lineGap) 0) + (check-equal? (· ef bbox) '(-161 -236 1193 963))) \ No newline at end of file diff --git a/pitfall/pitfall/fontkit.rkt b/pitfall/pitfall/fontkit.rkt index 84345e36..425019ea 100644 --- a/pitfall/pitfall/fontkit.rkt +++ b/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)) \ No newline at end of file + (check-equal? (measure-string f "f" (· f unitsPerEm)) 321.0) + (check-false (· f has-cff-table?)) + (check-equal? (· f lineGap) 0) + (· f createSubset) + + + ) \ No newline at end of file diff --git a/pitfall/pitfall/freetype-ffi.rkt b/pitfall/pitfall/freetype-ffi.rkt index 867830f6..bebff6bb 100644 --- a/pitfall/pitfall/freetype-ffi.rkt +++ b/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)) ) diff --git a/pitfall/pitfall/subset.rkt b/pitfall/pitfall/subset.rkt new file mode 100644 index 00000000..ebc923f1 --- /dev/null +++ b/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)) \ No newline at end of file diff --git a/pitfall/pitfall/test/test12.rkt b/pitfall/pitfall/test/test12.rkt index 5b6794d3..8fca9113 100644 --- a/pitfall/pitfall/test/test12.rkt +++ b/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"])