improve behavior of img tag (#35 progress)

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

quad/qtest/test-symbol.rkt

@@ -1,5 +1,7 @@
 #lang quadwriter/markdown
 
 ```
-foo
+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)
+```

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

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

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
+                      (list
-                               (format-id #'TYPES "~a-break" type)
+                       (format-id #'TYPES "~a-break" type)
-                               (symbol->string (syntax->datum type))
+                       (symbol->string (syntax->datum type))
-                               (format-id #'TYPES "q:~a-break" 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)
+           (match (quad-ref q :hyphenate)
-                     [#true #:when (and (pair? (quad-elems q))
+             [#true #:when (and (pair? (quad-elems q))
-                                        (andmap string? (quad-elems q)))
+                                (andmap string? (quad-elems q)))
-                            (for*/list ([str (in-list (quad-elems q))]
+                    (for*/list ([str (in-list (quad-elems q))]
-                                        [hyphen-char (in-value #\u00AD)]
+                                [hyphen-char (in-value #\u00AD)]
-                                        [hstr (in-value (hyphenate str hyphen-char
+                                [hstr (in-value (hyphenate str hyphen-char
-                                                                   #:min-left-length 3
+                                                           #:min-left-length 3
-                                                                   #:min-right-length 3))]
+                                                           #:min-right-length 3))]
-                                        [substr (in-list (regexp-match* (regexp (string hyphen-char)) hstr #:gap-select? #t))])
+                                [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)]))]
-                     [_ (list q)]))))
+             [_ (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
+  (define atomized-qs (atomize the-quad
-    (time-log atomize (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))

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