summaryrefslogtreecommitdiff
path: root/support/syngen/src/boxes.ml
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /support/syngen/src/boxes.ml
Initial commit
Diffstat (limited to 'support/syngen/src/boxes.ml')
-rw-r--r--support/syngen/src/boxes.ml104
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