--- trunk/lib/Frey/Class/Graph.pm	2009/01/09 21:50:21	976
+++ trunk/lib/Frey/Class/Graph.pm	2009/01/09 23:02:36	977
@@ -12,80 +12,127 @@
 	documentation => 'Regex to select classes',
 	is => 'rw',
 	isa => 'Str',
+	required => 1,
 	default => 'Frey',
 );
 
-has path => (
+has show_extends => (
+	documentation => 'connect to superclasses',
 	is => 'rw',
-	isa => 'Str',
-	required => 1,
-	default => 'var/introspect/',
+	isa => 'Bool',
+);
+
+has show_includes => (
+	documentation => 'use and require connections',
+	is => 'rw',
+	isa => 'Bool',
+	default => 1,
+);
+
+has show_roles => (
+	documentation => 'roles consumers connections',
+	is => 'rw',
+	isa => 'Bool',
+);
+
+has portrait => (
+	documentation => 'vertical layout',
+	is => 'rw',
+	isa => 'Bool',
 );
 
 has produce_dot => (
+	documentation => 'dump .dot text format',
 	is => 'rw',
 	isa => 'Bool',
 );
 
+sub introspect_path { 'var/introspect/' };
+
 sub as_markup {
 	my ($self) = @_;
 
+	my $rankdir = $self->portrait;
+
 	my $g = GraphViz->new(
-		rankdir => 1, # horizontal
+		rankdir => $rankdir,
 #		layout => 'neato', # grabs too much memory
 #		layout => 'twopi', # grabs too much memory
 #		overlap => 'compress',
 #		no_overlap => 1,
+		node => {
+			shape => 'box',
+#			style =>'filled',
+#			color => 'grey',
+#			fillcolor =>'lightgray',
+		},
+		edge => {
+			color => 'grey',
+		}
 	);
 
 	our $count = {};
+	our $max_count = {};
 	my $filter = $self->filter;
 
-	foreach my $path ( $self->dir_extension( $self->path, qr{\.(ya?ml)$}) ) {
+	foreach my $path ( $self->dir_extension( $self->introspect_path, qr{\.(ya?ml)$}) ) {
 
 		my $class = $self->strip_path_extension( $path ) || die "can't strip $path";
+		$max_count->{$class} = ++$count->{$class};
+
 		my $data = $self->load( $path );
 #		warn "## $class $path ", $self->dump( $data ); # if $self->debug;
 
-		sub count_label {
-			my ($self,$package) = @_;
-			my $label = $package;
-			$label .= $self->dump( $count->{$package} );
-			return $label;
-		}
-
 		next if $filter && $class !~ m{$filter};
 
-		if ( my $includes = $data->{includes} ) {
-			foreach my $type ( keys %$includes ) {
-				foreach my $package ( @{ $includes->{$type} } ) {
-
-					my $usage = $count->{$package}->{$type}->{$class}++;
-
-					my $label = $self->count_label($package);
-
+		if ( $self->show_includes && defined $data->{includes} ) {
+			foreach my $type ( keys %{ $data->{includes} } ) {
+				foreach my $package ( @{ $data->{includes}->{$type} } ) {
 					next if $filter && $package !~ m{$filter};
-
-					warn "# $class\t$type\t$package\n$label\n";
-
-					$g->add_edge( $class => $package, label => $type );
+					warn "# $class\t$type\t$package\n";
+					$g->add_edge( $class => $package, label => $type, color => 'blue' );
+					$max_count->{$package} = ++$count->{$package};
 				}
 			}
 		}
 
-=for later
-
-		foreach my $role ( keys %{ $data->{roles} } ) {
-			next if $filter && $role !~ m{$filter};
-			$g->add_edge( $role => $class, label => 'role' );
+		if ( $self->show_roles && defined $data->{roles} ) {
+			foreach my $role ( keys %{ $data->{roles} } ) {
+				next if $filter && $role !~ m{$filter};
+				warn "# $class\trole\t$role\n";
+				$g->add_edge( $role => $class, label => 'role', color => 'yellow' );
+#				$g->add_node( $role, rank => 'role' );
+				$max_count->{$role} = ++$count->{$role};
+			}
 		}
 
-=cut
+		if ( $self->show_extends && defined $data->{superclass} ) {
+			foreach my $extends ( keys %{ $data->{superclass} } ) {
+				next if $filter && $extends !~ m{$filter};
+				warn "# $class\textends\t$extends\n";
+				$g->add_edge( $extends => $class, label => 'extends', color => 'green' );
+				$max_count->{$extends} = ++$count->{$extends};
+			}
+		}
 
 	}
 
+=for xxx
 	warn "# count ",$self->dump( $count );
 
+	foreach my $node ( keys %$count ) {
+		my $pcnt = $count->{$node} / $max_count->{$node};
+		my $color = join(",", ( $pcnt, 0.5, 0.75 ) );
+
+		$g->add_node( $node, 
+			style =>'filled',
+			color => $color,
+			fillcolor => $color,
+			label => "$node\n$pcnt",
+		);
+
+	}
+=cut
 
 	if ( $self->produce_dot ) {
 		$self->content_type( 'text/plain' );