helm/www/lambdadelta/bin/xhtbl/pass1.ml

   1 module L = List
   2
   3 module T = Table
   4 module F = Fold
   5
   6 type status = {
   7    ts: T.size; (* current dimensions *)
   8    tc: T.css;  (* current class *)
   9 }
  10
  11 let empty = {
  12    ts = T.no_size; tc = [];
  13 }
  14
  15 let init b ts =
  16    if b then
  17       {ts with T.ri = max_int; T.ci = 0}
  18    else
  19       {ts with T.ri = 0; T.ci = max_int}
  20
  21 let combine b ts1 ts2 =
  22    if b then
  23       {ts1 with
  24          T.rf = max ts1.T.rf ts2.T.rf; T.ri = min ts1.T.ri ts2.T.ri;
  25          T.cf = ts1.T.cf + ts2.T.cf; T.ci = ts1.T.ci + ts2.T.ci;
  26       }
  27    else
  28       {ts1 with
  29          T.cf = max ts1.T.cf ts2.T.cf; T.ci = min ts1.T.ci ts2.T.ci;
  30          T.rf = ts1.T.rf + ts2.T.rf; T.ri = ts1.T.ri + ts2.T.ri;
  31       }
  32
  33 let deinit ts = {ts with
  34    T.ri = if ts.T.ri = max_int then 0 else ts.T.ri;
  35    T.ci = if ts.T.ci = max_int then 0 else ts.T.ci;
  36 }
  37
  38 (****************************************************************************)
  39
  40 let open_table st t =
  41    t.T.tc <- t.T.tc @ st.tc;
  42    {st with tc = t.T.tc}
  43
  44 let close_table st t =
  45    t.T.ts <- st.ts; st
  46
  47 let map_key st k =
  48    let ts = match k, st.ts.T.p with
  49       | T.Text _     , _          ->
  50          {st.ts with T.rf = 1; T.cf = 1; T.ri = 0; T.ci = 0}
  51       | T.Glue None  , _          ->
  52          {st.ts with T.rf = 0; T.cf = 0; T.ri = 1; T.ci = 1}
  53       | T.Glue Some g, Some false ->
  54          {st.ts with T.rf = g; T.cf = 0; T.ri = 0; T.ci = 1}
  55       | T.Glue Some g, Some true  ->
  56          {st.ts with T.rf = 0; T.cf = g; T.ri = 1; T.ci = 0}
  57       | T.Glue Some g, None       ->
  58          {st.ts with T.rf = g; T.cf = g; T.ri = 0; T.ci = 0}
  59    in
  60    {st with ts = ts}
  61
  62 let open_line b st =
  63    let ts = init b st.ts in
  64    let ts = {ts with T.rf = 0; T.cf = 0} in
  65    {st with ts = ts}
  66
  67 let open_entry b st =
  68    let ts = {st.ts with T.p = Some b} in
  69    {st with ts = ts}
  70
  71 let close_entry b st sst =
  72    {st with ts = combine b st.ts sst.ts}
  73
  74 let close_line b st =
  75    {st with ts = deinit st.ts}
  76
  77 let cb = {
  78    F.open_table = open_table; F.close_table = close_table;
  79    F.open_line = open_line; F.close_line = close_line;
  80    F.open_entry = open_entry; F.close_entry = close_entry;
  81    F.map_key = map_key;
  82 }
  83
  84 let process t =
  85    let st = F.fold_table cb empty t in
  86    st.ts