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

resolve relative paths in attribute values (closes #38)

Browse Source
main
Matthew Butterick 5 years ago
parent 530f4fad2d
commit 31761a3502
4 changed files with 62 additions and 41 deletions
Show Stats Download Patch File Download Diff File

4
quad/qtest/all.rkt
Unescape Escape View File

@ -11,7 +11,7 @@
(with-syntax ([PDF-NAME (test-pdf-name (syntax-e #'PATH))])
#'(begin
(parameterize ([quadwriter-test-mode #t])
(render-pdf (dynamic-require PATH 'doc) PDF-NAME))
(render-pdf (dynamic-require PATH 'doc) PDF-NAME PATH))
(make-test-pdf . REST)))]))
(define-syntax (test-each stx)
@ -26,7 +26,7 @@
(define-runtime-path path (path-replace-extension MOD-PATH #".pdf"))
(check-pdfs-equal? (time (parameterize ([quadwriter-test-mode #t]
[current-output-port (open-output-nowhere)])
(render-pdf (dynamic-require path-to-test 'doc) path)
(render-pdf (dynamic-require path-to-test 'doc) path path-to-test)
path)) test-base)
(test-each . REST)))]))

5
quad/quadwriter/attrs.rkt
Unescape Escape View File

@ -183,4 +183,7 @@ Naming guidelines
:font-size
:font-tracking
:font-baseline-shift
:line-height)) #true))
:line-height)) #true))
(define (takes-path? k)
(and (memq k (list :image-file)) #true))

2
quad/quadwriter/lang-helper.rkt
Unescape Escape View File

@ -70,7 +70,7 @@
(current-output-port)
(λ () (with-logging-to-port
(current-output-port)
(λ () (render-pdf DOC pdf-path))
(λ () (render-pdf DOC pdf-path PATH-STRING))
#:logger quadwriter-logger
'debug))
#:logger quad-logger

92
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,11 +93,19 @@
(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 (complete-every-path! attrs)
;; relies on `current-directory` being parameterized to source file's dir
(for ([(k v) (in-hash attrs)]
#:when (takes-path? k))
(hash-set! attrs k (path->string (path->complete-path v))))
attrs)
(define (handle-cascading-attrs attrs)
(parse-dimension-strings! attrs)
(complete-every-path! attrs)
(resolve-font-path! attrs)
(resolve-font-size! attrs)
(parse-font-features! attrs))
@ -161,11 +169,18 @@
(define (setup-column-gap qs)
(or (debug-column-gap) (quad-ref (car qs) :column-gap default-column-gap)))
(define/contract (render-pdf qx-arg pdf-path-arg
(define/contract (render-pdf qx-arg pdf-path-arg [base-dir-arg #f]
#: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?))
((qexpr? (or/c #false path? path-string?))
((or/c #false path? path-string?)
#:replace any/c
#:compress any/c) . ->* . (or/c void? bytes?))
(define base-dir (match base-dir-arg
[#false (current-directory)]
[path (define-values (dir name _) (split-path path))
dir]))
(define pdf-path (setup-pdf-path pdf-path-arg))
(unless replace-existing-file?
@ -176,31 +191,34 @@
#:auto-first-page #false
#:output-path pdf-path))
(parameterize ([current-pdf the-pdf]
;; set `current-directory` so that ops like `path->complete-path`
;; will be handled relative to the original directory
[current-directory base-dir]
[verbose-quad-printing? #false])
(define qs (time-log setup-qs (setup-qs qx-arg pdf-path)))
(define sections
(for/list ([qs (in-list (filter-split qs section-break-quad?))])
(match-define (list page-width page-height) (parse-page-size (and (pair? qs) (car 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 page-width page-height) (parse-page-size (and (pair? qs) (car 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))
(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)))
(struct-copy quad q:section [elems page-qs])))
(struct-copy quad q:section [elems page-qs])))
(define doc (time-log position (position (struct-copy quad q:doc [elems sections]))))
(time-log draw (draw doc (current-pdf))))

Write Preview
Loading…
Cancel
Save