implement `remove-font-without-char`

quad2/font.rkt

@@ -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]))))))

quad2/glyphrun.rkt

@@ -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))))
+

quad2/main.rkt

@@ -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