◊(Local Yarn Code "Check-in [e5a492af]")

  ◊url[1]{https://google.com}
}|

The @code{url} tag for a given identifier may be placed anywhere in the document, even before it is
referenced. If you create a @code{link} for an identifier that has no corresponding @code{url},
a @code{"Missing reference: [link-id]"} message will be substituted for the URL. Conversely, 
creating a @code{url} that is never referenced will produce no output and no warnings or errors.

@deftogether[(@defproc[(figure     [image-file string?] [caption xexpr?] ...) txexpr?]
              @defproc[(figure-@2x [image-file string?] [caption xexpr?] ...) txexpr?])]

Insert a block-level image. The @racket[_image-file] should be supplied as a filename only, with no
folder names. It is assumed that the image is located inside an @racket[images-folder] within the
same folder as the source document.

For web output, using @racket[figure-@2x] will produce an image hard-coded to display at half its
actual size, or the width of the text block, whichever is smaller.

@deftogether[(@defproc[(fn    [fn-id stringish?]) txexpr?]
              @defproc[(fndef [fn-id stringish?] [elements xexpr?] ...) txexpr?])]

As with hyperlinks, footnotes are specified reference-style. In the output, footnotes will be
numbered according to the order in which their identifiers are referenced in the source document.

(poly-branch-tag center)
(poly-branch-tag section)
(poly-branch-tag subsection)
(poly-branch-tag code)
(poly-branch-tag dialogue)
(poly-branch-tag say)
(poly-branch-tag index)
(poly-branch-tag figure)
(poly-branch-tag figure-@2x)
(poly-branch-kwargs-tag blockcode)
(poly-branch-kwargs-tag verse)          ; [#:title ""] [#:italic "no"]

(poly-branch-tag link)
(poly-branch-tag url)
(poly-branch-tag fn)
(poly-branch-tag fndef)

(poly-branch-kwargs-tag note)
(poly-branch-tag block)

;; Not yet implemented
; (poly-branch-tag table)         ; #:columns ""
; (poly-branch-tag inline-math)
; (poly-branch-tag margin-note)
; (poly-branch-tag noun)
; (poly-branch-func index-entry entry)

; (poly-branch-tag spot-illustration) ; #:src "img--sans-path.png" [#:has-print-version? "yes"]

;; My pet shortcut for for/splice. Greatly cuts down on parentheses for the
;; most common use case (looping through a single list).
(define-syntax (for/s stx)
  (syntax-case stx ()
    [(_ thing listofthings result-expr ...)
     #'(for/splice ([thing (in-list listofthings)]) result-expr ...)]))

#lang racket/base

; SPDX-License-Identifier: BlueOak-1.0.0
; This file is licensed under the Blue Oak Model License 1.0.0.

;; 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
         html-fndef)

;;  (define html-p (default-tag-function 'p)
(define-syntax (provide/define-html-default-tags stx)
  (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)))])
         #'(begin
             (provide HTML-TAG-FUNC ...)
             (define HTML-TAG-FUNC (default-tag-function 'HTML-TAG)) ...)))]))

;; Here we go:
(provide/define-html-default-tags p
                                  b

         html-subsection
         html-newthought
         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
         html-fn
         html-fndef

  (let* ([title  (maybe-attr 'title attrs "")]
         [italic? (assoc 'italic attrs)]
         [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
    (and (txexpr? tx)
         (eq? 'span (get-tag tx))

(define (html-fndef . elems)
  (hash-set! fn-definitions (format "~a" (first elems)) (rest elems)))

;; 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))))
  (cond [(null? note-items) ""]
        [else `(section ((class "footnotes")) (hr) (ol ,@note-items))]))

(define (html-note attrs elems)
  (txexpr 'note attrs (decode-hardwrapped-paragraphs elems)))

    figure>a {
        margin: 0;
        padding: 0;
        font-family: arial, sans-serif;
    }
    figure img {
        max-width: 100%;
        margin: 0 auto;
    }

    figcaption {
        font-size: 0.8rem;
        line-height: ◊derive-lineheight[4 #:per-lines 3];
        margin-bottom: 0.3rem;
        text-align: left;
    }

    dl {
        margin: ◊x-lineheight[1] 0;
    }