diff --git a/quad/qtest/all.rkt b/quad/qtest/all.rkt index dac4223f..1bb5ba2c 100644 --- a/quad/qtest/all.rkt +++ b/quad/qtest/all.rkt @@ -36,4 +36,5 @@ "test-fallback-super.rkt" "test-hello.rkt" "test-kafka.rkt" - "test-symbol.rkt") + "test-symbol.rkt" + "test-image.rkt") diff --git a/quad/qtest/test-docs-tester.pdf b/quad/qtest/test-docs-tester.pdf index 44329d3e..279185dc 100644 Binary files a/quad/qtest/test-docs-tester.pdf and b/quad/qtest/test-docs-tester.pdf differ diff --git a/quad/qtest/test-emoji-tester.pdf b/quad/qtest/test-emoji-tester.pdf index 1cebc9d0..71105cff 100644 Binary files a/quad/qtest/test-emoji-tester.pdf and b/quad/qtest/test-emoji-tester.pdf differ diff --git a/quad/qtest/test-fallback-mini-tester.pdf b/quad/qtest/test-fallback-mini-tester.pdf index 64404908..386e963b 100644 Binary files a/quad/qtest/test-fallback-mini-tester.pdf and b/quad/qtest/test-fallback-mini-tester.pdf differ diff --git a/quad/qtest/test-fallback-super-tester.pdf b/quad/qtest/test-fallback-super-tester.pdf index a4c29472..ea9135bc 100644 Binary files a/quad/qtest/test-fallback-super-tester.pdf and b/quad/qtest/test-fallback-super-tester.pdf differ diff --git a/quad/qtest/test-hello-tester.pdf b/quad/qtest/test-hello-tester.pdf index 25bbf488..24ce8b15 100644 Binary files a/quad/qtest/test-hello-tester.pdf and b/quad/qtest/test-hello-tester.pdf differ diff --git a/quad/qtest/test-image-tester.pdf b/quad/qtest/test-image-tester.pdf new file mode 100644 index 00000000..528000f7 Binary files /dev/null and b/quad/qtest/test-image-tester.pdf differ diff --git a/quad/qtest/test-jpeg.rkt b/quad/qtest/test-image.rkt similarity index 100% rename from quad/qtest/test-jpeg.rkt rename to quad/qtest/test-image.rkt diff --git a/quad/qtest/test-kafka-tester.pdf b/quad/qtest/test-kafka-tester.pdf index 32dfe75e..e9ecfe19 100644 Binary files a/quad/qtest/test-kafka-tester.pdf and b/quad/qtest/test-kafka-tester.pdf differ diff --git a/quad/qtest/test-symbol-tester.pdf b/quad/qtest/test-symbol-tester.pdf index 015655e7..96e9f7df 100644 Binary files a/quad/qtest/test-symbol-tester.pdf and b/quad/qtest/test-symbol-tester.pdf differ diff --git a/quad/qtest/test-symbol.rkt b/quad/qtest/test-symbol.rkt index dd0639fc..d31c58ea 100644 --- a/quad/qtest/test-symbol.rkt +++ b/quad/qtest/test-symbol.rkt @@ -1,5 +1,7 @@ #lang quadwriter/markdown ``` -foo -``` \ No newline at end of file +excl-middl→¬¬-elim : ∀ {A : Set} → A ⊎ ¬ A → (¬ ¬ A → A) +excl-middl→¬¬-elim (inj₁ a) = λ ¬¬a → a +excl-middl→¬¬-elim (inj₂ ¬a) = λ ¬¬a → ⊥-elim (¬¬a ¬a) +``` diff --git a/quad/quadwriter/attrs.rkt b/quad/quadwriter/attrs.rkt index b9abfba8..19204e91 100644 --- a/quad/quadwriter/attrs.rkt +++ b/quad/quadwriter/attrs.rkt @@ -137,7 +137,10 @@ Naming guidelines line-wrap image-data + image-object image-alt + image-height + image-width page-width page-height diff --git a/quad/quadwriter/layout.rkt b/quad/quadwriter/layout.rkt index 535a6bed..6934836d 100644 --- a/quad/quadwriter/layout.rkt +++ b/quad/quadwriter/layout.rkt @@ -54,10 +54,10 @@ (define-quad image-quad quad ()) (define (q:image-draw q doc) - (define src (quad-ref q :image-data)) + (define img (quad-ref q :image-object)) (match-define (list x y) (quad-origin q)) (match-define (list w h) (size q)) - (image doc src x y + (image doc img x y #:width w #:height h)) @@ -99,14 +99,26 @@ [(line-break-quad? q) q] [(match (quad-ref q :image-data) [#false #false] - [(? file-exists?) + [(? file-exists? path-string) + (define img-obj (open-image (current-pdf) path-string)) + (define img-width ($img-width img-obj)) + (define img-height ($img-height img-obj)) + (match-define (list layout-width layout-height) + (match (list (quad-ref q :image-width) (quad-ref q :image-height)) + [(list (? number? w) (? number? h)) (list w h)] + [(list #false (? number? h)) (define ratio (/ h img-height)) + (list (* ratio img-width) h)] + [(list (? number? w) #false) (define ratio (/ w img-width)) + (list w (* ratio img-height))])) (struct-copy image-quad q:image [attrs #:parent quad (let ([h (hash-copy (quad-attrs q))]) ;; defeat 'bi 'bo positioning by removing font reference (hash-set! h font-path-key #false) + ;; save the img-obj for later + (hash-set! h :image-object img-obj) h)] - [size #:parent quad (pt 100 100)])] + [size #:parent quad (pt layout-width layout-height)])] [bad-path (raise-argument-error 'quadwriter "image path that exists" bad-path)])] [else (struct-copy diff --git a/quad/quadwriter/render.rkt b/quad/quadwriter/render.rkt index eddf30ea..0509592c 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 @@ -106,35 +106,18 @@ :font-size (number->string default-font-size) :line-height (number->string (floor (* default-line-height-multiplier default-font-size)))) super-qexpr))) (setup-font-path-table! pdf-path) - (define atomized-qs - (time-log atomize (atomize the-quad + (define atomized-qs (atomize the-quad #:attrs-proc handle-cascading-attrs #:missing-glyph-action 'fallback #:fallback "fallback" #:emoji "fallback-emoji" #:math "fallback-math" - #:font-path-resolver resolve-font-path!))) + #:font-path-resolver resolve-font-path!)) (define hyphenated-qs (time-log hyphenate (handle-hyphenate atomized-qs))) (define typed-quads (map generic->typed-quad hyphenated-qs)) (define indented-qs (insert-first-line-indents typed-quads)) indented-qs) -(define (setup-pdf qs pdf-path compress?) - ;; page size can be specified by name, or measurements. - ;; 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)]) - (match (quad-ref (car qs) k) - [#false #false] - [val (parse-dimension val 'round)]))) - ;; `make-pdf` will sort out conflicts among page dimensions - (make-pdf #:compress compress? - #:auto-first-page #false - #:output-path pdf-path - #:width (or (debug-page-width) page-width) - #:height (or (debug-page-height) page-height) - #:size (quad-ref (car qs) :page-size default-page-size) - #:orientation (quad-ref (car qs) :page-orientation default-page-orientation))) - (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))))) @@ -170,6 +153,19 @@ (define (setup-column-gap qs) (or (debug-column-gap) (quad-ref (car qs) :column-gap default-column-gap))) +(define (set-page-size! the-pdf qs) + ;; page size can be specified by name, or measurements. + ;; 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)]) + (match (and (pair? qs) (quad-ref (car qs) k)) + [#false #false] + [val (parse-dimension val 'round)]))) + (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))) (define/contract (render-pdf qx-arg pdf-path-arg #:replace [replace? #t] @@ -180,11 +176,16 @@ (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)) - - (define qs (setup-qs qx-arg pdf-path)) - (parameterize ([current-pdf (setup-pdf qs pdf-path compress?)] + (define the-pdf (make-pdf #:compress compress? + #:auto-first-page #false + #:output-path pdf-path)) + (parameterize ([current-pdf the-pdf] [verbose-quad-printing? #false]) + (define qs (time-log setup-qs (setup-qs qx-arg pdf-path))) + + (set-page-size! the-pdf 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)) diff --git a/quad/quadwriter/tags.rkt b/quad/quadwriter/tags.rkt index 92d488dd..2cedfdbc 100644 --- a/quad/quadwriter/tags.rkt +++ b/quad/quadwriter/tags.rkt @@ -33,6 +33,7 @@ (define-tag-function (img attrs exprs) (qexpr (list->attrs :line-height "false" + :image-height "150" :line-align-last "center" ; need `last` because img is a block-level element. :image-data (second (assq 'src attrs)) :image-alt (second (assq 'alt attrs))