type box = TermBox of dim * char list
| NonTermBox of dim * char list
| ParamBox of dim * char list
| OptBox of dim * box
| RepBox of dim * box
| TermRepBox of dim * box * box
| OptRepBox of dim * box
| OrBoxList of dim * box list
| ConBox of dim * box * box
and dim = {l : float; h : float; lc : float; rc : float}
let dim = function
TermBox (d, _) -> d
| NonTermBox (d, _) -> d
| ParamBox (d, _) -> d
| OptBox (d, _) -> d
| RepBox (d, _) -> d
| TermRepBox (d, _, _) -> d
| OptRepBox (d, _) -> d
| OrBoxList (d, _) -> d
| ConBox (d, _, _) -> d
let dim_l t = (dim t).l
and dim_h t = (dim t).h
and dim_lc t = (dim t).lc
and dim_rc t = (dim t).rc
let of_syntree box_con box_off char_off box_height box_sep_frac =
let atom_dim lst = { l = 2. *. box_con +. float (List.length lst) *.
char_off +. box_off;
h = box_height;
lc = box_height /. 2.;
rc = box_height /. 2.
} in
let rec of_syntree_rec = function
NonTerm lst -> NonTermBox (atom_dim lst, lst)
| Term lst -> TermBox (atom_dim lst, lst)
| Param lst -> ParamBox (atom_dim lst, lst)
| Rep t -> let t = of_syntree_rec t in
RepBox (
{ l = dim_l t +. 2. *. box_con;
h = dim_h t +. box_height /. 2.;
lc = dim_lc t +. box_height /. 2.;
rc = dim_rc t
}, t)
| TermRep (t, Term lst) -> let t = of_syntree_rec t
and lng = float (List.length lst) in
TermRepBox (
{ l = dim_l t +. 2. *. box_con;
h = dim_h t +. box_height +. box_height /. 2.;
lc = dim_lc t +. 3. *. box_height /. 2.;
rc = dim_rc t
}, t,
TermBox (
{ l = lng *. char_off +. box_off;
h = box_height;
lc = box_height /. 2.;
rc = box_height /. 2.
}, lst))
| OptRep t -> let t = of_syntree_rec t in
OptRepBox (
{ l = dim_l t +. 2. *. box_con;
h = dim_h t +. box_height;
lc = dim_lc t +. box_height /. 2.;
rc = dim_rc t +. box_height /. 2.
}, t)
| Opt t -> let t = of_syntree_rec t in
OptBox (
{ l = dim_l t +. 2. *. box_con;
h = dim_h t +. box_height /. 2.;
lc = dim_lc t;
rc = dim_rc t +. box_height /. 2.
}, t)
| Con (t1, t2) -> let t1 = of_syntree_rec t1
and t2 = of_syntree_rec t2 in
ConBox (
{ l = dim_l t1 +. dim_l t2 -. box_con;
h = (max ((dim_h t1) -. (dim_rc t1))
(dim_lc t2)) +.
(max (dim_rc t1) ((dim_h t2) -. (dim_lc t2)));
lc = (let a = (dim_lc t2) -. ((dim_h t1) -. (dim_rc t1))
in if a > 0. then (dim_lc t1) +. a
else (dim_lc t1));
rc = (let a = (dim_rc t1) -. ((dim_h t2) -. (dim_lc t2))
in if a > 0. then (dim_rc t2) +. a
else (dim_rc t2))
}, t1, t2)
| OrList lst ->
let lst = List.map of_syntree_rec lst
and box_sep = box_height *. box_sep_frac in
let new_l = List.fold_left (fun l1 t2 -> max l1 (dim_l t2)) 0. lst
and new_h = List.fold_left (fun h1 t2 -> h1 +. dim_h t2 +. box_sep)
(~-. box_sep) lst in
OrBoxList (
{ l = new_l +. 2. *. box_con;
h = new_h;
lc = dim_lc (List.hd lst);
rc = dim_rc (List.hd (List.rev lst))
}, lst)
| _ -> raise (Failure "Parser Bug")
in of_syntree_rec
