% Visualisation of the supervision tree
%
% Thomas Arts
% November 2000
% Modified June 2001

-module(visualize).
-export([supervisor/3,
	 callback/1,
         callback/2]).

-include("gd.hrl").

-import(lists,[foldr/3]).

supervisor(Mod,Func,Args) ->
  SupervisorStruct =
    app:nonapp(Mod,Func,Args),
  gdtop:supertree({?MODULE,callback}, SupervisorStruct).

vertices({supervisor,Name,{error,Reason}},Path) ->
  [{Name,error,Path}];
vertices({supervisor,Name,Children},Path) ->
  {Vertices,_} =
     foldr(fun(Child,{Vs,N}) -> 
              {vertices(Child,Path++[N])++Vs,N+1}
           end,{[],1},Children),
  [{Name,supervisor,Path}|Vertices];
vertices({_,Name,{error,Reason}},Path) ->
  [{Name,error,Path}];
vertices({_,Name,{_,_,Behaviour,_}},Path) ->
  [{Name,Behaviour,Path}].

edges([]) -> 
  [];
edges([{N1,T1,P1}|Vs]) -> 
  [{{N1,T1,P1},{N2,T2,P2}} || {N2,T2,P2}<-Vs, prefix(P1,P2)]++
  edges(Vs).

prefix([],[N]) ->
  true;
prefix([N|Ns],[N|Ms]) ->
  prefix(Ns,Ms);
prefix(_,_) ->
  false.
  
%get_name([],SuperTree) ->
%  atom_to_list(element(2,SuperTree));
%get_name([N|Ns],{supervisor,_,Children}) ->
%  % here the node must be a supervisor node
%  get_name(Ns,lists:nth(N,Children)).

%%-------------------------------------------------------------

callback(graph,SuperTree) ->
    Vertices = (catch vertices(SuperTree,[])),
    {#gd_graph{directed=false,
	       cyclic=false,
	       vertices=Vertices,
	       start_vertices=[hd(Vertices)],
	       edges=edges(Vertices)
              },
     SuperTree};

callback({name_string,{Name,Type,Path}},SuperTree) ->
  {io_lib:format(" ~p ~n~n ~p ",[Name,Type]),SuperTree};

callback({shape,{Name,Type,Path}},SuperTree) -> 
  case Type of
       supervisor ->
         {rectangle,SuperTree};
       _ -> 
         {oval,SuperTree}
  end.

callback({click,node,Node}) ->
  io:format("clicked ~p~n",[Node]);

callback({select_node_attributes,Node}) -> [{fg,red}];
 
callback({old_node_attributes,{_,supervisor,_}}) -> [{fill,lightblue}];
callback({old_node_attributes,{_,error,_}}) -> [{fill,red}];
callback({old_node_attributes,{_,gen_server,_}}) -> [{fill,yellow}];
callback({old_node_attributes,{_,gen_fsm,_}}) -> [{fill,yellow}];
callback({old_node_attributes,{_,gen_event,_}}) -> [{fill,lightyellow}];
callback({old_node_attributes,{_,Worker,_}}) -> [{fill,white}];

callback({new_node_attributes,_}) -> [{fill,white}].