http://qs321.pair.com?node_id=720966

rocklee has asked for the wisdom of the Perl Monks concerning the following question:

Hi Monks

It's been a busy week, not much time for Perl hacking. Today I'm back at it, though! ;-) So I'm rewriting my previous POE+Tk::Zinc code, going for plain-old modules instead. After some experimenting, I have questions..

My module abstracts the concept of a group of buttons, so I can easily create buttons that scale to a given region on the screen. It turned out more neat than I first anticipated, but it's still full of ugly hacks.. ;-)

1. Am I duplicating effort here? I can't seem to find any modules that focus on UI widgets for Zinc? The exception is IntuiKit which I tried to obtain, but it is no longer for sale :-( How do you guys make UIs in Zinc?

2. Some things in my constructor seem pretty clumsy to me. I'm sure there are better ways:

sub new { my ($proto, $zinc, $args) = @_; my $self = { 'zinc' => $zinc, 'bbox' => $args->{'bbox'} || [[0,0],[200,200]], 'packer' => $args->{'packer'} || 'vertical', }; ... } sub packer { .. }
  1. I have a accessor/mutator function called packer() that allows changing $self->{packer} after creation time. Can I somehow use this function from the constructor to validate $args->{packer}? I.e $self->packer($args->{packer}), but obviously that's not going to work..
  2. Is there a shorthand way to test if $args->{bbox} conforms to [[int, int], [int, int]] ?
  3. Is there a better way to 'extract' $args into $self? Or in general an established way to handle (complex) arguments to a constructor? If so, where is this documented?

3. I find lots of information about creating composite widgets in Tk; I don't find so much about how to create 'composite items' on a Canvas, or Zinc specifically, which is what I do (?) in my code. Can you point me to some code that implements objects that represent complex item collections on a canvas? (or documentation of such a pattern).. or am I totally missing something obvious that invalidates my approach to this problem..?


ButtonCollection.pm
package ButtonCollection; use strict; use warnings; use Tk::Zinc::Graphics; use Carp; use base qw{ Class::Accessor::Fast }; __PACKAGE__->mk_accessors(qw{ spacing order }); __PACKAGE__->mk_ro_accessors(qw{ width height }); # Initialization and create a (zinc) group for our buttons. sub new { my ($proto, $zinc, $args) = @_; my $type = ref($proto) || $proto; my $self = { 'zinc' => $zinc, 'bbox' => $args->{'bbox'} || [[0,0],[200,200]], 'packer' => $args->{'packer'} || 'vertical', 'spacing' => defined($args->{'spacing'}) ? $args->{'spacing'} : + 5, 'buttons' => {}, 'order' => [], }; $self->{'width'} = $self->{'bbox'}->[1][0] - $self->{'bbox'}->[0][0 +]; $self->{'height'} = $self->{'bbox'}->[1][1] - $self->{'bbox'}->[0][1 +]; $self->{'group'} = $self->{'zinc'}->add( 'group', 1, -atomic => 0, -visible => 0, -tags => ['buttoncollection'], ); # Place group at bbox X1,Y1, to ease positioning buttons later on. $self->{'zinc'}->translate( $self->{'group'}, $self->{'bbox'}[0][0], $self->{'bbox'}[0][1] ); return bless($self, $type); } # # Given type, name and callback; create a group, shape and text item o +n the # zinc canvas, representing a button. No scaling/positioning is done a +t this # time (but mouse bindings are..) # # !! NOTE: 'type' is magic and requires two gradients to be present in # self->zinc. They must be named "$type" and "active_$type". # gradient "active_$type" is used when pointer is over butto +n. # sub add_button { my ($self, $type, $name, $callback) = @_; croak "Must specify name." unless defined $name; croak "Must specify type." unless defined $type; my $group = $self->{'zinc'}->add( 'group', $self->{'group'}, -atomic => 1, -visible => 0, -tags => ['button', $type, 'group'], ); my $shape = $self->{'zinc'}->add( 'curve', $group, $self->{'bbox'}, -tags => ['button', $type, 'shape'], -fillcolor => $type, -filled => 1, -closed => 1, -linewidth => 1, -linecolor => '#ffffff', ); my $text = $self->{'zinc'}->add( 'text', $group, -color => '#ffffff', -anchor => 'center', -text => $name, -tags => ['button', $type, 'text'], ); if (defined($callback)) { $self->{'zinc'}->bind($group, '<1>', \&{$callback}); } $self->{'zinc'}->bind($group, '<Enter>', sub { $self->{'zinc'}->itemconfigure($shape, -fillcolor=>'active_'.$type +); }); $self->{'zinc'}->bind($group, '<Leave>', sub { $self->{'zinc'}->itemconfigure($shape, -fillcolor=>$type); }); $self->{'buttons'}{$group} = [$shape, $text]; push @{ $self->{'order'} }, $group; return $group; } # Return a buttons shape and text items sub get_button { my ($self, $group) = @_; if (defined $self->{'buttons'}{$group}) { return @{ $self->{'buttons'}{$group}}; } croak "unknown button $group\n"; } # Given nothing, reshape all the (ordered) buttons in the collection # to fit within self->bbox according to packer (then make group visibl +e) sub pack { my ($self) = @_; my $numbtn = 1 + scalar @{ $self->{'order'} }; # Get the width, height and shape of ONE button. my ($BW, $BH) = $self->_get_button_size($numbtn); my $shapecoords = &roundedRectangleCoords( [ [-(int $BW/2),-(int $BH/2)], [int $BW/2, int $BH/2] ] ); # First hide and deactivate all buttons foreach my $group ( keys %{ $self->{'buttons'} } ) { $self->{'zinc'}->itemconfigure($group, -visible => 0); $self->{'zinc'}->itemconfigure($group, -sensitive => 0); } # Then resize, move, show and activate the ones specified by ->order my $i=0; my ($group, $shape, $text, $x, $y); foreach my $group (@{ $self->{'order'} }) { ($shape, $text) = @{ $self->{'buttons'}{$group} }; ($x, $y) = $self->_get_button_pos($BW, $BH, $i); $self->{'zinc'}->coords($shape, $shapecoords); $self->{'zinc'}->treset($group); $self->{'zinc'}->translate($group, $x, $y); $self->{'zinc'}->itemconfigure($group, -visible => 1); $self->{'zinc'}->itemconfigure($group, -sensitive => 1); $i++; } $self->{'zinc'}->itemconfigure($self->{'group'}, -visible => 1); } # Accessor/mutator sub packer { my ($self, $packer) = @_; if (defined $packer and $packer =~ m/^(horizontal|vertical)$/) { $self->{'packer'} = $packer; } elsif (not defined $packer) { return $self->{'packer'}; } else { die "Packer must be horizontal or vertical."; } } # Accessor/mutator sub bbox { my ($self, $bbox) = @_; if (defined $bbox) { $self->{'bbox'} = $bbox; $self->{'width'} = $self->{'bbox'}->[1][0] - $self->{'bbox'}->[0] +[0]; $self->{'height'} = $self->{'bbox'}->[1][1] - $self->{'bbox'}->[0] +[1]; return 1; } return $self->{'bbox'}; } # Accessor, return zinc groups of all buttons sub buttons { my $self = shift; return keys %{ $self->{buttons} }; } # Accessor, return whether _collection_ is visible sub visible { my $self = shift; return $self->{'zinc'}->itemcget($self->{'group'}, -visible); } # hides the collection('s zinc group) sub hide { my $self = shift; $self->{'zinc'}->itemconfigure($self->{'group'}, -visible => 0); } # shows the collection('s zinc group) sub show { my $self = shift; $self->{'zinc'}->itemconfigure($self->{'group'}, -visible => 1); } # _get_button_pos; # Given button width/height and number, return the buttons x/y positio +n sub _get_button_pos { my ($self, $BW, $BH, $num) = @_; my ($x, $y); if ($self->{'packer'} eq 'horizontal') { $x = ($BW/2)+($num*($self->spacing+$BW)+$self->spacing); $y = ($BH/2)+($self->spacing); } elsif ($self->{'packer'} eq 'vertical') { $x = ($BW/2)+($self->spacing); $y = ($BH/2)+($num*($self->spacing+$BH)+$self->spacing); } else { croak "Unsupported packer:", $self->{packer}; } # print "returning button $num position: $x, $y\n"; return ($x, $y); } # _get_button_size: # Given number of buttons in collection, return width and height of on +e button sub _get_button_size { my ($self, $numbtn) = @_; my ($BW, $BH); $numbtn -= 1; croak "pack() with no buttons?" if ($numbtn <= 0); if ($self -> {'packer'} eq 'horizontal') { $BW = ($self->{'width'} - ((1+$numbtn)*$self->{spacing})) / $numbt +n; $BH = $self->{'height'} - ($self->{spacing}*2); } elsif ($self->{'packer'} eq 'vertical') { $BW = $self->{'width'} - ($self->{spacing}*2); $BH = ($self->{'height'} - $self->spacing-($numbtn*$self->{spacing +}) ) / $numbtn; } else { croak "Unsupported packer:", $self->{packer}; } return ($BW, $BH); } 1;

TestButtons.pl (Esc exits)
#!/usr/bin/perl use strict; use warnings; use Tk; use Tk::Zinc; use Tk::Zinc::Graphics; require "ButtonCollection.pm"; # These gradients are used by ButtonCollection, and are # magically named (ie have a corresponding active_ gradient # for <Enter> event) my %gradients = ( 'button' => '=axial 200|#aaaaaa;50|#a8a8a8;10', 'active_button' => '=axial 250|#fafafa;20|#fefefe;50', 'button_red' => '=axial 200|#aa0000;20|#881010;10', 'active_button_red' => '=axial 250|#ff0000;50|#aa0000;50', ); # Initialize the mainwindow and pack a fullscreen zinc my $mw = new MainWindow; $mw->withdraw; my $zinc = $mw -> Zinc( -width => $mw -> screenwidth, -height => $mw -> screenheight, -render => 1, -borderwidth => 0, -backcolor => '#000000', ) -> pack; die "Need OpenGL support!" unless ($zinc->cget(-render) > 0); # Create a vertically packed buttoncollection on left side of screen my $mainmenu = new ButtonCollection($zinc, { bbox => [[0,0],[300,$mw->screenheight]], packer => 'vertical', spacing => 3, } ); &setGradients($zinc, \%gradients); # Add buttons to the collection, first parameter 'type' corresponds to # a 'magic gradient'. Parameters are type aka gradient, text, callback my $btn1 = $mainmenu->add_button('button', "Flip order", \&flip_or +der); my $btn2 = $mainmenu->add_button('button', "Toggle packer", \&toggle_ +packer); my $btn3 = $mainmenu->add_button('button', "Solo - resize", \&solo_re +size); my $btn4 = $mainmenu->add_button('button', "Solo - stretch", \&solo_st +retch); my $btn5 = $mainmenu->add_button('button', 'Solo - group', \&solo_gr +oup); my $btn6 = $mainmenu->add_button('button', 'Solo - Added', \&solo_ad +ded); my $btn7 = $mainmenu->add_button('button', "Add button", \&add_but +ton); $mainmenu->pack; $mw -> bind('<Key-Escape>' => sub{exit;}); $mw -> FullScreen(1); $mw -> focusForce; $mw -> grabGlobal; $mw -> deiconify; MainLoop; exit 0; # Reverse the current order of buttons. sub flip_order { $mainmenu->order(reverse @{$mainmenu->order}); $mainmenu->pack; } # Toggle between horizontal and vertical packer, also set # the ButtonCollection's bbox accordingly. sub toggle_packer { if ($mainmenu -> packer eq 'horizontal') { $mainmenu -> packer('vertical'); $mainmenu -> bbox([[0,0],[300,$mw->screenheight]]); } else { $mainmenu -> packer('horizontal'); $mainmenu -> bbox([[0,0],[$mw->screenwidth,100]]); } $mainmenu->pack; } # Toggle resized solo mode for button 3 my ($btn3_old_order, $btn3_old_bbox, $btn3_is_solo); sub solo_resize { my ($shape, $text) = $mainmenu->get_button($btn3); if ($btn3_is_solo) { $mainmenu -> bbox($btn3_old_bbox); $mainmenu -> order($btn3_old_order); $zinc->itemconfigure($text, -text => 'Solo - resize'); $btn3_is_solo = 0; } else { $btn3_old_order = $mainmenu -> order; $btn3_old_bbox = $mainmenu -> bbox; my ($x1, $y1, $x2, $y2) = $zinc->bbox($btn3); $mainmenu -> order([$btn3]); $mainmenu -> bbox([[$x1, $y1], [$x2, $y2]]); $zinc->itemconfigure($text, -text => 'Expand!'); $btn3_is_solo = 1; } $mainmenu -> pack; } # Toggle stretched solo mode for button 4 my ($btn4_old_order, $btn4_is_solo); sub solo_stretch { if ($btn4_is_solo) { $mainmenu -> order($btn4_old_order); $btn4_is_solo = 0; } else { $btn4_old_order = $mainmenu -> order; $mainmenu -> order([$btn4]); $btn4_is_solo = 1; } $mainmenu -> pack; } # Toggle solo for a given group of buttons # (same as above, only more buttons in ->order call) my ($btn5_old_order, $btn5_is_solo); sub solo_group { if ($btn5_is_solo) { $mainmenu -> order($btn5_old_order); $btn5_is_solo = 0; } else { $btn5_old_order = $mainmenu -> order; $mainmenu -> order([$btn1, $btn2, $btn4, $btn5]); $btn5_is_solo = 1; } $mainmenu -> pack; } # Add a new button to the end of collection my @added_buttons; sub add_button { push @added_buttons, $mainmenu -> add_button( 'button_red', (1+scalar @added_buttons), sub{ } ); $mainmenu -> pack; } # Toggle solo mode for added buttons (and btn6) my ($btn6_old_order, $btn6_is_solo); sub solo_added { if ($btn6_is_solo) { $mainmenu -> order($btn6_old_order); $btn6_is_solo = 0; } else { $btn6_old_order = $mainmenu -> order; $mainmenu -> order([$btn6, @added_buttons]); $btn6_is_solo = 1; } $mainmenu -> pack; }

Thanks in advance (Z);-)

Replies are listed 'Best First'.
Re: GUIs in Tk.:Zinc; a perl module experiment
by zentara (Archbishop) on Nov 02, 2008 at 21:01 UTC
    I find lots of information about creating composite widgets in Tk; I don't find so much about how to create 'composite items' on a Canvas, or Zinc specifically, which is what I do (?) in my code. Can you point me to some code that implements objects that represent complex item collections on a canvas? (or documentation of such a pattern)

    I already pointed you to the TripleRotatingWheel in the Zinc demo, and the Bubbles on Zinc at Re^3: Tk/Zinc mouse drag performance issues? I use the ztkbubble example as a basis for making almost any type of composite item on Zinc.

    I think basically the idea is to bless an object with Zinc as the parent, then make a group in it. Then have methods for the object and internal timers to make it alive. :-)

    Other than that, this is beginning to sound like work. :-)

    I'm not really an OO oriented type of programmer, but to me there are 2 possible paths....

    1. Create your Zinc canvas, and pass it as an option to your new class, like ztkbubble, so you can have a parent widget for your objects.

    2. Subclass Zinc, and make your own Zinc class. You can then add your own methods etc to it.

    Your script works well here, fast and peppy, but with that grabglobal, I can't start a top to see cpu usage. :-)


    I'm not really a human, but I play one on earth Remember How Lucky You Are

      Appreciate your feedback as always, Sir!

      I use the ztkbubble example as a basis for making almost any type of composite item on Zinc.

      I think you missed the operative word 'complex', and I failed to explain properly as is tradition by now. Specifically I need to create objects that have one-to-one, one-to-many or many-to-many relationships. Each object has a visual representation on the canvas (filled curve in most cases); Each relationship has a visual representation on the canvas (bezier). I can figure out how to do this -- the question is if some project exists that use Zinc (or canvas) to visualize complex relationships between objects; ie how to best approach this problem in an efficient way using PTK, hopefully saving me hours upon hours of experiments and refactoring ;-)

      Subclassing Zinc might be a viable option for me - I will look into this. When I understand bless(). ;-)

        Subclassing Zinc might be a viable option for me - I will look into this. When I understand bless()

        Look at Tk::CanvasDirTree where I subclass the Tk::Canvas. You could easily substitute Zinc in that, with minor syntax changes for things like finding the root group and scrollbar control, etc.

        You might want to post a new node asking about modules for handling complex interactions, I'm sure I've seen it discussed here before.


        I'm not really a human, but I play one on earth Remember How Lucky You Are