-
Notifications
You must be signed in to change notification settings - Fork 3
/
stjarticle.satyh
850 lines (732 loc) · 28 KB
/
stjarticle.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
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
% -*- coding: utf-8 -*-
%version[1.3.2]
%Repository:https://github.com/puripuri2100/stjarticle
%
%SATySFi:
%https://github.com/gfngfn/SATySFi
%Author:
%(C) Naoki Kaneko and T. Suwa 2018
@require: gr
@require: list
@require: math
@require: color
module Stjarticle : sig
val document : 'a -> block-text -> document
constraint 'a :: (|
title : inline-text;
author : inline-text;
date : inline-text;
normal-font-size : length;
show-toc : bool;
show-title : bool;
show-footer : bool;
show-header : bool;
show-title-deco : bool;
|)
val font-latin-roman : string * float * float
val font-latin-italic : string * float * float
val font-latin-sans : string * float * float
val font-latin-mono : string * float * float
val font-cjk-mincho : string * float * float
val font-cjk-gothic : string * float * float
val set-latin-font : (string * float * float) -> context -> context
val set-cjk-font : (string * float * float) -> context -> context
direct \ref : [string] inline-cmd
direct \ref-page : [string] inline-cmd
direct \figure : [string?; inline-text; block-text] inline-cmd
direct +p : [inline-text] block-cmd
direct +ph : [inline-text] block-cmd
direct +pn : [inline-text] block-cmd
direct +ep : [inline-text] block-cmd
direct +part : [string?; inline-text; block-text] block-cmd
direct +chapter : [string?; inline-text; block-text] block-cmd
direct +section : [string?; inline-text; block-text] block-cmd
direct +subsection : [string?; inline-text; block-text] block-cmd
direct +subsubsection : [string?;inline-text;block-text]block-cmd
direct \textrm : [inline-text] inline-cmd
direct \textbf : [inline-text] inline-cmd
direct \textit : [inline-text] inline-cmd
direct \textsf : [inline-text] inline-cmd
direct \textgt : [inline-text] inline-cmd
direct \textmc : [inline-text] inline-cmd
direct \text-tiny : [inline-text] inline-cmd
direct \text-scriptsize : [inline-text] inline-cmd
direct \text-footnotesize : [inline-text] inline-cmd
direct \text-small : [inline-text] inline-cmd
direct \text-normalsize : [inline-text] inline-cmd
direct \text-large : [inline-text] inline-cmd
direct \text-Large : [inline-text] inline-cmd
direct \text-LARGE : [inline-text] inline-cmd
direct \text-huge : [inline-text] inline-cmd
direct \text-Huge : [inline-text] inline-cmd
direct \font-size : [length; inline-text] inline-cmd
direct \font-size-modify : [float; inline-text] inline-cmd
end = struct
type toc-element =
| TOCElementPart of string * inline-text
| TOCElementChapter of string * inline-text
| TOCElementSection of string * inline-text
| TOCElementSubsection of string * inline-text
let generate-fresh-label =
let-mutable count <- 0 in
(fun () -> (
let () = count <- !count + 1 in
`generated:` ^ (arabic (!count))
))
let-inline ctx \ref key =
let opt = get-cross-reference (key ^ `:num`) in
let it =
match opt with
| None -> {?}
| Some(s) -> embed-string s
in
read-inline ctx it
let-inline ctx \ref-page key =
let opt = get-cross-reference (key ^ `:page`) in
let it =
match opt with
| None -> {?}
| Some(s) -> embed-string s
in
read-inline ctx it
let-mutable font-size-normal-ref <- 0pt
let font-size-title = 34pt
let font-size-author = 16pt
let font-size-date = 16pt
let font-size-part = 28pt
let font-size-chapter = 24pt
let font-size-section = 18pt
let font-size-subsection = 16pt
let font-size-subsubsection = 14pt
let section-top-margin = 20pt
let section-bottom-margin = 12pt
let section-top-padding = 6pt
let section-bottom-padding = 7pt
let section-line-sep = 4pt
let section-line-thickness1 = 2pt
let section-line-thickness2 = 1pt
let title-line-margin = 4pt
let title-line-thickness = 1pt
let header-line-thickness = 0.5pt
let header-line-margin-top = 2pt
let header-line-margin-bottom = 6pt
let font-ratio-latin = 1.
let font-ratio-cjk = 0.88
let font-latin-roman = (`Junicode` , font-ratio-latin, 0.)
let font-latin-bold = (`Junicode-b` , font-ratio-latin, 0.)
let font-latin-italic = (`Junicode-it`, font-ratio-latin, 0.)
let font-latin-sans = (`lmsans` , font-ratio-latin, 0.)
let font-latin-mono = (`lmmono` , font-ratio-latin, 0.)
let font-cjk-mincho = (`ipaexm` , font-ratio-cjk , 0.)
let font-cjk-gothic = (`ipaexg` , font-ratio-cjk , 0.)
let set-latin-font font ctx =
ctx |> set-font Latin font
let set-cjk-font font ctx =
ctx |> set-font HanIdeographic font
|> set-font Kana font
let get-standard-context wid =
get-initial-context wid (command \math)
|> set-dominant-wide-script Kana
|> set-language Kana Japanese
|> set-language HanIdeographic Japanese
|> set-dominant-narrow-script Latin
|> set-language Latin English
|> set-font Kana font-cjk-mincho
|> set-font HanIdeographic font-cjk-mincho
|> set-font Latin font-latin-roman
|> set-math-font `lmodern`
|> set-hyphen-penalty 100
let-mutable ref-float-boxes <- []
let height-of-float-boxes pageno =
% let () = display-message `get height` in
(!ref-float-boxes) |> List.fold-left (fun h (pn, bb) -> (
if pn < pageno then h +' (get-natural-length bb) else h
)) 0pt
let-mutable ref-figure <- 0
let-inline ctx \figure ?:labelopt caption inner =
let () = ref-figure <- !ref-figure + 1 in
let s-num = arabic (!ref-figure) in
let () =
match labelopt with
| Some(label) -> register-cross-reference (label ^ `:num`) s-num
| None -> ()
in
let it-num = embed-string s-num in
let bb-inner =
let d (_, _) _ _ _ = [] in
block-frame-breakable ctx (2pt, 2pt, 2pt, 2pt) (d, d, d, d) (fun ctx -> (
read-block ctx inner
+++ line-break true true ctx (inline-fil ++ read-inline ctx {図#it-num; #caption;} ++ inline-fil)
))
in
hook-page-break (fun pbinfo _ -> (
% let () = display-message (`register` ^ (arabic pbinfo#page-number)) in
ref-float-boxes <- (pbinfo#page-number, bb-inner) :: !ref-float-boxes
))
let title-deco =
let pads = (5pt, 5pt, 10pt, 10pt) in
let deco (x, y) wid hgt dpt =
let path1 =
let cx = 14pt in
let cy = 8pt in
let xL = x in
let xR = x +' wid in
let yT = y +' hgt in
let yB = y -' dpt in
start-path (xL, yT)
|> line-to (xR, yT)
|> bezier-to (xR +' cx, yT -' cy) (xR +' cx, yB +' cy) (xR, yB)
|> line-to (xL, yB)
|> close-with-bezier (xL -' cx, yB +' cy) (xL -' cx, yT -' cy)
in
let path2 =
let cx = 12pt in
let cy = 8pt in
let gapx = 3pt in
let gapy = 5pt in
let xL = x +' gapx in
let xR = x +' wid -' gapx in
let yT = y +' hgt -' gapy in
let yB = y -' dpt +' gapy in
start-path (xL, yT)
|> line-to (xR, yT)
|> bezier-to (xR +' cx, yT -' cy) (xR +' cx, yB +' cy) (xR, yB)
|> line-to (xL, yB)
|> close-with-bezier (xL -' cx, yB +' cy) (xL -' cx, yT -' cy)
in
[
stroke 3pt Color.black path1;
stroke 1pt Color.black path2;
]
in
(deco, deco, deco, deco)
let-block ctx +make-title it-title it-author it-date record =
let pads = (20pt, 20pt, 10pt, 10pt) in
let nodeco (_, _) _ _ _ = [] in
let deco = if record#show-title-deco
then title-deco
else (nodeco, nodeco, nodeco, nodeco) in
block-frame-breakable ctx pads deco (fun ctx -> (
let ctx-title =
ctx |> set-font-size font-size-title
|> set-font Latin font-latin-roman
in
let ctx-author =
ctx |> set-font-size font-size-author
|> set-font Latin font-latin-roman
in
let ctx-date =
ctx |> set-font-size font-size-date
|> set-font Latin font-latin-roman
in
let ib-title = read-inline ctx-title it-title in
let ib-line =
let thk = title-line-thickness in
let wid = get-text-width ctx in
let path (x, y) =
start-path (x, y +' thk *' 0.5)
|> line-to (x +' wid, y +' thk *' 0.5)
|> terminate-path
in
inline-graphics wid thk 0pt (fun pt -> (
[ stroke thk Color.black (path pt); ]
))
in
let ib-author = read-inline ctx-author it-author in
let ib-date = read-inline ctx-date it-date in
let bb-title =
% if get-text-width ctx <' get-natural-width ib-title then
% form-paragraph ctx-title (ib-title ++ inline-fil)
% else
form-paragraph (ctx-title |> set-paragraph-margin 12pt 0pt)
(inline-fil ++ ib-title ++ inline-fil)
in
let bb-line =
form-paragraph (ctx |> set-paragraph-margin title-line-margin title-line-margin)
(ib-line ++ inline-fil)
in
let bb-author = form-paragraph ctx-author (ib-date ++ inline-fil ++ ib-author) in
bb-title +++ bb-line +++ bb-author
))
let make-part-title ctx =
ctx |> set-font-size font-size-section
|> set-font Latin font-latin-sans
|> set-cjk-font font-cjk-gothic
let make-chapter-title ctx =
ctx |> set-font-size font-size-section
|> set-font Latin font-latin-sans
|> set-cjk-font font-cjk-gothic
let make-section-title ctx =
ctx |> set-font-size font-size-section
|> set-font Latin font-latin-sans
|> set-cjk-font font-cjk-gothic
let make-subsection-title ctx =
ctx |> set-font-size font-size-subsection
|> set-font Latin font-latin-sans
|> set-cjk-font font-cjk-gothic
let make-subsubsection-title ctx =
ctx |> set-font-size font-size-subsubsection
|> set-font Latin font-latin-sans
|> set-cjk-font font-cjk-gothic
let-mutable toc-acc-ref <- []
let get-cross-reference-number label =
match get-cross-reference (label ^ `:num`) with
| None -> `?`
| Some(s) -> s
let get-cross-reference-page label =
match get-cross-reference (label ^ `:page`) with
| None -> `?`
| Some(s) -> s
let section-heading ctx ib-heading =
let wid = get-text-width ctx in
let h = section-line-sep in
let th1 = section-line-thickness1 in
let th2 = section-line-thickness2 in
let color = get-text-color ctx in
line-break true false (ctx |> set-paragraph-margin section-top-margin 0pt)
(inline-graphics wid h 0pt (fun (x, y) -> [
stroke th1 color (Gr.line (x, y +' h) (x +' wid, y +' h));
stroke th2 color (Gr.line (x, y) (x +' wid, y));
]))
+++
line-break false false (ctx |> set-paragraph-margin section-top-padding section-bottom-padding)
ib-heading
+++
line-break false false (ctx |> set-paragraph-margin 0pt section-bottom-margin)
(inline-graphics wid h 0pt (fun (x, y) -> [
stroke th2 color (Gr.line (x, y +' h) (x +' wid, y +' h));
stroke th1 color (Gr.line (x, y) (x +' wid, y));
]))
let-inline ctx \dummy it =
let ib = read-inline (ctx |> set-text-color Color.white) it in
let w = get-natural-width ib in
ib ++ inline-skip (0pt -' w)
let-rec repeat-inline n ib =
if n <= 0 then inline-nil else
ib ++ (repeat-inline (n - 1) ib)
let make-dots-line ctx w =
let ib = read-inline ctx {.} ++ inline-skip 1pt in
let wdot = get-natural-width ib in
let n = round (w /' wdot) in
inline-fil ++ (repeat-inline n ib)
let document record inner =
% -- constants --
let () = font-size-normal-ref <- record#normal-font-size in
let title = record#title in
let author = record#author in
let date = record#date in
let page = A4Paper in
let txtorg = (80pt, 100pt) in
let txtwid = 440pt in
let txthgt = 630pt in
let hdrorg = (40pt, 30pt) in
let ftrorg = (40pt, 780pt) in
let hdrwid = 520pt in
let ftrwid = 520pt in
let thickness = header-line-thickness in
let ctx-doc = get-standard-context txtwid in
% -- title --
let bb-title =
if record#show-title then
read-block ctx-doc '<+make-title(title)(author)(date)(record);>
else
block-nil
in
% -- main --
let bb-main = read-block ctx-doc inner in
% -- table of contents --
let toc-part-indent = 0pt in
let toc-chapter-indent = 0pt in
let toc-section-indent = 13.5pt in
let toc-subsection-indent = 13.5pt in
let bb-toc =
if not record#show-toc then
block-nil
else
let ib-toc-title =
read-inline (make-section-title ctx-doc) {目次} ++ inline-fil
in
let bb-toc-main =
(!toc-acc-ref) |> List.reverse |> List.fold-left (fun bbacc tocelem -> (
match tocelem with
| TOCElementPart(label, title) ->
let it-num = embed-string (get-cross-reference-number label) in
let it-page = embed-string (get-cross-reference-page label) in
let ib-title =
inline-skip toc-part-indent
++ read-inline ctx-doc {#it-num; #title;}
++ inline-skip 3pt
in
let ib-page = inline-skip 3pt ++ read-inline ctx-doc it-page in
let ib-middle =
let w = (get-text-width ctx-doc) -' (get-natural-width ib-title) -' (get-natural-width ib-page) in
if w <' 0pt then inline-fil else
make-dots-line ctx-doc w
in
bbacc +++ line-break true true ctx-doc
(ib-title ++ inline-fil ++ib-page)
| TOCElementChapter(label, title) ->
let it-num = embed-string (get-cross-reference-number label) in
let it-page = embed-string (get-cross-reference-page label) in
let ib-title =
inline-skip toc-chapter-indent
++ read-inline ctx-doc {#it-num; #title;}
++ inline-skip 3pt
in
let ib-page = inline-skip 3pt ++ read-inline ctx-doc it-page in
let ib-middle =
let w = (get-text-width ctx-doc) -' (get-natural-width ib-title) -' (get-natural-width ib-page) in
if w <' 0pt then inline-fil else
make-dots-line ctx-doc w
in
bbacc +++ line-break true true ctx-doc
(ib-title ++ inline-fil ++ ib-page)
| TOCElementSection(label, title) ->
let it-num = embed-string (get-cross-reference-number label) in
let it-page = embed-string (get-cross-reference-page label) in
let ib-title =
inline-skip toc-section-indent
++ read-inline ctx-doc {#it-num;. #title;} ++ inline-skip 3pt in
let ib-page = inline-skip 3pt ++ read-inline ctx-doc it-page in
let ib-middle =
let w = (get-text-width ctx-doc) -' (get-natural-width ib-title) -' (get-natural-width ib-page) in
if w <' 0pt then inline-fil else
make-dots-line ctx-doc w
in
bbacc +++ line-break true true ctx-doc
(ib-title ++ ib-middle ++ ib-page)
| TOCElementSubsection(label, title) ->
let it-num = embed-string (get-cross-reference-number label) in
let it-page = embed-string (get-cross-reference-page label) in
let ib-title =
inline-skip toc-subsection-indent
++ read-inline ctx-doc {#it-num;. #title;}
++ inline-skip 3pt
in
let ib-page = inline-skip 3pt ++ read-inline ctx-doc it-page in
let ib-middle =
let w = (get-text-width ctx-doc) -' (get-natural-width ib-title) -' (get-natural-width ib-page) in
if w <' 0pt then inline-fil else
make-dots-line ctx-doc w
in
bbacc +++ line-break true true ctx-doc
(ib-title ++ ib-middle ++ ib-page)
)) block-nil
in
(section-heading ctx-doc ib-toc-title) +++ bb-toc-main
in
% -- page settings --
let pagecontf pbinfo =
let hgtfb = height-of-float-boxes pbinfo#page-number in
let (txtorgx, txtorgy) = txtorg in
(|
text-origin = (txtorgx, txtorgy +' hgtfb);
text-height = txthgt -' hgtfb;
|)
in
let pagepartsf pbinfo =
let pageno = pbinfo#page-number in
let header =
if not record#show-header then
block-nil
else
if record#show-title && pbinfo#page-number == 1 then
block-nil
else
let ctx =
get-standard-context hdrwid
|> set-paragraph-margin 0pt 0pt
in
let ib-text =
if pageno mod 2 == 0 then
(read-inline ctx author++ inline-fil ++ read-inline ctx title)
else
(read-inline ctx title ++ inline-fil ++ read-inline ctx author)
in
% let () = display-message `insert` in
let (bb-float-boxes, acc) =
(!ref-float-boxes) |> List.fold-left (fun (bbacc, acc) elem -> (
let (pn, bb) = elem in
if pn < pageno then
let bbs =
line-break true true (ctx |> set-paragraph-margin 0pt 12pt)
(inline-fil ++ embed-block-top ctx txtwid (fun _ -> bb) ++ inline-fil)
% 'ctx' is a dummy context
in
(bbacc +++ bbs, acc)
else
(bbacc, elem :: acc)
)) (block-nil, [])
in
let () = ref-float-boxes <- acc in
line-break true true ctx ib-text
+++ line-break true true (ctx |> set-paragraph-margin header-line-margin-top header-line-margin-bottom)
((inline-graphics hdrwid thickness 0pt
(fun (x, y) -> [ fill Color.black (Gr.rectangle (x, y) (x +' hdrwid, y +' thickness))])) ++ inline-fil)
+++ bb-float-boxes
in
let footer =
if not record#show-footer then
block-nil
else
let ctx = get-standard-context ftrwid in
let it-pageno = embed-string (arabic pbinfo#page-number) in
line-break true true ctx
(inline-fil ++ (read-inline ctx {— #it-pageno; —}) ++ inline-fil)
in
(|
header-origin = hdrorg;
header-content = header;
footer-origin = ftrorg;
footer-content = footer;
|)
in
page-break page pagecontf pagepartsf (bb-title +++ bb-toc +++ bb-main)
let-mutable needs-indentation-ref <- true
let-mutable num-part <- 0
let-mutable num-chapter <- 0
let-mutable num-section <- 0
let-mutable num-subsection <- 0
let-mutable num-subsubsection <- 0
let quad-indent-ja ctx =
inline-skip (get-font-size ctx *' 0.88)
let quad-indent-en ctx =
inline-skip (get-font-size ctx *' 1.0)
let-block ctx +p inner =
let ib-inner =
let ctx-normal =
ctx |> set-font-size !font-size-normal-ref
in
read-inline ctx-normal inner in
let br-parag =
(quad-indent-ja ctx) ++ ib-inner ++ inline-fil
in
form-paragraph ctx br-parag
let-block ctx +ph inner =
let ib-inner =
let ctx-normal =
ctx |> set-font-size !font-size-normal-ref
in
read-inline ctx-normal inner in
let br-parag =
(quad-indent-en ctx) ++ ib-inner ++ inline-fil
in
form-paragraph ctx br-parag
let-block ctx +pn inner =
let () = needs-indentation-ref <- true in
let ib-inner =
let ctx-normal =
ctx |> set-font-size !font-size-normal-ref
in
read-inline ctx-normal inner in
form-paragraph ctx (ib-inner ++ inline-fil)
let-block ctx +ep inner =
let needs-indentation =
if !needs-indentation-ref then true else
let () = needs-indentation-ref <- true in
false
in
let ib-inner =
let ctx-normal =
ctx |> set-font-size !font-size-normal-ref
in
read-inline ctx-normal inner in
let br-parag =
if needs-indentation then
(quad-indent-en ctx) ++ ib-inner ++ inline-fil
else
ib-inner ++ inline-fil
in
form-paragraph ctx br-parag
let part-scheme ctx label title inner =
let ctx-title = make-part-title ctx in
let () = num-part <- !num-part + 1 in
let () = num-chapter <- 0 in
let () = needs-indentation-ref <- false in
let s-num = `第` ^ arabic (!num-part) ^ `部` in
let () = register-cross-reference (label ^ `:num`) s-num in
let () = toc-acc-ref <- (TOCElementPart(label, title)) :: !toc-acc-ref in
let ctx-title = make-part-title ctx in
let ib-num =
read-inline ctx-title (embed-string (s-num))
++ hook-page-break (fun pbinfo _ -> register-cross-reference (label ^ `:page`) (arabic pbinfo#page-number))
in
let ib-title = read-inline ctx-title title in
let bb-title =
line-break true false (ctx |> set-paragraph-margin section-top-margin section-bottom-margin)
(ib-num ++ (inline-skip 20pt) ++ ib-title ++ (inline-fil))
in
let bb-inner = read-block ctx inner in
bb-title +++ bb-inner
let chapter-scheme ctx label title inner =
let () = num-chapter <- !num-chapter + 1 in
let () = num-section <- 0 in
let () = needs-indentation-ref <- false in
let s-num = `第` ^ arabic (!num-chapter) ^ `章` in
let () = register-cross-reference (label ^ `:num`) s-num in
let () = toc-acc-ref <- (TOCElementChapter(label, title)) :: !toc-acc-ref in
let ctx-title = make-chapter-title ctx in
let ib-num =
read-inline ctx-title (embed-string (s-num))
++ hook-page-break (fun pbinfo _ -> register-cross-reference (label ^ `:page`) (arabic pbinfo#page-number))
in
let ib-title = read-inline ctx-title title in
let bb-title =
line-break true false (ctx |> set-paragraph-margin section-top-margin section-bottom-margin)
(ib-num ++ (inline-skip 15pt) ++ ib-title ++ (inline-fil))
in
let bb-inner = read-block ctx inner in
bb-title +++ bb-inner
let section-scheme ctx label title inner =
let ctx-title = make-section-title ctx in
let () = num-section <- !num-section + 1 in
let () = num-subsection <- 0 in
let () = needs-indentation-ref <- false in
let s-num = arabic (!num-section) in
let () = register-cross-reference (label ^ `:num`) s-num in
let () = toc-acc-ref <- (TOCElementSection(label, title)) :: !toc-acc-ref in
let ib-num =
read-inline ctx-title (embed-string (s-num ^ `.`))
++ hook-page-break (fun pbinfo _ -> register-cross-reference (label ^ `:page`) (arabic pbinfo#page-number))
in
let ib-title = read-inline ctx-title title in
let bb-title =
line-break true false (ctx |> set-paragraph-margin section-top-margin section-bottom-margin)
(ib-num ++ (inline-skip 10pt) ++ ib-title ++ (inline-fil))
in
% section-heading ctx (ib-num ++ (inline-skip 10pt) ++ ib-title ++ (inline-fil)) in
let bb-inner = read-block ctx inner in
bb-title +++ bb-inner
let subsection-scheme ctx label title inner =
let () = num-subsection <- !num-subsection + 1 in
let () = needs-indentation-ref <- false in
let s-num = arabic (!num-section) ^ `.` ^ arabic (!num-subsection) in
let () = register-cross-reference (label ^ `:num`) s-num in
let () = toc-acc-ref <- (TOCElementSubsection(label, title)) :: !toc-acc-ref in
let ctx-title = make-subsection-title ctx in
let ib-num =
read-inline ctx-title (embed-string (s-num ^ `.`))
++ hook-page-break (fun pbinfo _ -> register-cross-reference (label ^ `:page`) (arabic pbinfo#page-number))
in
let ib-title = read-inline ctx-title title in
let bb-title =
line-break true false (ctx |> set-paragraph-margin section-top-margin section-bottom-margin)
(ib-num ++ (inline-skip 10pt) ++ ib-title ++ (inline-fil))
in
let bb-inner = read-block ctx inner in
bb-title +++ bb-inner
let subsubsection-scheme ctx label title inner =
let () = num-subsubsection <- !num-subsubsection + 1 in
let () = needs-indentation-ref <- false in
let s-num = arabic (!num-section) ^ `.` ^ arabic (!num-subsection) ^ `.` ^arabic(!num-subsubsection) in
let () = register-cross-reference (label ^ `:num`) s-num in
let ctx-title = make-subsubsection-title ctx in
let ib-num =
read-inline ctx-title (embed-string (s-num ^ `.`))
++ hook-page-break (fun pbinfo _ -> register-cross-reference (label ^ `:page`) (arabic pbinfo#page-number))
in
let ib-title = read-inline ctx-title title in
let bb-title =
line-break true false (ctx |> set-paragraph-margin section-top-margin section-bottom-margin)
(ib-num ++ (inline-skip 10pt) ++ ib-title ++ (inline-fil))
in
let bb-inner = read-block ctx inner in
bb-title +++ bb-inner
let-block ctx +part ?:labelopt title inner =
let label =
match labelopt with
| None -> generate-fresh-label ()
| Some(label) -> label
in
part-scheme ctx label title inner
let-block ctx +chapter ?:labelopt title inner =
let label =
match labelopt with
| None -> generate-fresh-label ()
| Some(label) -> label
in
chapter-scheme ctx label title inner
let-block ctx +section ?:labelopt title inner =
let label =
match labelopt with
| None -> generate-fresh-label ()
| Some(label) -> label
in
section-scheme ctx label title inner
let-block ctx +subsection ?:labelopt title inner =
let label =
match labelopt with
| None -> generate-fresh-label ()
| Some(label) -> label
in
subsection-scheme ctx label title inner
let-block ctx +subsubsection ?:labelopt title inner =
let label =
match labelopt with
| None -> generate-fresh-label ()
| Some(label) -> label
in
subsubsection-scheme ctx label title inner
let-inline ctx \textrm it =
let ctxrm =
ctx |> set-latin-font font-latin-roman
|> set-cjk-font font-cjk-mincho
in
read-inline ctxrm it
let-inline ctx \textbf it =
let ctxbf =
ctx |> set-latin-font font-latin-bold
|> set-cjk-font font-cjk-gothic
in
read-inline ctxbf it
let-inline ctx \textit it =
let ctxit =
ctx |> set-latin-font font-latin-italic
|> set-cjk-font font-cjk-mincho
in
read-inline ctxit it
let-inline ctx \textsf it =
let ctxsf =
ctx |> set-latin-font font-latin-sans
|> set-cjk-font font-cjk-gothic
in
read-inline ctxsf it
let-inline ctx \textmc it =
let ctxmc =
ctx |> set-latin-font font-latin-roman
|> set-cjk-font font-cjk-mincho
in
read-inline ctxmc it
let-inline ctx \textgt it =
let ctxgt =
ctx |> set-latin-font font-latin-bold
|> set-cjk-font font-cjk-gothic
in
read-inline ctxgt it
let-inline ctx \font-size size inner =
let ctx-size =
ctx |> set-font-size size
in
read-inline ctx-size inner
let font-size-modify ctx scale inner =
let ctx-size =
ctx |> set-font-size (get-font-size ctx *' scale)
in read-inline ctx-size inner
let-inline ctx \text-tiny = font-size-modify ctx .5
let-inline ctx \text-scriptsize = font-size-modify ctx .7
let-inline ctx \text-footnotesize = font-size-modify ctx .8
let-inline ctx \text-small = font-size-modify ctx .9
let-inline ctx \text-normalsize = font-size-modify ctx 1.
let-inline ctx \text-large = font-size-modify ctx 1.2
let-inline ctx \text-Large = font-size-modify ctx 1.44
let-inline ctx \text-LARGE = font-size-modify ctx 1.728
let-inline ctx \text-huge = font-size-modify ctx 2.074
let-inline ctx \text-Huge = font-size-modify ctx 2.488
let-inline ctx \font-size-modify scale inner =
let ctx-size-modify =
ctx |> set-font-size (get-font-size ctx *' scale)
in
read-inline ctx-size-modify inner
end
let document = Stjarticle.document
% ad-hoc