101 lines
3.8 KiB
Racket
101 lines
3.8 KiB
Racket
#lang scheme/base
|
|
|
|
(require scribble/manual
|
|
scribble/core
|
|
scribble/decode
|
|
scribble/html-properties
|
|
scribble/latex-properties
|
|
setup/main-collects
|
|
"private/counter.rkt")
|
|
|
|
(provide figure
|
|
figure*
|
|
figure**
|
|
figure-here
|
|
Figure-target
|
|
Figure-ref
|
|
figure-ref
|
|
(rename-out [leftfigure-style left]
|
|
[leftfiguremulti-style leftfiguremulti]
|
|
[leftfiguremultiwide-style leftfiguremultiwide]))
|
|
|
|
(define figure-style-extras
|
|
(let ([abs (lambda (s)
|
|
(path->main-collects-relative
|
|
(collection-file-path s "scriblib")))])
|
|
(list (make-css-addition (abs "figure.css"))
|
|
(make-tex-addition (abs "figure.tex")))))
|
|
|
|
(define herefigure-style (make-style "Herefigure" figure-style-extras))
|
|
(define figureinside-style (make-style "FigureInside" figure-style-extras))
|
|
(define legend-style (make-style "Legend" figure-style-extras))
|
|
|
|
(define centertext-style (make-style "Centertext" figure-style-extras))
|
|
(define figure-style (make-style "Figure" figure-style-extras))
|
|
|
|
(define centerfigure-style (make-style "Centerfigure" figure-style-extras))
|
|
(define centerfiguremulti-style (make-style "CenterfigureMulti" figure-style-extras))
|
|
(define centerfiguremultiwide-style (make-style "CenterfigureMultiWide" figure-style-extras))
|
|
|
|
(define leftfigure-style (make-style "Leftfigure" figure-style-extras))
|
|
(define leftfiguremulti-style (make-style "LeftfigureMulti" figure-style-extras))
|
|
(define leftfiguremultiwide-style (make-style "LeftfigureMultiWide" figure-style-extras))
|
|
|
|
(define (figure tag caption #:style [style centerfigure-style] . content)
|
|
(apply figure-helper figure-style style tag caption content))
|
|
|
|
(define (figure-here tag caption . content)
|
|
(apply figure-helper herefigure-style centerfigure-style tag caption content))
|
|
|
|
(define (figure-helper figure-style content-style tag caption . content)
|
|
(make-nested-flow
|
|
figure-style
|
|
(list
|
|
(make-nested-flow content-style (list (make-nested-flow figureinside-style (decode-flow content))))
|
|
(make-paragraph centertext-style (list (make-element legend-style (list (Figure-target tag) ": " caption)))))))
|
|
|
|
(define (*figure style tag caption content)
|
|
(make-nested-flow
|
|
style
|
|
(list
|
|
(make-nested-flow
|
|
figureinside-style
|
|
(append
|
|
(decode-flow content)
|
|
(list
|
|
(make-paragraph
|
|
plain
|
|
(list (make-element legend-style (list (Figure-target tag) ": " caption))))))))))
|
|
|
|
(define (figure* tag caption . content)
|
|
(*figure centerfiguremulti-style tag caption content))
|
|
(define (figure** tag caption . content)
|
|
(*figure centerfiguremultiwide-style tag caption content))
|
|
|
|
(define figures (new-counter "figure"))
|
|
(define (Figure-target tag)
|
|
(counter-target figures tag "Figure"))
|
|
|
|
(define (ref-proc initial)
|
|
(case-lambda
|
|
[(tag)
|
|
(make-element #f (list (counter-ref figures tag (string-append initial "igure"))))]
|
|
[(tag1 tag2)
|
|
(make-element #f (list (counter-ref figures tag1 (string-append initial "igures"))
|
|
" and "
|
|
(counter-ref figures tag2 #f)))]
|
|
[(tag . tags)
|
|
(make-element #f (cons (counter-ref figures tag (string-append initial "igures"))
|
|
(let loop ([tags tags])
|
|
(cond
|
|
[(null? (cdr tags))
|
|
(list ", and "
|
|
(counter-ref figures (car tags) #f))]
|
|
[else
|
|
(list* ", "
|
|
(counter-ref figures (car tags) #f)
|
|
(loop (cdr tags)))]))))]))
|
|
|
|
(define Figure-ref (ref-proc "F"))
|
|
(define figure-ref (ref-proc "f"))
|