The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.

NAME

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

SYNOPSIS

 use Tk ;
 use Tk::TreeGraph ;

 use strict ;

 my $mw = MainWindow-> new ;

 my $tg = $mw -> Scrolled('TreeGraph') ->pack(expand => 1, fill => 'both');

 $tg -> addLabel (text => 'some tree');

 my $ref = [1000..1005];
 my ($ox,$oy) = (100,100);

 $tg -> addNode 
  (
   nodeId => '1.0', 
   text => $ref, 
   xref => \$ox, 
   yref => \$oy
  ) ;

 my ($x,$y)= ($ox,$oy) ;
 $tg -> addDirectArrow
  (
   from => '1.0', 
   to => '1.1',
   xref => \$x,
   yref => \$y
  ) ;

 $tg->arrowBind
  (
   button => '<1>',
   color => 'orange',
   command =>  sub{my %h = @_;
                   warn "clicked 1 arrow $h{from} -> $h{to}\n";}
  );

 $tg->nodeBind
  (
   button => '<2>',
   color => 'red',
   command => sub {my %h = @_;
                   warn "clicked 2 node $h{nodeId}\n";}
  );

 $tg->command( on => 'arrow', label => 'dummy 2', 
                 command => sub{warn "arrow menu dummy2\n";});

 $tg->arrowBind(button => '<3>', color => 'green', 
              command => sub{$tg->popupMenu(@_);});

 $tg->command(on => 'node', label => 'dummy 1', 
                 command => sub{warn "node menu dummy1\n";});

 $tg->nodeBind(button => '<3>', color => 'green', 
              command => sub{$tg->popupMenu(@_);});

 MainLoop ; # Tk's

DESCRIPTION

Tk::TreeGraph is a Canvas specialized to draw trees on a Canvas using arrows and nodes. A node is simply some text imbedded in a rectangular shape.

TreeGraph is able to draw the following items:

  • node: some text in a rectangular shape.

  • direct arrow: an arrow to go from one node to the following one.

  • slanted arrow: an arrow to make a new branch.

  • shortcuts arrow: an arrow to represent a shortcut between 2 nodes from different branches.

GraphMgr also provides :

  • a binding on nodes on button 1 to 'select' them.

  • Methods to bind nodes and arrows on user's call-back.

CAVEATS

You might say that the tree is a weird tree since it is drawn downward and assymetric and adding branches leaves a lot of void between the them.

You'd be right. I'm not a specialist in tree drawing algorithms but the crude algorithm used here works quite fine with drawing id trees for VCS system. But as usual, I'm always listening for suggestions or even better, patches ;-) .

Widget Options

  • -nodeColor: Color of the node rectangle.

  • -nodeTextColor: Color of the text within the nodes

  • -labelColor

  • -arrowColor

  • -shortcutColor: Color of the shortcut arrow (default 'orange')

  • -arrowDeltaY: length of direct arrows (downward). default 40

  • -branchSeparation: minimum width between 2 branches of the tree (default 120)

Drawing Methods added to Canvas

In each drawing methods, passing a reference (here x_ref, y_ref and delta_x_ref) means that the value refered to will be modified by the method.

Note that all id parameters as treated as string.

addDirectArrow()

  • from: node id where the arrow starts

  • to: node id where the arrow ends

  • xref: \$x

  • yref: \$y

Add a new straight (i.e. vertical) arrow starting from coordinate (x,y).

x and y are modified so that their new value is the coordinate of the tip of the arrow.

addSlantedArrow()

Parameters are:

  • from: node id where the arrow starts

  • to: node id where the arrow ends

  • xref: x_ref

  • yref: y_ref

  • deltaXref: \$dx

Add a new branch connecting node 'id' to node 'id2'.

The arrow will be drawn from (x,y) to (x+delta_x, y).

x and y are modified so that their new value is the coordinate of the tip of the arrow.

delta_x is modified so that the next branch drawn from node 'id1' using this delta_x variable will not overlap the first branch.

addLabel()

Put some text on the top of the graph.

  • text: text to be inserted on the top of the graph.

addShortcutInfo()

  • from: node id where the arrow starts

  • to: node id where the arrow ends

Declare that a shortcut arrow will be drawn from node 'arrow_start' and 'arrow_end'.

addAllShortcuts()

This method is to be called once all nodes, direct arrow and branch arrows are drawn and all relevant calls to addShortcutInfo are done.

It will draw shortcut arrows between the ids declared with the addShortcutInfo method.

addNode()

  • nodeId: id

  • text: text array ref. This text will be written inside the rectangle

  • xref: \$x

  • yref: \$y)

Will add a new node (made of a rectangle with the text inside). The node will be drawn at coordinate (x,y)

x and y are modified so that their new value is the coordinate of the tip of the arrow.

Note that this method will add the nodeId on top of the text.

clear()

Clear the graph.

Management methods

nodeBind()

  • button: button name to bind (e.g. '<1>')

  • color: color of the node when it is clicked on.

  • command: sub ref

Bind the 'button' on all nodes. When 'button' is clicked, the node text color will change to 'color' and the callback sub will be called with these parameters:

 (on => 'node', nodeId => $nodeId)

arrowBind()

  • button: button name to bind (e.g. '<1>')

  • color: color of the node when it is clicked on.

  • command: sub ref

Bind the 'button' on arrows. When 'button' is clicked, the arrow color will change to 'color' and the callback sub will be called with these parameters:

 (
   on   => 'arrow', 
   from => nodeId_on_arrow_start, 
   to   => nodeId_on_arrow_tip
 ) 

unselectAllNodes()

Unselect all previously selected nodes (see button <1> binding)

getSelectedNodes()

Return an array containing nodeIds of all nodes currently selected.

command()

This will add a new entry on a Popup menu which can be raised on a node or an arrow.

Parameters are :

  • on: either 'node' or 'arrow'

  • label: Label of the Popup menu entry

  • command: sub ref runned when the menu is invoked

The callback will be invoked with these parameters when the command is set for nodes :

 (on => 'node', nodeId => $nodeId)

The callback will be invoked with these parameters when the command is set for arrows :

 (
   on   => 'arrow', 
   from => nodeId_on_arrow_start, 
   to   => nodeId_on_arrow_tip
 ) 

Private methods

These functions are documented only for people wanting to improve or inherit this widget.

setArrow()

  • color: color of the arrow when selected.

Reset any previously selected arrow to default color and set the current arrow to the color. This function should be used with a bind.

Returns (from => $endNodeId, to => $tipNodeId) to specify the nodes the arrow is attached to.

setNode()

  • color: color of the arrow when selected.

  • nodeId: nodeId to select (optional, default to the node under the mouse pointer)

Set node either from passed nodeId or from the mouse pointer. When a node is set, only the text is highlighted

Returns the nodeId of the current node (i.e. the node clicked by the user if this function was used in a bind)

toggleNode()

  • color: color of the arrow when selected.

  • nodeId: nodeId to select (optional, default to the node under the mouse pointer)

Will toggle the node rectangle between 'color' and default.

AUTHOR

Dominique Dumont, Dominique_Dumont@grenoble.hp.com

Copyright (c) 1998-1999 Dominique Dumont. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

SEE ALSO

perl(1), Tk(3), Tk::Canvas(3)