]> matita.cs.unibo.it Git - helm.git/blob - helm/www/lambdadelta/bin/xhtbl/textUnparser.ml
planned dehyphenation of lambdadelta eventually took place!
[helm.git] / helm / www / lambdadelta / bin / xhtbl / textUnparser.ml
1 module L = List
2 module P = Printf
3 module S = String
4
5 module T = Table
6 module F = Fold
7
8 type status = {
9    i: int;              (* indentation *)
10    out: string -> unit; (* output function *)
11 }
12
13 let home = {
14    i = 0; out = print_string
15 }
16
17 let indent st =
18    S.make st.i ' '
19
20 let add st = {st with i = st.i + 3}
21
22 let sub st = {st with i = st.i - 3}
23
24 let parent = function
25    | None       -> "key"
26    | Some false -> "col"
27    | Some true  -> "row"
28
29 let size ts =
30    P.sprintf "(%u, %u); (%u+%u, %u+%u); %s"
31       ts.T.y ts.T.x ts.T.rf ts.T.ri ts.T.cf ts.T.ci (parent ts.T.p)
32
33 let border tb =
34    let str = S.make 4 ' ' in
35    if tb.T.w then str.[0] <- 'W';
36    if tb.T.n then str.[1] <- 'N';
37    if tb.T.e then str.[2] <- 'E';
38    if tb.T.s then str.[3] <- 'S';
39    str
40
41 let css tc =
42    P.sprintf "\"%s\"" (S.concat " " tc)
43
44 let key = function
45    | T.Text sl       ->
46       let map s = P.sprintf "\"%s\"" s in
47       S.concat " + " (L.map map sl)
48    | T.Glue None     -> "*"
49    | T.Glue (Some i) -> P.sprintf "%u" i
50
51 let entry = function
52    | false -> "column"
53    | true  -> "row"
54
55 (****************************************************************************)
56
57 let open_table st t =
58    let str = 
59       P.sprintf "%s[{#%u: %s; %s; %s}\n"    
60          (indent st) t.T.ti (size t.T.ts) (border t.T.tb) (css t.T.tc)
61    in
62    st.out str; add st
63
64 let close_table st t =
65    let st = sub st in
66    let str = P.sprintf "%s]\n" (indent st) in
67    st.out str; st
68
69 let map_key st k =
70    let str = P.sprintf "%s%s\n" (indent st) (key k) in
71    st.out str; st
72    
73 let open_line b st =
74    let str = P.sprintf "%s%s\n" (indent st) (entry b) in
75    st.out str; st
76
77 let close_line b st = st
78
79 let open_entry b st = st
80
81 let close_entry b st sst = st
82
83 let cb = {
84    F.open_table = open_table; F.close_table = close_table;   
85    F.open_line = open_line; F.close_line = close_line;
86    F.open_entry = open_entry; F.close_entry = close_entry;
87    F.map_key = map_key;
88 }
89
90 let debug t =
91    let _ = F.fold_table cb home t in ()