Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

Comment on

( #3333=superdoc: print w/replies, xml ) Need Help??

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);-)


In reply to GUIs in Tk.:Zinc; a perl module experiment by rocklee

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others scrutinizing the Monastery: (7)
    As of 2018-06-19 05:29 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      Should cpanminus be part of the standard Perl release?



      Results (111 votes). Check out past polls.

      Notices?