add `resolve-font-features`

main
Matthew Butterick 2 years ago
parent 71ad54fa78
commit 8a3110e9f4

@ -3,6 +3,7 @@
racket/match
racket/runtime-path
racket/list
racket/set
racket/string
fontland/font-path
"quad.rkt"
@ -195,3 +196,52 @@
#:elems (list (make-quad #:tag 'span
#:attrs (make-hasheq (list (cons :font-size "200%"))))))))))
(check-equal? (quad-ref (quad-elems (car (resolve-font-sizes (parse-dimension-strings qs)))) :font-size) 150))
(define-pass (resolve-font-features qs)
;; put a :font-features field in every quad,
;; Along the way, resolve any :font-features-add and :font-features-subtract attrs.
#:pre (list-of quad?)
#:post (λ (qs)
(for/and ([q (in-list qs)])
(define attrs (quad-attrs q))
(and
(hash-has-key? attrs :font-features)
(not (hash-has-key? attrs :font-features-add))
(not (hash-has-key? attrs :font-features-subtract)))))
(define (resolve-font-features-once attrs parent-attrs)
;; if attrs already has an explicit :font-features key, we don't need to calculate it
(unless (hash-has-key? attrs :font-features)
;; otherwise we calculate :font-features by looking at the parent features
;; and adding / removing any indicated.
(define previous-features
(let ([parent-attrs (or parent-attrs (hash))])
(hash-ref parent-attrs :font-features default-no-features)))
(define features-to-add (hash-ref attrs :font-features-add default-no-features))
(define features-to-subtract (hash-ref attrs :font-features-subtract default-no-features))
;; TODO: which order of operations is preferable: add then remove, or remove then add?
(define these-features
(set-subtract (set-union previous-features features-to-add) features-to-subtract))
(hash-set! attrs :font-features these-features))
;; now that we've got :font-features, we can delete :font-features-add and :font-features-remove
(hash-remove! attrs :font-features-add)
(hash-remove! attrs :font-features-subtract))
(for-each-attrs qs resolve-font-features-once))
(module+ test
(let ([qs (bootstrap-input
(make-quad #:tag 'div
#:attrs (make-hasheq (list (cons :font-features "ss01 liga")))
#:elems (list (make-quad #:tag 'span
#:attrs (make-hasheq (list
(cons :font-features-add "swsh")
(cons :font-features-subtract "liga")))
#:elems (list (make-quad #:tag 'span
#:attrs (make-hasheq (list (cons :font-features "hist")))))))))])
(define q (car (resolve-font-features (convert-set-attr-values (upgrade-attr-keys qs)))))
(check-equal? (quad-ref q :font-features) (seteq 'ss01 'liga))
(check-equal? (quad-ref (car (quad-elems q)) :font-features) (seteq 'ss01 'swsh))
(check-equal? (quad-ref (car (quad-elems (car (quad-elems q)))) :font-features) (seteq 'hist))))

@ -36,7 +36,7 @@
;; these need the tree shape
parse-dimension-strings
resolve-font-sizes
#;resolve-font-features
resolve-font-features
;; linearization =============
;; we postpone this step until we're certain any

Loading…
Cancel
Save