mbutterick
/
typesetting
2
1
Fork 0
Code Issues 13 Pull Requests Projects Releases Wiki Activity

refacs

Browse Source
main
Matthew Butterick 6 years ago
parent 7549e1fca3
commit 8213ecbf0a
7 changed files with 125 additions and 202 deletions
Show Stats Download Patch File Download Diff File

15
fontland/fontland/bbox.rkt
Unescape Escape View File

@ -17,13 +17,14 @@
(raise-argument-error 'bbox-height "bbox" bb)) (raise-argument-error 'bbox-height "bbox" bb))
(- (bbox-max-y bb) (bbox-min-y 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) (unless (bbox? bb)
(raise-argument-error 'bbox-add-point "bbox" bb)) (raise-argument-error 'bbox-add-point "bbox" bb))
(set-bbox-min-x! bb (min x (bbox-min-x 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-min-y! bb (min y (bbox-min-y bb)))
(set-bbox-max-x! bb (max x (bbox-max-x 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) (define (bbox-copy bb)
(unless (bbox? bb) (unless (bbox? bb)
@ -31,3 +32,13 @@
(apply +bbox (bbox->list bb))) (apply +bbox (bbox->list bb)))
(define bbox->list struct->list) (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)))

269
fontland/fontland/font.rkt
Unescape Escape View File

@ -1,25 +1,17 @@
#lang debug racket/base #lang debug racket/base
(require (for-syntax racket/base) (require "helper.rkt"
"helper.rkt"
"unsafe/freetype.rkt" "unsafe/freetype.rkt"
"subset.rkt"
"glyph.rkt" "glyph.rkt"
"ttf-glyph.rkt"
"bbox.rkt" "bbox.rkt"
"glyphrun.rkt" "glyphrun.rkt"
"directory.rkt" "directory.rkt"
"db.rkt" "db.rkt"
"struct.rkt"
"table-stream.rkt"
xenomorph xenomorph
"tables.rkt"
racket/contract
racket/class
racket/match racket/match
racket/file
sugar/unstable/class
sugar/unstable/contract
sugar/unstable/dict sugar/unstable/dict
sugar/unstable/js sugar/unstable/js
racket/port
"unsafe/harfbuzz.rkt" "unsafe/harfbuzz.rkt"
"glyph-position.rkt" "glyph-position.rkt"
sugar/list sugar/list
@ -32,136 +24,70 @@ approximates
https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
|# |#
(test-module (test-module
(define f (openSync (path->string charter-path))) (define f (open-font charter-path))
(define fira (openSync (path->string fira-path))) (define fira (open-font (path->string fira-path)))
(define otf (openSync (path->string fira-otf-path))) (define otf (open-font (path->string fira-otf-path)))
(check-equal? (postscriptName f) "Charter")) (check-equal? (font-postscript-name 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 ft-library (delay (FT_Init_FreeType))) (define ft-library (delay (FT_Init_FreeType)))
(define (+ttf-font _port [_decoded-tables (mhash)] (define (+ttf-font port
[_src (path->string (object-name _port))] [decoded-tables (mhash)]
[_directory (delay (decode Directory _port #:parent (mhash '_startOffset 0)))] [src (path->string (object-name port))]
[_ft-face (delay (and _src (FT_New_Face (force ft-library) _src)))] [directory (delay (decode Directory port #:parent (mhash '_startOffset 0)))]
[_hb-font (delay (and _src (hb_ft_font_create (force _ft-face))))] [ft-face (delay (and src (FT_New_Face (force ft-library) src)))]
[_hb-buf (delay (hb_buffer_create))] [hb-font (delay (and src (hb_ft_font_create (force ft-face))))]
[_crc (begin0 (crc32c-input-port _port) (pos _port 0))] [hb-buf (delay (hb_buffer_create))]
[_get-head-table #f]) [crc (begin0 (crc32c-input-port port) (pos port 0))]
(unless (input-port? _port) [get-head-table-proc #f])
(raise-argument-error '+ttf-font "input port" _port)) (unless (input-port? port)
(unless (member (peek-bytes 4 0 _port) (list #"true" #"OTTO" (bytes 0 1 0 0))) (raise-argument-error '+ttf-font "input port" port))
(raise 'probe-fail)) (unless (member (peek-bytes 4 0 port) (list #"true" #"OTTO" (bytes 0 1 0 0)))
(define f (do-probe-fail!))
(ttf-font _port _decoded-tables _src _directory _ft-face _hb-font _hb-buf _crc _get-head-table)) (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 ;; needed for `loca` table decoding cross-reference
(set-ttf-font-get-head-table-proc! f (λ () (get-head-table f))) (set-ttf-font-get-head-table-proc! font (delay (dump (get-head-table font))))
f) font)
(define (font-postscript-name font) (FT_Get_Postscript_Name (ft-face font)))
(define (directory this) (force (· this _directory))) (define (font-units-per-em font) (· (get-head-table font) unitsPerEm))
(define (hb-font this) (or (force (ttf-font-hb-font this)) (error 'hb-font-not-available))) (define (font-ascent font) (· (get-hhea-table font) ascent))
(define (hb-buf this) (force (ttf-font-hb-buf this))) (define (font-descent font) (· (get-hhea-table font) descent))
(define (font-linegap font) (· (get-hhea-table font) lineGap))
(require "table-stream.rkt") (define (font-underline-position font) (· (get-post-table font) underlinePosition))
(define (font-underline-thickness font) (· (get-post-table font) underlineThickness))
;; The unique PostScript name for this font (define (font-italic-angle font) (· (get-post-table font) italicAngle))
(define (postscriptName this)
(FT_Get_Postscript_Name (ft-face this))) (define (font-cap-height font)
(if (has-table? font #"OS/2")
(· (get-OS/2-table font) capHeight)
;; The size of the font’s internal coordinate grid (font-ascent font)))
(define (unitsPerEm this)
(· (get-head-table this) unitsPerEm)) (define (font-x-height font)
(if (has-table? font #"OS/2")
(test-module (· (get-OS/2-table font) xHeight)
(check-equal? (unitsPerEm f) 1000))
;; The font’s [ascender](https://en.wikipedia.org/wiki/Ascender_(typography))
(define (ascent this)
(· (get-hhea-table this) ascent))
(test-module
(check-equal? (ascent f) 980))
;; The font’s [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)
0)) 0))
(test-module (test-module
(check-equal? (xHeight f) 481)) (check-equal? (font-units-per-em f) 1000)
(check-equal? (font-ascent f) 980)
(check-equal? (font-descent f) -238)
;; The font’s bounding box, i.e. the box that encloses all glyphs in the font. (check-equal? (font-linegap f) 0)
(define (font-bbox this) (check-equal? (font-underline-position f) -178)
(define head-table (get-head-table this)) (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))) (+bbox (· head-table xMin) (· head-table yMin) (· head-table xMax) (· head-table yMax)))
(test-module (test-module
(check-equal? (bbox->list (font-bbox f)) '(-161 -236 1193 963))) (check-equal? (bbox->list (font-bbox f)) '(-161 -236 1193 963)))
(define current-layout-caching (make-parameter #false)) (define current-layout-caching (make-parameter #false))
(struct hb-gid (val) #:transparent) (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-clusters (+Array (+Array uint16 uint16) uint16)
'hb-positions (+Array (+Array uint16 5) uint16)))) 'hb-positions (+Array (+Array uint16 5) uint16))))
(define (hb-layout->glyphrun this hbr) (define (hb-layout->glyphrun font hbr)
(match hbr (match hbr
[(hash-table ('hb-gids gidxs) [(hash-table ('hb-gids gids)
('hb-clusters clusters) ('hb-clusters clusters)
('hb-positions posns)) ('hb-positions posns))
(define glyphs (for/list ([gidx (in-list gidxs)] (define glyphs (for/list ([gidx (in-list gids)]
[cluster (in-list clusters)]) [cluster (in-list clusters)])
(get-glyph this gidx cluster))) (get-glyph font gidx cluster)))
(define positions (for/list ([pos (in-list posns)]) (define positions (for/list ([posn (in-list posns)])
(match pos (apply +glyph-position posn)))
[(list xad yad xoff yoff _) (+glyph-position xad yad xoff yoff)])))
(glyphrun glyphs positions)])) (glyphrun glyphs positions)]))
(define (harfbuzz-layout font codepoints features script language)
(define (harfbuzz-layout this codepoints userFeatures script language) (define buf (hb-buf font))
#;(string? (listof symbol?) symbol? symbol? . ->m . GlyphRun?)
(define buf (hb-buf this))
(hb_buffer_reset buf) (hb_buffer_reset buf)
(hb_buffer_add_codepoints buf codepoints) (hb_buffer_add_codepoints buf codepoints)
(define chars (map hb_glyph_info_t-codepoint (hb_buffer_get_glyph_infos buf))) (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)) (define gis (hb_buffer_get_glyph_infos buf))
(dictify 'hb-gids (map hb_glyph_info_t-codepoint gis) (dictify 'hb-gids (map hb_glyph_info_t-codepoint gis)
'hb-clusters (break-at chars (map hb_glyph_info_t-cluster 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)))) 'hb-positions (map hb_glyph_position_t->list (hb_buffer_get_glyph_positions buf))))
(define layout-cache (make-hasheqv)) (define layout-cache (make-hasheqv))
(require xenomorph/struct)
(define hb-input (+Struct (dictify (define hb-input (+Struct (dictify
'font-crc uint32 'font-crc uint32
'codepoints (+Array uint16) '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. ;; 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?) #;((string?) ((option/c (listof symbol?)) (option/c symbol?) (option/c symbol?)) . ->*m . GlyphRun?)
(define (get-layout string) (define (get-layout string)
(define codepoints (map char->integer (string->list string))) (define codepoints (map char->integer (string->list string)))
(define args (list codepoints (if user-features (sort user-features symbol<?) null) script language)) (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 (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) (match (get-layout-from-db key)
[(? bytes? res) (dump (decode hb-output res))] [(? 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))) (add-record! (cons key (encode hb-output new-layout #f)))
(make-hasheq new-layout)])))) ;; `dump` converts to hash (make-hasheq new-layout)])))) ;; `dump` converts to hash
;; work on substrs to reuse cached pieces ;; 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))] (define substrs (for/list ([substr (in-list (regexp-match* " " string #:gap-select? #t))]
#:when (positive? (string-length substr))) #:when (positive? (string-length substr)))
substr)) substr))
(apply append-glyphruns (map (λ (lo) (hb-layout->glyphrun this lo)) (map get-layout substrs)))] (apply append-glyphruns (map (λ (layout) (hb-layout->glyphrun font layout)) (map get-layout substrs)))]
[else (if debug [else (if test
(get-layout string) (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. ;; Returns an array of Glyph objects for the given string.
;; This is only a one-to-one mapping from characters to glyphs. ;; This is only a one-to-one mapping from characters to glyphs.
;; For most uses, you should use font.layout (described below), which ;; For most uses, you should use font.layout (described below), which
;; provides a much more advanced mapping supporting AAT and OpenType shaping. ;; 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?)) #;(string? . ->m . (listof glyph?))
;; todo: make this handle UTF-16 with surrogate bytes ;; todo: make this handle UTF-16 with surrogate bytes
;; for now, just use UTF-8 ;; for now, just use UTF-8
(define codepoints (map char->integer (string->list string))) (define codepoints (map char->integer (string->list string)))
(for/list ([cp (in-list codepoints)]) (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. ;; Maps a single unicode code point to a Glyph object.
;; Does not perform any advanced substitutions (there is no context to do so). ;; Does not perform any advanced substitutions (there is no context to do so).
(define (glyph-for-codepoint this codepoint) (define (glyph-for-codepoint font codepoint)
(define glyph-idx (FT_Get_Char_Index (· this ft-face) codepoint)) (define glyph-idx (FT_Get_Char_Index (· font ft-face) codepoint))
(get-glyph this glyph-idx (list codepoint))) (get-glyph font glyph-idx (list codepoint)))
(define (measure-char-width font char)
(define (measure-char-width this char) (define glyph-idx (FT_Get_Char_Index (ft-face font) (char->integer char)))
(define glyph-idx (FT_Get_Char_Index (ft-face this) (char->integer char))) (FT_Load_Glyph (ft-face font) glyph-idx FT_LOAD_NO_RECURSE)
(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 font)))))
(define width (FT_Vector-x (FT_GlyphSlotRec-advance (FT_FaceRec-glyph (ft-face this)))))
(* width 1.0)) (* width 1.0))
(define (measure-string this str size) (define (measure-string font str size)
(/ (* size (/ (* size
(for/sum ([c (in-string str)]) (for/sum ([c (in-string str)])
(measure-char-width this c))) (unitsPerEm this))) (measure-char-width font c))) (font-units-per-em font)))
#| #|
approximates approximates
@ -298,28 +214,29 @@ approximates
https://github.com/mbutterick/fontkit/blob/master/src/base.js 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)) (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 (or
;; rather than use a `probe` function, ;; rather than use a `probe` function,
;; just try making a font with each format and see what happens ;; just try making a font with each format and see what happens
(for/first ([font-format (in-list font-formats)]) (for/first ([font-format (in-list font-formats)])
(with-handlers ([probe-failed? (λ (exn) #f)]) (with-handlers ([probe-fail? (λ (exn) #f)])
(font-format port))) (font-format port)))
(error 'fontland:create "unknown font format"))) (error 'create-font "unknown font format")))
(test-module (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-true (has-table? f #"cmap"))
(check-exn exn:fail:contract? (λ () (get-table f 'nonexistent-table-tag))) (check-exn exn:fail:contract? (λ () (get-table f 'nonexistent-table-tag)))
(check-true (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)) (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-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))))))) (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)))))))

24
fontland/fontland/glyph.rkt
Unescape Escape View File

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

1
fontland/fontland/glyphrun.rkt
Unescape Escape View File

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

3
fontland/fontland/script.rkt
Unescape Escape View File

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

12
fontland/fontland/struct.rkt
Unescape Escape View File

@ -5,4 +5,14 @@
(struct ttf-font (port decoded-tables src directory ft-face hb-font hb-buf crc get-head-table-proc) (struct ttf-font (port decoded-tables src directory ft-face hb-font hb-buf crc get-head-table-proc)
#:transparent #:mutable) #: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)))

3
fontland/fontland/table/loca.rkt
Unescape Escape View File

@ -5,6 +5,7 @@
sugar/unstable/dict sugar/unstable/dict
racket/class racket/class
racket/list racket/list
racket/promise
"../struct.rkt" "../struct.rkt"
"../helper.rkt") "../helper.rkt")
(provide (all-defined-out)) (provide (all-defined-out))
@ -45,7 +46,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/loca.js
(define loca (+Rloca (define loca (+Rloca
;; todo: address ugliness to cross-ref head table from ttffont ;; 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 (dictify
0 (dictify 'offsets (+Array uint16be)) 0 (dictify 'offsets (+Array uint16be))
1 (dictify 'offsets (+Array uint32be))))) 1 (dictify 'offsets (+Array uint32be)))))

Write Preview
Loading…
Cancel
Save