diff --git a/quad2/font.rkt b/quad2/font.rkt index e8eb4de6..0256f3b4 100644 --- a/quad2/font.rkt +++ b/quad2/font.rkt @@ -96,12 +96,12 @@ ;; TODO: family->path doesn't work because it relies on ffi into fontconfig ;; which has broken in cs, I guess #;(unless (hash-has-key? font-paths regular-key) - (display "(fontconfig lookup unimplemented)") - #;(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)))) + (display "(fontconfig lookup unimplemented)") + #;(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 (make-key font-family bold italic) #false)] ;; try regular style if style-specific key isn't there for b i or bi @@ -118,12 +118,12 @@ ;; 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 (attr-key-name :font-family) default-font-family)) + (define this-font-family (hash-ref! attrs :font-family default-font-family)) (match (string-downcase this-font-family) [(? font-path-string? ps) (path->complete-path ps)] [_ - (define this-bold (hash-ref! attrs (attr-key-name :font-bold) #false)) - (define this-italic (hash-ref! attrs (attr-key-name :font-italic) #false)) + (define this-bold (hash-ref! attrs :font-bold #false)) + (define this-italic (hash-ref! attrs :font-italic #false)) (font-attrs->path font-paths this-font-family this-bold this-italic)])) (define-pass (resolve-font-paths qs) @@ -137,17 +137,18 @@ #:which-attr :font-family #:attr-proc (λ (ak av attrs) (resolve-font-path font-paths av attrs)))) +(define (resolved-font-for-family val #:bold [bold #f] #:italic [italic #f]) + (define qs (list (make-quad #:attrs (make-hasheq + (list (cons :font-family (string-downcase val)) + (cons :font-bold bold) + (cons :font-italic italic)))))) + (last (explode-path (quad-ref (car (resolve-font-paths qs)) :font-family)))) + (module+ test (require rackunit) (define-attr-list debug-attrs [:font-family (attr-uncased-string-key 'font-family)]) (parameterize ([current-attrs debug-attrs]) - (define (resolved-font-for-family val #:bold [bold #f] #:italic [italic #f]) - (define qs (list (make-quad #:attrs (make-hasheq - (list (cons 'font-family (string-downcase val)) - (cons 'font-bold bold) - (cons 'font-italic italic)))))) - (last (explode-path (quad-ref (car (resolve-font-paths qs)) 'font-family)))) (check-equal? (resolved-font-for-family "Heading") (string->path "fira-sans-light.otf")) (check-equal? (resolved-font-for-family "CODE") (string->path "fira-mono.otf")) (check-equal? (resolved-font-for-family "blockquote" #:bold #t) (string->path "fira-sans-bold.otf")) diff --git a/quad2/main.rkt b/quad2/main.rkt index aeb44f97..a6f9524d 100644 --- a/quad2/main.rkt +++ b/quad2/main.rkt @@ -41,11 +41,11 @@ #:post (list-of simple-quad?) (append* (for/list ([q (in-list qs)]) - (match q - [(quad _ _ (list (? string? str)) _) - (for/list ([c (in-string str)]) - (struct-copy quad q [elems (list (string c))]))] - [_ (list q)])))) + (match q + [(quad _ _ (list (? string? str)) _) + (for/list ([c (in-string str)]) + (struct-copy quad q [elems (list (string c))]))] + [_ (list q)])))) (define quad-compile (make-pipeline (list @@ -59,6 +59,8 @@ downcase-attr-values convert-boolean-attr-values convert-numeric-attr-values + ;; TODO: resolve font sizes + resolve-font-sizes ;; we resolve dimension strings after font size ;; because they can be denoted relative to em size parse-dimension-strings @@ -74,7 +76,6 @@ ;; resolutions & parsings ============= resolve-font-paths complete-attr-paths - ;; TODO: resolve font sizes ;; TODO: parse feature strings