@@ -6,12 +6,15 @@
 ;; Tag functions used by pollen.rkt when HTML is the output format.
 
 (require (for-syntax racket/base racket/syntax))
 (require racket/list
          racket/function
+         racket/draw
+         racket/class
          pollen/decode
          pollen/tag
+         pollen/setup
          net/uri-codec
          txexpr
          "dust.rkt")
 
 (provide html-fn
@@ -30,11 +33,11 @@
   (syntax-case stx ()
     [(_ TAG ...)
      (let ([tags (syntax->list #'(TAG ...))])
        (with-syntax ([((HTML-TAG-FUNC HTML-TAG) ...)
                       (for/list ([htag (in-list tags)])
-                                (list (format-id stx "html-~a" (syntax-e htag)) (syntax-e htag)))])
+                        (list (format-id stx "html-~a" (syntax-e htag)) (syntax-e htag)))])
          #'(begin
              (provide HTML-TAG-FUNC ...)
              (define HTML-TAG-FUNC (default-tag-function 'HTML-TAG)) ...)))]))
 
 ;; Here we go:
@@ -58,10 +61,12 @@
          html-smallcaps
          html-center
          html-block
          html-blockcode
          html-index
+         html-figure
+         html-figure-@2x
          html-dialogue
          html-say
          html-verse
          html-link
          html-url
@@ -115,10 +120,42 @@
          [pre-attrs (cond [italic? '([class "verse"] [style "font-style: italic"])]
                           [else '([class "verse"])])]
          [pre-title (cond [(string>? title "") `(p [[class "verse-heading"]] ,title)]
                           [else ""])])
     `(div [[class "poem"]] ,pre-title (pre ,pre-attrs ,@elems))))
+
+;; (Private) Get the dimensions of an image file
+(define (get-image-size filepath)
+  (define bmp (make-object bitmap% filepath))
+  (list (send bmp get-width) (send bmp get-height)))
+
+;; (Private) Builds a path to an image in the [image-dir] subfolder of the current document's 
+;; folder, relative to the current document’s folder
+(define (image-source basename)
+  (define here-path (string->path (maybe-meta 'here-path)))
+  (define-values (_ here-rel-path-parts)
+    (drop-common-prefix (explode-path (current-project-root))
+                        (explode-path here-path)))
+  (let* ([folder-parts (drop-right here-rel-path-parts 1)]
+         [img-path-parts (append folder-parts (list images-folder basename))]
+         [img-path (apply build-path/convention-type 'unix img-path-parts)])
+    (path->string img-path)))
+
+(define (html-figure-@2x . elems)
+  (define src (image-source (car elems)))
+  (define alt-text (tx-strs `(span ,@(cdr elems))))
+  (define img-width (car (get-image-size (build-path (current-project-root) src))))
+  (define style-str (format "width: ~apx" (/ img-width 2.0)))
+  `(figure (img [[alt ,alt-text] [style ,style-str] [src ,(string-append web-root src)]])
+           (figcaption ,@(cdr elems))))
+
+(define (html-figure . elems)
+  (define src (string-append web-root (image-source (car elems))))
+  (define alt-text (tx-strs `(span ,@(cdr elems))))
+  `(figure [[class "fullwidth"]]
+           (img [[alt ,alt-text] [src ,src]])
+           (figcaption ,@(cdr elems))))
 
 ;; There is no way in vanilla CSS to create a selector for “p tags that contain
 ;; a span of class ‘newthought’”. So we can handle it at the Pollen processing level.
 (define (detect-newthoughts block-xpr)
   (define (is-newthought? tx) ; Helper function
@@ -179,18 +216,18 @@
 
 ;; Private use (by html-root)
 (define (html-footnote-block)
   (define note-items
     (for/list ([fn-name (in-list (remove-duplicates (reverse fn-names)))])
-              (let* ([definition-text (or (hash-ref fn-definitions fn-name #f)
-                                          '((i "Missing footnote definition!")))]
-                     [backref-count (count (curry string=? fn-name) fn-names)]
-                     [backrefs (for/list ([fnref-num (in-range backref-count)])
-                                         `(a [[href ,(string-append "#"
-                                                                    (fn-id fn-name)
-                                                                    (format "~a" (+ 1 fnref-num)))]] "↩"))])
-                `(li [[id ,(fndef-id fn-name)]] ,@definition-text ,@backrefs))))
+      (let* ([definition-text (or (hash-ref fn-definitions fn-name #f)
+                                  '((i "Missing footnote definition!")))]
+             [backref-count (count (curry string=? fn-name) fn-names)]
+             [backrefs (for/list ([fnref-num (in-range backref-count)])
+                         `(a [[href ,(string-append "#"
+                                                    (fn-id fn-name)
+                                                    (format "~a" (+ 1 fnref-num)))]] "↩"))])
+        `(li [[id ,(fndef-id fn-name)]] ,@definition-text ,@backrefs))))
   (cond [(null? note-items) ""]
         [else `(section ((class "footnotes")) (hr) (ol ,@note-items))]))
 
 (define (html-note attrs elems)
   (txexpr 'note attrs (decode-hardwrapped-paragraphs elems)))