main
Matthew Butterick 4 years ago
parent e28ce401cb
commit 25f9eb3a38

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

Loading…
Cancel
Save