## dotgraph-to-planargraph.pkg
# Compiled by:
# src/lib/std/standard.lib# Dot-graphs are the raw abstract graphs as read in from disk.
# planar-graphs are the same graphs embedded in a plane for drawing.
# (See ../GRAPHS.OVERVIEW.)
stipulate
package dg = dot_graphtree; # dot_graphtree is from src/lib/std/dot/dot-graphtree.pkg package dt = dot_graphtree_traits; # dot_graphtree_traits is from src/lib/std/dot/dot-graphtree-traits.pkg package f8b = eight_byte_float; # eight_byte_float is from src/lib/std/eight-byte-float.pkg package gf = geometry2d_float; # geometry2d_float is from src/lib/std/2d/geometry2d-float.pkg package pg = planar_graphtree; # planar_graphtree is from src/lib/std/dot/planar-graphtree.pkg package g2d = geometry2d; # geometry2d is from src/lib/std/2d/geometry2d.pkgherein
package dotgraph_to_planargraph
: Dotgraph_To_Planargraph
{
default_font_size = 14; # This was in view-font.pkg, moved here to eliminate dependency on X-dependent code.
fun divscale (n, { wide, high } )
=
{ col => wide / n,
row => high / n
};
fun bind_view_node (ppf, prf, vg) node
=
{ name = dg::node_name node;
case (pg::find_node (vg, name))
#
NULL =>
{ my { center, size, label, shape, ... }
=
*(dg::node_info_of node);
bbox = g2d::box::make
( g2d::point::subtract (center, divscale (2, size)),
size
);
trait
=
{ position => ppf center,
bbox => prf bbox,
base => node,
shape,
label
};
pg::make_node (vg, name, THE trait);
};
THE nn => nn;
esac;
};
stipulate
arrowl = 10; # "arrow length" ?
arroww = 7; # "arrow width" ?
# pi_2 = 1.57079632679489661923;
# pi = 3.14159265358979323846;
#
# fun atan2 (y, 0.0)
# =>
# if (y == 0.0) 0.0;
# elif (y > 0.0) pi_2;
# else -pi_2;
# fi;
#
# atan2 (y, x)
# =>
# if (x > 0.0) arctan (y/x);
# elif (y >= 0.0) arctan (y/x) + pi;
# else arctan (y/x) - pi;
# fi;
# end;
herein
fun make_arrow
( { x=>x', y=>y'}: gf::Point,
p as { x, y }: gf::Point,
arrowl,
arroww
)
=
{ delx = x'-x;
dely = y'-y;
# math is from src/lib/std/src/bind-math-32.pkg theta = math::atan2 (dely, delx);
costh = math::cos theta;
sinth = math::sin theta;
sp = { x => x + (arrowl*costh + arroww*sinth),
y => y + (arrowl*sinth - arroww*costh)
};
ep = { x => x + (arrowl*costh - arroww*sinth),
y => y + (arrowl*sinth + arroww*costh)
};
[sp, p, ep];
};
fun make_view_node (scale_float, scale_point, scale_box, g, vg)
=
{
bind_v_node = bind_view_node (scale_point, scale_box, vg);
fun last [a] => a;
last (_ ! t) => last t;
last [] => raise exception lib_base::IMPOSSIBLE "dotgraph_to_vgraph::make_view_node";
end;
arrowl = scale_float arrowl;
arroww = (scale_float arroww) / 2.0;
fun make_edge tnode edge
=
{ hnode = bind_v_node (dg::head edge);
(*(dg::edge_info_of edge))
->
{ points, arrow };
info_points = map scale_point (points @ [arrow]);
arrowhead = make_arrow (scale_point (last points), scale_point arrow, arrowl, arroww);
info = { bbox => gf::bound_box (arrowhead @ info_points),
points => info_points,
arrowhead
};
pg::make_edge { graph=>vg, tail=>tnode, head=>hnode, info=>THE info };
();
};
\\ n = dg::out_edges_apply (make_edge( bind_v_node n)) (g, n);
};
end;
fun convert_dotgraph_to_planargraph graph
=
{ (*(dg::graph_info_of graph))
->
{ bbox => { wide=>gwid, high=>ght }, scale, ... };
fun scale_float x
=
scale * (f8b::from_int x);
fun scale_point ({ col=>x, row=>y } )
=
{ x=>scale_float x, y=>scale_float (ght-y) };
fun scale_box ({ col=>x, row=>y, wide, high } )
=
gf::BOX
{ x => scale_float x,
y => scale_float (ght-(y+high)),
#
wide => scale_float wide,
high => scale_float high
};
fun pick_node g
=
{ exception DONE;
my nodes: Ref( List( dg::Node ) )
=
REF [];
fun pick n
=
{ nodes := [n];
raise exception DONE;
};
dg::nodes_apply pick g
except
DONE = ();
list::head *nodes;
};
graph_info
= { graph,
fontsize => f8b::truncate (scale_float default_font_size),
graph_bbox => gf::BOX { x => 0.0,
y => 0.0,
#
wide => scale_float gwid,
high => scale_float ght
}
};
picknode = pick_node graph;
default_node_info
=
{ position => gf::point_zero,
bbox => gf::BOX { x=>0.0, y=>0.0, wide=>0.0, high=>0.0 },
shape => dt::BOX,
base => picknode,
label => ""
};
default_edge_info
=
{ points => [],
arrowhead => [],
bbox => gf::BOX { x => 0.0,
y => 0.0,
wide => scale_float gwid,
high => scale_float ght
}
};
vg = pg::make_graph
{
name => dg::graph_name graph,
info => THE graph_info,
#
make_default_graph_info => {. graph_info; },
make_default_node_info => {. default_node_info; },
make_default_edge_info => {. default_edge_info; }
};
dg::nodes_apply
(make_view_node (scale_float, scale_point, scale_box, graph, vg))
graph;
vg;
};
}; # package vgraph_aux
end;