diff --git a/pitfall/fontkit/font.rkt b/pitfall/fontkit/font.rkt index 8f5f944e..fbc0ee2f 100644 --- a/pitfall/fontkit/font.rkt +++ b/pitfall/fontkit/font.rkt @@ -10,8 +10,13 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js (require (for-syntax "tables.rkt")) (define-macro (define-table-getters) (with-pattern ([(TABLE-TAG ...) (hash-keys table-codecs)]) - #'(begin - (define/public (TABLE-TAG) (_getTable 'TABLE-TAG)) ...))) + #'(begin + (define/public (TABLE-TAG) (_getTable 'TABLE-TAG)) ...))) + + +(test-module + (define f (openSync (path->string charter-path))) + (check-equal? (postscriptName f) "Charter")) ;; This is the base class for all SFNT-based font formats in fontkit. ;; It supports TrueType, and PostScript glyphs, and several color glyph formats. @@ -96,63 +101,80 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js (->m number?) (· this head unitsPerEm)) +(test-module + (check-equal? (· f unitsPerEm) 1000)) ;; The font’s [ascender](https://en.wikipedia.org/wiki/Ascender_(typography)) (define/contract (ascent this) (->m number?) (· this hhea ascent)) +(test-module + (check-equal? (· f ascent) 980)) + ;; The font’s [descender](https://en.wikipedia.org/wiki/Descender) (define/contract (descent this) (->m number?) (· this hhea descent)) +(test-module + (check-equal? (· f descent) -238)) ;; The amount of space that should be included between lines (define/contract (lineGap this) (->m number?) (· this hhea lineGap)) +(test-module + (check-equal? (· f lineGap) 0)) + (define/contract (underlinePosition this) (->m number?) - (define post-table (cast (FT_Get_Sfnt_Table (· this ft-face) 'ft_sfnt_post) _pointer _FT_TT_Postscript-pointer)) - (FT_TT_Postscript-underlinePosition post-table)) + (· this post underlinePosition)) +(test-module + (check-equal? (· f underlinePosition) -178)) (define/contract (underlineThickness this) (->m number?) - (define post-table (cast (FT_Get_Sfnt_Table (· this ft-face) 'ft_sfnt_post) _pointer _FT_TT_Postscript-pointer)) - (FT_TT_Postscript-underlineThickness post-table)) + (· this post underlineThickness)) + +(test-module + (check-equal? (· f underlineThickness) 58)) ;; If this is an italic font, the angle the cursor should be drawn at to match the font design (define/contract (italicAngle this) (->m number?) - (define post-table (cast (FT_Get_Sfnt_Table (· this ft-face) 'ft_sfnt_post) _pointer _FT_TT_Postscript-pointer)) - (FT_TT_Postscript-italicAngle post-table)) + (· this post italicAngle)) + +(test-module + (check-equal? (· f italicAngle) 0)) ;; The height of capital letters above the baseline. (define/contract (capHeight this) (->m number?) - (cond - [(send this has-table? #"OS/2") - (define os2-table (cast (FT_Get_Sfnt_Table (· this ft-face) 'ft_sfnt_os2) _pointer _FT_TT_OS2-pointer)) - (FT_TT_OS2-sCapHeight os2-table)] - [else (· this ascent)])) + (if (send this has-table? #"OS/2") + (· this OS/2 capHeight) + (· this ascent))) + +(test-module + (check-equal? (· f capHeight) 671)) ;; The height of lower case letters in the font. (define/contract (xHeight this) (->m number?) - (cond - [(send this has-table? #"OS/2") - (define os2-table (cast (FT_Get_Sfnt_Table (· this ft-face) 'ft_sfnt_os2) _pointer _FT_TT_OS2-pointer)) - (FT_TT_OS2-sxHeight os2-table)] - [else 0])) + (if (send this has-table? #"OS/2") + (· this OS/2 xHeight) + 0)) + +(test-module + (check-equal? (· f xHeight) 481)) ;; The font’s bounding box, i.e. the box that encloses all glyphs in the font. @@ -163,6 +185,9 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js (· this head xMax) (· this head yMax))) +(test-module + (check-equal? (bbox->list (· f bbox)) '(-161 -236 1193 963))) + (define/contract (_cmapProcessor this) (->m (is-a?/c CmapProcessor)) @@ -189,6 +214,12 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js (define has-gpos-table? (curryr has-table? 'GPOS)) (define has-gsub-table? (curryr has-table? 'GSUB)) +(test-module + (check-false (· f has-cff-table?)) + (check-false (· f has-morx-table?)) + (check-false (· f has-gsub-table?)) + (check-false (· f has-gpos-table?))) + ;; Returns a glyph object for the given glyph id. ;; You can pass the array of code points this glyph represents for @@ -205,6 +236,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js ((string?) ((or/c (listof symbol?) #f) (or/c symbol? #f) (or/c symbol? #f)) . ->*m . (is-a?/c GlyphRun)) (unless (· this _layoutEngine) (set-field! _layoutEngine this (make-object LayoutEngine this))) + (report 'in-layout) (send (· this _layoutEngine) layout string userFeatures script language)) @@ -226,7 +258,6 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js ;; Does not perform any advanced substitutions (there is no context to do so). (define/contract (glyphForCodePoint this codePoint) (index? . ->m . (is-a?/c Glyph)) - #;(FT_Select_Charmap (· this ft-face) (tag->int #"unic")) (define glyph-idx (FT_Get_Char_Index (· this ft-face) codePoint)) (send this getGlyph glyph-idx (list codePoint))) @@ -278,27 +309,6 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js (test-module - (define f (openSync (path->string charter-path))) - (check-equal? (postscriptName f) "Charter") - (check-equal? (· f unitsPerEm) 1000) - (check-equal? (· f ascent) 980) - (check-equal? (· f descent) -238) - (check-equal? (bbox->list (· f bbox)) '(-161 -236 1193 963)) (check-equal? (measure-string f "f" (· f unitsPerEm)) 321.0) - (check-false (· f has-cff-table?)) - (check-false (· f has-morx-table?)) - (check-false (· f has-gsub-table?)) - (check-false (· f has-gpos-table?)) (check-true (send f has-table? #"cmap")) - (check-equal? (· f lineGap) 0) - (check-exn exn:fail:contract? (λ () (send f _getTable 'nonexistent-table-tag))) - #;(send f _getTable 'maxp) - (define subset (make-object TTFSubset f)) - (define es (+EncodeStream)) - (send subset encode es) - #;(with-output-to-file "subsetfont.rktd" (λ () (display (send es dump)) )) - #;(check-equal? (send es dump) (file->bytes "subsetfont.rktd")) - - (file-directory-decode "subsetfont.rktd") - (file-directory-decode "../pitfall/test/out.bin") - ) \ No newline at end of file + (check-exn exn:fail:contract? (λ () (send f _getTable 'nonexistent-table-tag)))) \ No newline at end of file