diff --git a/quad/quadwriter/render.rkt b/quad/quadwriter/render.rkt index f21eb3ea..2b1b595a 100644 --- a/quad/quadwriter/render.rkt +++ b/quad/quadwriter/render.rkt @@ -1,7 +1,5 @@ #lang debug racket/base -(require (for-syntax racket/base racket/syntax) - racket/match - txexpr/base +(require racket/match racket/contract racket/file racket/string @@ -46,13 +44,13 @@ #:min-left-length 3 #:min-right-length 3))] [substr (in-list (regexp-match* (regexp (string hyphen-char)) hstr #:gap-select? #t))]) - (quad-copy q [elems (list substr)]))] + (quad-copy q [elems (list substr)]))] [else (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) ;; `font-features` are OpenType font feature specifiers. @@ -76,7 +74,7 @@ ;; we parse them into the equivalent measurement in points. (for ([k (in-hash-keys attrs)] #:when (takes-dimension-string? k)) - (hash-update! attrs k parse-dimension)) + (hash-update! attrs k parse-dimension)) attrs) (define (downcase-values! attrs) @@ -84,18 +82,18 @@ ;; so we can check them more easily later. (for ([k (in-hash-keys attrs)] #:unless (has-case-sensitive-value? k)) - (hash-update! attrs k (λ (val) (match val - [(? string? str) (string-downcase str)] - [_ val])))) + (hash-update! attrs k (λ (val) (match val + [(? string? str) (string-downcase str)] + [_ val])))) attrs) (define (complete-every-path! attrs) - ;; convert every pathlike thing to a complete path, + ;; convert every pathlike thing to a complete path (string, because it's inside an attr) ;; so we don't get tripped up later by relative paths ;; relies on `current-directory` being parameterized to source file's dir (for ([k (in-hash-keys attrs)] #:when (takes-path? k)) - (hash-update! attrs k (compose1 path->string path->complete-path))) + (hash-update! attrs k (compose1 path->string path->complete-path))) attrs) (define (handle-cascading-attrs attrs) @@ -108,7 +106,7 @@ resolve-font-tracking! resolve-line-height! parse-font-features!))]) - (proc attrs))) + (proc attrs))) (define (drop-leading-breaks qs) ;; any leading breaks are pointless at the start of the doc, so drop them. @@ -196,11 +194,16 @@ (or (debug-column-gap) (quad-ref (car qs) :column-gap default-column-gap))) (define (setup-pdf-metadata! qs pdf) - (for ([k (in-list (list :pdf-title :pdf-author :pdf-subject :pdf-keywords))] + (for ([str (match qs + [(cons q _) + (in-list (for/list ([k (in-list (list :pdf-title + :pdf-author + :pdf-subject + :pdf-keywords))]) + (quad-ref q k)))] + [_ (in-value #f)])] [pdf-k (in-list '(Title Author Subject Keywords))]) - (hash-set! (pdf-info pdf) pdf-k (match (and (pair? qs) (quad-ref (car qs) k #false)) - [#false ""] ; default val is empty string - [val val]))) + (hash-set! (pdf-info pdf) pdf-k (or str ""))) ; default val is empty string (hash-set! (pdf-info pdf) 'Creator (format "Racket ~a [Quad library]" (version)))) (define (footnote-flow? q) (equal? (quad-ref q 'flow) "footnote")) @@ -301,16 +304,16 @@ ;; correct lines with inner / outer alignment (for* ([(page page-idx) (in-indexed (for*/list ([section (in-list (quad-elems doc))] [page (in-list (quad-elems section))]) - page))] + page))] [col (in-list (quad-elems page))] [block (in-list (quad-elems col))] [line (in-list (quad-elems block))]) - ;; all inner / outer lines are initially filled as if they were right-aligned - (define zero-filler-side (if (odd? (add1 page-idx)) "inner" "outer")) - (when (equal? zero-filler-side (quad-ref line :line-align)) - (match (quad-elems line) - [(cons (? filler-quad? fq) _) (set-quad-size! fq (pt 0 0))] - [_ (void)]))) + ;; all inner / outer lines are initially filled as if they were right-aligned + (define zero-filler-side (if (odd? (add1 page-idx)) "inner" "outer")) + (when (equal? zero-filler-side (quad-ref line :line-align)) + (match (quad-elems line) + [(cons (? filler-quad? fq) _) (set-quad-size! fq (pt 0 0))] + [_ (void)]))) doc) (define/contract (render-pdf qx-arg @@ -320,7 +323,7 @@ #:compress [compress? #t]) ((qexpr?) ((or/c #false path? path-string?) (or/c #false path? path-string?) - #:replace any/c #:compress any/c) . ->* . (or/c void? bytes?)) + #:replace boolean? #:compress boolean?) . ->* . (or/c void? bytes?)) ;; The principal public interface to rendering. ;; `qx-arg` is the Q-expression to be rendered. @@ -334,7 +337,7 @@ [#false (current-directory)] ;; for reasons unclear, DrRacket sometimes sneaks ;; an "unsaved editor" into this arg, despite efforts to prevent - ;; probably + ;; probably my fault ["unsaved editor" pdf-path-arg] [path path]))) @@ -358,11 +361,15 @@ ;; a lot of operations need to look at pages used so it's easier to ;; make it a parameter than endlessly pass it around as an argument. [section-pages-used 0] - [verbose-quad-printing? #false]) + [verbose-quad-printing? #false]) ; for ease of debugging; not mandatory (define qs (time-log setup-qs (setup-qs qx-arg base-dir))) (setup-pdf-metadata! qs (current-pdf)) + ;; all the heavy lifting happens inside `make-sections` + ;; which calls out to `make-pages`, `make-columns`, and so on. (define doc (correct-line-alignment (quad-copy q:doc [elems (make-sections qs)]))) + ;; call `position` and `draw` separately so we can print a timer for each (define positioned-doc (time-log position (position doc))) + ;; drawing implies that a PDF is written to disk (time-log draw (draw positioned-doc (current-pdf)))) (if pdf-path-arg