centralize dimension parsing

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?]{

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))
+                           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))

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

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)))