mbutterick
/
typesetting
2
1
Fork 0
Code Issues 13 Pull Requests Projects Releases Wiki Activity

add attr-keys font-features, font-features-add, font-features-subtract

Browse Source
main
Matthew Butterick 2 years ago
parent ec40caa7a2
commit fec7b03474
3 changed files with 56 additions and 29 deletions
Show Stats Download Patch File Download Diff File

58
quad2/attr.rkt
Unescape Escape View File

@ -20,11 +20,11 @@
(let loop ([xs xs][parent-attrs #false])
(for ([x (in-list xs)]
#:when (quad? x))
(define attrs (quad-attrs x))
(unless (set-member? attrs-seen attrs)
(proc attrs parent-attrs)
(set-add! attrs-seen attrs))
(loop (quad-elems x) attrs))))
(define attrs (quad-attrs x))
(unless (set-member? attrs-seen attrs)
(proc attrs parent-attrs)
(set-add! attrs-seen attrs))
(loop (quad-elems x) attrs))))
(define (do-attr-iteration qs
#:which-attr [which-attr 'all-attributes-signal]
@ -43,11 +43,11 @@
(λ (attrs parent-attrs)
(for ([(ak av) (in-hash attrs)]
#:when (attr-predicate ak av))
(match (if wants-parent-attrs? (attr-proc ak av attrs parent-attrs) (attr-proc ak av attrs))
;; void value: do nothing
[(? void?) (void)]
;; otherwise treat return value as new attr value
[new-av (hash-set! attrs ak new-av)])))))
(match (if wants-parent-attrs? (attr-proc ak av attrs parent-attrs) (attr-proc ak av attrs))
;; void value: do nothing
[(? void?) (void)]
;; otherwise treat return value as new attr value
[new-av (hash-set! attrs ak new-av)])))))
(define-pass (upgrade-attr-keys qs)
;; convert attr keys from symbols to attr struct types
@ -55,7 +55,7 @@
#:pre (list-of quad?)
#:post (list-of quad?)
(define attr-lookup-table (for/hasheq ([a (in-list (current-attrs))])
(values (attr-key-name a) a)))
(values (attr-key-name a) a)))
(define strict-attrs? (current-strict-attrs?))
(define (do-upgrade ak av attrs)
(cond
@ -77,7 +77,7 @@
(define mandatory-keys (filter attr-key-mandatory? (current-attrs)))
(for-each-attrs qs (λ (attrs parent-attrs)
(for ([ak (in-list mandatory-keys)])
(hash-ref! attrs ak (attr-key-default ak))))))
(hash-ref! attrs ak (attr-key-default ak))))))
(define-pass (downcase-string-attr-values qs)
;; make attribute values lowercase, unless they're case-sensitive
@ -114,6 +114,21 @@
(or (string->number av)
(raise-argument-error 'convert-numeric-attr-values "numeric string" av)))))
(define-pass (convert-set-attr-values qs)
#:pre (list-of quad?)
#:post (list-of quad?)
(do-attr-iteration qs
#:which-attr attr-set-key?
#:attr-proc (λ (ak av attrs)
(apply seteq (map string->symbol (string-split av))))))
(module+ test
(let ([q (convert-set-attr-values (upgrade-attr-keys (bootstrap-input '(div ((font-features "calt")(font-features-add "")(font-features-subtract "swsh liga"))))))])
(check-equal? (quad-ref q :font-features) (seteq 'calt))
(check-equal? (quad-ref q :font-features-add) (seteq))
(check-equal? (quad-ref q :font-features-subtract) (seteq 'swsh 'liga))))
(define-pass (complete-attr-paths qs)
#:pre (list-of quad?)
#:post (list-of quad?)
@ -124,6 +139,7 @@
#:which-attr attr-path-key?
#:attr-proc (λ (ak av attrs) (path->complete-path av))))
(define-pass (parse-dimension-strings qs)
#:pre (list-of quad?)
#:post (list-of quad?)
@ -139,18 +155,18 @@
[:foo (make-attr-cased-string-key 'foo)]
[:ps (make-attr-path-key 'ps)]
[:dim (make-attr-dimension-string-key 'dim)]
[:boolt (make-attr-boolean-key 'bool)]
[:boolf (make-attr-boolean-key 'bool)]
[:boolt (make-attr-boolean-key 'boolt)]
[:boolf (make-attr-boolean-key 'boolf)]
[:num (make-attr-numeric-key 'num)]
[:num-def-42 (make-attr-numeric-key 'num-def-42 #true 42)])
(parameterize ([current-attrs debug-attrs])
(define (make-q) (make-quad #:attrs (make-hasheq (list (cons :foo "BAR")
(cons 'ding "dong")
(cons :ps "file.txt")
(cons :dim "2in")
(cons :boolt "true")
(cons :boolf "false")
(cons :num "42.5")))))
(define (make-q) (make-quad #:attrs (list :foo "BAR"
'ding "dong"
:ps "file.txt"
:dim "2in"
:boolt "true"
:boolf "false"
:num "42.5")))
(define qs (list (make-q)))
(check-exn exn? (λ ()
(parameterize ([current-strict-attrs? #true])

16
quad2/constants.rkt
Unescape Escape View File

@ -1,5 +1,6 @@
#lang racket/base
(require "struct.rkt")
(require racket/list
"struct.rkt")
(provide (all-defined-out))
(define default-font-family "text")
@ -9,7 +10,13 @@
[ATTR-NAME ATTR-EXPR] ...)
(begin
(define ATTR-NAME ATTR-EXPR) ...
(define LIST-NAME (list ATTR-NAME ...))))
(define LIST-NAME
(let ([names (list ATTR-NAME ...)])
(cond
[(check-duplicates (map attr-key-name names))
=>
(λ (sym) (raise-user-error 'define-attr-list "duplicate attribute name: ~a" sym))]
[else names])))))
(define-attr-list all-attrs
[:unknown-key (make-attr-unknown-key (gensym))]
@ -17,4 +24,7 @@
[:font-path (make-attr-path-key 'font-path)]
[:font-bold (make-attr-boolean-key 'font-bold #true #false)]
[:font-italic (make-attr-boolean-key 'font-italic #true #false)]
[:font-size (make-attr-dimension-string-key 'font-size #true default-font-size)])
[:font-size (make-attr-dimension-string-key 'font-size #true default-font-size)]
[:font-features (make-attr-set-key 'font-features)]
[:font-features-add (make-attr-set-key 'font-features-add)]
[:font-features-subtract (make-attr-set-key 'font-features-subtract)])

11
quad2/main.rkt
Unescape Escape View File

@ -21,15 +21,16 @@
;; all attrs start out as symbol-string pairs.
;; we convert keys & values to corresponding higher-level types.
upgrade-attr-keys
;; I think this is wrong. Filling in default values here
;; will prevent parent values from cascading during linearization
;; but it would be OK at the top level, to ensure
;; that there are values that cascade
;; but that can be done by wrapping in a quad with the default values
;; I think `fill-default-attr-values` here is wrong.
;; It will prevent parent values from cascading during linearization.
;; But it would be OK at the top level, to ensure
;; that there are values that cascade.
;; But that can also be done by wrapping in a quad with the default values.
#;fill-default-attr-values
downcase-string-attr-values
convert-boolean-attr-values
convert-numeric-attr-values
convert-set-attr-values
;; pre-linearization resolutions & parsings =============
;; these need the tree shape

Write Preview
Loading…
Cancel
Save