From 9bc3349f79944b95102efbcb07831fa05a0c5023 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Wed, 1 Apr 2020 16:17:42 -0700
Subject: [PATCH] support system fonts

---
 quad/quad/scribblings/quad.scrbl |  7 ++++++-
 quad/quadwriter/font.rkt         | 32 +++++++++++++++++++++++++-------
 2 files changed, 31 insertions(+), 8 deletions(-)

diff --git a/quad/quad/scribblings/quad.scrbl b/quad/quad/scribblings/quad.scrbl
index a504c4e4..080ce63d 100644
--- a/quad/quad/scribblings/quad.scrbl
+++ b/quad/quad/scribblings/quad.scrbl
@@ -780,7 +780,7 @@ The optional @racket[compress?] argument controls whether data inside the result
 
 A design goal of Quadwriter is to treat document layout as the result of a program. Along those lines, fonts are handled differently than usual. When you use a word processor, you choose from whatever fonts might be installed on your system. 
 
-Quadwriter, by contrast, relies only on fonts that are @emph{in the same directory} as your other project source files. This is a feature: it means that everything  necessary to render the document travels together in the same directory. You can re-render it anywhere with identical results. You never have the problem — still with us after 35 years of desktop word processing — that ``oh, you need to install such-and-such font in your system before it will work.'' Bah!
+Quadwriter, by contrast, prefers to rely on fonts that are @emph{in the same directory} as your other project source files. This is a feature: it means that everything necessary to render the document can travel together in the same directory. You can re-render it anywhere with identical results. You never have the problem — still with us after 35 years of desktop word processing — that ``oh, you need to install such-and-such font in your system before it will work.'' Bah!
 
 Quadwriter supports the usual TrueType (@racket[.ttf]) and OpenType (@racket[.otf]) font files. It also supports WOFF files (@racket[.woff]). To add fonts to your Quadwriter experience:
 
@@ -837,6 +837,11 @@ Fallback only. Used for math symbols not present in the currently selected font.
 Fallback only. Used for other glyphs not present in the currently selected font.
 }
 
+@subsubsection{System fonts}
+
+Yes, if you're feeling lazy, you can use the name of a system font family in any field that takes a family name, and Quad will comply. But if you do this, bear in mind that your document will no longer necessarily be portable between systems, because it depends on a certain font already being available on that system. I include this option because I can imagine plenty of uses for Quad where ease outweighs portability. In which case, have at it. 
+
+
 @subsection{Colors}
 
 A @deftech{hex color} is a case-insensitive string of six hex digits prefixed with @litchar{#}, such as @racket["#fe456a"] or @racket["#cc6633"]. The pairs of digits represent the red, green, and blue components of the color respectively, each pair taking on hex values between 0 (@racket["00"]) and 255 (@racket["ff"]), inclusive. As optional shorthand, a three-digit hex color such as @racket["#c63"] is equivalent to @racket["#cc6633"].
diff --git a/quad/quadwriter/font.rkt b/quad/quadwriter/font.rkt
index a9946dbb..6f39b8c6 100644
--- a/quad/quadwriter/font.rkt
+++ b/quad/quadwriter/font.rkt
@@ -3,6 +3,7 @@
          racket/string
          racket/path
          racket/match
+         fontland/font-path
          "attrs.rkt")
 (provide (all-defined-out))
 
@@ -58,16 +59,33 @@
 
 (define (font-attrs->path font-family bold italic)
   ;; find the font-path corresponding to a certain family name and style.
-  (define key (cons (string-downcase font-family)
-                    (cond
-                      [(and bold italic) 'bi]
-                      [bold 'b]
-                      [italic 'i]
-                      [else 'r])))
-  (define regular-key (cons font-family 'r))
+  (define (make-key font-family [bold #f] [italic #f])
+    (cons (string-downcase font-family)
+          (cond
+            [(and bold italic) 'bi]
+            [bold 'b]
+            [italic 'i]
+            [else 'r])))
+  (define key (make-key font-family bold italic))
+  (define regular-key (make-key font-family))
   (cond
     [(hash-ref font-paths key #false)]
     [(hash-ref font-paths regular-key #false)]
+    ;; if it's not already in font paths, it might be a system font
+    ;; we use `family->path` to try to resolve the ribbi styles
+    ;; if the font is a system font, we will end up with paths.
+    ;; if it's not, we will end up with #false for those entries in `font-paths`,
+    ;; and fall through to the default font.
+    [(let ()
+       (unless (hash-has-key? font-paths regular-key)
+         (for* ([bold (in-list (list #false #true))]
+                [italic (in-list (list #false #true))])
+               (hash-set! font-paths
+                          (make-key font-family bold italic)
+                          (family->path font-family #:bold bold #:italic italic))))
+       (cond
+         [(hash-ref font-paths key #false)]
+         [else (hash-ref font-paths regular-key #false)]))]
     [else default-font-face]))
 
 (define (resolve-font-path! attrs)