From 0f27fb1f673c79e658d6ac0a3d17f6b312c8e796 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 9 Jun 2019 17:17:12 -0700 Subject: [PATCH] add font-features attributes (closes #28) --- quad/qtest/test-ot-features.rkt | 23 +++++++++++ quad/quad/scribblings/quad.scrbl | 8 ++++ quad/quadwriter/attrs.rkt | 2 + quad/quadwriter/font.rkt | 23 +++++------ quad/quadwriter/render.rkt | 67 ++++++++++++++++++++++---------- 5 files changed, 91 insertions(+), 32 deletions(-) create mode 100644 quad/qtest/test-ot-features.rkt diff --git a/quad/qtest/test-ot-features.rkt b/quad/qtest/test-ot-features.rkt new file mode 100644 index 00000000..03e0428a --- /dev/null +++ b/quad/qtest/test-ot-features.rkt @@ -0,0 +1,23 @@ +#lang quadwriter + +'(q ((font-features "liga 0")) "No ligs: fifle") + +'(q ((break "para"))) + +'(q ((font-features "liga 1")) "Ligs: fifle") + +'(q ((break "para"))) + +'(q ((font-features "liga 1")) (q ((font-features "liga 0")) "No ligs: fifle")) + +'(q ((break "para"))) + +'(q ((font-features "liga 1")) (q ((font-features-adjust "liga 0")) "No ligs: fifle")) + +'(q ((break "para"))) + +'(q ((font-features "zero 1")) (q ((font-features "liga 0")) "No ligs, no slashed zero: fifle0")) + +'(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 diff --git a/quad/quad/scribblings/quad.scrbl b/quad/quad/scribblings/quad.scrbl index 1133cebf..7bd29590 100644 --- a/quad/quad/scribblings/quad.scrbl +++ b/quad/quad/scribblings/quad.scrbl @@ -584,6 +584,14 @@ 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. + +@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].} +} + + @defthing[#:kind "attribute" font-tracking symbol?]{ Spacing between characters. Value is given as a @tech{dimension string}. } diff --git a/quad/quadwriter/attrs.rkt b/quad/quadwriter/attrs.rkt index cccda41e..b9abfba8 100644 --- a/quad/quadwriter/attrs.rkt +++ b/quad/quadwriter/attrs.rkt @@ -63,10 +63,12 @@ Naming guidelines |# (define-attrs (font-family + font-path font-size font-size-adjust font-color font-features + font-features-adjust font-italic font-bold font-tracking diff --git a/quad/quadwriter/font.rkt b/quad/quadwriter/font.rkt index dd76c73e..5063eced 100644 --- a/quad/quadwriter/font.rkt +++ b/quad/quadwriter/font.rkt @@ -2,7 +2,8 @@ (require racket/runtime-path racket/string racket/path - racket/match) + racket/match + "attrs.rkt") (provide (all-defined-out)) (define-runtime-path quadwriter-fonts-dir "fonts") @@ -64,20 +65,20 @@ [(hash-ref font-paths regular-key #false)] [else default-font-face])) -(define (resolve-font-path attrs) - (define this-font-family (hash-ref! attrs 'font-family default-font-family)) +(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 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%"))) +(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)) + (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%")) + (hash-set! attrs :font-size-adjust "100%")) diff --git a/quad/quadwriter/render.rkt b/quad/quadwriter/render.rkt index 4d2879c2..593c05aa 100644 --- a/quad/quadwriter/render.rkt +++ b/quad/quadwriter/render.rkt @@ -4,6 +4,9 @@ txexpr/base racket/contract racket/file + racket/string + racket/sequence + racket/list pitfall quad hyphenate @@ -29,10 +32,10 @@ [(_ ALL-BREAKS-ID . TYPES) (with-syntax ([((TYPE-BREAK TYPE-STR Q:TYPE-BREAK) ...) (for/list ([type (in-list (syntax->list #'TYPES))]) - (list - (format-id #'TYPES "~a-break" type) - (symbol->string (syntax->datum type)) - (format-id #'TYPES "q:~a-break" type)))]) + (list + (format-id #'TYPES "~a-break" type) + (symbol->string (syntax->datum type)) + (format-id #'TYPES "q:~a-break" type)))]) #'(begin (define TYPE-BREAK '(q ((break TYPE-STR)))) ... (define ALL-BREAKS-ID (list (cons TYPE-BREAK Q:TYPE-BREAK) ...))))])) @@ -51,21 +54,43 @@ ;; do this before ->string-quad so that it can handle the sizing promises (apply append (for/list ([q (in-list qs)]) - (match (quad-ref q :hyphenate) - [#true #:when (and (pair? (quad-elems q)) - (andmap string? (quad-elems q))) - (for*/list ([str (in-list (quad-elems q))] - [hyphen-char (in-value #\u00AD)] - [hstr (in-value (hyphenate str hyphen-char - #:min-left-length 3 - #:min-right-length 3))] - [substr (in-list (regexp-match* (regexp (string hyphen-char)) hstr #:gap-select? #t))]) - (struct-copy quad q [elems (list substr)]))] - [_ (list q)])))) + (match (quad-ref q :hyphenate) + [#true #:when (and (pair? (quad-elems q)) + (andmap string? (quad-elems q))) + (for*/list ([str (in-list (quad-elems q))] + [hyphen-char (in-value #\u00AD)] + [hstr (in-value (hyphenate str hyphen-char + #:min-left-length 3 + #:min-right-length 3))] + [substr (in-list (regexp-match* (regexp (string hyphen-char)) hstr #:gap-select? #t))]) + (struct-copy quad q [elems (list substr)]))] + [_ (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 (parse-font-features! attrs) + (cond + [(match (hash-ref attrs :font-features-adjust #f) + [(? string? str) + ;; override any existing features + (define parsed-features (string->feature-list str)) + (hash-update! attrs :font-features (λ (fs) (remove-duplicates (append parsed-features fs) equal? #:key car))) + ;; adjustment is incorporated, so delete it + (hash-set! attrs :font-features-adjust #false)] + [_ #false])] + [else (match (hash-ref attrs :font-features #f) + [(? string? str) + (define parsed-features (string->feature-list str)) + (hash-set! attrs :font-features parsed-features)] + [_ #false])])) (define (handle-cascading-attrs attrs) - (resolve-font-path attrs) - (resolve-font-size attrs)) + (resolve-font-path! attrs) + (resolve-font-size! attrs) + (parse-font-features! attrs)) (define default-line-height-multiplier 1.42) (define (setup-qs qx-arg pdf-path) @@ -83,7 +108,7 @@ #:fallback "fallback" #:emoji "fallback-emoji" #:math "fallback-math" - #:font-path-resolver resolve-font-path))] + #:font-path-resolver resolve-font-path!))] [define hyphenated-qs (time-log hyphenate (handle-hyphenate atomized-qs))] [define typed-quads (map generic->typed-quad hyphenated-qs)] [define indented-qs (insert-first-line-indents typed-quads)] @@ -93,9 +118,9 @@ ;; page size can be specified by name, or measurements. ;; explicit measurements from page-height and page-width supersede those from page-size. (match-define (list page-width page-height) (for/list ([k (list :page-width :page-height)]) - (match (quad-ref (car qs) k) - [#false #false] - [val (parse-dimension val 'round)]))) + (match (quad-ref (car qs) k) + [#false #false] + [val (parse-dimension val 'round)]))) ;; `make-pdf` will sort out conflicts among page dimensions (make-pdf #:compress compress? #:auto-first-page #false