view release on metacpan or  search on metacpan

lib/Tk/Canvas/GradientColor.pm  view on Meta::CPAN

package Tk::Canvas::GradientColor;

use warnings;
use strict;
use Carp;

#=============================================================================
# $Author    : Djibril Ousmanou                                              $
# $Copyright : 2014                                                          $
# $Update    : 30/04/2014                                                    $
# $AIM       : Create gradient background color on a button in Canvas widget $
#=============================================================================

use vars qw($VERSION);
$VERSION = '1.06';

use base qw/Tk::Derived Tk::Canvas/;
use POSIX qw( ceil );

Construct Tk::Widget 'GradientColor';

my $COLOR_TAG    = 'bg_gradient_color_canvas';
my $MIN_START    = 0;
my $MIDDLE_START = 50;
my $MAX_START    = 100;
my $NBR_COLOR    = 100;
my $PERCENT      = 100;

sub Populate {
	my ( $cw, $ref_parameters ) = @_;

	$cw->SUPER::Populate($ref_parameters);
	$cw->Advertise( 'canvas' => $cw );
	$cw->Advertise( 'Canvas' => $cw );

	# remove highlightthickness if necessary
	if ( !exists $ref_parameters->{-highlightthickness} ) {
		$cw->configure( -highlightthickness => 0 );
	}

	$cw->Delegates( DEFAULT => $cw );

	$cw->{GradientColorCanvas}{activation} = 1;
	foreach my $key (qw{ Down End Home Left Next Prior Right Up }) {
		$cw->Tk::bind( 'Tk::Canvas::GradientColor', "<Key-$key>",         undef );
		$cw->Tk::bind( 'Tk::Canvas::GradientColor', "<Control-Key-$key>", undef );
	}
	$cw->Tk::bind( '<Configure>' => \&set_gradientcolor );

	return;
}

sub get_gradientcolor {
	my $cw = shift;
	return $cw->{GradientColorCanvas}{gradient};
}

sub disabled_gradientcolor {
	my $cw = shift;
	$cw->{GradientColorCanvas}{activation} = '0';
	if ( $cw->find( 'withtag', $COLOR_TAG ) ) { $cw->delete($COLOR_TAG); }
	return 1;
}

sub enabled_gradientcolor {
	my $cw = shift;
	$cw->{GradientColorCanvas}{activation} = 1;
	$cw->set_gradientcolor;
	return 1;
}

sub set_gradientcolor {
	my ( $cw, %gradient ) = @_;

	if ( $cw->{GradientColorCanvas}{activation} == 0 ) { return; }

	my $ref_gradient = $cw->_treat_parameters_bg( \%gradient );