-
-
Notifications
You must be signed in to change notification settings - Fork 100
Expand file tree
/
Copy pathfigure.rkt
More file actions
178 lines (161 loc) · 7.29 KB
/
figure.rkt
File metadata and controls
178 lines (161 loc) · 7.29 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
#lang racket/base
(require racket/contract/base
scribble/core
scribble/decode
scribble/html-properties
scribble/latex-properties
scribble/manual
scribble/private/lang-parameters
setup/main-collects
"private/counter.rkt")
(provide figure
figure*
figure**
figure-here
(contract-out
[Figure-target (->* (string?)
(#:continue? any/c)
element?)]
[Figure-ref (->* (string?)
(#:link-render-style link-render-style?)
#:rest (listof string?)
element?)]
[figure-ref (->* (string?)
(#:link-render-style link-render-style?)
#:rest (listof string?)
element?)])
left-figure-style
center-figure-style
right-figure-style
suppress-floats
(rename-out [left-figure-style left]))
(define figure-style-extras
(let ([abs (lambda (s)
(path->main-collects-relative
(collection-file-path s "scriblib")))])
(list 'never-indents
(make-css-addition (abs "figure.css"))
(make-tex-addition (abs "figure.tex")))))
;; outer layer:
(define herefigure-style (make-style "Herefigure" figure-style-extras))
(define figure-style (make-style "Figure" figure-style-extras))
(define figuremulti-style (make-style "FigureMulti" figure-style-extras))
(define figuremultiwide-style (make-style "FigureMultiWide" figure-style-extras))
;; middle layer:
(define center-figure-style (make-style "Centerfigure" figure-style-extras))
(define left-figure-style (make-style "Leftfigure" figure-style-extras))
(define right-figure-style (make-style "Rightfigure" figure-style-extras))
;; inner layer:
(define figureinside-style (make-style "FigureInside" figure-style-extras))
(define legend-style (make-style "Legend" figure-style-extras))
(define legend-continued-style (make-style "LegendContinued" figure-style-extras))
(define centertext-style (make-style "Centertext" figure-style-extras))
;; See "figure.js":
(define figure-target-style
(make-style #f
(list
(make-attributes '((x-target-lift . "Figure")))
(make-js-addition
(path->main-collects-relative
(collection-file-path "figure.js" "scriblib"))))))
(define (make-figure-ref c s)
(element (style "FigureRef" (list* (command-extras (list s))
figure-style-extras))
c))
(define (make-figure-target c s)
(element (style "FigureTarget" (cons (command-extras (list s))
figure-style-extras))
c))
(define (figure tag caption
#:style [style center-figure-style]
#:label-sep [label-sep (default-figure-label-sep)]
#:label-style [label-style #f]
#:continue? [continue? #f]
. content)
(figure-helper figure-style style label-sep label-style tag caption content continue?))
(define (figure-here tag caption
#:style [style center-figure-style]
#:label-sep [label-sep (default-figure-label-sep)]
#:label-style [label-style #f]
#:continue? [continue? #f]
. content)
(figure-helper herefigure-style style label-sep label-style tag caption content continue?))
(define (figure* tag caption
#:style [style center-figure-style]
#:label-sep [label-sep (default-figure-label-sep)]
#:label-style [label-style #f]
#:continue? [continue? #f]
. content)
(figure-helper figuremulti-style style label-sep label-style tag caption content continue?))
(define (figure** tag caption
#:style [style center-figure-style]
#:label-sep [label-sep (default-figure-label-sep)]
#:label-style [label-style #f]
#:continue? [continue? #f]
. content)
(figure-helper figuremultiwide-style style label-sep label-style tag caption content continue?))
(define (figure-helper figure-style content-style label-sep label-style tag caption content continue?)
(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 (if continue?
legend-continued-style
legend-style)
(list (Figure-target tag
#:label-sep label-sep
#:label-style label-style
#:continue? continue?)
(make-element (default-figure-caption-style) caption))))))))
(define figures (new-counter "figure"
#:target-wrap make-figure-target
#:ref-wrap make-figure-ref))
(define (Figure-target tag
#:continue? [continue? #f]
#:label-sep [label-sep ": "]
#:label-style [label-style #f])
(counter-target figures tag
(default-figure-label-text)
#:label-suffix (list (if continue? " (continued)" "") label-sep)
#:label-style label-style
#:target-style figure-target-style
#:continue? continue?))
(define (ref-proc initial)
(lambda (tag #:link-render-style [link-style #f]
. tags)
(cond
[(null? tags)
(make-element
#f
(counter-ref figures tag (string-append initial "igure")
#:link-render-style link-style))]
[(null? (cdr tags))
(define tag1 tag)
(define tag2 (car tags))
(make-element #f (list (counter-ref figures tag1 (string-append initial "igures")
#:link-render-style link-style)
" and "
(counter-ref figures tag2 #f
#:link-render-style link-style)))]
[else
(make-element #f (cons (counter-ref figures tag (string-append initial "igures")
#:link-render-style link-style)
(let loop ([tags tags])
(cond
[(null? (cdr tags))
(list ", and "
(counter-ref figures (car tags) #f
#:link-render-style link-style))]
[else
(list* ", "
(counter-ref figures (car tags) #f
#:link-render-style link-style)
(loop (cdr tags)))]))))])))
(define Figure-ref (ref-proc "F"))
(define figure-ref (ref-proc "f"))
(define (suppress-floats)
(make-element "suppressfloats" null))