view release on metacpan or  search on metacpan

TreeGraph.pm  view on Meta::CPAN

package Tk::TreeGraph;

use strict;
use vars qw($VERSION @ISA);

use Carp ;
use Tk::Derived ;
use Tk::Canvas ;
use Tk::Frame;
use AutoLoader qw/AUTOLOAD/ ;


@ISA = qw(Tk::Derived Tk::Canvas);

$VERSION = sprintf "%d.%03d", q$Revision: 1.30 $ =~ /(\d+)\.(\d+)/;

Tk::Widget->Construct('TreeGraph');

sub InitObject {
    my ($dw,$args) = @_ ;

    # this should get a reasonable default ...
    my $defc = $dw->parent->cget('-foreground');
    $dw->ConfigSpecs (
       '-shortcutColor'    => ['PASSIVE', undef, undef, 'orange'   ],
       '-shortcutStyle'    => ['PASSIVE', undef, undef, 'straight' ],
       '-animation'        => ['PASSIVE', undef, undef, 0          ],
       '-nodeColor'        => ['PASSIVE', undef, undef, $defc      ],
       '-nodeFill'         => ['PASSIVE', undef, undef, undef      ],
       '-arrowColor'       => ['PASSIVE', undef, undef, $defc      ],
       '-nodeTextColor'    => ['PASSIVE', undef, undef, $defc      ],
       '-labelColor'       => ['PASSIVE', undef, undef, $defc      ],

       # add node Id to text
       '-nodeTag'          => ['PASSIVE', undef, undef, 1          ],
       # use this to tune the shape of nodes and arrows
       '-arrowDeltaY'      => ['PASSIVE', undef, undef,  40        ],
       '-branchSeparation' => ['PASSIVE', undef, undef, 120        ],
       '-x_start'          => ['PASSIVE', undef, undef,  40        ],
       '-y_start'          => ['PASSIVE', undef, undef, 100        ],
      );

    # bind button <1> on nodes to select a version
    $dw->bind ('node', 
               '<1>' => sub {$dw->toggleNode(color => 'blue')});

    $dw->{currentBranch} = 'b000';
    $dw->{column}{$dw->{currentBranch}} = 0;

    $dw->SUPER::InitObject($args) ;
}


1;

__END__



=head1 NAME

Tk::TreeGraph - Tk widget to draw a tree in a Canvas

=head1 SYNOPSIS

 use Tk ;
 use Tk::TreeGraph ;

 use strict ;

 my $mw = MainWindow-> new ;

 my $tg = $mw -> Scrolled('TreeGraph') ->