|
|
|
@ -57,7 +57,7 @@
|
|
|
|
|
#: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)]))]
|
|
|
|
|
(struct-copy quad q [elems (list substr)]))]
|
|
|
|
|
[else (list q)]))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
@ -66,12 +66,12 @@
|
|
|
|
|
(unless (even? (length pcs))
|
|
|
|
|
(raise-argument-error 'string->feature-list "even number of tags and values" pcs))
|
|
|
|
|
(for/list ([kv (in-slice 2 pcs)])
|
|
|
|
|
(cons (match (first kv)
|
|
|
|
|
[(? string? k) (string->bytes/utf-8 k)]
|
|
|
|
|
[k (raise-argument-error 'string->feature-list "string" k)])
|
|
|
|
|
(match (string->number (second kv))
|
|
|
|
|
[(? number? num) num]
|
|
|
|
|
[v (raise-argument-error 'string->feature-list "number string" v)]))))
|
|
|
|
|
(cons (match (first kv)
|
|
|
|
|
[(? string? k) (string->bytes/utf-8 k)]
|
|
|
|
|
[k (raise-argument-error 'string->feature-list "string" k)])
|
|
|
|
|
(match (string->number (second kv))
|
|
|
|
|
[(? number? num) num]
|
|
|
|
|
[v (raise-argument-error 'string->feature-list "number string" v)]))))
|
|
|
|
|
|
|
|
|
|
(define (parse-font-features! attrs)
|
|
|
|
|
;; `font-features` are OpenType font feature specifiers.
|
|
|
|
@ -106,7 +106,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 (λ (val) (parse-dimension val attrs))))
|
|
|
|
|
(hash-update! attrs k (λ (val) (parse-dimension val attrs))))
|
|
|
|
|
attrs)
|
|
|
|
|
|
|
|
|
|
(define (downcase-values! attrs)
|
|
|
|
@ -114,9 +114,9 @@
|
|
|
|
|
;; 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)
|
|
|
|
@ -125,7 +125,7 @@
|
|
|
|
|
;; 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)
|
|
|
|
@ -138,7 +138,7 @@
|
|
|
|
|
;; because they can be denoted relative to em size
|
|
|
|
|
parse-dimension-strings!
|
|
|
|
|
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.
|
|
|
|
@ -160,11 +160,11 @@
|
|
|
|
|
[else (convert-string-quad q)]))
|
|
|
|
|
|
|
|
|
|
#;(define (extract-defined-quads qs)
|
|
|
|
|
(define (get-define-val q) (quad-ref q 'define))
|
|
|
|
|
(define-values (dqs not-dqs) (partition get-define-val qs))
|
|
|
|
|
(for ([dq-group (in-list (group-by get-define-val dqs))])
|
|
|
|
|
(hash-set! (current-named-quads) (get-define-val (car dq-group)) dq-group))
|
|
|
|
|
not-dqs)
|
|
|
|
|
(define (get-define-val q) (quad-ref q 'define))
|
|
|
|
|
(define-values (dqs not-dqs) (partition get-define-val qs))
|
|
|
|
|
(for ([dq-group (in-list (group-by get-define-val dqs))])
|
|
|
|
|
(hash-set! (current-named-quads) (get-define-val (car dq-group)) dq-group))
|
|
|
|
|
not-dqs)
|
|
|
|
|
|
|
|
|
|
(define default-line-height-multiplier 1.42)
|
|
|
|
|
(define (setup-qs qx-arg base-dir)
|
|
|
|
@ -256,9 +256,9 @@
|
|
|
|
|
(cons :pdf-keywords 'Keywords)))]
|
|
|
|
|
[str (in-value (and (pair? qs) (quad-ref (car qs) k)))]
|
|
|
|
|
#:when str)
|
|
|
|
|
(cons pdf-k str))))
|
|
|
|
|
(cons pdf-k str))))
|
|
|
|
|
(for ([(k v) (in-dict kv-dict)])
|
|
|
|
|
(hash-set! (pdf-info pdf) k v)))
|
|
|
|
|
(hash-set! (pdf-info pdf) k v)))
|
|
|
|
|
|
|
|
|
|
(define (footnote-flow? q) (equal? (quad-ref q 'flow) "footnote"))
|
|
|
|
|
|
|
|
|
@ -292,19 +292,19 @@
|
|
|
|
|
(for ([page (in-list (for*/list ([sec (in-list secs)]
|
|
|
|
|
[elem (in-list (quad-elems sec))]
|
|
|
|
|
#:when (page-quad? elem))
|
|
|
|
|
elem))]
|
|
|
|
|
elem))]
|
|
|
|
|
[page-num (in-naturals 1)]
|
|
|
|
|
[page-side (in-cycle '(right left))])
|
|
|
|
|
(define repeaters-for-this-page
|
|
|
|
|
(for/list ([repeater (in-list repeaters)]
|
|
|
|
|
#:when (let* ([val (quad-ref repeater :page-repeat)]
|
|
|
|
|
[sym (string->symbol val)])
|
|
|
|
|
(or (eq? sym 'all)
|
|
|
|
|
(eq? sym page-side)
|
|
|
|
|
(eq? sym (if (= page-num 1) 'first 'rest)))))
|
|
|
|
|
repeater))
|
|
|
|
|
(when (pair? repeaters-for-this-page)
|
|
|
|
|
(set-quad-elems! page (append repeaters-for-this-page (quad-elems page)))))
|
|
|
|
|
(define repeaters-for-this-page
|
|
|
|
|
(for/list ([repeater (in-list repeaters)]
|
|
|
|
|
#:when (let* ([val (quad-ref repeater :page-repeat)]
|
|
|
|
|
[sym (string->symbol val)])
|
|
|
|
|
(or (eq? sym 'all)
|
|
|
|
|
(eq? sym page-side)
|
|
|
|
|
(eq? sym (if (= page-num 1) 'first 'rest)))))
|
|
|
|
|
repeater))
|
|
|
|
|
(when (pair? repeaters-for-this-page)
|
|
|
|
|
(set-quad-elems! page (append repeaters-for-this-page (quad-elems page)))))
|
|
|
|
|
secs)
|
|
|
|
|
|
|
|
|
|
(define (make-sections all-qs)
|
|
|
|
@ -355,20 +355,20 @@
|
|
|
|
|
(for/list ([page (in-list section-pages-without-repeaters)]
|
|
|
|
|
[page-num (in-naturals 1)]
|
|
|
|
|
[page-side (in-cycle ((if (eq? section-starting-side 'right) values reverse) '(right left)))])
|
|
|
|
|
(define section-repeaters-for-this-page
|
|
|
|
|
(for/list ([repeater (in-list section-repeaters)]
|
|
|
|
|
#:when (let* ([val (quad-ref repeater :page-repeat)]
|
|
|
|
|
[sym (string->symbol (string-trim val #px"section\\s"))])
|
|
|
|
|
(or (eq? sym 'section)
|
|
|
|
|
(eq? sym 'all)
|
|
|
|
|
(eq? sym page-side)
|
|
|
|
|
(eq? sym (if (= page-num 1) 'first 'rest)))))
|
|
|
|
|
repeater))
|
|
|
|
|
(cond
|
|
|
|
|
[(null? section-repeaters-for-this-page) page]
|
|
|
|
|
[else
|
|
|
|
|
(quad-copy page-quad page
|
|
|
|
|
[elems (append section-repeaters-for-this-page (quad-elems page))])])))
|
|
|
|
|
(define section-repeaters-for-this-page
|
|
|
|
|
(for/list ([repeater (in-list section-repeaters)]
|
|
|
|
|
#:when (let* ([val (quad-ref repeater :page-repeat)]
|
|
|
|
|
[sym (string->symbol (string-trim val #px"section\\s"))])
|
|
|
|
|
(or (eq? sym 'section)
|
|
|
|
|
(eq? sym 'all)
|
|
|
|
|
(eq? sym page-side)
|
|
|
|
|
(eq? sym (if (= page-num 1) 'first 'rest)))))
|
|
|
|
|
repeater))
|
|
|
|
|
(cond
|
|
|
|
|
[(null? section-repeaters-for-this-page) page]
|
|
|
|
|
[else
|
|
|
|
|
(quad-copy page-quad page
|
|
|
|
|
[elems (append section-repeaters-for-this-page (quad-elems page))])])))
|
|
|
|
|
|
|
|
|
|
(begin0
|
|
|
|
|
(cond
|
|
|
|
@ -400,6 +400,28 @@
|
|
|
|
|
(cons new-section sections-acc)])
|
|
|
|
|
(section-pages-used (+ (section-pages-used) (length section-pages))))))
|
|
|
|
|
|
|
|
|
|
(define (resolve-parents doc)
|
|
|
|
|
;; resolve location of any quad with a dynamic anchor-parent attribute like @line:1
|
|
|
|
|
(for* ([section (in-list (quad-elems doc))]
|
|
|
|
|
[(page page-idx) (in-indexed (quad-elems section))]
|
|
|
|
|
#:when (page-quad? page))
|
|
|
|
|
(define unresolved-qs
|
|
|
|
|
(let loop ([x page])
|
|
|
|
|
(match x
|
|
|
|
|
[(? quad?) ((if (quad-ref x :anchor-parent)
|
|
|
|
|
(λ (tail) (cons x tail))
|
|
|
|
|
values) (append-map loop (quad-elems x)))]
|
|
|
|
|
[_ null])))
|
|
|
|
|
(for ([line (in-list (quad-elems page))]
|
|
|
|
|
[line-num (in-naturals 1)]
|
|
|
|
|
#:when (line-quad? line))
|
|
|
|
|
(define line-key (format "@line:~a" line-num))
|
|
|
|
|
#R line-key
|
|
|
|
|
(for ([uq (in-list unresolved-qs)]
|
|
|
|
|
#:when (equal? (quad-ref uq :anchor-parent) line-key))
|
|
|
|
|
(quad-update! line [elems (append (quad-elems line) (list uq))]))))
|
|
|
|
|
doc)
|
|
|
|
|
|
|
|
|
|
(define (correct-line-alignment doc)
|
|
|
|
|
;; correct lines with inner / outer alignment
|
|
|
|
|
;; all inner / outer lines are initially filled as if they were right-aligned
|
|
|
|
@ -407,16 +429,16 @@
|
|
|
|
|
(for* ([section (in-list (quad-elems doc))]
|
|
|
|
|
[(page page-idx) (in-indexed (quad-elems section))]
|
|
|
|
|
#:when (page-quad? page))
|
|
|
|
|
(define right-side? (odd? (add1 page-idx)))
|
|
|
|
|
(define zero-filler-side (if right-side? "inner" "outer"))
|
|
|
|
|
(let loop ([x page])
|
|
|
|
|
(cond
|
|
|
|
|
[(and (line-quad? x)
|
|
|
|
|
(equal? zero-filler-side (quad-ref x :line-align))
|
|
|
|
|
(filler-quad? (car (quad-elems x))))
|
|
|
|
|
;; collapse the filler quad by setting size to 0
|
|
|
|
|
(set-quad-size! (car (quad-elems x)) (pt 0 0))]
|
|
|
|
|
[(quad? x) (for-each loop (quad-elems x))])))
|
|
|
|
|
(define right-side? (odd? (add1 page-idx)))
|
|
|
|
|
(define zero-filler-side (if right-side? "inner" "outer"))
|
|
|
|
|
(let loop ([x page])
|
|
|
|
|
(cond
|
|
|
|
|
[(and (line-quad? x)
|
|
|
|
|
(equal? zero-filler-side (quad-ref x :line-align))
|
|
|
|
|
(filler-quad? (car (quad-elems x))))
|
|
|
|
|
;; collapse the filler quad by setting size to 0
|
|
|
|
|
(set-quad-size! (car (quad-elems x)) (pt 0 0))]
|
|
|
|
|
[(quad? x) (for-each loop (quad-elems x))])))
|
|
|
|
|
doc)
|
|
|
|
|
|
|
|
|
|
(define/contract (render-pdf qx-arg
|
|
|
|
@ -474,7 +496,10 @@
|
|
|
|
|
(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-update! q:doc [elems (make-sections qs)])))
|
|
|
|
|
(define doc (let* ([doc (quad-update! q:doc [elems (make-sections qs)])]
|
|
|
|
|
[doc (correct-line-alignment doc)]
|
|
|
|
|
[doc (resolve-parents doc)])
|
|
|
|
|
doc))
|
|
|
|
|
;; 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
|
|
|
|
|