diff --git a/quad/quad/scribblings/quad.scrbl b/quad/quad/scribblings/quad.scrbl index 8c634670..be2eb33a 100644 --- a/quad/quad/scribblings/quad.scrbl +++ b/quad/quad/scribblings/quad.scrbl @@ -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?] @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?]{ diff --git a/quad/quadwriter/attrs.rkt b/quad/quadwriter/attrs.rkt index f3b7d0a5..ac8de53b 100644 --- a/quad/quadwriter/attrs.rkt +++ b/quad/quadwriter/attrs.rkt @@ -7,42 +7,40 @@ (define (list->attrs . kvs) (for/list ([kv (in-slice 2 kvs)]) - kv)) + kv)) (define (cm->in x) (/ x 2.54)) (define (in->pts x) (* 72 x)) (define (mm->cm x) (/ x 10)) -(define (parse-dimension x [round? #f]) - (define val - (match x - [#false #false] - [(? number?) x] - [(? string? x) - (match (cdr (regexp-match #rx"^(-?[0-9\\.]+)([a-z]+)$" (string-downcase x))) - [(list num-string unit) - ((match unit - [(regexp #rx"in(ch(es)?)?$") in->pts] - [(regexp #rx"cm$") (compose1 in->pts cm->in)] - [(regexp #rx"mm$") (compose1 in->pts cm->in mm->cm)] - [_ (raise-argument-error 'parse-dimension "dimension string" x)]) (string->number num-string))])])) - (if round? (inexact->exact (floor val)) val)) +(define (parse-dimension x) + (match x + [#false #false] + [(? number?) x] + [(? string? x) + (match (cdr (regexp-match #rx"^(-?[0-9\\.]+)([a-z]+)$" (string-downcase x))) + [(list num-string unit) + ((match unit + [(regexp #rx"in(ch(es)?)?$") in->pts] + [(regexp #rx"cm$") (compose1 in->pts cm->in)] + [(regexp #rx"mm$") (compose1 in->pts cm->in mm->cm)] + [_ (raise-argument-error 'parse-dimension "dimension string" x)]) (string->number num-string))])])) (define (copy-block-attrs source-hash dest-hash) (define new-hash (make-hasheq)) (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)] [v (in-value (hash-ref source-hash k #f))] #:when v) - (hash-set! new-hash k v)) + (hash-set! new-hash k v)) new-hash) (define-syntax (define-attrs stx) (syntax-case stx () [(_ (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 (define ATTR-ID 'ATTR-NAME) ...))] [(_ ID (ATTR-NAME ...)) @@ -63,6 +61,7 @@ Naming guidelines |# + (define-attrs (font-family font-path font-size @@ -155,4 +154,33 @@ Naming guidelines page-margin-left page-margin-right - footer-display)) \ No newline at end of file + 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)) \ No newline at end of file diff --git a/quad/quadwriter/layout.rkt b/quad/quadwriter/layout.rkt index e0e1c9a8..5d0e3224 100644 --- a/quad/quadwriter/layout.rkt +++ b/quad/quadwriter/layout.rkt @@ -24,8 +24,8 @@ (fill-color doc (quad-ref q :font-color default-font-color)) (define str (unsafe-car (quad-elems q))) (match-define (list x y) (quad-origin q)) - (text doc str x (- y (parse-dimension (quad-ref q :font-baseline-shift 0))) - #:tracking (parse-dimension (quad-ref q :font-tracking 0)) + (text doc str x (- y (quad-ref q :font-baseline-shift 0)) + #:tracking (quad-ref q :font-tracking 0) #:bg (quad-ref q :bg) #:features (quad-ref q :font-features default-font-features) #:link (quad-ref q :link)))) @@ -86,14 +86,14 @@ [str (font-size pdf (quad-ref q :font-size default-font-size)) (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") ft-value (+ (string-width pdf str #:tracking ft-value #:features (quad-ref q :font-features default-font-features))))] [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) (cond @@ -105,8 +105,8 @@ (define img-width ($img-width img-obj)) (define img-height ($img-height img-obj)) (match-define (list layout-width layout-height) - (match (list (parse-dimension (quad-ref q :image-width)) - (parse-dimension (quad-ref q :image-height))) + (match (list (quad-ref q :image-width) + (quad-ref q :image-height)) [(list (? number? w) (? number? h)) (list w h)] [(list #false (? number? h)) (define ratio (/ h img-height)) (list (* ratio img-width) h)] @@ -181,7 +181,7 @@ (define arbitrary-width 20) (q #:type line-spacer-quad #: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])) #:from 'sw #:to 'nw @@ -347,7 +347,7 @@ (match-define (list line-width line-height) (quad-size line-q)) (define new-size (let () (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))))) (list (struct-copy @@ -525,7 +525,7 @@ ;; adjust drawing coordinates for border inset (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))]) - (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 width height) (pt- (size q) (list (+ bil bir) (+ bit bib)))) ;; fill rect @@ -536,7 +536,7 @@ (fill doc bgcolor))]) ;; draw border (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 :border-width-left :border-width-top @@ -593,9 +593,9 @@ #:size (delay (pt (pt-x (size ln0)) ; (+ (for/sum ([line (in-list lines)]) (pt-y (size line))) - (parse-dimension (quad-ref ln0 :inset-top 0)) - (parse-dimension (quad-ref ln0 :inset-bottom 0))))) - #:shift-elems (pt 0 (+ (parse-dimension (quad-ref ln0 :inset-top 0)))) + (quad-ref ln0 :inset-top 0) + (quad-ref ln0 :inset-bottom 0)))) + #:shift-elems (pt 0 (quad-ref ln0 :inset-top 0)) #:draw-start (block-draw-start ln0) #:draw-end (block-draw-end ln0))]) @@ -681,7 +681,7 @@ #:result (reverse qs-out)) ([q (in-list 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)] [indent-val (list* next-q (make-quad #:from 'bo #:to 'bi diff --git a/quad/quadwriter/render.rkt b/quad/quadwriter/render.rkt index 24c35592..52a6a29d 100644 --- a/quad/quadwriter/render.rkt +++ b/quad/quadwriter/render.rkt @@ -34,10 +34,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) ...))))])) @@ -56,22 +56,22 @@ ;; 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))))) + (cons (string->bytes/utf-8 (first kv)) (string->number (second kv))))) (define (parse-font-features! attrs) (cond @@ -89,7 +89,15 @@ (hash-set! attrs :font-features parsed-features)] [_ #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) + (parse-dimension-strings! attrs) (resolve-font-path! attrs) (resolve-font-size! attrs) (parse-font-features! attrs)) @@ -126,20 +134,20 @@ (define left (or (debug-x-margin) (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 (or (debug-x-margin) (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 (or (debug-y-margin) (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 bottom (or (debug-y-margin) - (parse-dimension (quad-ref (car qs) :page-margin-bottom - (λ () (+ vert-optical-adjustment (quad-ref (car qs) :page-margin-top (* default-top-margin 1.4)))))))) + (quad-ref (car qs) :page-margin-bottom + (λ () (+ vert-optical-adjustment (quad-ref (car qs) :page-margin-top (* default-top-margin 1.4))))))) (list left top right bottom)) (define default-column-count 1) @@ -151,21 +159,21 @@ (define default-column-gap 36) (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) - ;; 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 (and (pair? qs) (quad-ref (car qs) k)) - [#false #false] - [val (parse-dimension val 'round)]))) - (resolve-page-size! the-pdf - (or (debug-page-width) page-width) - (or (debug-page-height) page-height) - (quad-ref (car qs) :page-size default-page-size) - (quad-ref (car qs) :page-orientation default-page-orientation))) + ;; 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)]) + (and (pair? qs) (match (quad-ref (car qs) k) + [#false #false] + [val (inexact->exact (floor val))])))) + (resolve-page-size! the-pdf + (or (debug-page-width) page-width) + (or (debug-page-height) page-height) + (quad-ref (car qs) :page-size default-page-size) + (quad-ref (car qs) :page-orientation default-page-orientation))) (define/contract (render-pdf qx-arg pdf-path-arg #:replace [replace? #t] @@ -178,8 +186,8 @@ (raise-argument-error 'render-pdf "path that doesn't exist" pdf-path)) (define the-pdf (make-pdf #:compress compress? - #:auto-first-page #false - #:output-path pdf-path)) + #:auto-first-page #false + #:output-path pdf-path)) (parameterize ([current-pdf the-pdf] [verbose-quad-printing? #false]) (define qs (time-log setup-qs (setup-qs qx-arg pdf-path)))