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

centralize dimension parsing

Browse Source
main
Matthew Butterick 5 years ago
parent dc211888e1
commit 6903d6c67c
4 changed files with 106 additions and 70 deletions
Show Stats Download Patch File Download Diff File

2
quad/quad/scribblings/quad.scrbl
Unescape Escape View File

@ -575,7 +575,7 @@ Specify a quad with an image (either @racket{.png} or @racket{.jpeg}). @racket[i
@deftogether[(@defthing[#:kind "attribute" font-size symbol?] @deftogether[(@defthing[#:kind "attribute" font-size symbol?]
@defthing[#:kind "attribute" font-size-adjust symbol?])]{ @defthing[#:kind "attribute" font-size-adjust symbol?])]{
Two ways of setting the point size for text. @racket[font-size] takes a size string. @racket[font-size-adjust] takes a string representing a percentage (like @racket["120%"] or @racket["1.2"]) and sets the font size to the size of the parent, multiplied by the percentage. Two ways of setting the point size for text. @racket[font-size] takes a @tech{dimension string}. @racket[font-size-adjust] takes a string representing a percentage (like @racket["120%"] or @racket["1.2"]) and sets the font size to the size of the parent, multiplied by the percentage.
} }
@defthing[#:kind "attribute" font-family symbol?]{ @defthing[#:kind "attribute" font-family symbol?]{

66
quad/quadwriter/attrs.rkt
Unescape Escape View File

@ -7,42 +7,40 @@
(define (list->attrs . kvs) (define (list->attrs . kvs)
(for/list ([kv (in-slice 2 kvs)]) (for/list ([kv (in-slice 2 kvs)])
kv)) kv))
(define (cm->in x) (/ x 2.54)) (define (cm->in x) (/ x 2.54))
(define (in->pts x) (* 72 x)) (define (in->pts x) (* 72 x))
(define (mm->cm x) (/ x 10)) (define (mm->cm x) (/ x 10))
(define (parse-dimension x [round? #f]) (define (parse-dimension x)
(define val (match x
(match x [#false #false]
[#false #false] [(? number?) x]
[(? number?) x] [(? string? x)
[(? string? x) (match (cdr (regexp-match #rx"^(-?[0-9\\.]+)([a-z]+)$" (string-downcase x)))
(match (cdr (regexp-match #rx"^(-?[0-9\\.]+)([a-z]+)$" (string-downcase x))) [(list num-string unit)
[(list num-string unit) ((match unit
((match unit [(regexp #rx"in(ch(es)?)?$") in->pts]
[(regexp #rx"in(ch(es)?)?$") in->pts] [(regexp #rx"cm$") (compose1 in->pts cm->in)]
[(regexp #rx"cm$") (compose1 in->pts cm->in)] [(regexp #rx"mm$") (compose1 in->pts cm->in mm->cm)]
[(regexp #rx"mm$") (compose1 in->pts cm->in mm->cm)] [_ (raise-argument-error 'parse-dimension "dimension string" x)]) (string->number num-string))])]))
[_ (raise-argument-error 'parse-dimension "dimension string" x)]) (string->number num-string))])]))
(if round? (inexact->exact (floor val)) val))
(define (copy-block-attrs source-hash dest-hash) (define (copy-block-attrs source-hash dest-hash)
(define new-hash (make-hasheq)) (define new-hash (make-hasheq))
(for ([(k v) (in-hash dest-hash)]) (for ([(k v) (in-hash dest-hash)])
(hash-set! new-hash k v)) (hash-set! new-hash k v))
(for* ([k (in-list block-attrs)] (for* ([k (in-list block-attrs)]
[v (in-value (hash-ref source-hash k #f))] [v (in-value (hash-ref source-hash k #f))]
#:when v) #:when v)
(hash-set! new-hash k v)) (hash-set! new-hash k v))
new-hash) new-hash)
(define-syntax (define-attrs stx) (define-syntax (define-attrs stx)
(syntax-case stx () (syntax-case stx ()
[(_ (ATTR-NAME ...)) [(_ (ATTR-NAME ...))
(with-syntax ([(ATTR-ID ...) (for/list ([attr-id (in-list (syntax->list #'(ATTR-NAME ...)))]) (with-syntax ([(ATTR-ID ...) (for/list ([attr-id (in-list (syntax->list #'(ATTR-NAME ...)))])
(format-id stx ":~a" (syntax-e attr-id)))]) (format-id stx ":~a" (syntax-e attr-id)))])
#'(begin #'(begin
(define ATTR-ID 'ATTR-NAME) ...))] (define ATTR-ID 'ATTR-NAME) ...))]
[(_ ID (ATTR-NAME ...)) [(_ ID (ATTR-NAME ...))
@ -63,6 +61,7 @@ Naming guidelines
|# |#
(define-attrs (font-family (define-attrs (font-family
font-path font-path
font-size font-size
@ -155,4 +154,33 @@ Naming guidelines
page-margin-left page-margin-left
page-margin-right page-margin-right
footer-display)) footer-display))
(define (takes-dimension-string? k)
(and (memq k (list :page-width
:page-height
:page-margin-top
:page-margin-bottom
:page-margin-left
:page-margin-right
:column-gap
:inset-top
:inset-bottom
:inset-left
:inset-right
:border-inset-top
:border-inset-bottom
:border-inset-left
:border-inset-right
:border-width-left
:border-width-right
:border-width-top
:border-width-bottom
:space-before
:space-after
:image-height
:image-width
:font-size
:font-tracking
:font-baseline-shift
:line-height)) #true))

28
quad/quadwriter/layout.rkt
Unescape Escape View File

@ -24,8 +24,8 @@
(fill-color doc (quad-ref q :font-color default-font-color)) (fill-color doc (quad-ref q :font-color default-font-color))
(define str (unsafe-car (quad-elems q))) (define str (unsafe-car (quad-elems q)))
(match-define (list x y) (quad-origin q)) (match-define (list x y) (quad-origin q))
(text doc str x (- y (parse-dimension (quad-ref q :font-baseline-shift 0))) (text doc str x (- y (quad-ref q :font-baseline-shift 0))
#:tracking (parse-dimension (quad-ref q :font-tracking 0)) #:tracking (quad-ref q :font-tracking 0)
#:bg (quad-ref q :bg) #:bg (quad-ref q :bg)
#:features (quad-ref q :font-features default-font-features) #:features (quad-ref q :font-features default-font-features)
#:link (quad-ref q :link)))) #:link (quad-ref q :link))))
@ -86,14 +86,14 @@
[str [str
(font-size pdf (quad-ref q :font-size default-font-size)) (font-size pdf (quad-ref q :font-size default-font-size))
(font pdf (path->string (quad-ref q font-path-key default-font-face))) (font pdf (path->string (quad-ref q font-path-key default-font-face)))
(define ft-value (parse-dimension (quad-ref q :font-tracking 0))) (define ft-value (quad-ref q :font-tracking 0))
(if (equal? str "\u00AD") (if (equal? str "\u00AD")
ft-value ft-value
(+ (string-width pdf str (+ (string-width pdf str
#:tracking ft-value #:tracking ft-value
#:features (quad-ref q :font-features default-font-features))))] #:features (quad-ref q :font-features default-font-features))))]
[else 0])) [else 0]))
(list string-size (parse-dimension (quad-ref q :line-height (current-line-height pdf)))))) (list string-size (quad-ref q :line-height (current-line-height pdf)))))
(define (generic->typed-quad q) (define (generic->typed-quad q)
(cond (cond
@ -105,8 +105,8 @@
(define img-width ($img-width img-obj)) (define img-width ($img-width img-obj))
(define img-height ($img-height img-obj)) (define img-height ($img-height img-obj))
(match-define (list layout-width layout-height) (match-define (list layout-width layout-height)
(match (list (parse-dimension (quad-ref q :image-width)) (match (list (quad-ref q :image-width)
(parse-dimension (quad-ref q :image-height))) (quad-ref q :image-height))
[(list (? number? w) (? number? h)) (list w h)] [(list (? number? w) (? number? h)) (list w h)]
[(list #false (? number? h)) (define ratio (/ h img-height)) [(list #false (? number? h)) (define ratio (/ h img-height))
(list (* ratio img-width) h)] (list (* ratio img-width) h)]
@ -181,7 +181,7 @@
(define arbitrary-width 20) (define arbitrary-width 20)
(q #:type line-spacer-quad (q #:type line-spacer-quad
#:size (pt arbitrary-width (cond #:size (pt arbitrary-width (cond
[(and maybe-first-line-q (parse-dimension (quad-ref maybe-first-line-q key)))] [(and maybe-first-line-q (quad-ref maybe-first-line-q key))]
[else default-val])) [else default-val]))
#:from 'sw #:from 'sw
#:to 'nw #:to 'nw
@ -347,7 +347,7 @@
(match-define (list line-width line-height) (quad-size line-q)) (match-define (list line-width line-height) (quad-size line-q))
(define new-size (let () (define new-size (let ()
(define line-heights (define line-heights
(filter-map (λ (q) (or (parse-dimension (quad-ref q :line-height)) (pt-y (size q)))) pcs)) (filter-map (λ (q) (or (quad-ref q :line-height) (pt-y (size q)))) pcs))
(pt line-width (if (empty? line-heights) line-height (apply max line-heights))))) (pt line-width (if (empty? line-heights) line-height (apply max line-heights)))))
(list (list
(struct-copy (struct-copy
@ -525,7 +525,7 @@
;; adjust drawing coordinates for border inset ;; adjust drawing coordinates for border inset
(match-define (list bil bit bir bib) (match-define (list bil bit bir bib)
(for/list ([k (in-list (list :border-inset-left :border-inset-top :border-inset-right :border-inset-bottom))]) (for/list ([k (in-list (list :border-inset-left :border-inset-top :border-inset-right :border-inset-bottom))])
(parse-dimension (quad-ref first-line k 0)))) (quad-ref first-line k 0)))
(match-define (list left top) (pt+ (quad-origin q) (list bil bit))) (match-define (list left top) (pt+ (quad-origin q) (list bil bit)))
(match-define (list width height) (pt- (size q) (list (+ bil bir) (+ bit bib)))) (match-define (list width height) (pt- (size q) (list (+ bil bir) (+ bit bib))))
;; fill rect ;; fill rect
@ -536,7 +536,7 @@
(fill doc bgcolor))]) (fill doc bgcolor))])
;; draw border ;; draw border
(match-define (list bw-left bw-top bw-right bw-bottom) (match-define (list bw-left bw-top bw-right bw-bottom)
(map (λ (k) (max 0 (parse-dimension (quad-ref first-line k 0)))) (map (λ (k) (max 0 (quad-ref first-line k 0)))
(list (list
:border-width-left :border-width-left
:border-width-top :border-width-top
@ -593,9 +593,9 @@
#:size (delay (pt (pt-x (size ln0)) ; #:size (delay (pt (pt-x (size ln0)) ;
(+ (for/sum ([line (in-list lines)]) (+ (for/sum ([line (in-list lines)])
(pt-y (size line))) (pt-y (size line)))
(parse-dimension (quad-ref ln0 :inset-top 0)) (quad-ref ln0 :inset-top 0)
(parse-dimension (quad-ref ln0 :inset-bottom 0))))) (quad-ref ln0 :inset-bottom 0))))
#:shift-elems (pt 0 (+ (parse-dimension (quad-ref ln0 :inset-top 0)))) #:shift-elems (pt 0 (quad-ref ln0 :inset-top 0))
#:draw-start (block-draw-start ln0) #:draw-start (block-draw-start ln0)
#:draw-end (block-draw-end ln0))]) #:draw-end (block-draw-end ln0))])
@ -681,7 +681,7 @@
#:result (reverse qs-out)) #:result (reverse qs-out))
([q (in-list qs)] ([q (in-list qs)]
[next-q (in-list (cdr qs))]) [next-q (in-list (cdr qs))])
(match (and (para-break-quad? q) (parse-dimension (quad-ref next-q :first-line-indent 0))) (match (and (para-break-quad? q) (quad-ref next-q :first-line-indent 0))
[(or #false 0) (cons next-q qs-out)] [(or #false 0) (cons next-q qs-out)]
[indent-val (list* next-q (make-quad #:from 'bo [indent-val (list* next-q (make-quad #:from 'bo
#:to 'bi #:to 'bi

80
quad/quadwriter/render.rkt
Unescape Escape View File

@ -34,10 +34,10 @@
[(_ ALL-BREAKS-ID . TYPES) [(_ ALL-BREAKS-ID . TYPES)
(with-syntax ([((TYPE-BREAK TYPE-STR Q:TYPE-BREAK) ...) (with-syntax ([((TYPE-BREAK TYPE-STR Q:TYPE-BREAK) ...)
(for/list ([type (in-list (syntax->list #'TYPES))]) (for/list ([type (in-list (syntax->list #'TYPES))])
(list (list
(format-id #'TYPES "~a-break" type) (format-id #'TYPES "~a-break" type)
(symbol->string (syntax->datum type)) (symbol->string (syntax->datum type))
(format-id #'TYPES "q:~a-break" type)))]) (format-id #'TYPES "q:~a-break" type)))])
#'(begin #'(begin
(define TYPE-BREAK '(q ((break TYPE-STR)))) ... (define TYPE-BREAK '(q ((break TYPE-STR)))) ...
(define ALL-BREAKS-ID (list (cons TYPE-BREAK Q:TYPE-BREAK) ...))))])) (define ALL-BREAKS-ID (list (cons TYPE-BREAK Q:TYPE-BREAK) ...))))]))
@ -56,22 +56,22 @@
;; do this before ->string-quad so that it can handle the sizing promises ;; do this before ->string-quad so that it can handle the sizing promises
(apply append (apply append
(for/list ([q (in-list qs)]) (for/list ([q (in-list qs)])
(match (quad-ref q :hyphenate) (match (quad-ref q :hyphenate)
[#true #:when (and (pair? (quad-elems q)) [#true #:when (and (pair? (quad-elems q))
(andmap string? (quad-elems q))) (andmap string? (quad-elems q)))
(for*/list ([str (in-list (quad-elems q))] (for*/list ([str (in-list (quad-elems q))]
[hyphen-char (in-value #\u00AD)] [hyphen-char (in-value #\u00AD)]
[hstr (in-value (hyphenate str hyphen-char [hstr (in-value (hyphenate str hyphen-char
#:min-left-length 3 #:min-left-length 3
#:min-right-length 3))] #:min-right-length 3))]
[substr (in-list (regexp-match* (regexp (string hyphen-char)) hstr #:gap-select? #t))]) [substr (in-list (regexp-match* (regexp (string hyphen-char)) hstr #:gap-select? #t))])
(struct-copy quad q [elems (list substr)]))] (struct-copy quad q [elems (list substr)]))]
[_ (list q)])))) [_ (list q)]))))
(define (string->feature-list str) (define (string->feature-list str)
(for/list ([kv (in-slice 2 (string-split str))]) (for/list ([kv (in-slice 2 (string-split str))])
(cons (string->bytes/utf-8 (first kv)) (string->number (second kv))))) (cons (string->bytes/utf-8 (first kv)) (string->number (second kv)))))
(define (parse-font-features! attrs) (define (parse-font-features! attrs)
(cond (cond
@ -89,7 +89,15 @@
(hash-set! attrs :font-features parsed-features)] (hash-set! attrs :font-features parsed-features)]
[_ #false])])) [_ #false])]))
(define (parse-dimension-strings! attrs)
(for ([k (in-hash-keys attrs)]
#:when (takes-dimension-string? k))
(hash-set! attrs k (parse-dimension (hash-ref attrs k))))
attrs)
(define (handle-cascading-attrs attrs) (define (handle-cascading-attrs attrs)
(parse-dimension-strings! attrs)
(resolve-font-path! attrs) (resolve-font-path! attrs)
(resolve-font-size! attrs) (resolve-font-size! attrs)
(parse-font-features! attrs)) (parse-font-features! attrs))
@ -126,20 +134,20 @@
(define left (define left
(or (debug-x-margin) (or (debug-x-margin)
(quad-ref (car qs) :page-margin-left (quad-ref (car qs) :page-margin-left
(λ () (parse-dimension (quad-ref (car qs) :page-margin-right default-side-margin)))))) (λ () (quad-ref (car qs) :page-margin-right default-side-margin)))))
(define right (define right
(or (debug-x-margin) (or (debug-x-margin)
(quad-ref (car qs) :page-margin-right (quad-ref (car qs) :page-margin-right
(λ () (parse-dimension (quad-ref (car qs) :page-margin-left default-side-margin)))))) (λ () (quad-ref (car qs) :page-margin-left default-side-margin)))))
(define top (define top
(or (debug-y-margin) (or (debug-y-margin)
(quad-ref (car qs) :page-margin-top (quad-ref (car qs) :page-margin-top
(λ () (parse-dimension (quad-ref (car qs) :page-margin-bottom default-top-margin)))))) (λ () (quad-ref (car qs) :page-margin-bottom default-top-margin)))))
(define vert-optical-adjustment 10) (define vert-optical-adjustment 10)
(define bottom (define bottom
(or (debug-y-margin) (or (debug-y-margin)
(parse-dimension (quad-ref (car qs) :page-margin-bottom (quad-ref (car qs) :page-margin-bottom
(λ () (+ vert-optical-adjustment (quad-ref (car qs) :page-margin-top (* default-top-margin 1.4)))))))) (λ () (+ vert-optical-adjustment (quad-ref (car qs) :page-margin-top (* default-top-margin 1.4)))))))
(list left top right bottom)) (list left top right bottom))
(define default-column-count 1) (define default-column-count 1)
@ -151,21 +159,21 @@
(define default-column-gap 36) (define default-column-gap 36)
(define (setup-column-gap qs) (define (setup-column-gap qs)
(or (debug-column-gap) (parse-dimension (quad-ref (car qs) :column-gap default-column-gap)))) (or (debug-column-gap) (quad-ref (car qs) :column-gap default-column-gap)))
(define (set-page-size! the-pdf qs) (define (set-page-size! the-pdf qs)
;; page size can be specified by name, or measurements. ;; page size can be specified by name, or measurements.
;; explicit measurements from page-height and page-width supersede those from page-size. ;; explicit measurements from page-height and page-width supersede those from page-size.
(match-define (list page-width page-height) (match-define (list page-width page-height)
(for/list ([k (list :page-width :page-height)]) (for/list ([k (list :page-width :page-height)])
(match (and (pair? qs) (quad-ref (car qs) k)) (and (pair? qs) (match (quad-ref (car qs) k)
[#false #false] [#false #false]
[val (parse-dimension val 'round)]))) [val (inexact->exact (floor val))]))))
(resolve-page-size! the-pdf (resolve-page-size! the-pdf
(or (debug-page-width) page-width) (or (debug-page-width) page-width)
(or (debug-page-height) page-height) (or (debug-page-height) page-height)
(quad-ref (car qs) :page-size default-page-size) (quad-ref (car qs) :page-size default-page-size)
(quad-ref (car qs) :page-orientation default-page-orientation))) (quad-ref (car qs) :page-orientation default-page-orientation)))
(define/contract (render-pdf qx-arg pdf-path-arg (define/contract (render-pdf qx-arg pdf-path-arg
#:replace [replace? #t] #:replace [replace? #t]
@ -178,8 +186,8 @@
(raise-argument-error 'render-pdf "path that doesn't exist" pdf-path)) (raise-argument-error 'render-pdf "path that doesn't exist" pdf-path))
(define the-pdf (make-pdf #:compress compress? (define the-pdf (make-pdf #:compress compress?
#:auto-first-page #false #:auto-first-page #false
#:output-path pdf-path)) #:output-path pdf-path))
(parameterize ([current-pdf the-pdf] (parameterize ([current-pdf the-pdf]
[verbose-quad-printing? #false]) [verbose-quad-printing? #false])
(define qs (time-log setup-qs (setup-qs qx-arg pdf-path))) (define qs (time-log setup-qs (setup-qs qx-arg pdf-path)))

Write Preview
Loading…
Cancel
Save