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

finish resolving font sizes

Browse Source
main
Matthew Butterick 3 years ago
parent 03f8ca5d79
commit 728433fcde
5 changed files with 87 additions and 65 deletions
Show Stats Download Patch File Download Diff File

9
quad2/attr.rkt
Unescape Escape View File

@ -20,7 +20,7 @@
(let loop ([xs xs][parent-attrs #false])
(for ([x (in-list xs)]
#:when (quad? x))
(let* ([attrs (quad-attrs x)])
(let ([attrs (quad-attrs x)])
(unless (set-member? attrs-seen attrs)
(proc attrs parent-attrs)
(set-add! attrs-seen attrs))
@ -79,7 +79,7 @@
(for ([ak (in-list mandatory-keys)])
(hash-ref! attrs ak (attr-key-default ak))))))
(define-pass (downcase-attr-values qs)
(define-pass (downcase-string-attr-values qs)
;; make attribute values lowercase, unless they're case-sensitive
;; so we can check them more easily later.
;; in principle we could do this earlier and recursively process a single quad
@ -114,7 +114,6 @@
(or (string->number av)
(raise-argument-error 'convert-numeric-attr-values "numeric string" av)))))
(define-pass (complete-attr-paths qs)
#:pre (list-of quad?)
#:post (list-of quad?)
@ -134,8 +133,6 @@
#:which-attr attr-dimension-string-key?
#:attr-proc (λ (ak av attrs) (parse-dimension av))))
(module+ test
(require rackunit)
(define-attr-list debug-attrs
@ -162,7 +159,7 @@
(parameterize ([current-strict-attrs? #false])
(upgrade-attr-keys (list (make-q))))))
(check-equal? (quad-ref (car (fill-default-attr-values (list (make-q)))) :num-def-42) 42)
(check-equal? (quad-ref (car (downcase-attr-values qs)) :foo) "bar")
(check-equal? (quad-ref (car (downcase-string-attr-values qs)) :foo) "bar")
(check-true (complete-path? (quad-ref (car (complete-attr-paths qs)) :ps)))
(check-equal? (quad-ref (car (parse-dimension-strings qs)) :dim) 144)
(let ([q (car (convert-boolean-attr-values qs))])

57
quad2/dimension.rkt
Unescape Escape View File

@ -12,34 +12,43 @@
(define (in->pts x) (* 72 x))
(define (mm->cm x) (/ x 10.0))
(define (parse-em-or-percentage str)
;; percentage is alternate notation for em
(and
(string? str)
(for/or ([suffix (list "em" "%")]
[divisor (list 1 100)]
#:when (string-suffix? str suffix))
(match (string->number (string-trim str suffix))
[(? number? num) (/ num divisor)]
[_ #false]))))
(define pica-pat (regexp "^(p|pica)(s)?$"))
(define (unit->converter-proc unit)
(match unit
[(regexp #rx"^(pt|point)(s)?$") values] ; points
[(regexp pica-pat) pica->pts] ; pica (no pts)
[(regexp #rx"^inch(es)?|in(s)?$") in->pts] ; inches
[(regexp #rx"^cm(s)?$") (compose1 in->pts cm->in)] ; cm
[(regexp #rx"^mm(s)?$") (compose1 in->pts cm->in mm->cm)] ; mm
[_ values]))
(define (parse-dimension x)
(define pica-pat (regexp "^(p|pica)(s)?$"))
(define (unit->converter-proc unit)
(match unit
[(regexp #rx"^(pt|point)(s)?$") values] ; points
[(regexp pica-pat) pica->pts] ; pica (no pts)
[(regexp #rx"^inch(es)?|in(s)?$") in->pts] ; inches
[(regexp #rx"^cm(s)?$") (compose1 in->pts cm->in)] ; cm
[(regexp #rx"^mm(s)?$") (compose1 in->pts cm->in mm->cm)] ; mm
[_ values]))
(define (parse-em pstr)
(define em-suffix "em")
(and
pstr
(string? pstr)
(string-suffix? pstr em-suffix)
(string->number (string-trim pstr em-suffix))))
(define parsed-thing
(match x
[#false #false]
[(? number? num) num]
[(app parse-em em) #:when em
(procedure-rename
(λ (previous-size)
(unless (number? previous-size)
(raise-argument-error 'em-resolver "number" previous-size))
(* em previous-size))
'em-resolver)]
[(app parse-em-or-percentage em)
#:when em
(procedure-rename
(λ (previous-size)
(unless (number? previous-size)
(raise-argument-error 'em-resolver "number" previous-size))
(match (* em previous-size)
[(? integer? int) (inexact->exact int)]
[num num]))
'em-resolver)]
[(? string? str)
(match (regexp-match #px"^(-?[0-9\\.]+)\\s*([a-z]+)([0-9\\.]+)?$" (string-downcase str))
[(list str
@ -53,7 +62,7 @@
(app string->number suffix-num))
#:when (and prefix-num suffix-num) ; prefix + suffix measurement (only pica + point)
(pica->pts prefix-num suffix-num)]
[_ str])]))
[_ (raise-argument-error 'parse-dimension "dimension string" str)])]))
(match parsed-thing
[(and (? integer?) (? inexact?)) (inexact->exact parsed-thing)]
[_ parsed-thing]))

49
quad2/font.rkt
Unescape Escape View File

@ -58,7 +58,7 @@
[(= (length fonts-in-this-directory) 1) 'r]
;; cases where fonts are in subdirectories named by style
;; infer style from subdir name
[(member "bold-italic" path-parts) 'bi]
[(and (member "bold" path-parts) (member "italic" path-parts)) 'bi]
[(member "bold" path-parts) 'b]
[(member "italic" path-parts) 'i]
[else
@ -159,35 +159,44 @@
#:pre (list-of quad?)
#:post (list-of quad?)
(define (resolve-font-size-once attrs)
;; FIXME: this technique no longer works because
;; it depends on resolving values while attrs are being cascaded
(define (resolve-font-size-once attrs parent-attrs)
(define base-size-adjusted
(match (hash-ref attrs :font-size default-font-size)
(match (hash-ref attrs :font-size 'missing)
;; if our value represents an adjustment,
;; we apply the adjustment to the previous value
[(? procedure? proc) (proc (hash-ref attrs :font-size-previous default-font-size))]
[(? procedure? proc)
(define previous-font-size (cond
[(and parent-attrs (hash-ref parent-attrs :font-size-previous #false))]
[else default-font-size]))
(proc previous-font-size)]
;; otherwise we use our value directly
[val val]))
[(? number? num) num]
[other (raise-user-error 'resolve-font-sizes "procedure or number" other)]))
;; we write our new value into both font-size and font-size-previous
;; because as we cascade down, we're likely to come across superseding values
;; of font-size (but font-size-previous will persist)
(hash-set! attrs :font-size base-size-adjusted)
(hash-set! attrs :font-size-previous base-size-adjusted))
(define font-paths (setup-font-path-table))
(do-attr-iteration qs
#:attr-proc (λ (_ __ attrs) (resolve-font-size-once attrs))))
;; of font-size
;; but the font-size-previous will persist
;; because on the next recursion, the current `attrs` will be `parent-attrs`
(hash-set*! attrs :font-size base-size-adjusted
:font-size-previous base-size-adjusted))
(for-each-attrs qs resolve-font-size-once))
(module+ test
(require rackunit)
(define-attr-list debug-attrs
[:font-family (make-attr-uncased-string-key 'font-family)])
(parameterize ([current-attrs debug-attrs])
(check-equal? (resolved-font-for-family "Heading") (string->path "fira-sans-light.otf"))
(check-equal? (resolved-font-for-family "CODE") (string->path "fira-mono.otf"))
(check-equal? (resolved-font-for-family "blockquote" #:bold #t) (string->path "fira-sans-bold.otf"))
(check-equal? (resolved-font-for-family "nonexistent-fam") (string->path "SourceSerifPro-Regular.otf")))
(check-equal? (resolved-font-for-family "Heading") (build-path "fira-sans-light.otf"))
(check-equal? (resolved-font-for-family "CODE") (build-path "fira-mono.otf"))
(check-equal? (resolved-font-for-family "blockquote" #:bold #t) (build-path "fira-sans-bold.otf"))
(check-equal? (resolved-font-for-family "nonexistent-fam") (build-path "SourceSerifPro-Regular.otf")))
(define qs (bootstrap-input (make-quad #:tag 'div #:attrs (make-hasheq (list (cons :font-size "100pt"))) #:elems (list (make-quad #:tag 'span #:attrs (make-hasheq (list (cons :font-size-previous "100pt") (cons :font-size "1.5em"))))))))
#;(resolve-font-sizes (parse-dimension-strings qs)))
(define qs (bootstrap-input
(make-quad #:tag 'div
#:attrs (make-hasheq (list (cons :font-size "100pt")))
#:elems (list (make-quad #:tag 'span
#:attrs (make-hasheq (list (cons :font-size "1.5em")))
#: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))

29
quad2/main.rkt
Unescape Escape View File

@ -22,9 +22,12 @@
;; we convert keys & values to corresponding higher-level types.
upgrade-attr-keys
fill-default-attr-values
downcase-attr-values
downcase-string-attr-values
convert-boolean-attr-values
convert-numeric-attr-values
;; pre-linearization resolutions & parsings =============
;; these need the tree shape
parse-dimension-strings
resolve-font-sizes
@ -36,7 +39,7 @@
;; because once we linearize, that information is gone.
linearize
;; resolutions & parsings =============
;; post-linearization resolutions & parsings =============
resolve-font-paths
complete-attr-paths
;; TODO: parse feature strings
@ -54,18 +57,18 @@
(require "render.rkt")
(define (test-compile x)
(parameterize ([current-wrap-width 13]
[current-attrs all-attrs]
[current-strict-attrs? #t]
[current-show-timing? #f]
[current-use-preconditions? #t]
[current-use-postconditions? #t])
(quad-compile (bootstrap-input x))))
[current-attrs all-attrs]
[current-strict-attrs? #t]
[current-show-timing? #f]
[current-use-preconditions? #t]
[current-use-postconditions? #t])
(quad-compile (bootstrap-input x))))
(match (test-compile "Hello this is the earth")
[(? string? insts)
(render insts #:using text-renderer)
(render insts #:using drr-renderer)
#;(render-to-html drawing-insts)
#;(render-to-pdf drawing-insts)
]))
(render insts #:using text-renderer)
(render insts #:using drr-renderer)
#;(render-to-html drawing-insts)
#;(render-to-pdf drawing-insts)
]))

8
quad2/quad.rkt
Unescape Escape View File

@ -47,10 +47,14 @@
(let ([attrs (if (immutable? attrs) (make-hasheq (hash->list attrs)) attrs)])
(quad-constructor tag attrs elems #false)))
(define (quad-ref q key [default-val #false])
(define (quad-ref q-or-qs key [default-val #false])
(unless (attr-key? key)
(raise-argument-error 'quad-ref "attr-key?" key))
(hash-ref (quad-attrs q) key default-val))
(hash-ref (quad-attrs (match q-or-qs
[(? quad? q) q]
[(cons q _) q]
[_ (raise-argument-error 'quad-ref "quad or list of quads" q-or-qs)])) key default-val))
(define (quad-set! q key val)
(hash-set! (quad-attrs q) key val))

Write Preview
Loading…
Cancel
Save