From bb0e459e662d9c866aba3befb159b5bcf0eec3f3 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 29 Jan 2020 17:46:59 -0800 Subject: [PATCH] consolidate font-features attributes (closes #45) --- quad/qtest/test-ot-features.rkt | 5 +- quad/quad/scribblings/quad.scrbl | 5 +- quad/quadwriter/render.rkt | 85 +++++++++++++++++++------------- 3 files changed, 57 insertions(+), 38 deletions(-) diff --git a/quad/qtest/test-ot-features.rkt b/quad/qtest/test-ot-features.rkt index 03e0428a..a300c538 100644 --- a/quad/qtest/test-ot-features.rkt +++ b/quad/qtest/test-ot-features.rkt @@ -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")) \ No newline at end of file +'(q ((font-features "zero 1")) (q ((font-features "+ liga 0")) "No ligs, slashed zero: fifle0")) \ No newline at end of file diff --git a/quad/quad/scribblings/quad.scrbl b/quad/quad/scribblings/quad.scrbl index a993117e..16786ccf 100644 --- a/quad/quad/scribblings/quad.scrbl +++ b/quad/quad/scribblings/quad.scrbl @@ -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].} } diff --git a/quad/quadwriter/render.rkt b/quad/quadwriter/render.rkt index 5c1e6317..763a2515 100644 --- a/quad/quadwriter/render.rkt +++ b/quad/quadwriter/render.rkt @@ -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) bytesstring 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))