forked from gfngfn/SATySFi
-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
68 changed files
with
3,910 additions
and
1,626 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,7 +1,41 @@ | ||
| @require: option | ||
|
|
||
| let-inline ctx \tabular lstf = | ||
| let pads = (5pt, 5pt, 2pt, 10pt) in | ||
| let cellf it = NormalCell(pads, inline-fil ++ (read-inline ctx it) ++ inline-fil) in | ||
| let multif nr nc it = MultiCell(nr, nc, pads, inline-fil ++ (read-inline ctx it) ++ inline-fil) in | ||
| let empty = EmptyCell in | ||
| tabular (lstf cellf multif empty) | ||
| type cell-record = | ||
| (| | ||
| left : bool; | ||
| right : bool; | ||
| |) | ||
|
|
||
|
|
||
| module Tabular : sig | ||
|
|
||
| direct \tabular : [ | ||
| (cell-record option -> inline-text -> cell) -> | ||
| (cell-record option -> int -> int -> inline-text -> cell) -> | ||
| cell -> | ||
| (cell list) list; | ||
| length list -> length list -> graphics list; | ||
| ] inline-cmd | ||
|
|
||
| end = struct | ||
|
|
||
| let make-alignments ropt = | ||
| let r = Option.from (| right = true; left = true; |) ropt in | ||
| let f b = if b then inline-fil else inline-nil in | ||
| (f r#left, f r#right) | ||
|
|
||
|
|
||
| let-inline ctx \tabular lstf = | ||
| let pads = (5pt, 5pt, 2pt, 10pt) in | ||
| let cellf ropt it = | ||
| let (alignL, alignR) = make-alignments ropt in | ||
| NormalCell(pads, alignL ++ read-inline ctx it ++ alignR) | ||
| in | ||
| let multif ropt nr nc it = | ||
| let (alignL, alignR) = make-alignments ropt in | ||
| MultiCell(nr, nc, pads, alignL ++ (read-inline ctx it) ++ alignR) | ||
| in | ||
| let empty = EmptyCell in | ||
| tabular (lstf cellf multif empty) | ||
|
|
||
| end |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,80 @@ | ||
| @require: color | ||
| @require: gr | ||
|
|
||
|
|
||
| module FootnoteScheme : sig | ||
|
|
||
| val start-page : unit -> unit | ||
| val main : context -> (int -> inline-boxes) -> (int -> block-boxes) -> inline-boxes | ||
|
|
||
| end = struct | ||
|
|
||
| let-mutable footnote-ref <- 0 | ||
| let-mutable first-footnote <- true | ||
|
|
||
|
|
||
| let bar-ratio = 0.5 | ||
|
|
||
|
|
||
| let start-page () = | ||
| first-footnote <- true | ||
|
|
||
|
|
||
| let generate-footnote-label n = | ||
| `footnote:` ^ (arabic n) | ||
|
|
||
|
|
||
| let promote-another-trial () = | ||
| register-cross-reference `changed` `T` | ||
|
|
||
|
|
||
| let main ctx ibf bbf = | ||
| let () = footnote-ref <- !footnote-ref + 1 in | ||
| let num = !footnote-ref in | ||
| let label = generate-footnote-label num in | ||
| let it-num = embed-string (arabic num) in | ||
| let size = get-font-size ctx in | ||
| let ib-num = ibf num in | ||
| let bb = bbf num in | ||
| let bb-before = | ||
| match get-cross-reference label with | ||
| | Some(`T`) -> | ||
| let () = display-message (`'` ^ label ^ `': T`) in % for debug | ||
| let bar-top-margin = size in | ||
| let bar-bottom-margin = size *' 0.125 in | ||
| let wid = get-text-width ctx *' bar-ratio in | ||
| let ib = | ||
| inline-graphics wid bar-top-margin bar-bottom-margin (fun (x, y) -> | ||
| [ stroke 0.5pt Color.black (Gr.line (x, y) (x +' wid, y)); ] | ||
| ) ++ inline-fil | ||
| in | ||
| line-break false false (ctx |> set-paragraph-margin 0pt 0pt) ib | ||
|
|
||
| | _ -> | ||
| let () = display-message (`'` ^ label ^ `': F`) in % for debug | ||
| block-skip (size *' 0.5) | ||
| in | ||
| no-break | ||
| (add-footnote (bb-before +++ bb) ++ ib-num | ||
| ++ hook-page-break (fun _ _ -> ( | ||
| let () = | ||
| if !first-footnote then | ||
| match get-cross-reference label with | ||
| | Some(`T`) -> | ||
| () | ||
|
|
||
| | _ -> | ||
| let () = promote-another-trial () in | ||
| register-cross-reference label `T` | ||
| else | ||
| match get-cross-reference label with | ||
| | Some(`F`) -> | ||
| () | ||
|
|
||
| | _ -> | ||
| let () = promote-another-trial () in | ||
| register-cross-reference label `F` | ||
| in | ||
| first-footnote <- false))) | ||
|
|
||
| end |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,25 @@ | ||
| @require: option | ||
| @require: list | ||
|
|
||
| module HTMLBase : sig | ||
|
|
||
| val tag : (string * string) list?-> bool?-> int?-> text-info -> string -> (text-info -> string) -> string | ||
|
|
||
| end = struct | ||
|
|
||
| let make-props props = | ||
| props |> List.fold-left (fun sacc (k, v) -> ( | ||
| sacc ^ #` `# ^ k ^ `="` ^ v ^ `"` | ||
| )) ` ` | ||
|
|
||
|
|
||
| let tag ?:propsopt ?:bropt ?:indentopt tinfo s sf = | ||
| let props = Option.from [] propsopt in | ||
| let br = Option.from true bropt in | ||
| let indent = Option.from 2 indentopt in | ||
| let tinfo-inner = tinfo |> deepen-indent indent in | ||
| `<` ^ s ^ (make-props props) ^ `>` ^ (if br then break tinfo-inner else ` `) | ||
| ^ (sf tinfo-inner) | ||
| ^ (if br then break tinfo else ` `) ^ `</ ` ^ s ^ `>` | ||
|
|
||
| end |
Oops, something went wrong.