view release on metacpan or  search on metacpan

Prima/Sliders.pm  view on Meta::CPAN

{
	my $self = shift;
	my %profile = @_;
	my $visible = $profile{visible};
	$profile{visible} = 0;
	for (qw( min max step circulate pageStep)) {$self-> {$_} = 1;};
	$self-> {edit} = bless [], q\Prima::SpinEdit::DummyEdit\;
	%profile = $self-> SUPER::init(%profile);
	my ( $w, $h) = ( $self-> size);
	$self-> {spin} = $self-> insert( $profile{spinClass} =>
		ownerBackColor => 1,
		name           => 'Spin',
		bottom         => 1,
		right          => $w - 1,
		height         => $h - 1 * 2,
		growMode       => gm::Right,
		delegations    => $profile{spinDelegations},
		(map { $_ => $profile{$_}} grep { exists $profile{$_} ? 1 : 0} keys %spinDynas),
		%{$profile{spinProfile}},
	);
	$self-> {edit} = $self-> insert( $profile{editClass} =>
		name         => 'InputLine',
		origin      => [ 1, 1],
		size        => [ $w - $self-> {spin}-> width - 1 * 2, $h - 1 * 2],
		growMode    => gm::GrowHiX|gm::GrowHiY,
		selectable  => 1,
		tabStop     => 1,
		borderWidth => 0,
		current     => 1,
		delegations => $profile{editDelegations},
		(map { $_ => $profile{$_}} keys %editProps),
		%{$profile{editProfile}},
		text        => $profile{value},
	);
	for (qw( min max step value circulate pageStep)) {$self-> $_($profile{$_});};
	$self-> visible( $visible);
	return %profile;
}

sub on_paint
{
	my ( $self, $canvas) = @_;
	my @s = $canvas-> size;
	$canvas-> rect3d( 0, 0, $s[0]-1, $s[1]-1, 1, $self-> dark3DColor, $self-> light3DColor);
}

sub InputLine_MouseWheel
{
	my ( $self, $edit, $mod, $x, $y, $z) = @_;
	$z = (abs($z) > 120) ? int($z/120) : (($z > 0) ? 1 : -1);
	$z *= $self-> {pageStep} if $mod & km::Ctrl;
	my $value = $self-> value;
	$self-> value( $value + $z * $self-> {step});
	$self-> value( $z > 0 ? $self-> min : $self-> max)
		if $self-> {circulate} && ( $self-> value == $value);
	$edit-> clear_event;
}

sub InputLine_DragEnd
{
	my ( $self, $edit, $clipboard, $action, $mod, $x, $y, $ref ) = @_;
	return unless $clipboard;
	my $text = $clipboard->text;
	return unless defined $text;
	$text =~ s/^\s+//;
	$text =~ s/\s+$//;
	return if $text =~ /^-?\d+(\.\d+)?$/ and $text >= $self->min and $text <= $self->max;
	$edit->clear_event;
	$edit->on_dragend(undef, $action, $mod, $x, $y, $ref);
	$ref->{allow} = 0;
}

sub Spin_Increment
{
	my ( $self, $spin, $increment) = @_;
	my $value = $self-> value;
	$self-> value( $value + $increment * $self-> {step});
	$self-> value( $increment > 0 ? $self-> min : $self-> max)
		if $self-> {circulate} && ( $self-> value == $value);
}

sub InputLine_KeyDown
{
	my ( $self, $edit, $code, $key, $mod) = @_;
	$edit-> clear_event, return if
		$key == kb::NoKey && !($mod & (km::Alt | km::Ctrl)) &&
		chr($code) !~ /^[.\d+-]$/;
	if ( $key == kb::Up || $key == kb::Down || $key == kb::PgDn || $key == kb::PgUp) {
		my ($s,$pgs) = ( $self-> step, $self-> pageStep);
		my $z = ( $key == kb::Up) ? $s : (( $key == kb::Down) ? -$s :
			(( $key == kb::PgUp) ? $pgs : -$pgs));
		if (( $mod & km::Ctrl) && ( $key == kb::PgDn || $key == kb::PgUp)) {
			$self-> value( $key == kb::PgDn ? $self-> min : $self-> max);
		} else {
			my $value = $self-> value;
			$self-> value( $value + $z);
			$self-> value( $z > 0 ? $self-> min : $self-> max)
				if $self-> {circulate} && ( $self-> value == $value);
		}
		$edit-> clear_event;
		return;
	}
	if ($key == kb::Enter) {
		my $value = $edit-> text;
		$self-> value( $value);
		$edit-> clear_event if $value ne $self-> value;
		return;
	}
}

sub InputLine_Change
{
	my ( $self, $edit) = @_;
	$self-> notify(q(Change));
}

sub InputLine_Enter
{
	my ( $self, $edit) = @_;
	$self-> notify(q(Enter));
}

sub InputLine_Leave