helm/www/lambda_delta/bin/xhtbl/textUnparser.ml

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