(* Graph viewer
 * Copyright (C) 2010 Jérôme Vouillon
 * Laboratoire PPS - CNRS Université Paris Diderot
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 *)

module G = Dot_graph
module IntMap = G.IntMap
module StringMap = G.StringMap

(****)

let convert (r, g, b) =
  let c i = float i /. 255.99 in
  c r, c g, c b

let named_colors =
  let colors = Hashtbl.create 101 in
  List.iter
    (fun (nm, v) -> Hashtbl.add colors nm (convert v))
    [ "aliceblue", (240, 248, 255)
    ; "antiquewhite", (250, 235, 215)
    ; "aqua", (0, 255, 255)
    ; "aquamarine", (127, 255, 212)
    ; "azure", (240, 255, 255)
    ; "beige", (245, 245, 220)
    ; "bisque", (255, 228, 196)
    ; "black", (0, 0, 0)
    ; "blanchedalmond", (255, 235, 205)
    ; "blue", (0, 0, 255)
    ; "blueviolet", (138, 43, 226)
    ; "brown", (165, 42, 42)
    ; "burlywood", (222, 184, 135)
    ; "cadetblue", (95, 158, 160)
    ; "chartreuse", (127, 255, 0)
    ; "chocolate", (210, 105, 30)
    ; "coral", (255, 127, 80)
    ; "cornflowerblue", (100, 149, 237)
    ; "cornsilk", (255, 248, 220)
    ; "crimson", (220, 20, 60)
    ; "cyan", (0, 255, 255)
    ; "darkblue", (0, 0, 139)
    ; "darkcyan", (0, 139, 139)
    ; "darkgoldenrod", (184, 134, 11)
    ; "darkgray", (169, 169, 169)
    ; "darkgreen", (0, 100, 0)
    ; "darkgrey", (169, 169, 169)
    ; "darkkhaki", (189, 183, 107)
    ; "darkmagenta", (139, 0, 139)
    ; "darkolivegreen", (85, 107, 47)
    ; "darkorange", (255, 140, 0)
    ; "darkorchid", (153, 50, 204)
    ; "darkred", (139, 0, 0)
    ; "darksalmon", (233, 150, 122)
    ; "darkseagreen", (143, 188, 143)
    ; "darkslateblue", (72, 61, 139)
    ; "darkslategray", (47, 79, 79)
    ; "darkslategrey", (47, 79, 79)
    ; "darkturquoise", (0, 206, 209)
    ; "darkviolet", (148, 0, 211)
    ; "deeppink", (255, 20, 147)
    ; "deepskyblue", (0, 191, 255)
    ; "dimgray", (105, 105, 105)
    ; "dimgrey", (105, 105, 105)
    ; "dodgerblue", (30, 144, 255)
    ; "firebrick", (178, 34, 34)
    ; "floralwhite", (255, 250, 240)
    ; "forestgreen", (34, 139, 34)
    ; "fuchsia", (255, 0, 255)
    ; "gainsboro", (220, 220, 220)
    ; "ghostwhite", (248, 248, 255)
    ; "gold", (255, 215, 0)
    ; "goldenrod", (218, 165, 32)
    ; "gray", (128, 128, 128)
    ; "grey", (128, 128, 128)
    ; "green", (0, 128, 0)
    ; "greenyellow", (173, 255, 47)
    ; "honeydew", (240, 255, 240)
    ; "hotpink", (255, 105, 180)
    ; "indianred", (205, 92, 92)
    ; "indigo", (75, 0, 130)
    ; "ivory", (255, 255, 240)
    ; "khaki", (240, 230, 140)
    ; "lavender", (230, 230, 250)
    ; "lavenderblush", (255, 240, 245)
    ; "lawngreen", (124, 252, 0)
    ; "lemonchiffon", (255, 250, 205)
    ; "lightblue", (173, 216, 230)
    ; "lightcoral", (240, 128, 128)
    ; "lightcyan", (224, 255, 255)
    ; "lightgoldenrodyellow", (250, 250, 210)
    ; "lightgray", (211, 211, 211)
    ; "lightgreen", (144, 238, 144)
    ; "lightgrey", (211, 211, 211)
    ; "lightpink", (255, 182, 193)
    ; "lightsalmon", (255, 160, 122)
    ; "lightseagreen", (32, 178, 170)
    ; "lightskyblue", (135, 206, 250)
    ; "lightslategray", (119, 136, 153)
    ; "lightslategrey", (119, 136, 153)
    ; "lightsteelblue", (176, 196, 222)
    ; "lightyellow", (255, 255, 224)
    ; "lime", (0, 255, 0)
    ; "limegreen", (50, 205, 50)
    ; "linen", (250, 240, 230)
    ; "magenta", (255, 0, 255)
    ; "maroon", (128, 0, 0)
    ; "mediumaquamarine", (102, 205, 170)
    ; "mediumblue", (0, 0, 205)
    ; "mediumorchid", (186, 85, 211)
    ; "mediumpurple", (147, 112, 219)
    ; "mediumseagreen", (60, 179, 113)
    ; "mediumslateblue", (123, 104, 238)
    ; "mediumspringgreen", (0, 250, 154)
    ; "mediumturquoise", (72, 209, 204)
    ; "mediumvioletred", (199, 21, 133)
    ; "midnightblue", (25, 25, 112)
    ; "mintcream", (245, 255, 250)
    ; "mistyrose", (255, 228, 225)
    ; "moccasin", (255, 228, 181)
    ; "navajowhite", (255, 222, 173)
    ; "navy", (0, 0, 128)
    ; "oldlace", (253, 245, 230)
    ; "olive", (128, 128, 0)
    ; "olivedrab", (107, 142, 35)
    ; "orange", (255, 165, 0)
    ; "orangered", (255, 69, 0)
    ; "orchid", (218, 112, 214)
    ; "palegoldenrod", (238, 232, 170)
    ; "palegreen", (152, 251, 152)
    ; "paleturquoise", (175, 238, 238)
    ; "palevioletred", (219, 112, 147)
    ; "papayawhip", (255, 239, 213)
    ; "peachpuff", (255, 218, 185)
    ; "peru", (205, 133, 63)
    ; "pink", (255, 192, 203)
    ; "plum", (221, 160, 221)
    ; "powderblue", (176, 224, 230)
    ; "purple", (128, 0, 128)
    ; "red", (255, 0, 0)
    ; "rosybrown", (188, 143, 143)
    ; "royalblue", (65, 105, 225)
    ; "saddlebrown", (139, 69, 19)
    ; "salmon", (250, 128, 114)
    ; "sandybrown", (244, 164, 96)
    ; "seagreen", (46, 139, 87)
    ; "seashell", (255, 245, 238)
    ; "sienna", (160, 82, 45)
    ; "silver", (192, 192, 192)
    ; "skyblue", (135, 206, 235)
    ; "slateblue", (106, 90, 205)
    ; "slategray", (112, 128, 144)
    ; "slategrey", (112, 128, 144)
    ; "snow", (255, 250, 250)
    ; "springgreen", (0, 255, 127)
    ; "steelblue", (70, 130, 180)
    ; "tan", (210, 180, 140)
    ; "teal", (0, 128, 128)
    ; "thistle", (216, 191, 216)
    ; "tomato", (255, 99, 71)
    ; "turquoise", (64, 224, 208)
    ; "violet", (238, 130, 238)
    ; "wheat", (245, 222, 179)
    ; "white", (255, 255, 255)
    ; "whitesmoke", (245, 245, 245)
    ; "yellow", (255, 255, 0)
    ; "yellowgreen", (154, 205, 50)
    ];
  colors

let rgb_of_hsv h s v =
  if s <= 0.0
  then v, v, v
  else
    let h = 6. *. if h >= 1. then 0. else h in
    let i = truncate h in
    let f = h -. float i in
    let p = v *. (1. -. s) in
    let q = v *. (1. -. (s *. f)) in
    let t = v *. (1. -. (s *. (1. -. f))) in
    match i with
    | 0 -> v, t, p
    | 1 -> q, v, p
    | 2 -> p, v, t
    | 3 -> p, q, v
    | 4 -> t, p, v
    | 5 -> v, p, q
    | _ -> assert false

let parse_color c =
  if c = "none"
  then None
  else if String.length c = 7 && c.[0] = '#'
  then
    let conv s = int_of_string ("0x" ^ s) in
    let c = conv (String.sub c 1 2), conv (String.sub c 3 2), conv (String.sub c 5 2) in
    Some (convert c)
  else
    try Scanf.sscanf c "%f,%f,%f" (fun h s v -> Some (rgb_of_hsv h s v))
    with Scanf.Scan_failure _ | Failure _ | End_of_file | Invalid_argument _ ->
      Some
        (try Hashtbl.find named_colors c
         with Not_found ->
           Format.eprintf "%s@." c;
           assert false)

let convert (r, g, b) =
  let c i = float i /. 255.99 in
  c r, c g, c b

let named_colors =
  let colors = Hashtbl.create 101 in
  List.iter
    (fun (nm, v) -> Hashtbl.add colors nm (convert v))
    [ "aliceblue", (240, 248, 255)
    ; "antiquewhite", (250, 235, 215)
    ; "aqua", (0, 255, 255)
    ; "aquamarine", (127, 255, 212)
    ; "azure", (240, 255, 255)
    ; "beige", (245, 245, 220)
    ; "bisque", (255, 228, 196)
    ; "black", (0, 0, 0)
    ; "blanchedalmond", (255, 235, 205)
    ; "blue", (0, 0, 255)
    ; "blueviolet", (138, 43, 226)
    ; "brown", (165, 42, 42)
    ; "burlywood", (222, 184, 135)
    ; "cadetblue", (95, 158, 160)
    ; "chartreuse", (127, 255, 0)
    ; "chocolate", (210, 105, 30)
    ; "coral", (255, 127, 80)
    ; "cornflowerblue", (100, 149, 237)
    ; "cornsilk", (255, 248, 220)
    ; "crimson", (220, 20, 60)
    ; "cyan", (0, 255, 255)
    ; "darkblue", (0, 0, 139)
    ; "darkcyan", (0, 139, 139)
    ; "darkgoldenrod", (184, 134, 11)
    ; "darkgray", (169, 169, 169)
    ; "darkgreen", (0, 100, 0)
    ; "darkgrey", (169, 169, 169)
    ; "darkkhaki", (189, 183, 107)
    ; "darkmagenta", (139, 0, 139)
    ; "darkolivegreen", (85, 107, 47)
    ; "darkorange", (255, 140, 0)
    ; "darkorchid", (153, 50, 204)
    ; "darkred", (139, 0, 0)
    ; "darksalmon", (233, 150, 122)
    ; "darkseagreen", (143, 188, 143)
    ; "darkslateblue", (72, 61, 139)
    ; "darkslategray", (47, 79, 79)
    ; "darkslategrey", (47, 79, 79)
    ; "darkturquoise", (0, 206, 209)
    ; "darkviolet", (148, 0, 211)
    ; "deeppink", (255, 20, 147)
    ; "deepskyblue", (0, 191, 255)
    ; "dimgray", (105, 105, 105)
    ; "dimgrey", (105, 105, 105)
    ; "dodgerblue", (30, 144, 255)
    ; "firebrick", (178, 34, 34)
    ; "floralwhite", (255, 250, 240)
    ; "forestgreen", (34, 139, 34)
    ; "fuchsia", (255, 0, 255)
    ; "gainsboro", (220, 220, 220)
    ; "ghostwhite", (248, 248, 255)
    ; "gold", (255, 215, 0)
    ; "goldenrod", (218, 165, 32)
    ; "gray", (128, 128, 128)
    ; "grey", (128, 128, 128)
    ; "green", (0, 128, 0)
    ; "greenyellow", (173, 255, 47)
    ; "honeydew", (240, 255, 240)
    ; "hotpink", (255, 105, 180)
    ; "indianred", (205, 92, 92)
    ; "indigo", (75, 0, 130)
    ; "ivory", (255, 255, 240)
    ; "khaki", (240, 230, 140)
    ; "lavender", (230, 230, 250)
    ; "lavenderblush", (255, 240, 245)
    ; "lawngreen", (124, 252, 0)
    ; "lemonchiffon", (255, 250, 205)
    ; "lightblue", (173, 216, 230)
    ; "lightcoral", (240, 128, 128)
    ; "lightcyan", (224, 255, 255)
    ; "lightgoldenrodyellow", (250, 250, 210)
    ; "lightgray", (211, 211, 211)
    ; "lightgreen", (144, 238, 144)
    ; "lightgrey", (211, 211, 211)
    ; "lightpink", (255, 182, 193)
    ; "lightsalmon", (255, 160, 122)
    ; "lightseagreen", (32, 178, 170)
    ; "lightskyblue", (135, 206, 250)
    ; "lightslategray", (119, 136, 153)
    ; "lightslategrey", (119, 136, 153)
    ; "lightsteelblue", (176, 196, 222)
    ; "lightyellow", (255, 255, 224)
    ; "lime", (0, 255, 0)
    ; "limegreen", (50, 205, 50)
    ; "linen", (250, 240, 230)
    ; "magenta", (255, 0, 255)
    ; "maroon", (128, 0, 0)
    ; "mediumaquamarine", (102, 205, 170)
    ; "mediumblue", (0, 0, 205)
    ; "mediumorchid", (186, 85, 211)
    ; "mediumpurple", (147, 112, 219)
    ; "mediumseagreen", (60, 179, 113)
    ; "mediumslateblue", (123, 104, 238)
    ; "mediumspringgreen", (0, 250, 154)
    ; "mediumturquoise", (72, 209, 204)
    ; "mediumvioletred", (199, 21, 133)
    ; "midnightblue", (25, 25, 112)
    ; "mintcream", (245, 255, 250)
    ; "mistyrose", (255, 228, 225)
    ; "moccasin", (255, 228, 181)
    ; "navajowhite", (255, 222, 173)
    ; "navy", (0, 0, 128)
    ; "oldlace", (253, 245, 230)
    ; "olive", (128, 128, 0)
    ; "olivedrab", (107, 142, 35)
    ; "orange", (255, 165, 0)
    ; "orangered", (255, 69, 0)
    ; "orchid", (218, 112, 214)
    ; "palegoldenrod", (238, 232, 170)
    ; "palegreen", (152, 251, 152)
    ; "paleturquoise", (175, 238, 238)
    ; "palevioletred", (219, 112, 147)
    ; "papayawhip", (255, 239, 213)
    ; "peachpuff", (255, 218, 185)
    ; "peru", (205, 133, 63)
    ; "pink", (255, 192, 203)
    ; "plum", (221, 160, 221)
    ; "powderblue", (176, 224, 230)
    ; "purple", (128, 0, 128)
    ; "red", (255, 0, 0)
    ; "rosybrown", (188, 143, 143)
    ; "royalblue", (65, 105, 225)
    ; "saddlebrown", (139, 69, 19)
    ; "salmon", (250, 128, 114)
    ; "sandybrown", (244, 164, 96)
    ; "seagreen", (46, 139, 87)
    ; "seashell", (255, 245, 238)
    ; "sienna", (160, 82, 45)
    ; "silver", (192, 192, 192)
    ; "skyblue", (135, 206, 235)
    ; "slateblue", (106, 90, 205)
    ; "slategray", (112, 128, 144)
    ; "slategrey", (112, 128, 144)
    ; "snow", (255, 250, 250)
    ; "springgreen", (0, 255, 127)
    ; "steelblue", (70, 130, 180)
    ; "tan", (210, 180, 140)
    ; "teal", (0, 128, 128)
    ; "thistle", (216, 191, 216)
    ; "tomato", (255, 99, 71)
    ; "turquoise", (64, 224, 208)
    ; "violet", (238, 130, 238)
    ; "wheat", (245, 222, 179)
    ; "white", (255, 255, 255)
    ; "whitesmoke", (245, 245, 245)
    ; "yellow", (255, 255, 0)
    ; "yellowgreen", (154, 205, 50)
    ];
  colors

(****)

let comma_re = Str.regexp ","

let semi_re = Str.regexp ";"

let wsp_re = Str.regexp "[\x20\x09\x0D\x0A]+"

let parse_float s = try float_of_string s with Failure _ -> raise Not_found

let parse_rectangle s =
  match Str.split comma_re s with
  | [ x1; y1; x2; y2 ] ->
      parse_float x1, -.parse_float y2, parse_float x2, -.parse_float y1
  | _ -> raise Not_found

let parse_point s =
  match Str.split comma_re s with
  | [ x; y ] -> parse_float x, -.parse_float y
  | _ -> raise Not_found

let start_point l =
  match l with
  | x :: _ -> x
  | _ -> raise Not_found

let rec end_point l =
  match l with
  | [ x ] -> x
  | _ :: r -> end_point r
  | _ -> raise Not_found

let epsilon = 0.0001

let add_arrow scene (px, py) (ux, uy) color arrow_size (*XXX pen_width*) =
  let dx = ux -. px in
  let dy = uy -. py in
  let s = 10. /. (sqrt ((dx *. dx) +. (dy *. dy)) +. epsilon) in
  let dx = s *. if dx >= 0. then dx +. epsilon else dx -. epsilon in
  let dy = s *. if dy >= 0. then dy +. epsilon else dy -. epsilon in
  let arrow_width = 0.35 in
  let vx = -.dy *. arrow_width in
  let vy = dx *. arrow_width in
  let qx = px +. dx in
  let qy = py +. dy in
  let l = [| px, py; px -. vx, py -. vy; qx, qy; px +. vx, py +. vy |] in
  Scene.add scene (Scene.Polygon (l, color, color))

let rec render_spline_rec l =
  match l with
  | [] -> []
  | (x1, y1) :: (x2, y2) :: (x3, y3) :: r ->
      Scene.Curve_to (x1, y1, x2, y2, x3, y3) :: render_spline_rec r
  | _ -> raise Not_found

let render_spline l =
  match l with
  | (x, y) :: r -> Array.of_list (Scene.Move_to (x, y) :: render_spline_rec r)
  | _ -> raise Not_found

let parse_spline scene s color arrow_size =
  let l = Str.split semi_re s in
  List.iter
    (fun s ->
      let l = List.map (fun s -> Str.split comma_re s) (Str.split wsp_re s) in
      let endp, l =
        match l with
        | [ "e"; x; y ] :: r -> Some (parse_float x, -.parse_float y), r
        | _ -> None, l
      in
      let startp, l =
        match l with
        | [ "s"; x; y ] :: r -> Some (parse_float x, -.parse_float y), r
        | _ -> None, l
      in
      let l =
        List.map
          (fun l ->
            match l with
            | [ x; y ] -> parse_float x, -.parse_float y
            | _ -> raise Not_found)
          l
      in
      (match endp with
      | Some u -> add_arrow scene (end_point l) u color arrow_size
      | None -> ());
      (match startp with
      | Some u -> add_arrow scene (start_point l) u color arrow_size
      | None -> ());
      Scene.add scene (Scene.Path (render_spline l, None, color)))
    l

let add_rect_margin (x1, y1, x2, y2) w = x1 -. w, y1 -. w, x2 +. w, y2 +. w

let dpi = 72.

let f g =
  let bbox = parse_rectangle (StringMap.find "bb" g.G.graph_attr) in
  let margin =
    try parse_float (StringMap.find "margin" g.G.graph_attr) with Not_found -> 4.
  in
  let bbox = add_rect_margin bbox margin in
  let scene = Scene.make () in
  IntMap.iter
    (fun _ n ->
      let x, y = parse_point (StringMap.find "pos" n.G.node_attr) in
      let width = dpi *. parse_float (StringMap.find "width" n.G.node_attr) in
      let height = dpi *. parse_float (StringMap.find "height" n.G.node_attr) in
      let color =
        parse_color (try StringMap.find "color" n.G.node_attr with Not_found -> "black")
      in
      let shape =
        try StringMap.find "shape" n.G.node_attr with Not_found -> "ellipse"
      in
      (*XXX parse style *)
      let style = try StringMap.find "style" n.G.node_attr with Not_found -> "" in
      let fillcolor =
        if style <> "filled"
        then None
        else
          try parse_color (StringMap.find "fillcolor" n.G.node_attr)
          with Not_found -> color
      in
      (match shape with
      | "box" | "rect" | "rectangle" ->
          let w2 = width /. 2. in
          let h2 = height /. 2. in
          Scene.add
            scene
            (Scene.rectangle (x -. w2, y -. h2, x +. w2, y +. h2) fillcolor color)
      | _ ->
          Scene.add
            scene
            (Scene.Ellipse (x, y, width /. 2., height /. 2., fillcolor, color)));
      let font_color =
        parse_color (try StringMap.find "color" n.G.node_attr with Not_found -> "black")
      in
      let font_size =
        try parse_float (StringMap.find "fontsize" n.G.node_attr) with Not_found -> 14.
      in
      let label =
        (*XXX Parse...*)
        try StringMap.find "label" n.G.node_attr with Not_found -> n.G.name
      in
      let font_family = "serif" in
      Scene.add
        scene
        (Scene.Text
           (x, y +. (height *. 0.1), label, (font_family, font_size), font_color, None));
      ())
    g.G.nodes.G.seq;
  IntMap.iter
    (fun _ e ->
      (*      Format.eprintf "%s -> %s@." e.G.tail.G.name e.G.head.G.name;*)
      let color =
        parse_color (try StringMap.find "color" e.G.edge_attr with Not_found -> "black")
      in
      let arrow_size =
        try parse_float (StringMap.find "arrowsize" e.G.edge_attr) with Not_found -> 1.
      in
      parse_spline scene (StringMap.find "pos" e.G.edge_attr) color arrow_size;
      ())
    g.G.edges.G.seq;
  bbox, scene
