From 4b8e4c299255dfce04594d44b9324530677afe48 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 5 Aug 2019 22:33:21 -0700 Subject: [PATCH] start page sizer --- quad/quadwriter/layout.rkt | 3 ++ quad/quadwriter/render.rkt | 101 +++++++++++++++++++------------------ 2 files changed, 55 insertions(+), 49 deletions(-) diff --git a/quad/quadwriter/layout.rkt b/quad/quadwriter/layout.rkt index 5d0e3224..674ec4ae 100644 --- a/quad/quadwriter/layout.rkt +++ b/quad/quadwriter/layout.rkt @@ -657,6 +657,9 @@ (pt-x (size x)))) #:finish-wrap (page-finish-wrap page-quad (pdf-output-path (current-pdf))))) +(define (section-wrap qs) + qs) + (define (insert-blocks lines) (define groups-of-lines (contiguous-group-by (λ (x) (quad-ref x :display)) lines)) (append* (for/list ([line-group (in-list groups-of-lines)]) diff --git a/quad/quadwriter/render.rkt b/quad/quadwriter/render.rkt index 52a6a29d..7714811e 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 @@ -93,7 +93,7 @@ (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)))) + (hash-set! attrs k (parse-dimension (hash-ref attrs k)))) attrs) (define (handle-cascading-attrs attrs) @@ -126,9 +126,9 @@ (define indented-qs (insert-first-line-indents typed-quads)) indented-qs) -(define (setup-margins qs pdf) - (define default-side-margin (min (* 72 1.5) (floor (* .20 (pdf-width pdf))))) - (define default-top-margin (min 72 (floor (* .10 (pdf-height pdf))))) +(define (setup-margins qs page-width page-height) + (define default-side-margin (min (* 72 1.5) (floor (* .20 page-width)))) + (define default-top-margin (min 72 (floor (* .10 page-height)))) ;; if only left or right margin is provided, copy other value in preference to default margin (define left @@ -166,24 +166,25 @@ ;; 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))) + (and (pair? qs) (match (quad-ref (car qs) k) + [#false #false] + [val (inexact->exact (floor val))])))) + (resolve-page-size + (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] + #:replace [replace-existing-file? #t] #:compress [compress? #t]) ((qexpr? (or/c #false path? path-string?)) (#:replace any/c #:compress any/c) . ->* . (or/c void? bytes?)) (define pdf-path (setup-pdf-path pdf-path-arg)) - (when (and (not replace?) (file-exists? pdf-path)) - (raise-argument-error 'render-pdf "path that doesn't exist" pdf-path)) + (unless replace-existing-file? + (when (file-exists? pdf-path) + (raise-argument-error 'render-pdf "path that doesn't exist" pdf-path))) (define the-pdf (make-pdf #:compress compress? #:auto-first-page #false @@ -192,28 +193,30 @@ [verbose-quad-printing? #false]) (define qs (time-log setup-qs (setup-qs qx-arg pdf-path))) - (set-page-size! the-pdf qs) + (define sections (time-log section-wrap (section-wrap qs))) + (for ([qs (in-list sections)]) + (match-define (list page-width page-height) (set-page-size! the-pdf qs)) + (match-define (list left-margin top-margin right-margin bottom-margin) + (setup-margins qs page-width page-height)) + (define printable-width (- page-width left-margin right-margin)) + (define printable-height (- page-height top-margin bottom-margin)) + (define column-count (setup-column-count qs)) + (define column-gap (setup-column-gap qs)) - (match-define (list left-margin top-margin right-margin bottom-margin) (setup-margins qs (current-pdf))) - (define printable-width (- (pdf-width (current-pdf)) left-margin right-margin)) - (define printable-height (- (pdf-height (current-pdf)) top-margin bottom-margin)) - (define column-count (setup-column-count qs)) - (define column-gap (setup-column-gap qs)) + (define line-wrap-size (/ (- printable-width (* (sub1 column-count) column-gap)) column-count)) + (define line-qs (time-log line-wrap (apply-keeps (line-wrap qs line-wrap-size)))) - (define line-wrap-size (/ (- printable-width (* (sub1 column-count) column-gap)) column-count)) - (define line-qs (time-log line-wrap (apply-keeps (line-wrap qs line-wrap-size)))) + (define col-quad-prototype (struct-copy quad q:column + [size (pt line-wrap-size printable-height)])) + (define column-qs (time-log column-wrap (column-wrap line-qs printable-height column-gap col-quad-prototype))) - (define col-quad-prototype (struct-copy quad q:column - [size (pt line-wrap-size printable-height)])) - (define column-qs (time-log column-wrap (column-wrap line-qs printable-height column-gap col-quad-prototype))) + (define page-quad-prototype (struct-copy quad q:page + [shift (pt left-margin top-margin)] + [size (pt line-wrap-size printable-height)])) + (define page-qs (time-log page-wrap (page-wrap column-qs printable-width page-quad-prototype))) - (define page-quad-prototype (struct-copy quad q:page - [shift (pt left-margin top-margin)] - [size (pt line-wrap-size printable-height)])) - (define page-qs (time-log page-wrap (page-wrap column-qs printable-width page-quad-prototype))) - - (define positioned-qs (time-log position (position (struct-copy quad q:doc [elems page-qs])))) - (time-log draw (draw positioned-qs (current-pdf)))) + (define positioned-qs (time-log position (position (struct-copy quad q:doc [elems page-qs])))) + (time-log draw (draw positioned-qs (current-pdf))))) (if pdf-path-arg (log-quadwriter-info (format "wrote PDF to ~a" pdf-path))