#!/usr/bin/perl -w

#
# Since the machine this script is installed on, mintzer, uses an old version 
# of dot, i need to copy over the generated .dot file to setzer and run
# manually:
# $ dot -Tpng Misc.dot > misc.png
# $ dot -Tcmap Misc.dot > misc.map
#
# then I have to ':r misc.map' into misc.html manually, too.
#

use strict;

#use lib "/home/wxwindows/perllibs/local/share/perl/5.6.1/";
#use lib "/home/wxwindows/perllibs/local/lib/perl/5.6.1/";

use XML::LibXML::XPathContext;
use XML::LibXML;

# color/fontcolor/fillcolor
# in h,s,v, #rrggbb or white black red  green  blue  yellow  magenta  cyan burlywood
my %colouring;
my %colournodeswithparent;
$colournodeswithparent{wxObject} = ",style=filled,fillcolor=green";
#$colournodeswithparent{wxWindow} = ",style=filled,fillcolor=yellow";
#$colournodeswithparent{wxControl} = ",style=filled,fillcolor=yellow";

my %splitclasses;
$splitclasses{wxWindow} = 1;
$splitclasses{wxCommandEvent} = 1;
#$splitclasses{wxDialog} = 1;
$splitclasses{wxControl} = 1;
$splitclasses{wxFrame} = 1;

#require "/home/wxwindows/cgi-bin/wiki/wxkeywords.pl";
#my %classlinks = wxclasslist();

my $parser = XML::LibXML->new();
my $classes = $parser->parse_file("../../classes.xml");
my $xc = XML::LibXML::XPathContext->new($classes);

sub getParents {
  my ($classnode) = @_;
  my @retval;

  my $nodes = $classnode->findnodes("parents/classref");
  foreach my $node ($nodes->get_nodelist) {
    my @attributes = $node->getAttributes;
    foreach my $attr (@attributes) {
      if ($attr->getName() eq 'name') {
        push (@retval, $attr->nodeValue())
      }
    }
  }

  $nodes = $classnode->findnodes("parents/ref");
  foreach my $node ($nodes->get_nodelist) {
    my @attributes = $node->getAttributes;
    foreach my $attr (@attributes) {
      if ($attr->getName() eq 'target') {
        push (@retval, $attr->nodeValue())
      }
    }
  }

  return @retval;
}

sub getallparents {
  ## get parents information
  my $nodelist = $xc->find("/classes/class");
  my %classparents;

  foreach my $node ($nodelist->get_nodelist) {
    my @attributes = $node->getAttributes;
    my $classname;
    foreach my $attr (@attributes) {
      if ($attr->getName() eq 'name') {
        $classname = $attr->nodeValue();
      }
    }
    #print "Looking at node $classname\n";

    my @parents = getParents ($node);
    foreach my $parent (@parents) {
      #print "found parent $parent\n";
      	$classparents{$classname}{$parent} = 1;
    }
  }
  return \%classparents;
}

# if {classname}{parent} is defined, parent is a parent of classname
my %classparents = %{getallparents()};

## remove redundant information
# (if 'wxObject' is a parent of 'wxWidget', and 'wxButton' is a 'wxWidget',
#  'wxButton' doesn't explicitly have to be a 'wxObject'.
sub isParent {
  my ($parent, $class) = @_;
  if (defined $classparents{$class}{$parent}) {
    return 1;
  }
  foreach my $p (keys %{$classparents{$class}}) {
    if (isParent($parent, $p) == 1) {
      return 1;
    }
  }
  return 0;
}

foreach my $class (keys %classparents) {
  foreach my $parent (keys %{$classparents{$class}}) {
    foreach my $otherparent (keys %{$classparents{$class}}) {
      if (isParent($parent, $otherparent) == 1) {
        delete $classparents{$class}{$parent};
        next;
      }
    }
  }
}

# Some parents are hidden, and shown as a colour instead
foreach my $class (keys %classparents) {
  foreach my $parent (keys %{$classparents{$class}}) {
    if (defined ($colournodeswithparent{$parent})) {
      $colouring{$class} = $colournodeswithparent{$parent};
      delete $classparents{$class}{$parent}; 
    }
  }
}


# based on lowercase class name, generate link
sub classlink {
  return undef;
}
## split the graph out into multiple disjunct graphs.
# a seperate graph for children of wxEvent, wxControl, wxWindow, wxDialog

# removes all parents from $graphref, recursively, returns a graph.
sub splitgraph {
  my ($graphref, $target) = @_;

  my %result;
  my %todo;

  # take one class name
  $todo{$target} = 1;

  while ((keys %todo) > 0) {
    my $current = (keys %todo)[0];

    # add all parents to the result and the todo-list
    foreach my $parent (keys %{$graphref->{$current}}) {
      $result{$current}{$parent} = 1;
      $todo{$parent} = 1;
    }
    delete $graphref->{$current};
    delete $todo{$current};
  }
 
  return %result;
}

sub inverse {
  my ($graphref) = @_;

  my %retval;

  foreach my $child (keys %$graphref) {
    foreach my $parent (keys %{$graphref->{$child}}) {
      $retval{$parent}{$child} = 1;
    }
  }
  
  return %retval;
}

my %classchildren = inverse (\%classparents);

#my %eventgraphs = splitgraph (\%classchildren, "wxEvent");
#printchildren (\%eventgraphs, "Events");
#my %controlgraphs = splitgraph (\%classchildren, "wxControl");
#printchildren (\%controlgraphs, "Control");
#my %dialoggraphs = splitgraph (\%classchildren, "wxDialog");
#printchildren (\%dialoggraphs, "Dialog");
#my %windowgraphs = splitgraph (\%classchildren, "wxWindow");
#printchildren (\%windowgraphs, "Window");
#my %streambasegraphs = splitgraph (\%classchildren, "wxStreamBase");
#printchildren (\%streambasegraphs, "Stream");
#my %loggraphs = splitgraph (\%classchildren, "wxLog");
#printchildren (\%loggraphs, "Log");
#my %evthgraphs = splitgraph (\%classchildren, "wxEvtHandler");
#printchildren (\%evthgraphs, "EvtHandler");

printchildren (\%classchildren, "Misc");

sub printchildren {
  my ($graphref, $name) = @_;

  open (TARGET, ">$name.dot");

  print TARGET <<"  EOF";
  digraph $name {
    rankdir=LR
    edge [fontname="Helvetica",fontsize=10,labelfontname="Helvetica",labelfontsize=10,dir=back];
    node [fontname="Helvetica",fontsize=10,shape=record,height=0.2,width=0.4];

    center="";
  EOF

  my %allnodes;

  # generate all transitions 
  foreach my $class (keys %$graphref) {
    $allnodes{$class} = 1;
    foreach my $child (keys %{$graphref->{$class}}) {
      $allnodes{$child} = 1;
      if (defined ($splitclasses{$class})) {
        print TARGET "  \"$class \" -> \"$child\";\n";
      } else {
        print TARGET "  \"$class\" -> \"$child\";\n";
      }
    }
  }

  # generate all nodes
  foreach my $node (keys %allnodes) {
    # print TARGET "  \"$node\" [URL=\"http://wiki.wxwindows.org/class.cgi?name=$node\"];\n";
    my $link = "http://www.wxwindows.org/manuals/2.4.2/";
    if (defined (classlink(lc($node)))) {
      $link .= classlink(lc($node));
    } else {
      #print STDERR "No link found for class $node\n";
    }
    #print TARGET "  \"$node\" [URL=\"$link\"" . $colouring{$node} . "];\n";

    if (!defined ($colouring{$node})) { $colouring{$node} = "" }

    print TARGET "  \"$node\" [width=2.5" . $colouring{$node} . "];\n";

    if (defined ($splitclasses{$node})) {
      print TARGET "  \"$node \" [width=2.5" . $colouring{$node} . "];\n";
    }
  }

  print TARGET "}";
  close TARGET;
  print "Generating output using $name.dot\n";
  `dot -Nshape=box -Tsvg $name.dot > $name.svg`;
  #`dot -Nshape=box -Tpng $name.dot > $name.png`;
  #`dot -Nshape=box -Tps $name.dot > $name.ps`;
}