main
Matthew Butterick 6 years ago
parent 7549e1fca3
commit 8213ecbf0a

@ -17,13 +17,14 @@
(raise-argument-error 'bbox-height "bbox" bb))
(- (bbox-max-y bb) (bbox-min-y bb)))
(define (bbox-add-point bb x y)
(define (bbox-add-point! bb x y)
(unless (bbox? bb)
(raise-argument-error 'bbox-add-point "bbox" bb))
(set-bbox-min-x! bb (min x (bbox-min-x bb)))
(set-bbox-min-y! bb (min y (bbox-min-y bb)))
(set-bbox-max-x! bb (max x (bbox-max-x bb)))
(set-bbox-max-y! bb (max y (bbox-max-y bb))))
(set-bbox-max-y! bb (max y (bbox-max-y bb)))
(void))
(define (bbox-copy bb)
(unless (bbox? bb)
@ -31,3 +32,13 @@
(apply +bbox (bbox->list bb)))
(define bbox->list struct->list)
(module+ test
(require rackunit)
(define bb (+bbox 1 2 4 8))
(check-equal? (bbox-width bb) 3)
(check-equal? (bbox-height bb) 6)
(bbox-add-point! bb 0 0)
(check-equal? (bbox-width bb) 4)
(check-equal? (bbox-height bb) 8)
(check-equal? (bbox->list (bbox-copy bb)) (bbox->list bb)))

@ -1,25 +1,17 @@
#lang debug racket/base
(require (for-syntax racket/base)
"helper.rkt"
(require "helper.rkt"
"unsafe/freetype.rkt"
"subset.rkt"
"glyph.rkt"
"ttf-glyph.rkt"
"bbox.rkt"
"glyphrun.rkt"
"directory.rkt"
"db.rkt"
"struct.rkt"
"table-stream.rkt"
xenomorph
"tables.rkt"
racket/contract
racket/class
racket/match
racket/file
sugar/unstable/class
sugar/unstable/contract
sugar/unstable/dict
sugar/unstable/js
racket/port
"unsafe/harfbuzz.rkt"
"glyph-position.rkt"
sugar/list
@ -32,136 +24,70 @@ approximates
https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
|#
(test-module
(define f (openSync (path->string charter-path)))
(define fira (openSync (path->string fira-path)))
(define otf (openSync (path->string fira-otf-path)))
(check-equal? (postscriptName f) "Charter"))
;; This is the base class for all SFNT-based font formats in fontkit.
;; (including CFF)
;; It supports TrueType, and PostScript glyphs, and several color glyph formats.
(require "struct.rkt")
(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 [_decoded-tables (mhash)]
[_src (path->string (object-name _port))]
[_directory (delay (decode Directory _port #:parent (mhash '_startOffset 0)))]
[_ft-face (delay (and _src (FT_New_Face (force ft-library) _src)))]
[_hb-font (delay (and _src (hb_ft_font_create (force _ft-face))))]
[_hb-buf (delay (hb_buffer_create))]
[_crc (begin0 (crc32c-input-port _port) (pos _port 0))]
[_get-head-table #f])
(unless (input-port? _port)
(raise-argument-error '+ttf-font "input port" _port))
(unless (member (peek-bytes 4 0 _port) (list #"true" #"OTTO" (bytes 0 1 0 0)))
(raise 'probe-fail))
(define f
(ttf-font _port _decoded-tables _src _directory _ft-face _hb-font _hb-buf _crc _get-head-table))
;; needed for `loca` table decoding cross-reference
(set-ttf-font-get-head-table-proc! f (λ () (get-head-table f)))
f)
(define (directory this) (force (· this _directory)))
(define (hb-font this) (or (force (ttf-font-hb-font this)) (error 'hb-font-not-available)))
(define (hb-buf this) (force (ttf-font-hb-buf this)))
(require "table-stream.rkt")
;; The unique PostScript name for this font
(define (postscriptName this)
(FT_Get_Postscript_Name (ft-face this)))
;; The size of the fonts internal coordinate grid
(define (unitsPerEm this)
(· (get-head-table this) unitsPerEm))
(test-module
(check-equal? (unitsPerEm f) 1000))
;; The fonts [ascender](https://en.wikipedia.org/wiki/Ascender_(typography))
(define (ascent this)
(· (get-hhea-table this) ascent))
(test-module
(check-equal? (ascent f) 980))
;; The fonts [descender](https://en.wikipedia.org/wiki/Descender)
(define (descent this)
(· (get-hhea-table this) descent))
(test-module
(check-equal? (descent f) -238))
;; The amount of space that should be included between lines
(define (lineGap this)
(· (get-hhea-table this) lineGap))
(define line-gap lineGap) ; todo: avoid this name collision in pitfall/embedded
(test-module
(check-equal? (lineGap f) 0))
(define (underlinePosition this)
(· (get-post-table this) underlinePosition))
(test-module
(check-equal? (underlinePosition f) -178))
(define (underlineThickness this)
(· (get-post-table this) underlineThickness))
(test-module
(check-equal? (underlineThickness f) 58))
;; If this is an italic font, the angle the cursor should be drawn at to match the font design
(define (italicAngle this)
(· (get-post-table this) italicAngle))
(test-module
(check-equal? (italicAngle f) 0))
;; The height of capital letters above the baseline.
(define (capHeight this)
(if (has-table? this #"OS/2")
(· (get-OS/2-table this) capHeight)
(ascent this)))
(test-module
(check-equal? (capHeight f) 671))
;; The height of lower case letters in the font.
(define (xHeight this)
(if (has-table? this #"OS/2")
(· (get-OS/2-table this) xHeight)
(define (+ttf-font port
[decoded-tables (mhash)]
[src (path->string (object-name port))]
[directory (delay (decode Directory port #:parent (mhash '_startOffset 0)))]
[ft-face (delay (and src (FT_New_Face (force ft-library) src)))]
[hb-font (delay (and src (hb_ft_font_create (force ft-face))))]
[hb-buf (delay (hb_buffer_create))]
[crc (begin0 (crc32c-input-port port) (pos port 0))]
[get-head-table-proc #f])
(unless (input-port? port)
(raise-argument-error '+ttf-font "input port" port))
(unless (member (peek-bytes 4 0 port) (list #"true" #"OTTO" (bytes 0 1 0 0)))
(do-probe-fail!))
(define font
(ttf-font port decoded-tables src directory ft-face hb-font hb-buf crc get-head-table-proc))
;; needed for `loca` table decoding cross-reference
(set-ttf-font-get-head-table-proc! font (delay (dump (get-head-table font))))
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-cap-height font)
(if (has-table? font #"OS/2")
(· (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)
0))
(test-module
(check-equal? (xHeight f) 481))
;; The fonts bounding box, i.e. the box that encloses all glyphs in the font.
(define (font-bbox this)
(define head-table (get-head-table this))
(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)))
(define current-layout-caching (make-parameter #false))
(struct hb-gid (val) #:transparent)
@ -174,36 +100,31 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
'hb-clusters (+Array (+Array uint16 uint16) uint16)
'hb-positions (+Array (+Array uint16 5) uint16))))
(define (hb-layout->glyphrun this hbr)
(define (hb-layout->glyphrun font hbr)
(match hbr
[(hash-table ('hb-gids gidxs)
[(hash-table ('hb-gids gids)
('hb-clusters clusters)
('hb-positions posns))
(define glyphs (for/list ([gidx (in-list gidxs)]
(define glyphs (for/list ([gidx (in-list gids)]
[cluster (in-list clusters)])
(get-glyph this gidx cluster)))
(define positions (for/list ([pos (in-list posns)])
(match pos
[(list xad yad xoff yoff _) (+glyph-position xad yad xoff yoff)])))
(get-glyph font gidx cluster)))
(define positions (for/list ([posn (in-list posns)])
(apply +glyph-position posn)))
(glyphrun glyphs positions)]))
(define (harfbuzz-layout this codepoints userFeatures script language)
#;(string? (listof symbol?) symbol? symbol? . ->m . GlyphRun?)
(define buf (hb-buf this))
(define (harfbuzz-layout font codepoints features script language)
(define buf (hb-buf font))
(hb_buffer_reset buf)
(hb_buffer_add_codepoints buf codepoints)
(define chars (map hb_glyph_info_t-codepoint (hb_buffer_get_glyph_infos buf)))
(hb_shape (hb-font this) buf (map tag->hb-feature (or userFeatures null)))
(hb_shape (hb-font font) buf (map tag->hb-feature (or features null)))
(define gis (hb_buffer_get_glyph_infos buf))
(dictify 'hb-gids (map hb_glyph_info_t-codepoint gis)
'hb-clusters (break-at chars (map hb_glyph_info_t-cluster gis))
'hb-positions (map hb_glyph_position_t->list (hb_buffer_get_glyph_positions buf))))
(define layout-cache (make-hasheqv))
(require xenomorph/struct)
(define hb-input (+Struct (dictify
'font-crc uint32
'codepoints (+Array uint16)
@ -217,18 +138,18 @@ 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.
(define (layout this string [user-features #f] [script #f] [language #f] #:debug [debug #f])
(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)
(define codepoints (map char->integer (string->list string)))
(define args (list codepoints (if user-features (sort user-features symbol<?) null) script language))
(define key (apply layout-cache-key (ttf-font-crc this) args))
(define key (apply layout-cache-key (ttf-font-crc font) args))
(hash-ref! layout-cache key
(λ ()
#;(encode hb-output (apply harfbuzz-layout this args) #f)
#;(encode hb-output (apply harfbuzz-layout font args) #f)
(match (get-layout-from-db key)
[(? bytes? res) (dump (decode hb-output res))]
[_ (define new-layout (apply harfbuzz-layout this args))
[_ (define new-layout (apply harfbuzz-layout font args))
(add-record! (cons key (encode hb-output new-layout #f)))
(make-hasheq new-layout)])))) ;; `dump` converts to hash
;; work on substrs to reuse cached pieces
@ -240,45 +161,40 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
(define substrs (for/list ([substr (in-list (regexp-match* " " string #:gap-select? #t))]
#:when (positive? (string-length substr)))
substr))
(apply append-glyphruns (map (λ (lo) (hb-layout->glyphrun this lo)) (map get-layout substrs)))]
[else (if debug
(apply append-glyphruns (map (λ (layout) (hb-layout->glyphrun font layout)) (map get-layout substrs)))]
[else (if test
(get-layout string)
(hb-layout->glyphrun this (get-layout string)))]))
(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 (glyphsForString this string)
(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)])
(send this glyphForCodePoint cp)))
(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 this codepoint)
(define glyph-idx (FT_Get_Char_Index (· this ft-face) codepoint))
(get-glyph this glyph-idx (list codepoint)))
(define (measure-char-width this char)
(define glyph-idx (FT_Get_Char_Index (ft-face this) (char->integer char)))
(FT_Load_Glyph (ft-face this) glyph-idx FT_LOAD_NO_RECURSE)
(define width (FT_Vector-x (FT_GlyphSlotRec-advance (FT_FaceRec-glyph (ft-face this)))))
(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 this str size)
(define (measure-string font str size)
(/ (* size
(for/sum ([c (in-string str)])
(measure-char-width this c))) (unitsPerEm this)))
(measure-char-width font c))) (font-units-per-em font)))
#|
approximates
@ -298,28 +214,29 @@ approximates
https://github.com/mbutterick/fontkit/blob/master/src/base.js
|#
(define (openSync str-or-path)
(define (open-font str-or-path)
(define filename (if (path? str-or-path) (path->string str-or-path) str-or-path))
(create (open-input-file filename)))
(create-font (open-input-file filename)))
(define (probe-failed? x) (eq? x 'probe-fail))
(struct probe-fail exn ())
(define (do-probe-fail!)
(raise (probe-fail "fail" (current-continuation-marks))))
(define (create port)
(define (create-font port)
(or
;; rather than use a `probe` function,
;; just try making a font with each format and see what happens
(for/first ([font-format (in-list font-formats)])
(with-handlers ([probe-failed? (λ (exn) #f)])
(with-handlers ([probe-fail? (λ (exn) #f)])
(font-format port)))
(error 'fontland:create "unknown font format")))
(error 'create-font "unknown font format")))
(test-module
(check-equal? (measure-string f "f" (unitsPerEm f)) 321.0)
(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)))
(check-true
(let ([h (layout fira "Rifle" #:debug #t)])
(let ([h (layout fira "Rifle" #:test #t)])
(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)))))))

@ -1,14 +1,12 @@
#lang racket/base
(require (for-syntax)
sugar/unstable/dict
sugar/unstable/js
"unsafe/freetype.rkt"
"table-stream.rkt"
"struct.rkt"
"helper.rkt")
(provide (all-defined-out))
#|
approximates
https://github.com/mbutterick/fontkit/blob/master/src/glyph/Glyph.js
@ -21,7 +19,6 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/Glyph.js
; 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.
(struct glyph (id codepoints font is-mark? is-ligature? metrics) #:transparent #:mutable)
(define (+glyph id codepoints font
@ -31,11 +28,6 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/Glyph.js
#:constructor [constructor glyph])
(constructor id codepoints font is-mark? is-ligature? metrics))
#;(define-stub-stop _getPath)
#;(define-stub-stop _getCBox)
#;(define-stub-stop _getBBox)
#;(define-stub-stop _getTableMetrics)
(define (glyph-advance-width g)
(hash-ref (get-glyph-metrics g) 'advanceWidth))
@ -51,22 +43,16 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/Glyph.js
'leftBearing (FT_Glyph_Metrics-horiBearingX ft-glyph-metrics)))
(glyph-metrics g))
;; Represents a TrueType glyph.
(struct ttf-glyph glyph () #:transparent)
(define (+ttf-glyph . args)
(apply +glyph #:constructor ttf-glyph args))
;; Returns a glyph object for the given glyph id.
;; You can pass the array of code points this glyph represents for
;; your use later, and it will be stored in the glyph object.
(define (get-glyph this glyph [characters null])
;; no CFF
#;(make-object (if (· this has-cff-table?)
CFFGlyph
TTFGlyph) glyph characters this)
(+ttf-glyph glyph characters this))
(define (get-glyph font gid [codepoints null])
((if (has-table? font #"cff_")
(error 'cff-fonts-unsupported)
+ttf-glyph) gid codepoints font))

@ -9,7 +9,6 @@ approximates
https://github.com/mbutterick/fontkit/blob/master/src/layout/GlyphRun.js
|#
;; Represents a run of Glyph and GlyphPosition objects.
;; Returned by the font layout method.
; An array of Glyph objects in the run

@ -182,6 +182,5 @@ https://github.com/mbutterick/fontkit/blob/master/src/layout/Script.js
phlp ;; Psalter Pahlavi
))
(define/contract (direction script)
((option/c symbol?) . -> . (or/c 'rtl 'ltr))
(define (direction script)
(if (memq script RTL) 'rtl 'ltr))

@ -5,4 +5,14 @@
(struct ttf-font (port decoded-tables src directory ft-face hb-font hb-buf crc get-head-table-proc)
#:transparent #:mutable)
(define (ft-face this) (or (force (ttf-font-ft-face this)) (error 'ft-face-not-available)))
(define (ft-face this)
(or (force (ttf-font-ft-face this)) (error 'ft-face-not-available)))
(define (directory this)
(or (force (ttf-font-directory directory)) (error 'directory-not-available)))
(define (hb-font this)
(or (force (ttf-font-hb-font this)) (error 'hb-font-not-available)))
(define (hb-buf this)
(or (force (ttf-font-hb-buf this)) (error 'hp-buf-not-available)))

@ -5,6 +5,7 @@
sugar/unstable/dict
racket/class
racket/list
racket/promise
"../struct.rkt"
"../helper.rkt")
(provide (all-defined-out))
@ -45,7 +46,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/loca.js
(define loca (+Rloca
;; todo: address ugliness to cross-ref head table from ttffont
(λ (o) (hash-ref (dump ((ttf-font-get-head-table-proc o))) 'indexToLocFormat))
(λ (o) (hash-ref (force (ttf-font-get-head-table-proc o)) 'indexToLocFormat))
(dictify
0 (dictify 'offsets (+Array uint16be))
1 (dictify 'offsets (+Array uint32be)))))

Loading…
Cancel
Save