view release on metacpan or  search on metacpan

FireButton.pm  view on Meta::CPAN

# 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'])