start image support (#35)

quad/qtest/test-jpeg.rkt

@@ -0,0 +1,7 @@
+#lang quadwriter/markdown
+
+Foo
+
+![alt text](test.jpeg)
+
+Bar

quad/quadwriter/attrs.rkt

@@ -134,6 +134,9 @@ Naming guidelines
 
                            line-wrap
 
+                           image-data
+                           image-alt
+
                            page-width
                            page-height
                            page-size ; e.g., "letter"

quad/quadwriter/layout.rkt

@@ -51,6 +51,28 @@
                     #:draw q:string-draw
                     #:draw-end q:string-draw-end))
 
+(define-quad image-quad quad ())
+
+(define (q:image-draw q doc)
+  (define src (quad-ref q :image-data))
+  (match-define (list x y) (quad-origin q))
+  (match-define (list w h) (size q))
+  (image doc src x y
+         #:width w
+         #:height h))
+
+(define (q:image-draw-end q doc)
+  (when (draw-debug-image?)
+    (draw-debug q doc "orange" "orange")))
+
+(define q:image (q #:type image-quad
+                   #:from 'bo
+                   #:to 'bi
+                   #:id 'image
+                   #:printable #true
+                   #:draw q:image-draw
+                   #:draw-end q:image-draw-end))
+
 (define (make-size-promise q [str-arg #f])
   (delay
     (define pdf (current-pdf))
@@ -72,15 +94,26 @@
         [else 0]))
     (list string-size (quad-ref q :line-height (current-line-height pdf)))))
 
-(define (->string-quad q)
-  (match q
-    [(? line-break-quad?) q]
-    [_
+(define (generic->typed-quad q)
+  (cond
+    [(line-break-quad? q) q]
+    [(match (quad-ref q :image-data)
+       [#false #false]
+       [(? file-exists?)
+        (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)
+                                h)]
+         [size #:parent quad (pt 100 100)])]
+       [bad-path (raise-argument-error 'quadwriter "image path that exists" bad-path)])]
+    [else
      (struct-copy
       string-quad q:string
       [attrs #:parent quad (let ([attrs (quad-attrs q)])
-               (hash-ref! attrs :font-size default-font-size)
-               attrs)]
+                             (hash-ref! attrs :font-size default-font-size)
+                             attrs)]
       [elems #:parent quad (quad-elems q)]
       [size #:parent quad (make-size-promise q)])]))
 
@@ -299,7 +332,7 @@
           (match-define (list line-width line-height) (quad-size line-q))
           (define new-size (let ()
                              (define line-heights
-                               (filter-map (λ (q) (quad-ref q :line-height)) pcs))
+                               (filter-map (λ (q) (pt-y (size q))) pcs))
                              (pt line-width (if (empty? line-heights) line-height (apply max line-heights)))))
           (list
            (struct-copy

quad/quadwriter/param.rkt

@@ -12,10 +12,11 @@
          (define current-line-wrap (make-parameter #f)) ; because kp is slow and maybe we want to disable for "draft" mode
          (define quadwriter-test-mode (make-parameter #f)) ; used during rackunit to suppress nondeterministic elements, like timestamp in header
 
-         (define draw-debug? (make-parameter #t))
+         (define draw-debug? (make-parameter #true))
          (define draw-debug-line? (make-parameter #true))
          (define draw-debug-block? (make-parameter #true))
          (define draw-debug-string? (make-parameter #true))
+         (define draw-debug-image? (make-parameter #true))
 
          (define debug-page-width (make-parameter 400))
          (define debug-page-height (make-parameter 400))
@@ -37,6 +38,7 @@
          (define draw-debug-line? (make-parameter #true))
          (define draw-debug-block? (make-parameter #true))
          (define draw-debug-string? (make-parameter #true))
+         (define draw-debug-image? (make-parameter #true))
 
          (define debug-page-width (make-parameter #f))
          (define debug-page-height (make-parameter #f))

quad/quadwriter/render.rkt

@@ -22,13 +22,6 @@
 (define (setup-pdf-path pdf-path-arg)
   (define fallback-path (build-path (find-system-path 'temp-dir) "quadwriter-temp.pdf"))
   (path->complete-path (simplify-path (expand-user-path (->path (or pdf-path-arg fallback-path))))))
-#|
-(define para-break '(q ((break "para"))))
-(define line-break '(q ((break "line"))))
-(define page-break '(q ((break "page"))))
-(define column-break '(q ((break "column"))))
-(define hr-break '(q ((break "hr"))))
-|#
 
 
 (define-syntax (define-break-types stx)
@@ -92,8 +85,8 @@
                                #:math "fallback-math"
                                #:font-path-resolver resolve-font-path))]
   [define hyphenated-qs (time-log hyphenate (handle-hyphenate atomized-qs))]
-  [define stringified-qs (map ->string-quad hyphenated-qs)]
-  [define indented-qs (insert-first-line-indents stringified-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?)

quad/quadwriter/tags.rkt

@@ -25,6 +25,14 @@
                   :display (symbol->string (gensym)))
                  attrs) exprs))
 
+(define div p)
+
+(define-tag-function (img attrs exprs)
+  (qexpr (list->attrs
+                  :image-data (second (assq 'src attrs))
+                  :image-alt (second (assq 'alt attrs))
+                  :display (symbol->string (gensym))) exprs))
+
 (define-tag-function (br attrs exprs) line-break)
 
 (define-tag-function (hr attrs exprs) hr-break)