diff --git a/fontland/fontland/font.rkt b/fontland/fontland/font.rkt index 41edbcff..ee3212cd 100644 --- a/fontland/fontland/font.rkt +++ b/fontland/fontland/font.rkt @@ -8,11 +8,9 @@ "db.rkt" "struct.rkt" "table-stream.rkt" - racket/class xenomorph racket/match sugar/unstable/dict - sugar/unstable/js "unsafe/harfbuzz.rkt" "glyph-position.rkt" sugar/list @@ -25,12 +23,6 @@ approximates https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js |# -(test-module - (define f (open-font charter-path)) - (define fira (open-font (path->string fira-path))) - (define otf (open-font (path->string fira-otf-path))) - (check-equal? (font-postscript-name f) "Charter")) - (define ft-library (delay (FT_Init_FreeType))) (define (+ttf-font port @@ -53,41 +45,28 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js font) (define (font-postscript-name font) (FT_Get_Postscript_Name (ft-face font))) -(define (font-units-per-em font) (· (get-head-table font) unitsPerEm)) -(define (font-ascent font) (· (get-hhea-table font) ascent)) -(define (font-descent font) (· (get-hhea-table font) descent)) -(define (font-linegap font) (· (get-hhea-table font) lineGap)) -(define (font-underline-position font) (· (get-post-table font) underlinePosition)) -(define (font-underline-thickness font) (· (get-post-table font) underlineThickness)) -(define (font-italic-angle font) (· (get-post-table font) italicAngle)) +(define (font-units-per-em font) (hash-ref (get-head-table font) 'unitsPerEm)) +(define (font-ascent font) (hash-ref (get-hhea-table font) 'ascent)) +(define (font-descent font) (hash-ref (get-hhea-table font) 'descent)) +(define (font-linegap font) (hash-ref (get-hhea-table font) 'lineGap)) +(define (font-underline-position font) (hash-ref (get-post-table font) 'underlinePosition)) +(define (font-underline-thickness font) (hash-ref (get-post-table font) 'underlineThickness)) +(define (font-italic-angle font) (hash-ref (get-post-table font) 'italicAngle)) (define (font-cap-height font) (if (has-table? font #"OS/2") - (· (get-OS/2-table font) capHeight) + (hash-ref (get-OS/2-table font) 'capHeight) (font-ascent font))) (define (font-x-height font) (if (has-table? font #"OS/2") - (· (get-OS/2-table font) xHeight) + (hash-ref (get-OS/2-table font) 'xHeight) 0)) -(test-module - (check-equal? (font-units-per-em f) 1000) - (check-equal? (font-ascent f) 980) - (check-equal? (font-descent f) -238) - (check-equal? (font-linegap f) 0) - (check-equal? (font-underline-position f) -178) - (check-equal? (font-underline-thickness f) 58) - (check-equal? (font-italic-angle f) 0) - (check-equal? (font-cap-height f) 671) - (check-equal? (font-x-height f) 481)) - (define (font-bbox font) (define head-table (get-head-table font)) - (+bbox (· head-table xMin) (· head-table yMin) (· head-table xMax) (· head-table yMax))) - -(test-module - (check-equal? (bbox->list (font-bbox f)) '(-161 -236 1193 963))) + (+bbox (hash-ref head-table 'xMin) (hash-ref head-table 'yMin) + (hash-ref head-table 'xMax) (hash-ref head-table 'yMax))) (define current-layout-caching (make-parameter #false)) @@ -137,6 +116,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js ;; Returns a GlyphRun object, which includes an array of Glyphs and GlyphPositions for the given string. +(init-db) ; make sure db is ready for queries (define (layout font string [user-features #f] [script #f] [language #f] #:test [test #f]) #;((string?) ((option/c (listof symbol?)) (option/c symbol?) (option/c symbol?)) . ->*m . GlyphRun?) (define (get-layout string) @@ -166,35 +146,6 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js (hb-layout->glyphrun font (get-layout string)))])) -;; Returns an array of Glyph objects for the given string. -;; This is only a one-to-one mapping from characters to glyphs. -;; For most uses, you should use font.layout (described below), which -;; provides a much more advanced mapping supporting AAT and OpenType shaping. -(define (glyphs-for-string font string) - #;(string? . ->m . (listof glyph?)) - ;; todo: make this handle UTF-16 with surrogate bytes - ;; for now, just use UTF-8 - (define codepoints (map char->integer (string->list string))) - (for/list ([cp (in-list codepoints)]) - (glyph-for-codepoint font cp))) - -;; Maps a single unicode code point to a Glyph object. -;; Does not perform any advanced substitutions (there is no context to do so). -(define (glyph-for-codepoint font codepoint) - (define glyph-idx (FT_Get_Char_Index (· font ft-face) codepoint)) - (get-glyph font glyph-idx (list codepoint))) - -(define (measure-char-width font char) - (define glyph-idx (FT_Get_Char_Index (ft-face font) (char->integer char))) - (FT_Load_Glyph (ft-face font) glyph-idx FT_LOAD_NO_RECURSE) - (define width (FT_Vector-x (FT_GlyphSlotRec-advance (FT_FaceRec-glyph (ft-face font))))) - (* width 1.0)) - -(define (measure-string font str size) - (/ (* size - (for/sum ([c (in-string str)]) - (measure-char-width font c))) (font-units-per-em font))) - #| approximates https://github.com/mbutterick/fontkit/blob/master/src/index.js @@ -231,12 +182,26 @@ https://github.com/mbutterick/fontkit/blob/master/src/base.js (error 'create-font "unknown font format"))) (module+ test - (require rackunit racket/dict) - (check-equal? (measure-string f "f" (font-units-per-em f)) 321.0) - (check-true (has-table? f #"cmap")) - (check-exn exn:fail:contract? (λ () (get-table f 'nonexistent-table-tag))) + (require rackunit) + (define charter (open-font charter-path)) + (define fira (open-font (path->string fira-path))) + (define otf (open-font (path->string fira-otf-path))) + (check-equal? (font-postscript-name charter) "Charter") + (check-equal? (font-units-per-em charter) 1000) + (check-equal? (font-ascent charter) 980) + (check-equal? (font-descent charter) -238) + (check-equal? (font-linegap charter) 0) + (check-equal? (font-underline-position charter) -178) + (check-equal? (font-underline-thickness charter) 58) + (check-equal? (font-italic-angle charter) 0) + (check-equal? (font-cap-height charter) 671) + (check-equal? (font-x-height charter) 481) + (check-equal? (bbox->list (font-bbox charter)) '(-161 -236 1193 963)) + (check-equal? (caar (hash-ref (layout charter "f" #:test #t) 'hb-positions)) 321) + (check-true (has-table? charter #"cmap")) + (check-exn exn:fail:contract? (λ () (get-table charter 'nonexistent-table-tag))) (check-true (let ([h (layout fira "Rifle" #:test #t)]) - (and (equal? (dict-ref h 'hb-gids) '(227 480 732 412)) - (equal? (dict-ref h 'hb-clusters) '((82) (105) (102 108) (101))) - (equal? (dict-ref h 'hb-positions) '((601 0 0 0 0) (279 0 0 0 0) (580 0 0 0 0) (547 0 0 0 0))))))) + (and (equal? (hash-ref h 'hb-gids) '(227 480 732 412)) + (equal? (hash-ref h 'hb-clusters) '((82) (105) (102 108) (101))) + (equal? (hash-ref h 'hb-positions) '((601 0 0 0 0) (279 0 0 0 0) (580 0 0 0 0) (547 0 0 0 0)))))))