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 uri tu tx =
  45    P.sprintf "@\"%s\" \"%s\"" tu tx
  46
  47 let name tn =
  48    P.sprintf "$\"%s\"" tn
  49
  50
  51 let text = function
  52    | T.Plain s              -> P.sprintf "\"%s\"" s
  53    | T.Link (true, uri, s)  -> P.sprintf "@(\"%s\" \"%s\")" uri s
  54    | T.Link (false, uri, s) -> P.sprintf "@@(\"%s\" \"%s\")" uri s
  55
  56 let key = function
  57    | T.Text sl       -> S.concat " ^ " (L.map text sl)
  58    | T.Glue None     -> "*"
  59    | T.Glue (Some i) -> P.sprintf "%u" i
  60
  61 let entry = function
  62    | false -> "column"
  63    | true  -> "row"
  64
  65 (****************************************************************************)
  66
  67 let open_table st t =
  68    let str =
  69       P.sprintf "%s[{#%u: %s; %s; %s; %s; %s}\n"
  70          (indent st) t.T.ti (size t.T.ts) (border t.T.tb) (css t.T.tc) (uri t.T.tu t.T.tx) (name t.T.tn)
  71    in
  72    st.out str; add st
  73
  74 let close_table st t =
  75    let st = sub st in
  76    let str = P.sprintf "%s]\n" (indent st) in
  77    st.out str; st
  78
  79 let map_key st k =
  80    let str = P.sprintf "%s%s\n" (indent st) (key k) in
  81    st.out str; st
  82
  83 let open_line b st =
  84    let str = P.sprintf "%s%s\n" (indent st) (entry b) in
  85    st.out str; st
  86
  87 let close_line b st = st
  88
  89 let open_entry b st = st
  90
  91 let close_entry b st sst = st
  92
  93 let cb = {
  94    F.open_table = open_table; F.close_table = close_table;
  95    F.open_line = open_line; F.close_line = close_line;
  96    F.open_entry = open_entry; F.close_entry = close_entry;
  97    F.map_key = map_key;
  98 }
  99
 100 let debug t =
 101    let _ = F.fold_table cb home t in ()