implement `remove-font-without-char`

main
Matthew Butterick 2 years ago
parent fd30c9ed44
commit 6edad964bd

@ -13,6 +13,7 @@
"struct.rkt"
"dimension.rkt"
"attr.rkt"
"glyphrun.rkt"
(prefix-in unicode: (combine-in "unicode/emoji.rkt" "unicode/math.rkt")))
(provide (all-defined-out))
@ -268,15 +269,17 @@
(quad-ref! q :font-path #false)))
(define-pass (remove-font-without-char qs)
;; TODO: missing glyphs
;; at this point we have a font-path for each character
;; at this point we have a font-path value for each character
;; (which might be #false)
;; but we don't know if the character is in that font.
;; for chars whose font is missing, we mark the font-path as #false.
#:pre (list-of simple-quad-with-font-path-key?)
#:post (list-of simple-quad-with-font-path-key?)
(error 'remove-font-without-char-unimplemented)
qs
)
(for* ([q (in-list qs)]
[font-path (in-value (quad-ref q :font-path))]
#:when font-path
#:unless (char-in-font? font-path (car (quad-elems q))))
(quad-set! q :font-path #false)))
(define (simple-quad-with-complete-font-path? q)
(and (simple-quad? q) (complete-path? (quad-ref q :font-path))))
@ -301,5 +304,4 @@
[(? unicode:emoji? c) default-emoji-face]
#;[(? unicode:math? c) default-math-face]
[_ default-math-face])]
[_ default-math-face])))))
qs)
[_ default-math-face]))))))

@ -0,0 +1,27 @@
#lang debug racket/base
(require racket/match
fontland)
(provide (all-defined-out))
(define get-font
(let ([font-cache (make-hasheqv)])
(λ (font-path)
(hash-ref! font-cache font-path (λ () (open-font font-path))))))
(define get-gid
(let ([gid-cache (make-hash)])
(λ (font-path c-or-str)
;; layout a string with just c in it and get the gid
(define f (get-font font-path))
(define str (match c-or-str
[(? char? c) (string c)]
[str #:when (eq? (string-length str) 1) str]
[val (raise-argument-error 'get-gid "char or string of length 1" val)]))
(define gid-key (cons str font-path))
(hash-ref! gid-cache gid-key
(λ () (glyph-id (vector-ref (glyphrun-glyphs (layout f str)) 0)))))))
(define (char-in-font? font-path c-or-str)
(not (zero? (get-gid font-path c-or-str))))

@ -53,7 +53,7 @@
split-whitespace
split-into-single-char-quads
fill-missing-font-path
#;remove-font-without-char
remove-font-without-char
insert-fallback-font
layout
make-drawing-insts

Loading…
Cancel
Save