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

work on font size cascading

Browse Source
main
Matthew Butterick 2 years ago
parent 1028171471
commit 6175eeb909
7 changed files with 125 additions and 67 deletions
Show Stats Download Patch File Download Diff File

4
quad2/attr.rkt
Unescape Escape View File

@ -114,7 +114,7 @@
;; we parse them into the equivalent measurement in points. ;; we parse them into the equivalent measurement in points.
(do-attr-iteration qs (do-attr-iteration qs
#:which-attr attr-dimension-string-key? #:which-attr attr-dimension-string-key?
#:attr-proc (λ (ak av attrs) (parse-dimension av attrs)))) #:attr-proc (λ (ak av attrs) (parse-dimension av))))
(module+ test (module+ test
(require rackunit) (require rackunit)
@ -142,7 +142,7 @@
(upgrade-attr-keys (list (make-q)))))) (upgrade-attr-keys (list (make-q))))))
(check-equal? (quad-ref (car (downcase-attr-values qs)) :foo) "bar") (check-equal? (quad-ref (car (downcase-attr-values qs)) :foo) "bar")
(check-true (complete-path? (quad-ref (car (complete-attr-paths qs)) :ps))) (check-true (complete-path? (quad-ref (car (complete-attr-paths qs)) :ps)))
(check-equal? (quad-ref (car (parse-dimension-strings qs)) :dim) 144) (check-true (procedure? (quad-ref (car (parse-dimension-strings qs)) :dim)))
(let ([q (car (convert-boolean-attr-values qs))]) (let ([q (car (convert-boolean-attr-values qs))])
(check-true (quad-ref q :boolt)) (check-true (quad-ref q :boolt))
(check-false (quad-ref q :boolf))) (check-false (quad-ref q :boolf)))

3
quad2/constants.rkt
Unescape Escape View File

@ -14,4 +14,5 @@
[:font-path (attr-path-key 'font-path)] [:font-path (attr-path-key 'font-path)]
[:font-bold (attr-boolean-key 'font-bold)] [:font-bold (attr-boolean-key 'font-bold)]
[:font-italic (attr-boolean-key 'font-italic)] [:font-italic (attr-boolean-key 'font-italic)]
[:font-size (attr-dimension-string-key 'font-size)]) [:font-size (attr-dimension-string-key 'font-size)]
[:font-size-previous (attr-dimension-string-key 'font-size-previous)])

29
quad2/dimension.rkt
Unescape Escape View File

@ -1,5 +1,7 @@
#lang debug racket/base #lang debug racket/base
(require racket/match (require racket/match
racket/string
"quad.rkt"
"constants.rkt") "constants.rkt")
(provide (all-defined-out)) (provide (all-defined-out))
@ -10,7 +12,7 @@
(define (in->pts x) (* 72 x)) (define (in->pts x) (* 72 x))
(define (mm->cm x) (/ x 10.0)) (define (mm->cm x) (/ x 10.0))
(define (parse-dimension x [em-resolution-attrs #false]) (define (parse-dimension x)
(define pica-pat (regexp "^(p|pica)(s)?$")) (define pica-pat (regexp "^(p|pica)(s)?$"))
(define (unit->converter-proc unit) (define (unit->converter-proc unit)
(match unit (match unit
@ -19,22 +21,31 @@
[(regexp #rx"^inch(es)?|in(s)?$") in->pts] ; inches [(regexp #rx"^inch(es)?|in(s)?$") in->pts] ; inches
[(regexp #rx"^cm(s)?$") (compose1 in->pts cm->in)] ; cm [(regexp #rx"^cm(s)?$") (compose1 in->pts cm->in)] ; cm
[(regexp #rx"^mm(s)?$") (compose1 in->pts cm->in mm->cm)] ; mm [(regexp #rx"^mm(s)?$") (compose1 in->pts cm->in mm->cm)] ; mm
[(regexp #rx"^em(s)?$") [_ values]))
#:when em-resolution-attrs (define (parse-em pstr)
;; if we don't have attrs for resolving the em string, we ignore it (define em-suffix "em")
(λ (num) (* (hash-ref em-resolution-attrs :font-size) num))] (and
[_ #false])) pstr
(string? pstr)
(string-suffix? pstr em-suffix)
(string->number (string-trim pstr em-suffix))))
(define parsed-thing (define parsed-thing
(match x (match x
[#false #false] [#false #false]
[(? number? num) num] [(? 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)]
[(? string? str) [(? string? str)
(match (regexp-match #px"^(-?[0-9\\.]+)\\s*([a-z]+)([0-9\\.]+)?$" (string-downcase str)) (match (regexp-match #px"^(-?[0-9\\.]+)\\s*([a-z]+)([0-9\\.]+)?$" (string-downcase str))
[(list str [(list str
(app string->number num) (app string->number num)
(app unit->converter-proc converter-proc) (app unit->converter-proc converter-proc)
#false) ; prefix measurement (suffix is #false) #false) ; prefix measurement (suffix is #false)
#:when (and converter-proc num)
(converter-proc num)] (converter-proc num)]
[(list str [(list str
(app string->number prefix-num) (app string->number prefix-num)
@ -45,4 +56,6 @@
[_ str])])) [_ str])]))
(match parsed-thing (match parsed-thing
[(and (? integer?) (? inexact?)) (inexact->exact parsed-thing)] [(and (? integer?) (? inexact?)) (inexact->exact parsed-thing)]
[_ parsed-thing])) [_ parsed-thing]))
(define q (bootstrap-input '(div ((font-size "100")) (span ((font-size "1.5em"))))))

30
quad2/draw.rkt
Unescape Escape View File

@ -15,10 +15,12 @@
(flatten (flatten
(list ($doc 'start) ($page 'start) (list ($doc 'start) ($page 'start)
(for/list ([q (in-list qs)]) (for/list ([q (in-list qs)])
(cond (cond
[(quad? q) [(quad? q)
(list ($move (quad-posn q)) ($text (char->integer (car (string->list (car (quad-elems q)))))))] (if (pair? (quad-elems q))
[else (error 'render-unknown-thing)])) (list ($move (quad-posn q)) ($text (char->integer (car (string->list (car (quad-elems q)))))))
(list))]
[else (error 'render-unknown-thing)]))
($page 'end) ($doc 'end)))) ($page 'end) ($doc 'end))))
(define valid-tokens '(doc-start doc-end page-start page-end text move)) (define valid-tokens '(doc-start doc-end page-start page-end text move))
@ -27,15 +29,15 @@
#:pre (list-of $drawing-inst?) #:pre (list-of $drawing-inst?)
#:post string? #:post string?
(define move-points (map $move-posn (filter $move? xs))) (define move-points (map $move-posn (filter $move? xs)))
(define xmax (add1 (apply max (map $point-x move-points)))) (define xmax (if (pair? move-points) (add1 (apply max (map $point-x move-points))) 0))
(define ymax (add1 (apply max (map $point-y move-points)))) (define ymax (if (pair? move-points) (add1 (apply max (map $point-y move-points))) 0))
(string-join (string-join
(for/list ([x (in-list xs)]) (for/list ([x (in-list xs)])
(string-join (map ~a (match x (string-join (map ~a (match x
[($move ($point x y)) (list y x 'move)] [($move ($point x y)) (list y x 'move)]
[($text charint) (list charint 'text)] [($text charint) (list charint 'text)]
[($doc 'start) '(doc-start)] [($doc 'start) '(doc-start)]
[($doc 'end) '(doc-end)] [($doc 'end) '(doc-end)]
[($page 'start) (list ymax xmax 'page-start)] [($page 'start) (list ymax xmax 'page-start)]
[($page 'end) '(page-end)] [($page 'end) '(page-end)]
[_ (error 'unknown-drawing-inst)])) " ")) "\n")) [_ (error 'unknown-drawing-inst)])) " ")) "\n"))

43
quad2/font.rkt
Unescape Escape View File

@ -10,6 +10,7 @@
"pipeline.rkt" "pipeline.rkt"
"param.rkt" "param.rkt"
"struct.rkt" "struct.rkt"
"dimension.rkt"
"attr.rkt") "attr.rkt")
(provide (all-defined-out)) (provide (all-defined-out))
@ -18,6 +19,7 @@
(define top-font-directory "fonts") (define top-font-directory "fonts")
(define font-file-extensions '(#".otf" #".ttf" #".woff" #".woff2")) (define font-file-extensions '(#".otf" #".ttf" #".woff" #".woff2"))
(define default-font-family "text") (define default-font-family "text")
(define default-font-size 12)
(define (fonts-in-directory dir) (define (fonts-in-directory dir)
(for/list ([font-path (in-directory dir)] (for/list ([font-path (in-directory dir)]
@ -152,4 +154,43 @@
(check-equal? (resolved-font-for-family "Heading") (string->path "fira-sans-light.otf")) (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 "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 "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 "nonexistent-fam") (string->path "SourceSerifPro-Regular.otf"))))
(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-pass (resolve-font-sizes qs)
;; convert font-size attributes into a simple font size
;; we stashed the previous size in private key 'font-size-previous
#: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 base-size-adjusted
(match (hash-ref attrs :font-size default-font-size)
;; 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))]
;; otherwise we use our value directly
[val val]))
;; 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 (λ (ak av attrs) (resolve-font-size-once attrs))))
(module+ test
(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)))

60
quad2/main.rkt
Unescape Escape View File

@ -1,40 +1,17 @@
#lang debug racket/base #lang debug racket/base
(require "layout.rkt" (require "layout.rkt"
"render.rkt"
"quad.rkt" "quad.rkt"
"pipeline.rkt" "pipeline.rkt"
"linearize.rkt" "linearize.rkt"
"layout.rkt" "layout.rkt"
"draw.rkt" "draw.rkt"
"struct.rkt"
"attr.rkt" "attr.rkt"
"font.rkt" "font.rkt"
"constants.rkt" "constants.rkt"
"param.rkt" "param.rkt"
racket/string
txexpr
racket/list racket/list
racket/match) racket/match)
(define (txexpr->quad x)
(match x
[(txexpr tag attrs elems)
(make-quad #:tag tag
#:attrs (attrs->hash attrs)
#:elems (map txexpr->quad elems))]
[_ x]))
(define-pass (bootstrap-input x)
;; turn a simple string into a quad for testing layout.
#:pre values
#:post (list-of quad?)
(let loop ([x x])
(match x
[(? quad? q) (list q)]
[(and (list (? quad?) ...) qs) (loop (make-quad #:elems qs))]
[(? txexpr? tx) (loop (txexpr->quad tx))]
[(? string? str) (loop (make-quad #:elems (list str)))])))
(define-pass (split-into-single-char-quads qs) (define-pass (split-into-single-char-quads qs)
;; break list of quads into single characters (keystrokes) ;; break list of quads into single characters (keystrokes)
#:pre (list-of simple-quad?) #:pre (list-of simple-quad?)
@ -59,10 +36,6 @@
downcase-attr-values downcase-attr-values
convert-boolean-attr-values convert-boolean-attr-values
convert-numeric-attr-values convert-numeric-attr-values
;; TODO: resolve font sizes
resolve-font-sizes
;; we resolve dimension strings after font size
;; because they can be denoted relative to em size
parse-dimension-strings parse-dimension-strings
;; linearization ============= ;; linearization =============
@ -74,10 +47,11 @@
linearize linearize
;; resolutions & parsings ============= ;; resolutions & parsings =============
;; TODO: finish resolve-font-sizes
#;resolve-font-sizes
resolve-font-paths resolve-font-paths
complete-attr-paths complete-attr-paths
;; TODO: parse feature strings ;; TODO: parse feature strings
mark-text-runs mark-text-runs
merge-adjacent-strings merge-adjacent-strings
@ -88,16 +62,22 @@
make-drawing-insts make-drawing-insts
stackify))) stackify)))
(define insts (parameterize ([current-wrap-width 13] (module+ test
[current-attrs all-attrs] (require "render.rkt")
[current-strict-attrs? #t] (define (test-compile x)
[current-show-timing? #f] (parameterize ([current-wrap-width 13]
[current-use-preconditions? #t] [current-attrs all-attrs]
[current-use-postconditions? #t]) [current-strict-attrs? #t]
(quad-compile (bootstrap-input "Hello this is the earth")))) [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)
]))
(when (string? insts)
(render insts #:using text-renderer)
(render insts #:using drr-renderer)
#;(render-to-html drawing-insts)
#;(render-to-pdf drawing-insts))

23
quad2/quad.rkt
Unescape Escape View File

@ -2,7 +2,9 @@
(require racket/contract (require racket/contract
racket/match racket/match
racket/hash racket/hash
(for-syntax racket/base racket/syntax)) txexpr
(for-syntax racket/base racket/syntax)
"struct.rkt")
(provide (all-defined-out)) (provide (all-defined-out))
(struct $point (x y) #:transparent #:mutable) (struct $point (x y) #:transparent #:mutable)
@ -46,6 +48,8 @@
(quad-constructor tag attrs elems #false))) (quad-constructor tag attrs elems #false)))
(define (quad-ref q key [default-val #false]) (define (quad-ref q 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 q) key default-val))
(define (quad-set! q key val) (define (quad-set! q key val)
(hash-set! (quad-attrs q) key val)) (hash-set! (quad-attrs q) key val))
@ -64,5 +68,22 @@
(define (has-no-position? q) (not (has-position? q))) (define (has-no-position? q) (not (has-position? q)))
(define (has-position? q) (quad-posn q)) (define (has-position? q) (quad-posn q))
(define (txexpr->quad x)
(match x
[(txexpr tag attrs elems)
(make-quad #:tag tag
#:attrs (attrs->hash attrs)
#:elems (map txexpr->quad elems))]
[_ x]))
(define (bootstrap-input x)
;; turn a simple string into a quad for testing layout.
(let loop ([x x])
(match x
[(? quad? q) (list q)]
[(and (list (? quad?) ...) qs) (loop (make-quad #:elems qs))]
[(? txexpr? tx) (loop (txexpr->quad tx))]
[(? string? str) (loop (make-quad #:elems (list str)))])))
(module+ test (module+ test
(define q (make-quad #:tag 'div #:attrs (make-hasheq '((hello . "world"))) #:elems (list "fine")))) (define q (make-quad #:tag 'div #:attrs (make-hasheq '((hello . "world"))) #:elems (list "fine"))))
Write Preview
Loading…
Cancel
Save