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