view release on metacpan or  search on metacpan

EMatrix.pm  view on Meta::CPAN

package Tk::EMatrix;

use warnings;

require Tk::TableMatrix;
require Exporter;

@ISA = qw(Exporter Tk::Derived Tk::TableMatrix);

$VERSION = '0.01';

Construct Tk::Widget 'EMatrix';

sub Populate{
   my($dw, $args) = @_;
   $dw->SUPER::Populate($args);
   
   $dw->ConfigSpecs(DEFAULT => [$dw]);
   $dw->Delegates(DEFAULT => $dw);
}

# Bind all cells of a particular row
sub bindRow{
   my($dw, %args) = @_;
   
   my $index = $args{-index};
   my $sequence = $args{-sequence};
   my $callback = $args{-command};
   
   if(!defined($index)){ die "\nNo index value specified: $!" }
   if(!defined($sequence)){ die "\nNo sequence value specified: $!" }
   if(!defined($callback)){ die "\nNo callback value specified: $!" }
   
   $dw->bind($sequence, sub{
      my $Ev = $dw->XEvent;
      my $indexTemp = $dw->index('@' . $Ev->x.",".$Ev->y);
      my($row,$col) = $indexTemp =~ /(\d),(\d)/;
      if($row != $index){ return }
      else{ &$callback }
   });   
}

# Bind all cells of a particular column
sub bindCol{
   my($dw, %args) = @_;
   
   my $index = $args{-index};
   my $sequence = $args{-sequence};
   my $callback = $args{-command};
   
   if(!defined($index)){ die "\nNo index value specified: $!" }
   if(!defined($sequence)){ die "\nNo sequence value specified: $!" }
   if(!defined($callback)){ die "\nNo callback value specified: $!" }
   
   $dw->bind($sequence, sub{
      my $Ev = $dw->XEvent;
      my $indexTemp = $dw->index('@' . $Ev->x.",".$Ev->y);
      my($row,$col) = $indexTemp =~ /(\d),(\d)/;
      if($col != $index){ return }
      else{ &$callback }
   });   
}

#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
# Return the contents of the row specified by '$index' as an array in list
# context, or an array reference in scalar context.
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub getRow{