mbutterick
/
typesetting
2
1
Fork 0
Code Issues 13 Pull Requests Projects Releases Wiki Activity

simpler

Browse Source
main
Matthew Butterick 4 years ago
parent 9bc3349f79
commit d80001b882
1 changed files with 39 additions and 40 deletions
Show Stats Download Patch File Download Diff File

79
quad/quadwriter/font.rkt
Unescape Escape View File

@ -41,51 +41,50 @@
#: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)
(cond
[(and bold italic) 'bi]
[bold 'b]
[italic 'i]
[else 'r])))
(define (font-attrs->path font-family bold italic)
;; find the font-path corresponding to a certain family name and style.
(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))
;; 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 when we do the `cond` below.
(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)]
[(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)]))]
[(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
[(or bold italic (hash-ref font-paths regular-key #false))]
;; otherwise use default
[else default-font-face]))
(define (resolve-font-path! attrs)

Write Preview
Loading…
Cancel
Save