open Boxes
open Picture

let rec tex_string = function
    [] -> ""
  | h::t -> let chr = match h
                       with '#' -> "\char'43{}"
                          | '$' -> "\char'44{}"
                          | '%' -> "\char'45{}"
                          | '&' -> "\char'46{}"
                          | '*' -> "\char'52{}"
                          | '^' -> "\char'136{}"
                          | '_' -> "\char'137{}"
                          | '{' -> "\char'173{}"
                          | '}' -> "\char'175{}"
                          | '~' -> "\char'176{}"
                          | '\\' -> "\char'134{}"
                          | _ -> String.make 1 h
            in (tex_string t) ^ chr

let last s = List.hd (List.rev s)

let strbalance = "\\rule[-\\bdepth]{0pt}{\\bheight}"
and strfont = "\\ttfamily{}"
and epsilon = 1.0e-10

let generate box_con box_off char_off box_height box_sep_frac t = 
  let rec out_list xend yoff = function
      [] -> []
    | h :: s -> 
        let difference = xend -. dim_l h -. box_con 
        and box_sep = box_height *. box_sep_frac 
        and ypos = if yoff -. dim_h h < epsilon then 0. 
                   else yoff -. dim_h h in
        if abs_float difference < epsilon then
          SubPicture ((box_con, ypos), generate_aux false h, []) ::
          out_list xend (ypos -. box_sep) s
        else
          SubPicture ((box_con, ypos), generate_aux false h, []) ::
          Line ((box_con +. dim_l h, ypos +. dim_rc h), 1, 0, 
               difference, []) ::
          out_list xend (ypos -. box_sep) s
  and generate_aux islast = function
      TermBox (d, s) -> 
        Picture (d.l, d.h, 0., 0., [ 
          Line ((0., d.h -. d.lc), 1, 0, box_con, [Arrowhead]);
          Oval ((d.l /. 2., d.h /. 2.), d.l -. 2. *. box_con, box_height, []); 
          Text ((d.l /. 2., d.h /. 2.), strfont ^ tex_string s ^ strbalance, 
               []);
          Line ((d.l -. box_con, d.rc), 1, 0, box_con, 
               if islast then [Arrowhead] else [])
        ])
    | ParamBox (d, s) -> 
        Picture (d.l, d.h, 0., 0., [ 
          Line ((0., d.h -. d.lc), 1, 0, box_con, [Arrowhead]);
          Framebox ((box_con, 0.), d.l -. 2. *. box_con, box_height, 
                   [Dashed 2.]); 
          Text ((d.l /. 2., d.h /. 2.), strfont ^ tex_string s ^ strbalance, 
               []);
          Line ((d.l -. box_con, d.rc), 1, 0, box_con, 
               if islast then [Arrowhead] else [])
        ])
    | NonTermBox (d, s) ->
        Picture (d.l, d.h, 0., 0., [ 
          Line ((0., d.h -. d.lc), 1, 0, box_con, [Arrowhead]);
          Framebox ((box_con, 0.), d.l -. 2. *. box_con, box_height, []); 
          Text ((d.l /. 2., d.h /. 2.), strfont ^ tex_string s ^ strbalance, 
               []);
          Line ((d.l -. box_con, d.rc), 1, 0, box_con, 
               if islast then [Arrowhead] else [])
        ])
    | OptBox (d, t) -> 
        Picture (d.l, d.h, 0., 0., [ 
          Line ((0., d.h -. d.lc), 1, 0, box_con, []);
          SubPicture ((box_con, box_height /. 2.), generate_aux false t, []);
          Line ((box_con, d.h -. d.lc), 0, -1, d.h -. d.lc, []);
          Line ((box_con, 0.), 1, 0, d.l -. 2. *. box_con, []);
          Line ((d.l -. box_con, 0.), 0, 1, d.rc, [Arrowhead]);
          Line ((d.l -. box_con, d.rc), 1, 0, box_con, 
               if islast then [Arrowhead] else [])
        ])
    | RepBox (d, t) -> 
        Picture (d.l, d.h, 0., 0., [ 
          Line ((0., d.h -. d.lc), 1, 0, box_con, []);
          SubPicture ((box_con, 0.), generate_aux false t, []);
          Line ((box_con, d.h), 0, -1, d.lc, [Arrowhead]);
          Line ((d.l -. box_con, d.h), -1, 0, d.l -. 2. *. box_con, []);
          Line ((d.l -. box_con, d.h), 0, -1, d.h -. d.rc, []);
          Line ((d.l -. box_con, d.rc), 1, 0, box_con, 
               if islast then [Arrowhead] else [])
        ])
    | TermRepBox (d, t1, TermBox (d1, s)) -> 
        Picture (d.l, d.h, 0., 0., [ 
          Line ((0., d.h -. d.lc), 1, 0, box_con, []);
          SubPicture ((box_con, 0.), generate_aux false t1, []);
          Oval ((d.l /. 2., d.h -. box_height /. 2.), d1.l, box_height, []);
          Text ((d.l /. 2., d.h -. box_height /. 2.), 
               strfont ^ tex_string s ^ strbalance, []);
          Line ((box_con, d.h -. box_height /. 2.), 0, -1, 
               d.lc -. box_height /. 2., [Arrowhead]);
          Line ((d.l -. box_con, d.h -. box_height /. 2.), -1, 0, 
               d.l /. 2. -. box_con -. d1.l /. 2., []);
          Line ((box_con, d.h -. box_height /. 2.), 1, 0,  
               d.l /. 2. -. box_con -. d1.l /. 2., []);
          Line ((d.l -. box_con, d.h -. box_height /. 2.), 0, -1,  
               d.h -. d.rc -. box_height /. 2., []);
          Line ((d.l -. box_con, d.rc), 1, 0, box_con, 
               if islast then [Arrowhead] else [])
        ])
    | OptRepBox (d, t) -> 
        Picture (d.l, d.h, 0., 0., [ 
          Line ((0., d.h -. d.lc), 1, 0, box_con, []);
          SubPicture ((box_con, box_height /. 2.), generate_aux false t, []);
          Line ((box_con, d.h), 0, -1, d.lc, [Arrowhead]);
          Line ((d.l -. box_con, d.h), -1, 0, d.l -. 2. *. box_con, []);
          Line ((d.l -. box_con, d.h), 0, -1, d.h -. d.rc, []);
          Line ((box_con, d.h -. d.lc), 0, -1, d.h -. d.lc, []);
          Line ((box_con, 0.), 1, 0, d.l -. 2. *. box_con, []);
          Line ((d.l -. box_con, 0.), 0, 1, d.rc, [Arrowhead]);
          Line ((d.l -. box_con, d.rc), 1, 0, box_con,
               if islast then [Arrowhead] else [])
        ])
    | OrBoxList (d, l) ->
        Picture (d.l, d.h, 0., 0.,  
          Line ((0., d.h -. d.lc), 1, 0, box_con, []) ::
          (out_list (d.l -. box_con) d.h l) @ [
            Line ((d.l -. box_con, d.h -. dim_h (List.hd l) +. 
                                   dim_rc (List.hd l)), 0, -1, 
                 d.h -. dim_h (List.hd l) +. dim_rc (List.hd l) -. d.rc, 
                 [Arrowhead]);
            Line ((box_con, d.h -. d.lc), 0, -1, 
                 d.h -. d.lc -. (let lst = last l 
                                 in dim_h lst -. dim_lc lst), []);
            Line ((d.l -. box_con, d.rc), 1, 0, box_con, 
               if islast then [Arrowhead] else [])
          ])
    | ConBox (d, t1, t2) ->
        let a = dim_h t2 -. dim_lc t2 -. dim_rc t1 in
        Picture (d.l, d.h, 0., 0., [ 
          SubPicture ((0., if a > 0. then a else 0.), generate_aux false t1, 
                     []);
          SubPicture ((dim_l t1 -. box_con, if a < 0. then ~-.a else 0.), 
                     generate_aux islast t2, [])
        ])
    | _ -> raise (Failure "Bug im Parser!")
in generate_aux true t