(* 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 begin
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
end
let parse_color c =
if c = "none" then None else
if String.length c = 7 && c.[0] = '#' then begin
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)
end 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
begin match endp with
Some u -> add_arrow scene (end_point l) u color arrow_size
| None -> ()
end;
begin match startp with
Some u -> add_arrow scene (start_point l) u color arrow_size
| None -> ()
end;
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
begin 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))
end;
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)
distrib
>
Mageia
>
5
>
i586
>
media
>
core-release
>
by-pkgid
>
b4603fcd3afb71dfbec25f4867b993f4
>
files
>
719
