diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /support/syngen/src/boxes.ml |
Initial commit
Diffstat (limited to 'support/syngen/src/boxes.ml')
-rw-r--r-- | support/syngen/src/boxes.ml | 104 |
1 files changed, 104 insertions, 0 deletions
diff --git a/support/syngen/src/boxes.ml b/support/syngen/src/boxes.ml new file mode 100644 index 0000000000..ba02d84adf --- /dev/null +++ b/support/syngen/src/boxes.ml @@ -0,0 +1,104 @@ +open Parser + +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 |