-
Notifications
You must be signed in to change notification settings - Fork 0
/
simple-itemize.satyh
242 lines (205 loc) · 6.89 KB
/
simple-itemize.satyh
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
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
@require: base/list-ext
@require: option
@require: gr
@require: color
@require: vdecoset
module SimpleItemize :sig
direct \item : [inline-text?; (context -> int list -> inline-text -> inline-boxes)?; bool?; inline-text] inline-cmd
direct +listing : [(context -> int list -> inline-text -> inline-boxes)?; bool?; inline-text list] block-cmd
direct +enumerate : [(context -> int list -> inline-text -> inline-boxes)?; bool?; inline-text list] block-cmd
direct +description : [(context -> int list -> inline-text -> inline-boxes)?; bool?; inline-text list] block-cmd
direct \listing : [(context -> int list -> inline-text -> inline-boxes)?; bool?; inline-text list] inline-cmd
direct \enumerate : [(context -> int list -> inline-text -> inline-boxes)?; bool?; inline-text list] inline-cmd
direct \description : [(context -> int list -> inline-text -> inline-boxes)?; bool?; inline-text list] inline-cmd
end = struct
let minus = float (-1)
let default-listing ctx lst title =
let text-width = get-text-width ctx in
let main-size = (get-font-size ctx) *' 0.5 in
let gr-lst =
match (List.length lst) mod 3 with
| 1 ->
[
Gr.circle (main-size*'0.5,main-size*'0.5) (main-size *' 0.4)
|> fill Color.black
]
| 2 ->
[
Gr.polygon (0pt,0pt) [(main-size, main-size *' 0.5); (0pt, main-size)]
|> fill Color.black
]
| _ ->
[
Gr.polygon (main-size *' 0.5, main-size)
[
(0pt, main-size *' 0.5);
(main-size *' 0.5, 0pt);
(main-size, main-size *' 0.5);
]
|> fill Color.black
]
in
let circle-ib =
let main =
inline-graphics main-size main-size 0pt
(fun pt -> List.map (shift-graphics pt) gr-lst)
in
inline-skip 3pt ++ main ++ inline-skip 3pt
in
circle-ib
let default-enumerate ctx lst title =
let num-opt = List.head lst in
let num-str =
match num-opt with
| None -> ` `
| Some(n) -> `(` ^ arabic n ^ `)`
in
let title-ib =
num-str |> embed-string |> read-inline ctx
in
inline-skip 3pt ++ title-ib ++ inline-skip 3pt
let default-description ctx lst title =
let d-ctx =
ctx
|> set-font Kana (`ipaexg`, 0.88, 0.0)
|> set-font HanIdeographic (`ipaexg`, 0.88, 0.0)
|> set-font Latin (`lmsans`, 0.88, 0.0)
in
let title-ib = read-inline d-ctx title in
inline-skip 3pt ++ title-ib ++ inline-skip 3pt
type t =
| Nothing
| Listing
| Enumerate
| Description
let is-Nothing t =
match t with
| Nothing -> true
| _ -> false
let equal-t t1 t2 =
match (t1, t2) with
| (Nothing,_) -> true
| (_,Nothing) -> true
| (Listing,Listing) -> true
| (Enumerate,Enumerate) -> true
| (Description,Description) -> true
| _ -> false
let-mutable t-ref <- Nothing
let-mutable if-break <- false
let-mutable count-lst <- []
let-mutable title-fun <- default-listing
let-inline ctx \item ?:title-opt?:f-opt ?:break-opt inner =
let main-font-size = get-font-size ctx in
let old-lst = !count-lst in
let head =
List.head old-lst |> Option.from 0
in
let tail-lst =
List.tail old-lst |> Option.from []
in
let () = count-lst <- (head+1) :: tail-lst in
let new-lst = !count-lst in
let f =
match f-opt with
| None -> !title-fun
| Some(f) -> f
in
let title =
match title-opt with
| None -> {}
| Some(it) -> it
in
let is-break =
match break-opt with
| None -> !if-break
| Some(b) -> b
in
let title-ib = f ctx new-lst title in
let title-ib-width = get-natural-width title-ib in
let inner-ib = read-inline ctx inner in
let make-non-break-main-bb ctx =
inline-skip (title-ib-width *' minus) ++ title-ib ++ inner-ib ++ inline-fil
|> line-break true true ctx
in
let deco-set = VDecoSet.empty in
let non-break-pads = (title-ib-width, 0pt, 0pt, 0pt) in
let non-break-main-bb =
block-frame-breakable ctx non-break-pads deco-set make-non-break-main-bb
in
let break-pads = (main-font-size, 0pt, 0pt, 0pt) in
let break-main-bb =
let title-bb = line-break true true ctx title-ib in
let inner-bb =
block-frame-breakable ctx break-pads deco-set
(fun ctx -> line-break true true ctx (inner-ib ++ inline-fil))
in
title-bb +++ inner-bb
in
if is-break then
inline-fil ++ embed-block-breakable ctx break-main-bb
else
inline-fil ++ embed-block-breakable ctx non-break-main-bb
let make-itemize ctx f-default f-opt break-default break-opt change-bool itemize =
let old-default-f = !title-fun in
let old-default-break = !if-break in
let old-default-lst = !count-lst in
let () =
if change-bool then
count-lst <- 0::!count-lst
else
count-lst <- []
in
let f =
match f-opt with
| None -> f-default
| Some(f) -> f
in
let () = title-fun <- f in
let () =
match break-opt with
| None -> if-break <- break-default
| Some(b) -> if-break <- b
in
let make-bb it =
let ctx =
ctx
|> set-paragraph-margin 0pt 0pt
in
let ib = read-inline ctx it in
ib ++ inline-fil
|> line-break true true ctx
in
let main-bb =
itemize
|> List.map make-bb
|> List.fold-left (+++) block-nil
in
let () = title-fun <- old-default-f in
let () = if-break <- old-default-break in
let () = count-lst <- old-default-lst in
main-bb
let listing ctx f-opt break-opt itemize =
let b = equal-t Listing !t-ref in
let () = t-ref <- Listing in
make-itemize ctx default-listing f-opt false break-opt b itemize
let enumerate ctx f-opt break-opt itemize =
let b = equal-t Enumerate !t-ref in
let () = t-ref <- Enumerate in
make-itemize ctx default-enumerate f-opt false break-opt b itemize
let description ctx f-opt break-opt itemize =
let b = equal-t Description !t-ref in
let () = t-ref <- Description in
make-itemize ctx default-description f-opt true break-opt b itemize
let-block ctx +listing ?:f-opt ?:break-opt itemize =
listing ctx f-opt break-opt itemize
let-inline ctx \listing ?:f-opt ?:break-opt itemize =
inline-fil ++ embed-block-breakable ctx (listing ctx f-opt break-opt itemize)
let-block ctx +enumerate ?:f-opt ?:break-opt itemize =
enumerate ctx f-opt break-opt itemize
let-inline ctx \enumerate ?:f-opt ?:break-opt itemize =
inline-fil ++ embed-block-breakable ctx (enumerate ctx f-opt break-opt itemize)
let-block ctx +description ?:f-opt ?:break-opt itemize =
description ctx f-opt break-opt itemize
let-inline ctx \description ?:f-opt ?:break-opt itemize =
inline-fil ++ embed-block-breakable ctx (description ctx f-opt break-opt itemize)
end