#!/usr/bin/perl

use strict;
use warnings;

use lib 'lib', '../lib';

use Perl6::MetaModel;
use Perl6::MetaModel::Parser;

do $ARGV[1] if $ARGV[1];

sub draw {
    my ($class) = @_;
    my $output = "graph test {\n";
      
    $output .= _draw($::Object);    

    $output .= "}\n";
    return $output;
}

my %SEEN;

sub _draw_role_node {
    my ($node) = @_;
    return "node_" . $node->id . " [ " . 
                    "shape = box, " . 
                    "fontcolor = orange, " . 
                    "color = orange, " . 
                    "style = rounded, " .
                    "label = \"" . $node->name . "(" . $node->id . ")\" ". 
                    "];\n";
}

sub _draw_class_node {
    my ($node) = @_;
    return "node_" . $node->id . " [ " . 
                    "shape = box, " . 
                    ($node->id > 6 ? 
                        ($node->class == $::EigenClass ? 
                            "color = grey60, " .
                            "fontcolor = grey60, "
                            :
                            "color = green, " .
                            "fontcolor = green, "                                                          
                            )
                        :                        
                        '') .
                    "style = rounded, " . 
                    "label = \"" . $node->name . "(" . $node->id . ")\" " . 
                    "];\n";  
}

sub _draw {
    my ($class) = @_;
    my $output;
    if (not exists $SEEN{$class}) {
        $output .= _draw_class_node($class);
        $output .= "node_" . $class->class->id . " -- node_" . $class->id . " [ dir = back, style = dotted, color = red ];\n";
    }
    
    if ($class->can('subclasses')) { # roles don't have subclasses
        foreach my $subclass (@{$class->subclasses}) {
           $output .= _draw($subclass);     
        }
    }
    
    if ($class->can('superclasses')) { # roles don't have subclasses
        foreach my $superclass (@{$class->superclasses}) {
           $output .= "node_" . $superclass->id . " -- node_" . $class->id . " [ dir = back, style = dashed, color = blue ];\n";       
        }
    }    
    
    foreach my $role (@{$class->roles}) {
        $output .= _draw_role($role);
        $output .= "node_" . $role->id . " -- node_" . $class->id . " [ dir = back, style = solid, color = orange ];\n";       
    } 
    
    $SEEN{$class} = 1;       
    return $output;
}

sub _draw_role {
    my ($role) = @_;
    my $output = _draw_role_node($role);   
    foreach my $subrole (@{$role->roles}) {
        $output .= _draw_role($subrole);
        #$output .= "node_" . $subrole->id . " -- node_" . $role->id . " [ dir = back, style = solid, color = orange ];\n";       
    }       
    return $output;
}

open OUTFILE, ">", $ARGV[0];
print OUTFILE draw();
close OUTFILE;