allow path string as font-family value

quad/fontproof/command.rkt

@@ -47,14 +47,14 @@
      [("-l" "--leading") line-heights-arg
                          "line height"
                          (set! line-heights line-heights-arg)]
-     [("-b" "--bold") "also generate bold proof"
+     [("-b" "--bold") "also generate bold proof (only works with family name)"
                       (set! make-bold? #true)]
-     [("-i" "--italic")  "also generate italic proof"
+     [("-i" "--italic")  "also generate italic proof (only works with family name)"
                          (set! make-italic? #true)]
      [("-q" "--qml")  "output QML file"
                       (set! output-qml? #true)]
-     #:args families
-     families))
+     #:args font-family-names-or-font-paths
+     font-family-names-or-font-paths))
   (match families
     [(? null?) (raise-user-error "no font to proof; exiting")]
     [_ (for ([family (in-list families)])

quad/fontproof/main.rkt

@@ -42,9 +42,12 @@
        (unless (and sample-text (non-empty-string? sample-text))
          (raise-user-error "nothing to proof; exiting"))
        (define-values (initial-font-family initial-font-bold initial-font-italic)
-         (let ([bi-suffix-pat #px"\\s*((?i:bold))?\\s*((?i:italic))?$"])
-           (match-define (list suffix bold? italic?) (regexp-match bi-suffix-pat font-name-arg))
-           (values (string-trim font-name-arg suffix #:left? #false) bold? italic?)))
+         (match font-name-arg
+           [(? path-string? ps) (values (path->string (path->complete-path ps)) #f #f)]
+           [_ 
+            (let ([bi-suffix-pat #px"\\s*((?i:bold))?\\s*((?i:italic))?$"])
+              (match-define (list suffix bold? italic?) (regexp-match bi-suffix-pat font-name-arg))
+              (values (string-trim font-name-arg suffix #:left? #false) bold? italic?))]))
        (log-fontproof-info (format "generating proof for ~a" font-name-arg))
        (define page-size (or page-size-arg "letter"))
        (define font-sizes (string-split (or font-sizes-arg "12 10.5 9")))

quad/quadwriter/attrs.rkt

@@ -296,6 +296,7 @@ Naming guidelines
                      :pdf-author
                      :pdf-keywords
                      :string
+                     :font-family
                      :footer-text
                      :output-path)) #true))
 

quad/quadwriter/font.rkt

@@ -41,21 +41,21 @@
          #:when (directory-exists? font-family-subdir)
          [font-path (in-directory font-family-subdir)]
          #:when (member (path-get-extension font-path) font-file-extensions))
-    (match-define (list font-path-string family-name)
-      (for/list ([x (list font-path font-family-subdir)])
-        (path->string (find-relative-path fonts-dir x))))
-    (define path-parts (for/list ([part (in-list (explode-path (string->path (string-downcase font-path-string))))])
-                         (path->string part)))
-    (define key
-      (cons (string-downcase family-name)
-            (cond
-              [(member "bold-italic" path-parts) 'bi]
-              [(member "bold" path-parts) 'b]
-              [(member "italic" path-parts) 'i]
-              [else 'r])))
-    ;; only set value if there's not one there already.
-    ;; this means that we only use the first eligible font we find.
-    (hash-ref! font-paths key font-path)))
+        (match-define (list font-path-string family-name)
+          (for/list ([x (list font-path font-family-subdir)])
+                    (path->string (find-relative-path fonts-dir x))))
+        (define path-parts (for/list ([part (in-list (explode-path (string->path (string-downcase font-path-string))))])
+                                     (path->string part)))
+        (define key
+          (cons (string-downcase family-name)
+                (cond
+                  [(member "bold-italic" path-parts) 'bi]
+                  [(member "bold" path-parts) 'b]
+                  [(member "italic" path-parts) 'i]
+                  [else 'r])))
+        ;; only set value if there's not one there already.
+        ;; this means that we only use the first eligible font we find.
+        (hash-ref! font-paths key font-path)))
 
 (define (make-key font-family [bold #f] [italic #f])
   (cons (string-downcase font-family)
@@ -77,9 +77,9 @@
   (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))))
+          (hash-set! font-paths
+                     (make-key font-family bold italic)
+                     (family->path font-family #:bold bold #:italic italic))))
   (cond
     [(hash-ref font-paths (make-key font-family bold italic) #false)]
     ;; try regular style if style-specific key isn't there for b i or bi
@@ -87,15 +87,32 @@
     ;; otherwise use default
     [else default-font-face]))
 
+(define (font-path-string? x)
+  (and (path-string? x)
+       (member (path-get-extension (string->path x)) '(#".otf" #".ttf" #".woff"))
+       #true))
+
+(module+ test
+  (require rackunit)
+  (check-true (font-path-string? "foo.woff"))
+  (check-true (font-path-string? "foo.otf"))
+  (check-true (font-path-string? "foo.ttf"))
+  (check-false (font-path-string? "foo.woffy"))
+  (check-false (font-path-string? "foo")))
+  
+
 (define (resolve-font-path! attrs)
   ;; convert references to a font family and style to an font path on disk
   ;; we trust it exists because we used `setup-font-path-table!` earlier,
   ;; but if not, fallback fonts will kick in, on the idea that a missing font shouldn't stop the show
   (define this-font-family (hash-ref! attrs :font-family default-font-family))
-  (unless (complete-path? this-font-family)
-    (define this-bold (hash-ref! attrs :font-bold #false))
-    (define this-italic (hash-ref! attrs :font-italic #false))
-    (hash-set! attrs :font-path (font-attrs->path this-font-family this-bold this-italic))))
+  (hash-set! attrs :font-path 
+             (match this-font-family
+               [(? font-path-string? ps) (path->complete-path ps)]
+               [_
+                (define this-bold (hash-ref! attrs :font-bold #false))
+                (define this-italic (hash-ref! attrs :font-italic #false))
+                (font-attrs->path this-font-family this-bold this-italic)])))
 
 (define (parse-em pstr)
   (define em-suffix "em")