view release on metacpan or  search on metacpan

lib/Tk/Spectrum.pm  view on Meta::CPAN

	$labValues->Label (
		-text => 'Red:',
	)->grid (-column => 0, -row => 0);
	my $txtRed = $labValues->Entry (
		-textvariable => \$args->{redval},
		-width        => 3,
	)->grid (-column => 1, -row => 0);
	$labValues->Label (
		-text => 'Green:',
	)->grid (-column => 2, -row => 0);
	my $txtGrn = $labValues->Entry (
		-textvariable => \$args->{grnval},
		-width        => 3,
	)->grid (-column => 3, -row => 0);
	$labValues->Label (
		-text => 'Blue:',
	)->grid (-column => 4, -row => 0);
	my $txtBlu = $labValues->Entry (
		-textvariable => \$args->{bluval},
		-width        => 3,
	)->grid (-column => 5, -row => 0);

	# Bind the return keys for these entries.
	$txtRed->bind ('<Return>', sub {
		my $hex = $args->getHex ([
			$args->{redval},
			$args->{grnval},
			$args->{bluval},
		]);
		$curColor->configure (-background => $hex);
		$args->{selectedcolor} = $hex;
		$args->hexToRGB($hex);
	});
	$txtGrn->bind ('<Return>', sub {
		my $hex = $args->getHex ([
			$args->{redval},
			$args->{grnval},
			$args->{bluval},
		]);
		$curColor->configure (-background => $hex);
		$args->{selectedcolor} = $hex;
		$args->hexToRGB($hex);
	});
	$txtBlu->bind ('<Return>', sub {
		my $hex = $args->getHex ([
			$args->{redval},
			$args->{grnval},
			$args->{bluval},
		]);
		$curColor->configure (-background => $hex);
		$args->{selectedcolor} = $hex;
		$args->hexToRGB($hex);
	});

	$labValues->Label (
		-text => 'Hex:',
	)->grid (-column => 0, -row => 1);
	my $txtHex = $labValues->Entry (
		-textvariable => \$args->{hexval},
	)->grid (-column => 1, -row => 1, -columnspan => 5, -sticky => 'ew');
	$txtHex->bind ('<Return>', sub {
		my $valid = 1;
		if (length $args->{hexval} > 7 || length $args->{hexval} < 6) {
			$valid = 0;
		}
		if ($args->{hexval} =~ /[^A-Fa-f0-9\#]/) {
			$valid = 0;
		}

		if ($valid) {
			$args->{hexval} = '#' . $args->{hexval} unless $args->{hexval} =~ /^#/;
			$curColor->configure (-background => $args->{hexval});
			$args->{selectedcolor} = $args->{hexval};
			$args->hexToRGB($args->{hexval});
		}
	});

	my $labPreset = $rightFrame->LabFrame (
		-label     => 'Preset Colors',
		-labelside => 'acrosstop',
	)->pack (-side => 'top', -fill => 'x', -padx => 5);

	my $y = 0;
	foreach my $row (@{$presets}) {
		my $x = 0;
		foreach my $color (@{$row}) {
			my $pre = $labPreset->Frame (
				-background  => $color,
				-borderwidth => 1,
				-relief      => 'sunken',
				-width       => 19,
				-height      => 19,
			)->grid (-column => $x, -row => $y);
			$pre->bind ('<Button-1>', sub {
				$curColor->configure (-background => $color);
				$args->{selectedcolor} = $color;
				$args->hexToRGB($color);
			});
			$x++;
		}
		$y++;
	}

	# Load the data for the initial color.
	$args->hexToRGB($initColor);

	$win->waitVariable (\$args->{selectedbtn});
	$win->destroy;

	if ($args->{selectedbtn} eq $btnOkay) {
		return $args->{selectedcolor};
	}
	else {
		return $initColor;
	}
}

sub getHex {
	my ($self,$color) = @_;