You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
typesetting/quad/quadwriter/font.rkt

85 lines
3.7 KiB
Racket

This file contains invisible Unicode characters!

This file contains invisible Unicode characters that may be processed differently from what appears below. If your use case is intentional and legitimate, you can safely ignore this warning. Use the Escape button to reveal hidden characters.

#lang debug racket/base
(require racket/runtime-path
racket/string
racket/path
racket/match)
(provide (all-defined-out))
(define-runtime-path quadwriter-fonts-dir "fonts")
(define-runtime-path default-font-face "fonts/source-serif/SourceSerifPro-Regular.otf")
(define default-font-family "source-serif")
(define default-font-size 12)
(define default-line-height 16)
(define font-paths (make-hash))
(define (setup-font-path-table! base-path)
;; populate `font-paths` table with font paths
;; search "fonts" subdirectory in project for other subdirectories
;; which are presumed to contain fonts.
;; and link them to their family names & styles.
;; this allows a flexible mapping from internal to external names, like @font-face
;; note that all the semantics are derived from the file system
;; not any metadata fields within the font.
;; this is faster and easier, because you can just muck with the directory and filenames
;; to change the font mapping.
;; though it also creates the potential for mischief,
;; if a font is named something that doesn't reflect its visual reality.
;; but we are not the font police.
(hash-clear! font-paths)
(define-values (dir path _) (split-path base-path))
(define doc-fonts-dir (build-path dir "fonts"))
;; run doc-fonts-dir first because earlier fonts take precedence
(for* ([fonts-dir (in-list (list quadwriter-fonts-dir doc-fonts-dir ))]
#:when (directory-exists? fonts-dir)
[font-family-subdir (in-directory fonts-dir)]
#:when (directory-exists? font-family-subdir)
[font-path (in-directory font-family-subdir)]
#:when (member (path-get-extension font-path) '(#".otf" #".ttf")))
(match-define (list font-path-string family-name)
(map (λ (x) (path->string (find-relative-path fonts-dir x))) (list font-path font-family-subdir)))
(define key
(cons family-name
(match (string-downcase font-path-string)
[(and (regexp "bold") (regexp "it(alic)?")) 'bi]
[(regexp "bold") 'b]
[(regexp "it(alic)?") 'i]
[_ '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 (font-attrs->path font-family bold italic)
;; find the font-path corresponding to a certain family name and style.
(define key (cons font-family
(cond
[(and bold italic) 'bi]
[bold 'b]
[italic 'i]
[else 'r])))
(define regular-key (cons font-family 'r))
(cond
[(hash-ref font-paths key #false)]
;; if there isn't one, try the regular style.
[(hash-ref font-paths regular-key #false)]
;; If there isn't one, use the default.
[else default-font-face]))
(define (resolve-font-path attrs)
(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))))
(define (parse-percentage pstr)
(/ (string->number (string-trim pstr "%")) 100.0))
(define (resolve-font-size attrs)
(define this-font-size (hash-ref! attrs 'font-size default-font-size))
(define this-font-size-adjust (parse-percentage (hash-ref! attrs 'font-size-adjust "100%")))
;; we bake the adjustment into the font size...
(hash-set! attrs 'font-size (* this-font-size this-font-size-adjust))
;; and then set the adjustment back to 100% (since it's now accounted for)
(hash-set! attrs 'font-size-adjust "100%"))