summaryrefslogtreecommitdiff
path: root/support/syngen/src/boxes.ml
blob: ba02d84adff9a5fecc138a12bf3e5a77cce4ee2d (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
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