consolidate font-features attributes (closes #45)

main
Matthew Butterick 4 years ago
parent eef839b1ce
commit bb0e459e66

@ -1,5 +1,6 @@
#lang quadwriter
'(q ((font-features "liga 0")) "No ligs: fifle")
'(q ((break "para")))
@ -12,7 +13,7 @@
'(q ((break "para")))
'(q ((font-features "liga 1")) (q ((font-features-adjust "liga 0")) "No ligs: fifle"))
'(q ((font-features "liga 1")) (q ((font-features "+ liga 0")) "No ligs: fifle"))
'(q ((break "para")))
@ -20,4 +21,4 @@
'(q ((break "para")))
'(q ((font-features "zero 1")) (q ((font-features-adjust "liga 0")) "No ligs, slashed zero: fifle0"))
'(q ((font-features "zero 1")) (q ((font-features "+ liga 0")) "No ligs, slashed zero: fifle0"))

@ -645,9 +645,8 @@ Whether the quad has bold styling applied. Activated only when value is @racket[
Whether the quad has italic styling applied. Activated only when value is @racket["true"].
}
@deftogether[(@defthing[#:kind "attribute" font-features symbol?]
@defthing[#:kind "attribute" font-features-adjust symbol?])]{
Two ways of setting OpenType layout features. @racket[font-features] takes a @deftech{feature string}, which is an alternating list of OT feature tags and values, separated by white space. For instance, @racket{liga 0 smcp 1} would deactivate the ligature feature and activate the small-cap feature. @racket[font-features-adjust] works the same way, but rather than replacing the current feature settings, it amends them.
@defthing[#:kind "attribute" font-features symbol?]{
Sets OpenType layout features. @racket[font-features] takes a @deftech{feature string}, which is an alternating list of OT feature tags and values, separated by white space. For instance, @racket{liga 0 smcp 1} would deactivate the ligature feature and activate the small-cap feature. If the feature string is prefixed with @racket["+"], rather than replacing the current feature settings, it amends the features that would otherwise apply.
@margin-note{Fonts with OpenType layout features may be configured so that certain features, like ligatures, are activated by default. Your font will display these layout features even though there is no @racket[font-features] attribute in your Q-expression. You can, however, still turn them off with @racket[font-features].}
}

@ -45,37 +45,56 @@
#:min-left-length 3
#:min-right-length 3))]
[substr (in-list (regexp-match* (regexp (string hyphen-char)) hstr #:gap-select? #t))])
(quad-copy q [elems (list substr)]))]
(quad-copy q [elems (list substr)]))]
[else (list q)]))
(define (string->feature-list str)
(for/list ([kv (in-slice 2 (string-split str))])
(cons (string->bytes/utf-8 (first kv)) (string->number (second kv)))))
(define pcs (string-split str))
(unless (even? (length pcs))
(raise-argument-error 'string->feature-list "even number of tags and values" pcs))
(for/list ([kv (in-slice 2 pcs)])
(cons (match (first kv)
[(? string? k) (string->bytes/utf-8 k)]
[k (raise-argument-error 'string->feature-list "string" k)])
(match (string->number (second kv))
[(? number? num) num]
[v (raise-argument-error 'string->feature-list "number string" v)]))))
(define (parse-font-features! attrs)
;; `font-features` are OpenType font feature specifiers.
(match (hash-ref attrs :font-features-adjust #false)
[(? string? str)
;; adjustment: parse the feature string and append to the current feature set
(define parsed-features (string->feature-list str))
(hash-update! attrs :font-features (λ (fs) (remove-duplicates (append parsed-features fs) equal? #:key car)))
;; once adjustment is incorporated, delete it
(hash-set! attrs :font-features-adjust #false)]
[_ (match (hash-ref attrs :font-features #false)
;; override: parse features & replace current set
[(? string? str)
(define parsed-features (string->feature-list str))
(hash-set! attrs :font-features parsed-features)]
[_ (void)])]))
(define font-features-previous-key 'font-features-previous)
(define features-previous (hash-ref attrs font-features-previous-key empty))
(define val (hash-ref attrs :font-features #false))
(when (string? val)
(hash-set! attrs :font-features
(cond
[(regexp-match #px"^\\s*\\+ " val)
;; adjustment: parse the feature string and append to the previous feature set
(define parsed-features (string->feature-list (string-trim (string-trim val) "+")))
(remove-duplicates (append parsed-features features-previous) bytes=? #:key car)]
;; replacement of previous feature string
[else (string->feature-list val)]))
(hash-set! attrs font-features-previous-key (hash-ref attrs :font-features))))
(module+ test
(require rackunit)
;; feature replacement
(define attrs (make-hash '((font-features-previous '((#"smcp" . 1))))))
(hash-set! attrs :font-features " liga 0 ")
(parse-font-features! attrs)
(check-equal? (hash-ref attrs :font-features) '((#"liga" . 0)))
;; feature append
(hash-set! attrs :font-features " + calt 1 ")
(parse-font-features! attrs)
(check-equal? (sort (hash-ref attrs :font-features) bytes<? #:key car) '((#"calt" . 1)(#"liga" . 0))))
(define (parse-dimension-strings! attrs)
;; certain attributes can be "dimension strings", which are strings like "3in" or "4.2cm"
;; we parse them into the equivalent measurement in points.
(for ([k (in-hash-keys attrs)]
#:when (takes-dimension-string? k))
(hash-update! attrs k parse-dimension))
(hash-update! attrs k parse-dimension))
attrs)
(define (downcase-values! attrs)
@ -83,9 +102,9 @@
;; so we can check them more easily later.
(for ([k (in-hash-keys attrs)]
#:unless (has-case-sensitive-value? k))
(hash-update! attrs k (λ (val) (match val
[(? string? str) (string-downcase str)]
[_ val]))))
(hash-update! attrs k (λ (val) (match val
[(? string? str) (string-downcase str)]
[_ val]))))
attrs)
(define (complete-every-path! attrs)
@ -94,7 +113,7 @@
;; relies on `current-directory` being parameterized to source file's dir
(for ([k (in-hash-keys attrs)]
#:when (takes-path? k))
(hash-update! attrs k (compose1 path->string path->complete-path)))
(hash-update! attrs k (compose1 path->string path->complete-path)))
attrs)
(define (handle-cascading-attrs attrs)
@ -109,7 +128,7 @@
;; because line height might be dependent
resolve-line-height!
parse-font-features!))])
(proc attrs)))
(proc attrs)))
(define (drop-leading-breaks qs)
;; any leading breaks are pointless at the start of the doc, so drop them.
@ -206,9 +225,9 @@
(cons :pdf-keywords 'Keywords)))]
[str (in-value (and (pair? qs) (quad-ref (car qs) k)))]
#:when str)
(cons pdf-k str))))
(cons pdf-k str))))
(for ([(k v) (in-dict kv-dict)])
(hash-set! (pdf-info pdf) k v)))
(hash-set! (pdf-info pdf) k v)))
(define (footnote-flow? q) (equal? (quad-ref q 'flow) "footnote"))
@ -308,16 +327,16 @@
;; correct lines with inner / outer alignment
(for* ([(page page-idx) (in-indexed (for*/list ([section (in-list (quad-elems doc))]
[page (in-list (quad-elems section))])
page))]
page))]
[col (in-list (quad-elems page))]
[block (in-list (quad-elems col))]
[line (in-list (quad-elems block))])
;; all inner / outer lines are initially filled as if they were right-aligned
(define zero-filler-side (if (odd? (add1 page-idx)) "inner" "outer"))
(when (equal? zero-filler-side (quad-ref line :line-align))
(match (quad-elems line)
[(cons (? filler-quad? fq) _) (set-quad-size! fq (pt 0 0))]
[_ (void)])))
;; all inner / outer lines are initially filled as if they were right-aligned
(define zero-filler-side (if (odd? (add1 page-idx)) "inner" "outer"))
(when (equal? zero-filler-side (quad-ref line :line-align))
(match (quad-elems line)
[(cons (? filler-quad? fq) _) (set-quad-size! fq (pt 0 0))]
[_ (void)])))
doc)
(define/contract (render-pdf qx-arg
@ -347,7 +366,7 @@
(match maybe-dir
[(? directory-exists? dir) dir]
[_ (define-values (dir name _) (split-path maybe-dir))
dir])))
dir])))
(unless (directory-exists? base-dir)
(raise-argument-error 'render-pdf "existing directory" base-dir))

Loading…
Cancel
Save