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

start page sizer

Browse Source
main
Matthew Butterick 5 years ago
parent 10cbb47950
commit 4b8e4c2992
2 changed files with 55 additions and 49 deletions
Show Stats Download Patch File Download Diff File

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

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

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

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

Write Preview
Loading…
Cancel
Save