libtk-gbarr-perl 2.08-2 / usr / share / perl5 / Tk / FireButton.pm

# POD after __END__
# $Id: FireButton.pm,v 1.5 2003/10/22 21:33:11 eserte Exp $

package Tk::FireButton;

use Tk 402.002 (); # for DefineBitmap
use Tk::Derived;
use Tk::Button;
use strict;

use vars qw(@ISA $VERSION);
@ISA = qw(Tk::Derived Tk::Button);
$VERSION = sprintf("%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/);

Construct Tk::Widget 'FireButton';

use vars qw($DECBITMAP $INCBITMAP $HORIZDECBITMAP $HORIZINCBITMAP);

$INCBITMAP = __PACKAGE__ . "::inc";
$DECBITMAP = __PACKAGE__ . "::dec";
$HORIZINCBITMAP = __PACKAGE__ . "::horizinc";
$HORIZDECBITMAP = __PACKAGE__ . "::horizdec";

my $def_bitmaps = 0;

sub ClassInit {
    my($class,$mw) = @_;

    unless($def_bitmaps) {
	my $bits = pack("b8"x5,	"........",
				"...11...",
				"..1111..",
				".111111.",
				"........");

	$mw->DefineBitmap($INCBITMAP => 8,5, $bits);

	# And of course, decrement is the reverse of increment :-)
	$mw->DefineBitmap($DECBITMAP => 8,5, scalar reverse $bits);

	my @rot_bits = (".....",
			".1...",
			".11..",
			".111.",
			".111.",
			".11..",
			".1...",
			".....");
	my $rot_bits          = pack("b5"x8, @rot_bits);
	my $mirrored_rot_bits = pack("b5"x8, map { scalar reverse } @rot_bits);

	$mw->DefineBitmap($HORIZINCBITMAP => 5,8, $rot_bits);
	$mw->DefineBitmap($HORIZDECBITMAP => 5,8, $mirrored_rot_bits);

	$def_bitmaps = 1;
    }

    $class->SUPER::ClassInit($mw);
}


sub butDown {
    my $b = shift;
    my $fire = shift || 'initial';

    if ($fire eq 'initial') {
	# XXX why isn't relief saving done the Tk::Button as
        #soon as callback is invoked?
	$b->{tk_firebutton_save_relief} = $b->cget('-relief');

   	$b->RepeatId($b->after( $b->cget('-repeatdelay'),
		[\&butDown, $b, 'again'])
		); 
    } else {
    	$b->invoke;
        $b->RepeatId($b->after( $b->cget('-repeatinterval'),
                [\&butDown, $b, 'again'])
                );
    }

    $b->SUPER::butDown;
}

sub butUp {
    my $b = shift;
    $b->CancelRepeat;
    $b->SUPER::butUp;
    $b->configure(-relief=>$b->{tk_firebutton_save_relief})
	if $b->{tk_firebutton_save_relief};
}

sub Populate {
    my($b,$args) = @_;

    $b->SUPER::Populate($args);

    $b->ConfigSpecs(
	# Override button fallbacks
	-padx 		    => [qw(SELF padX               Pad                0)],
	-pady 		    => [qw(SELF padY               Pad                0)],

	# new options
        -repeatdelay     => [qw(PASSIVE repeatDelay    RepeatDelay    300)],
	-repeatinterval  => [qw(PASSIVE repeatInterval RepeatInterval 100)],
	);

    $b;
}

sub INCBITMAP      { $INCBITMAP      }
sub HORIZINCBITMAP { $HORIZINCBITMAP }
sub DECBITMAP      { $DECBITMAP      }
sub HORIZDECBITMAP { $HORIZDECBITMAP }

1;

__END__

=head1 NAME

Tk::FireButton - Button that keeps invoking callback when pressed


=head1 SYNOPSIS

    use Tk::FireButton;

    $fire = $parent->FireButton( ... );

    # May/should change:
    $w->Whatever(... -bitmap => $Tk::FireButton::INCBITMAP, ...);
    $w->Whatever(... -bitmap => $Tk::FireButton::DECBITMAP, ...);
    $w->Whatever(... -bitmap => $Tk::FireButton::HORIZINCBITMAP, ...);
    $w->Whatever(... -bitmap => $Tk::FireButton::HORIZDECBITMAP, ...);


=head1 DESCRIPTION

B<FireButton> is-a B<Button> widget (see L<Tk::Button>) that
keeps invoking the callback bound to it as long as the <FireButton>
is pressed.

Four suitable bitmaps are predefined in this package: $INCBITMAP and
$DECBITMAP for vertical increment and decrement buttons, and
$HORIZINCBITMAP and $HORIZDECBITMAP for horizontal increment and
decrement buttons. See below for methods accessing these bitmaps.


=head1 SUPER-CLASS

The B<FireButton> widget-class is derived from the B<Button>
widget-class and inherits all the methods and options its
super-class (see L<Tk::Button>).


=head1 STANDARD OPTIONS

B<FireButton> supports all the standard options of a B<Button> widget.
See L<Tk::options> for details on the standard options.


=head1 WIDGET-SPECIFIC OPTIONS


=over 4

=item Name:             B<repeatDelay>

=item Class:            B<RepeatDelay>

=item Switch:           B<-repeatdelay>

=item Fallback:		B<300> (milliseconds)

Specifies the amount of time before the callback is first invoked after
the Button-1 is pressed over the widget.


=item Name:             B<repeatInterval>

=item Class:            B<RepeatInterval>

=item Switch:           B<-repeatinterval>

=item Fallback:		B<100> (milliseconds)

Specifies the amount of time between invocations of the
callback bound to the widget with the C<command> option.

=back

=head1 CHANDED OPTION FALLBACK VALUES

The fallback values of the following options as different
from the B<Button> widget:

        -padx               => 0,
        -pady               => 0,


=head1 METHODS

Same as for L<Button|Tk::Button> widget.

Additionally, there are four methods returning the names of the
standard increment and decrement bitmaps: INCBITMAP, HORIZINCBITMAP,
DECBITMAP, and HORIZDECBITMAP.

Subclasses of FireButton may override these methods to supply
different increment and decrement bitmaps.

=head1 ADVERTISED WIDGETS

None.


=head1 HISTORY

The code was extracted from Tk::NumEntry and slightly modified
by Achim Bohnet E<gt>ach@mpe.mpg.deE<gt>.  Tk::NumEntry's author
is Graham Barr E<gt>gbarr@pobox.comE<gt>. The current maintainer is
Slaven Rezic E<gt>slaven@rezic.deE<gt>.

=cut