# contains:
#   SpinButton
#   AltSpinButton
#   SpinEdit
#   Gauge
#   Slider
#   CircularSlider

package Prima::Sliders;

use strict;
use warnings;
use Prima;

package Prima::AbstractSpinButton;
use base qw(Prima::Widget Prima::Widget::MouseScroller);

{
my %RNT = (
	%{Prima::Widget-> notification_types()},
	Increment  => nt::Default,
	TrackEnd   => nt::Default,
);
sub notification_types { return \%RNT; }
}

sub profile_default
{
	return {
		%{$_[ 0]-> SUPER::profile_default},
		ownerBackColor => 1,
		color          => cl::Black,
		selectable     => 0,
		tabStop        => 0,
		widgetClass    => wc::ScrollBar,
	}
}

sub init
{
	my $self = shift;
	my %profile = $self-> SUPER::init( @_);
	$self-> { pressState} = 0;
	return %profile;
}

sub on_mouseclick
{
	my $self = shift;
	$self-> clear_event;
	return unless pop;
	$self-> clear_event unless $self-> notify( "MouseDown", @_);
}

sub state         {($#_)?$_[0]-> set_state ($_[1]):return $_[0]-> {pressState}}

#sub on_trackend   {}
#sub on_increment  {
#  my ( $self, $increment) = @_;
#}


package Prima::SpinButton;
use vars qw(@ISA);
@ISA = qw(Prima::AbstractSpinButton);

sub profile_default
{
	return {
		%{$_[ 0]-> SUPER::profile_default},
		width        => 17 * $::application-> uiScaling,
		height       => 24 * $::application-> uiScaling,
	}
}

sub on_mousedown
{
	my ( $self, $btn, $mod, $x, $y) = @_;
	return if $self-> {mouseTransaction};
	return if $btn != mb::Left;
	my $h = $self-> height;
	if ( $y >= $h * 0.6) {
		$self-> { mouseTransaction} = 1;
	} elsif ( $y <  $h * 0.4) {
		$self-> { mouseTransaction} = 2;
	} else {
		$self-> { mouseTransaction} = 3;
	}
	delete $self->{prelight};
	$self-> { lastMouseOver}  = 1;
	$self-> { startMouseY  }  = $y;
	$self-> state( $self-> { mouseTransaction});
	$self-> capture(1);
	$self-> clear_event;
	$self-> {increment} = 0;
	if ( $self-> { mouseTransaction} != 3) {
		$self-> notify( 'Increment', $self-> { mouseTransaction} == 1 ? 1 : -1);
		$self-> scroll_timer_start;
		$self-> scroll_timer_semaphore(0);
	} else {
		$self-> {pointerSave} = $self-> pointer;
		$self-> pointer( cr::SizeWE);
	}
}

sub on_mouseup
{
	my ( $self, $btn, $mod, $x, $y) = @_;
	return if $btn != mb::Left;
	return unless $self-> {mouseTransaction};
	my $mt  = $self-> {mouseTransaction};
	my $inc = $mt != 2 ? 1 : -1;

	$self-> {mouseTransaction} = undef;
	$self-> {spaceTransaction} = undef;
	$self-> {lastMouseOver}    = undef;
	$self-> capture(0);
	$self-> scroll_timer_stop;
	$self-> state( 0);
	$self-> pointer( $self-> {pointerSave}), $self-> {pointerSave} = undef
		if $mt == 3;
	$self-> {increment} = 0;
	$self-> notify( 'TrackEnd');
}

sub on_mousemove
{
	my ( $self, $mod, $x, $y) = @_;
	unless ( $self-> {mouseTransaction}) {
		my $h = $self-> height;
		my $prelight;
		if ( $self-> enabled ) {
			if ( $y >= $h * 0.6) {
				$prelight = 'lower';
				$self-> pointer(cr::Default);
			} elsif ($y < $h * 0.4 ) {
				$prelight = 'upper';
				$self-> pointer(cr::Default);
			} else {
				$prelight = 'middle';
				$self-> pointer(cr::SizeWE);
			}
			if (( $prelight // '') ne ($self->{prelight} // '')) {
				$self->{prelight} = $prelight;
				$self-> repaint;
			}
		}
		return;
	}
	my @size = $self-> size;
	my $mouseOver = $x > 0 && $y > 0 && $x < $size[0] && $y < $size[1];
	$self-> state( $self-> {pressState} ? 0 : $self-> {mouseTransaction})
		if $self-> { lastMouseOver} != $mouseOver && $self-> {pressState} != 3;
	$self-> { lastMouseOver} = $mouseOver;

	if ( $self-> {pressState} == 3) {
		my $d  = ( $self-> {startMouseY} - $y) / 3; # 2 is mouse sensitivity
		$self-> notify( 'Increment', int($self-> {increment}) - int($d))
			if int( $self-> {increment}) != int( $d);
		$self-> {increment}  = $d;
	} elsif ( $self-> {pressState} > 0) {
		$self-> scroll_timer_start unless $self-> scroll_timer_active;
		return unless $self-> scroll_timer_semaphore;
		$self-> scroll_timer_semaphore(0);
		$self-> notify( 'Increment', $self-> {mouseTransaction} == 1 ? 1 : -1);
	} else {
		$self-> scroll_timer_stop;
	}
}

sub on_mouseleave
{
	my $self = shift;
	$self-> repaint if defined( delete $self->{prelight} );
}

sub on_paint
{
	my ( $self, $canvas) = @_;
	my @clr;
	my ($prelightPart, $prelightColor) = ('');
	if ( $self-> enabled) {
		@clr = ($self-> color, $self-> backColor);
		if ($self->{prelight}) {
			$prelightColor = $self-> prelight_color($clr[1], 1.5);
			$prelightPart  = $self->{prelight};
		}
	} else {
		@clr = ( $self-> disabledColor, $self-> disabledBackColor);
	}
	my @c3d  = ( $self-> light3DColor, $self-> dark3DColor);
	my @size = $canvas-> size;
	my $p = $self-> {pressState};

	my @parts = (
		lower  => [0, $size[1] * 0.6, $size[0] - 1, $size[1] - 1],
		upper  => [0, 0, $size[0] - 1, $size[1] * 0.4 - 1],
		middle => [0, $size[1] * 0.4, $size[0] - 1, $size[1] * 0.6 - 1],
	);
	my $flat = $self-> skin eq 'flat';
	for ( my ($i, $pressed) = (0, 1); $i < @parts; $i+=2, $pressed++) {
		my $clr  = ($prelightPart eq $parts[$i]) ? $prelightColor : $clr[1];
		my $rect = $parts[$i+1];
		if ( $flat ) {
			$self-> color($clr);
			$self-> bar( @$rect );
		} else {
			$canvas-> rect3d( @$rect, 2, (($p != $pressed) ? @c3d : reverse @c3d), $clr);
		}
	}

	$canvas-> color( $clr[0]);
	my $p1 = ( $p == 1) ? 1 : 0;
	$canvas-> fillpoly( [
		$size[0] * 0.3 + $p1, $size[1] * 0.73 - $p1,
		$size[0] * 0.5 + $p1, $size[1] * 0.87 - $p1,
		$size[0] * 0.7 + $p1, $size[1] * 0.73 - $p1
	]);
	$p1 = ( $p == 2) ? 1 : 0;
	$canvas-> fillpoly( [
		$size[0] * 0.3 + $p1, $size[1] * 0.27 - $p1,
		$size[0] * 0.5 + $p1, $size[1] * 0.13 - $p1,
		$size[0] * 0.7 + $p1, $size[1] * 0.27 - $p1
	]);
}

sub set_state
{
	my ( $self, $s) = @_;
	$s = 0 if $s > 3;
	return if $s == $self-> {pressState};
	$self-> {pressState} = $s;
	$self-> repaint;
}

package Prima::AltSpinButton;
use vars qw(@ISA);
@ISA = qw(Prima::AbstractSpinButton);

sub profile_default
{
	return {
		%{$_[ 0]-> SUPER::profile_default},
		width        => 18 * $::application-> uiScaling,
		height       => 18 * $::application-> uiScaling,
		flatSeparator => 0,
	}
}

sub profile_check_in
{
	my ( $self, $p, $default) = @_;
	$p-> {height} = $p-> {width}  if !exists( $p-> {height}) && exists( $p-> {width});
	$p-> {width}  = $p-> {height} if exists( $p-> {height}) && !exists( $p-> {width});
	$self-> SUPER::profile_check_in( $p, $default);
}

sub init
{
	my $self = shift;
	my %profile = $self-> SUPER::init( @_);
	$self-> {flatSeparator} = $profile{flatSeparator};
	return %profile;
}

sub on_mousedown
{
	my ( $self, $btn, $mod, $x, $y) = @_;
	return if $self-> {mouseTransaction};
	return if $btn != mb::Left;
	$self-> { mouseTransaction} =
		(( $x * $self-> height / ( $self-> width || 1)) > $y) ?
			2 : 1;
	$self-> { lastMouseOver}  = 1;
	delete $self->{prelight};
	$self-> state( $self-> { mouseTransaction});
	$self-> capture(1);
	$self-> clear_event;
	$self-> notify( 'Increment', $self-> { mouseTransaction} == 1 ? 1 : -1);
	$self-> scroll_timer_start;
	$self-> scroll_timer_semaphore(0);
}

sub on_mouseup
{
	my ( $self, $btn, $mod, $x, $y) = @_;
	return if $btn != mb::Left;
	return unless $self-> {mouseTransaction};
	$self-> {mouseTransaction} = undef;
	$self-> {spaceTransaction} = undef;
	$self-> {lastMouseOver}    = undef;
	$self-> capture(0);
	$self-> scroll_timer_stop;
	$self-> state( 0);
	$self-> notify( 'TrackEnd');
}

sub on_mousemove
{
	my ( $self, $mod, $x, $y) = @_;
	unless ($self-> {mouseTransaction}) {
		if ( $self-> enabled ) {
			my $prelight = (( $x * $self-> height / ( $self-> width || 1)) > $y) ?  2 : 1;
			if (( $self->{prelight} // 0 ) != $prelight) {
				$self->{prelight} = $prelight;
				$self->repaint;
			}
		}
		return;
	}
	my @size = $self-> size;
	my $mouseOver = $x > 0 && $y > 0 && $x < $size[0] && $y < $size[1];
	$self-> state( $self-> {pressState} ? 0 : $self-> {mouseTransaction})
		if $self-> { lastMouseOver} != $mouseOver;
	$self-> { lastMouseOver} = $mouseOver;
	if ( $self-> {pressState}) {
		$self-> scroll_timer_start unless $self-> scroll_timer_active;
		return unless $self-> scroll_timer_semaphore;
		$self-> scroll_timer_semaphore(0);
		$self-> notify( 'Increment', $self-> {mouseTransaction} == 1 ? 1 : -1);
	} else {
		$self-> scroll_timer_stop;
	}
}

sub on_mouseleave
{
	my $self = shift;
	$self-> repaint if defined( delete $self->{prelight} );
}

sub fix_triangle
{
	my @spot = map { int($_ + .5) } @_;
	my $dx = $spot[4] - $spot[0];
	my $dy = $spot[3] - $spot[1];
	if ($dx % 2) {
		$spot[2] = $spot[0] + ($dx - 1) / 2;
		$spot[4]--;
		$dx--;
	}
	if ( $dx == 2 ) {
		$spot[4]++;
		$spot[0]--;
		$dx += 2;
	}
	$spot[3] -= ($dy > 0) ? 1 : -1 if abs($dy) > $dx / 2;
	return \@spot;
}

sub on_paint
{
	my ( $self, $canvas) = @_;
	my @clr  = ( $self-> color, $self-> backColor);
	@clr = ( $self-> hiliteColor, $self-> hiliteBackColor)     if $self-> { default};
	@clr = ( $self-> disabledColor, $self-> disabledBackColor) if !$self-> enabled;
	my ($prelightPart, $prelightColor) = (0);
	my $flat = $self->skin eq 'flat';
	if ($self->{prelight}) {
		$prelightColor = $self-> prelight_color($clr[1], 1.5);
		$prelightPart  = $self->{prelight};
	}
	my @c3d  = ( $self-> light3DColor, $self-> dark3DColor);
	my @size = $canvas-> size;
	$canvas-> color( $clr[ 1]);
	$canvas-> bar( 0, 0, $size[0]-1, $size[1]-1);
	my $p = $self-> {pressState};

	if ( $prelightPart == 1 && $size[1] > 4 && $size[0] > 4 ) {
		$canvas->color( $prelightColor );
		$canvas->fillpoly([
			2, 2,
			2, $size[1] - 3,
			$size[0] - 3, $size[1] - 3,
		]);
	}

	if ( $flat ) {
		if ( $self->{flatSeparator}) {
			$canvas-> color( $self-> dark3DColor );
			$canvas-> line(0, 0, 0, $size[1]);
		}
	} else {
		$canvas-> color( $p == 1 ? 0x404040 : $c3d[1]);
		$canvas-> polyline( [0, 0, 0, $size[1] - 1, $size[0] - 2, $size[1] - 1]);
		$canvas-> color( $p == 1 ? $c3d[1]  : $c3d[0]);
		$canvas-> polyline( [1, 1, 1, $size[1] - 2, $size[0] - 3, $size[1] - 2]);
	}

	if ( $prelightPart == 2 && $size[1] > 4 && $size[0] > 4 ) {
		$canvas->color( $prelightColor );
		$canvas->fillpoly([
			2, 2,
			$size[0] - 3, $size[1] - 3,
			$size[0] - 3, 2,
		]);
	}
	unless ( $flat ) {
		$canvas-> color( $p == 2 ? $c3d[0] : $c3d[1]);
		$canvas-> polyline([2, 1, $size[0] - 2, 1, $size[0] - 2, $size[1] - 2]);
		$canvas-> color( $p == 2 ? $c3d[1] : 0x404040);
		$canvas-> polyline([1, 0, $size[0] - 1, 0, $size[0] - 1, $size[1] - 1]);

		$canvas-> color( $p == 1 ? $c3d[ 0] : $c3d[ 1]);
		$canvas-> line( -1, 0, $size[0] - 2, $size[1] - 1);
		$canvas-> color( 0x404040);
		$canvas-> line( 0, 0, $size[0] - 1, $size[1] - 1);
		$canvas-> color( $p == 2 ? $c3d[ 1] : $c3d[ 0]);
		$canvas-> line( 1, 0, $size[0], $size[1] - 1);
	}

	$canvas-> color( $clr[0]);
	my $p1 = ( $p == 1) ? 1 : 0;
	$canvas-> fillpoly( fix_triangle(
		$size[0] * 0.2 + $p1, $size[1] * 0.65 - $p1,
		$size[0] * 0.3 + $p1, $size[1] * 0.77 - $p1,
		$size[0] * 0.4 + $p1, $size[1] * 0.65 - $p1
	));
	$p1 = ( $p == 2) ? 1 : 0;
	$canvas-> fillpoly( fix_triangle(
		$size[0] * 0.59 + $p1, $size[1] * 0.35 - $p1,
		$size[0] * 0.69 + $p1, $size[1] * 0.23 - $p1,
		$size[0] * 0.79 + $p1, $size[1] * 0.35 - $p1
	));
}

sub set_state
{
	my ( $self, $s) = @_;
	$s = 0 if $s > 2;
	return if $s == $self-> {pressState};
	$self-> {pressState} = $s;
	$self-> repaint;
}

sub flatSeparator { $#_ ? $_[0]->{flatSeparator} = $_[1] : $_[0]->{flatSeparator} }

package Prima::SpinEdit;
use vars qw(@ISA %editProps %spinDynas);
use Prima::InputLine;
@ISA = qw(Prima::Widget);


%editProps = (
	alignment      => 1, autoScroll  => 1, text        => 1,
	charOffset     => 1, maxLen      => 1, insertMode  => 1, firstChar   => 1,
	selection      => 1, selStart    => 1, selEnd      => 1, writeOnly   => 1,
	copy           => 1, cut         => 1, 'delete'    => 1, paste       => 1,
	wordDelimiters => 1, readOnly    => 1, passwordChar=> 1, focus       => 1,
	select_all     => 1,
);

%spinDynas = ( onIncrement => 1, onTrackEnd => 1,);

for ( keys %editProps) {
	eval <<GENPROC;
   sub $_ { return shift-> {edit}-> $_(\@_); }
   sub Prima::SpinEdit::DummyEdit::$_ { }
GENPROC
}

sub profile_default
{
	my $font = $_[ 0]-> get_default_font;
	my $fh   = $font-> {height} + 2;
	return {
		%{Prima::InputLine-> profile_default},
		%{$_[ 0]-> SUPER::profile_default},
		autoEnableChildren => 1,
		allowEmpty     => 0,
		ownerBackColor => 1,
		selectable     => 0,
		scaleChildren  => 0,
		min            => 0,
		max            => 100,
		step           => 1,
		pageStep       => 10,
		value          => 0,
		circulate      => 0,
		height         => $fh < 20 ? 20 : $fh,
		editClass      => 'Prima::InputLine',
		spinClass      => 'Prima::AltSpinButton',
		editProfile    => {},
		spinProfile    => {},
		editDelegations=> [qw(KeyDown Change MouseWheel Enter Leave DragEnd)],
		spinDelegations=> [qw(Increment)],
	}
}

sub init
{
	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,
		ownerColor     => 1,
		name           => 'Spin',
		bottom         => 1,
		right          => $w - 1,
		height         => $h - 1 * 2,
		growMode       => gm::Right,
		flatSeparator  => 1,
		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( allowEmpty min max step value circulate pageStep)) {$self-> $_($profile{$_});};
	$self-> visible( $visible);
	return %profile;
}

sub on_paint
{
	my ( $self, $canvas) = @_;
	my @s = $canvas-> size;
	if ( $self-> skin eq 'flat') {
		$canvas->color( $self->dark3DColor);
		$canvas->rectangle(0,0,$s[0]-1,$s[1]-1);
	} else {
		$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;
	$value = $self->min if $value eq '';
	$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+$//;
	my $ok = $text =~ /^-?\d+(\.\d+)?$/ && $text >= $self->min && $text <= $self->max;
	$ok = 1 if $self->{allowEmpty} && $text eq '';
	return unless $ok;
	$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;
	$value = $self->min if $value eq '';
	$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;
			$value = $self->min if $value eq '';
			$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
{
	my ( $self, $edit) = @_;
	$self-> notify(q(Leave));
}

sub set_bounds
{
	my ( $self, $min, $max) = @_;
	$max = $min if $max < $min;
	( $self-> { min}, $self-> { max}) = ( $min, $max);
	return if $self->{allowEmpty} && $self->value eq '';
	$self-> value( $max) if $max < $self-> value;
	$self-> value( $min) if $min > $self-> value;
}

sub set_step
{
	my ( $self, $step) = @_;
	$step  = 0 if $step < 0;
	$self-> {step} = $step;
}

sub circulate
{
	return $_[0]-> {circulate} unless $#_;
	$_[0]-> {circulate} = $_[1];
}

sub pageStep
{
	return $_[0]-> {pageStep} unless $#_;
	$_[0]-> {pageStep} = $_[1];
}

sub allowEmpty   {$#_ ? $_[0]-> {allowEmpty} = $_[1] : return $_[0]-> {allowEmpty}}

sub min          {($#_)?$_[0]-> set_bounds($_[1], $_[0]-> {'max'})      : return $_[0]-> {min};}
sub max          {($#_)?$_[0]-> set_bounds($_[0]-> {'min'}, $_[1])      : return $_[0]-> {max};}
sub step         {($#_)?$_[0]-> set_step         ($_[1]):return $_[0]-> {step}}
sub value
{
	if ($#_) {
		my ( $self, $value) = @_;
		$value //= '';
		if ( $self->{allowEmpty} && $value eq '') {
			# ok
		} elsif ( $value =~ m/^\s*([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?\s*$/) {
			$value = $self-> {min} if $value < $self-> {min};
			$value = $self-> {max} if $value > $self-> {max};
		} else {
			$value = $self-> {min};
		}
		return if $value eq $self-> {edit}-> text;
		$self-> {edit}-> text( $value);
	} else {
		my $self = $_[0];
		my $value = $self-> {edit}-> text;
		if ( $self->{allowEmpty} && $value eq '') {
			# ok
		} elsif ( $value =~ m/^\s*([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?\s*$/) {
			$value = $self-> {min} if $value < $self-> {min};
			$value = $self-> {max} if $value > $self-> {max};
		} else {
			$value = $self-> {min};
		}
		return $value;
	}
}


# gauge reliefs
package
    gr;
use constant Sink         =>  -1;
use constant Border       =>  0;
use constant Raise        =>  1;


package Prima::Gauge;
use vars qw(@ISA);
@ISA = qw(Prima::Widget);

{
my %RNT = (
	%{Prima::Widget-> notification_types()},
	Stringify => nt::Action,
);

sub notification_types { return \%RNT; }
}

sub profile_default
{
	return {
		%{$_[ 0]-> SUPER::profile_default},
		indent         => 1,
		relief         => gr::Sink,
		ownerBackColor => 1,
		hiliteBackColor=> cl::Blue,
		hiliteColor    => cl::White,
		min            => 0,
		max            => 100,
		value          => 0,
		threshold      => 0,
		vertical       => 0,
		# additional properties for indeterminate mode
		indeterminate	=> '1',
		sliderLength	=> 30,
	}
}

sub init
{
	my $self = shift;
	my %profile = $self-> SUPER::init(@_);
	for (qw( relief value indent min max threshold vertical))
	{$self-> {$_} = 0}
	$self-> {string} = '';
	for (qw( vertical threshold min max relief indent value))
	{$self-> $_($profile{$_}); }

	# additional properties for indeterminate mode
	$self->{direction} = 1;
	for (qw( indeterminate sliderLength))
	{$self-> $_($profile{$_}); }
	# If indeterminate is true, the start value must be > sliderLength
	$self->value($self->{sliderLength}) if ($self->indeterminate);

	return %profile;
}

sub setup
{
	$_[0]-> SUPER::setup;
	$_[0]-> value($_[0]-> {value});
}

sub on_paint
{
	my ($self,$canvas) = @_;
	my ($x, $y) = $canvas-> size;

	$canvas->clear();
	my $i = $self-> indent;
	my ($clComplete,$clBack,$clFore,$clHilite) = ($self-> hiliteBackColor, $self-> backColor, $self-> color, $self-> hiliteColor);
	my $v = $self-> {vertical};
	my $complete = $v ? $y : $x;
	my $range = ($self-> {max} - $self-> {min}) || 1;
	$complete = int(($complete - $i*2) * $self-> {value} / $range + 0.5);
	my ( $l3, $d3) = ( $self-> light3DColor, $self-> dark3DColor);
	$canvas-> color( $clComplete);

 	# INDETERMINATE STYLE HACK
	my $left_bound =
		$self->indeterminate ?
			$complete - ($self->{sliderLength} * ($v ? $y : $x) / $range + 0.5) :
			$i;
	$canvas-> bar ( $v ?
		($i, $left_bound, $x-$i-1, $i+$complete) :
		($left_bound, $i, $i + $complete, $y-$i-1));

	$canvas-> color( $clBack);
	$canvas-> bar ( $v ? ($i, $i+$complete+1, $x-$i-1, $y-$i-1) : ( $i+$complete+1, $i, $x-$i-1, $y-$i-1));

	# draw the border
	my $relief = $self-> relief;
	$canvas-> color(( $relief == gr::Sink) ? $d3 : (( $relief == gr::Border) ? cl::Black : $l3));
	for ( my $j = 0; $j < $i; $j++)
	{
		$canvas-> line( $j, $j, $j, $y - $j - 1);
		$canvas-> line( $j, $y - $j - 1, $x - $j - 1, $y - $j - 1);
	}
	$canvas-> color(( $relief == gr::Sink) ? $l3 : (( $relief == gr::Border) ? cl::Black : $d3));
	for ( my $j = 0; $j < $i; $j++)
	{
		$canvas-> line( $j + 1, $j, $x - $j - 1, $j);
		$canvas-> line( $x - $j - 1, $j, $x - $j - 1, $y - $j - 1);
	}


	# draw the text, if neccessary
	my $s = $self-> {string};
	if ( $s ne '')
	{
		my ($fw, $fh) = ( $canvas-> get_text_width( $s), $canvas-> font-> height);
		my $xBeg = int(( $x - $fw) / 2 + 0.5);
		my $xEnd = $xBeg + $fw;
		my $yBeg = int(( $y - $fh) / 2 + 0.5);
		my $yEnd = $yBeg + $fh;
		my ( $zBeg, $zEnd) = $v ? ( $yBeg, $yEnd) : ( $xBeg, $xEnd);
		if ( $zBeg > $i + $complete) {
			$canvas-> color( $clFore);
			$canvas-> text_shape_out( $s, $xBeg, $yBeg);
		} elsif ( $zEnd < $i + $complete + 1) {
			$canvas-> color( $clHilite);
			$canvas-> text_shape_out( $s, $xBeg, $yBeg);
		} else {
			$canvas-> clipRect( $v ?
				( 0, 0, $x, $i + $complete) :
				( 0, 0, $i + $complete, $y)
			);
			$canvas-> color( $clHilite);
			$canvas-> text_shape_out( $s, $xBeg, $yBeg);
			$canvas-> clipRect( $v ?
				( 0, $i + $complete + 1, $x, $y) :
				( $i + $complete + 1, 0, $x, $y)
			);
			$canvas-> color( $clFore);
			$canvas-> text_shape_out( $s, $xBeg, $yBeg);
		}
	}
}

sub set_bounds
{
	my ( $self, $min, $max) = @_;
	$max = $min if $max < $min;
	( $self-> { min}, $self-> { max}) = ( $min, $max);
	my $oldValue = $self-> {value};
	$self-> value( $max) if $self-> {value} > $max;
	$self-> value( $min) if $self-> {value} < $min;
}

sub value {
	return $_[0]-> {value} unless $#_;
	my $v = $_[1] < $_[0]-> {min} ? $_[0]-> {min} : ($_[1] > $_[0]-> {max} ? $_[0]-> {max} : $_[1]);
	$v -= $_[0]-> {min};
	if ($_[0]->indeterminate) {
		$_[0]-> {value} = $v;
		$_[0]-> repaint;
	}
	else {
		my $old = $_[0]-> {value};
		if (abs($old - $v) >= $_[0]-> {threshold}) {
			my ($x, $y) = $_[0]-> size;
			my $i = $_[0]-> {indent};
			my $range = ( $_[0]-> {max} - $_[0]-> {min}) || 1;
			my $x1 = $i + ($x - $i*2) * $old / $range;
			my $x2 = $i + ($x - $i*2) * $v   / $range;
			($x1, $x2) = ( $x2, $x1) if $x1 > $x2;
			my $s = $_[0]-> {string};
			$_[0]-> {value} = $v;
			$_[0]-> notify(q(Stringify), $v, \$_[0]-> {string});
			( $_[0]-> {string} eq $s) ?
				$_[0]-> invalidate_rect( $x1, 0, $x2+1, $y) :
				$_[0]-> repaint;
		}
	}
}

sub on_stringify
{
	my ( $self, $value, $sref) = @_;
	$$sref = sprintf( "%2d%%", $value * 100.0 / (($_[0]-> {max} - $_[0]-> {min})||1));
	$self-> clear_event;
}

sub indent    {($#_)?($_[0]-> {indent} = $_[1],$_[0]-> repaint)  :return $_[0]-> {indent};}
sub relief    {($#_)?($_[0]-> {relief} = $_[1],$_[0]-> repaint)  :return $_[0]-> {relief};}
sub vertical  {($#_)?($_[0]-> {vertical} = $_[1],$_[0]-> repaint):return $_[0]-> {vertical};}
sub min       {($#_)?$_[0]-> set_bounds($_[1], $_[0]-> {'max'})  : return $_[0]-> {min};}
sub max       {($#_)?$_[0]-> set_bounds($_[0]-> {'min'}, $_[1])  : return $_[0]-> {max};}
sub threshold {($#_)?($_[0]-> {threshold} = $_[1]):return $_[0]-> {threshold};}

sub indeterminate    {
	my ($self, $indeterminate) = @_;
	return $self-> {indeterminate} unless $#_;

	# Create the timer for the motion in indeterminate mode
	# if it is not still created
	unless ( $self->{timer} ) {
		$self->{timer} = $self->insert( Timer =>
		name	    => 'Timer',
		timeout     => 25,
		delegations => ['Tick'],
		);
	}

	# When the style property is changed, reset the timer frequency
	# and the start_angle and for style circle the end_angle, too
	if ( $indeterminate) {
		$self->{timer}->start;
	}

	else {
		$self->{timer}->stop;
	}
	$self->{indeterminate} = $indeterminate;

}

sub Timer_Tick
{
	my $self = shift;
	my $newval = $self->value;
	my $sliderLength = $self->sliderLength;
	$newval = $newval+1 if ($self->direction == 1);
	$newval = $newval-1 if ($self->direction == 0);
	$self->value($newval);
	$self->direction(0) if ($newval == 100);
	$self->direction(1) if ($newval == $sliderLength);
	$self->repaint;
}

sub direction    {($#_)?($_[0]-> {direction} = $_[1])  :return $_[0]-> {direction};}
sub sliderLength    {($#_)?($_[0]-> {sliderLength} = $_[1])  :return $_[0]-> {sliderLength};}

# slider standard schemes
package
    ss;
use constant Gauge        => 0;
use constant Axis         => 1;
use constant Thermometer  => 2;
use constant StdMinMax    => 3;

package Prima::AbstractSlider;
use vars qw(@ISA);
@ISA = qw(Prima::Widget);

{
my %RNT = (
	%{Prima::Widget-> notification_types()},
	Track   => nt::Default,
);
sub notification_types { return \%RNT; }
}

sub profile_default
{
	return {
		%{$_[ 0]-> SUPER::profile_default},
		autoHeight     => 0,
		autoWidth      => 0,
		autoTrack      => 1,
		increment      => 10,
		min            => 0,
		max            => 100,
		ownerBackColor => 1,
		readOnly       => 0,
		scheme         => undef,
		selectable     => 1,
		snap           => 0,
		step           => 1,
		ticks          => undef,
		value          => 0,
		widgetClass    => wc::Slider,
	}
}


sub init
{
	my $self = shift;
	for ( qw( min max readOnly snap value autoTrack autoWidth autoHeight))
		{$self-> {$_}=0}
	for ( qw( tickVal tickLen tickTxt )) { $self-> {$_} = [] };
	my %profile = $self-> SUPER::init( @_);
	for ( qw( step min max increment readOnly ticks snap value autoTrack autoHeight autoWidth))
	{$self-> $_($profile{$_});}
	$self-> scheme( $profile{scheme}) if defined $profile{scheme};
	return %profile;
}

sub autoTrack  { $#_ ? $_[0]-> {autoTrack}  = $_[1] : $_[0]-> {autoTrack}  }
sub autoWidth  { $#_ ? $_[0]-> {autoWidth}  = $_[1] : $_[0]-> {autoWidth}  }
sub autoHeight { $#_ ? $_[0]-> {autoHeight} = $_[1] : $_[0]-> {autoHeight} }

sub on_mouseclick
{
	my $self = shift;
	$self-> clear_event;
	return unless pop;
	$self-> clear_event unless $self-> notify( "MouseDown", @_);
}

sub on_mousewheel
{
	my ( $self, $mod, $x, $y, $z) = @_;
	$self-> set_next_value( $self-> {step} * $z / 120);
	$self-> clear_event;
}

sub set_next_value
{
	my ( $self, $dir) = @_;
	$dir *= -1 if $self-> {min} > $self-> {max};
	if ( $self-> snap) {
		my $v = $self-> value;
		my $w = $v;
		return if ( $v + $dir > $self-> {min} and $v + $dir > $self-> {max}) or
			( $v + $dir < $self-> {min} and $v + $dir < $self-> {max});
		$self-> value( $v += $dir) while $self-> {value} == $w;
	} else {
		$self-> value( $self-> value + $dir);
	}
}

sub update_geom_sizes {}

sub set_read_only
{
	$_[0]-> {readOnly} = $_[1];
	$_[0]-> repaint;
	$_[0]-> notify(q(MouseUp),0,0,0) if defined $_[0]-> {mouseTransaction};
}


sub set_snap
{
	$_[0]-> {snap} = $_[1];
	$_[0]-> value( $_[0]-> value) if $_[1];
}

sub set_step
{
	my $i = $_[1];
	$i = 1 if $i == 0;
	$_[0]-> {step} = $i;
}

sub get_ticks
{
	my $self  =  $_[0];
	my $i;
	my ( $tv, $tl, $tt) = ($self-> {tickVal}, $self-> {tickLen}, $self-> {tickTxt});
	my @t;
	for ( $i = 0; $i < scalar @{$tv}; $i++) {
		push ( @t, {
			value => $$tv[$i],
			height => $$tl[$i],
			text => $$tt[$i]
		});
	}
	return @t;
}

sub set_ticks
{
	my $self  = shift;
	return unless defined $_[0];
	my @ticks = (@_ == 1 and ref($_[0]) eq q(ARRAY)) ? @{$_[0]} : @_;
	my @val;
	my @len;
	my @txt;
	for ( @ticks) {
		next unless exists $$_{value};
		push( @val, $$_{value});
		push( @len, exists($$_{height})    ? $$_{height}    : 0);
		push( @txt, exists($$_{text})      ? $$_{text}      : undef);
	}
	$self-> {tickVal} = \@val;
	$self-> {tickLen} = \@len;
	$self-> {tickTxt} = \@txt;
	$self-> {scheme}  = undef;
	$self-> update_geom_sizes;
	$self-> value( $self-> value);
	$self-> repaint;
}

sub set_bound
{
	my ( $self, $val, $bound) = @_;
	$self-> {$bound} = $val;
	$self-> scheme($self-> {scheme}) if defined $self-> {scheme};
	$self-> repaint;
}

sub set_scheme
{
	my ( $self, $s) = @_;
	unless ( defined $s) {
		$self-> {scheme} = undef;
		return;
	}
	my ( $max, $min) = ( $self-> {max}, $self-> {min});
	$self-> ticks([]), return if $max == $min;

	my @t;
	my $i;
	my $inc = $self-> {increment};
	if ( $s == ss::Gauge) {
		for ( $i = $min; $i <= $max; $i += $inc) {
			push ( @t, { value => $i, height => 4, text => $i });
		}
	} elsif ( $s == ss::Axis) {
		for ( $i = $min; $i <= $max; $i += $inc) {
			push ( @t, { value => $i, height => 6,   text => $i });
			if ( $i < $max) {
				for ( 1..4) {
					my $v = $i + $inc / 5 * $_;
					last if $v > $max;
					push ( @t, { value => $v, height => 3 });
				}
			}
		}
		push ( @t, { value => $max, height => 6,   text => $max }) if $i != $max;
	} elsif ( $s == ss::StdMinMax) {
		push ( @t, { value => $min, height => 6,   text => "Min" });
		push ( @t, { value => $max, height => 6,   text => "Max" });
	} elsif ( $s == ss::Thermometer ) {
		for ( $i = $min; $i <= $max; $i += $inc) {
			push ( @t, {
				value => $i,
				height => 6,
				text => $i
			});
			if ( $i < $max) {
				my $j;
				for ( $j = 1; $j < 10; $j++) {
					my $v = $i + $inc / 10 * $j;
					last if $v > $max;
					push ( @t, {
						value => $v,
						height => $j == 5 ? 5 : 3
					});
				}
			}
		}
		push ( @t, { value => $max, height => 6,   text => $max }) if $i != $max;
	}
	$self-> ticks( @t);
	$self-> {scheme} = $s;
}

sub increment
{
	return $_[0]-> {increment} unless $#_;
	my ( $self, $increment) = @_;
	$self-> {increment} = $increment;
	if ( defined $self-> {scheme}) {
		$self-> scheme( $self-> {scheme});
		$self-> repaint;
	}
}
sub readOnly    {($#_)?$_[0]-> set_read_only   ($_[1]):return $_[0]-> {readOnly};}
sub ticks       {($#_)?shift-> set_ticks          (@_):return $_[0]-> get_ticks;}
sub snap        {($#_)?$_[0]-> set_snap        ($_[1]):return $_[0]-> {snap};}
sub step        {($#_)?$_[0]-> set_step        ($_[1]):return $_[0]-> {step};}
sub scheme      {($#_)?shift-> set_scheme         (@_):return $_[0]-> {scheme}}
sub value       {($#_)?$_[0]-> {value} =       $_[1]  :return $_[0]-> {value};}
sub min         {($#_)?$_[0]-> set_bound($_[1],q(min)):return $_[0]-> {min};}
sub max         {($#_)?$_[0]-> set_bound($_[1],q(max)):return $_[0]-> {max};}


# linear slider tick alignment
package
    tka;
use constant Normal      => 0;
use constant Alternative => 1;
use constant Dual        => 2;

package Prima::Slider;
use vars qw(@ISA);
use base qw(
	Prima::AbstractSlider
	Prima::Widget::Fader
);

{
my %RNT = (
	%{Prima::AbstractSlider-> notification_types()},
	%{Prima::Widget::Fader-> notification_types()},
);
sub notification_types { return \%RNT; }
}

sub profile_default
{
	return {
		%{$_[ 0]-> SUPER::profile_default},
		borderWidth    => 0,
		ribbonStrip    => 0,
		shaftBreadth   => 6,
		knobBreadth    => 12,
		tickAlign      => tka::Normal,
		vertical       => 0,
		scheme         => ss::Gauge,
	}
}

sub profile_check_in
{
	my ( $self, $p, $default) = @_;
	$p-> { autoWidth} = 1
		if !exists $p->{autoWidth} and (($p->{vertical} // $default->{vertical}) == 1);
	$p-> { autoHeight} = 1
		if !exists $p->{autoHeight} and (($p->{vertical} // $default->{vertical}) == 0);
	$p-> { autoHeight} = 0
		if exists $p-> {height} || exists $p-> {size} || exists $p-> {rect} ||
			( exists $p-> {top} && exists $p-> {bottom});
	$p-> { autoWidth} = 0
		if exists $p-> {width} || exists $p-> {size} || exists $p-> {rect} ||
			( exists $p-> {left} && exists $p-> {right});
	my $sc = $::application->uiScaling;
	$p->{$_} = ( exists($p->{$_}) ? $p->{$_} : $default->{$_} ) * $sc for qw(shaftBreadth knobBreadth );
	$self-> SUPER::profile_check_in( $p, $default);
}

sub init
{
	my $self = shift;
	$self-> {$_} = 0
		for qw( vertical tickAlign ribbonStrip shaftBreadth borderWidth knobBreadth);
	my %profile = $self-> SUPER::init( @_);
	$self-> $_($profile{$_})
		for qw( vertical tickAlign ribbonStrip shaftBreadth borderWidth knobBreadth);
	return %profile;
}

sub on_paint
{
	my ( $self, $canvas) = @_;
	my @clr;
	my $prelight;

	my $enabled = $self->enabled;

	if ( $enabled ) {
		@clr  = ( $self-> color, $self-> backColor);
		$prelight = $self-> prelight_color($clr[1], 1.5) if $self->{prelight};
	} else {
		@clr = ( $self-> disabledColor, $self-> disabledBackColor)
	}
	my @c3d  = ( $self-> dark3DColor, $self-> light3DColor);
	my @cht  = ( $self-> hiliteColor, $self-> hiliteBackColor);
	if ( $enabled ) {
		my $blend = $self->{mouse_in} ? $self->fader_current_value // 1 : 0;
		$cht[1] = cl::blend(( map { $self->map_color($_) } ( $clr[1], $cht[1] )), $blend / 2 + .5);
	}

	my @glyph_deltas = ([$clr[0], 0, 0]);
	unshift @glyph_deltas, [cl::White, 1, -1] unless $enabled;
	my $flat = $self-> skin eq 'flat';

	my @size = $canvas-> size;
	my (
		$sb, $v,
		$range, $min,
		$tval, $tlen, $ttxt,
		$ta, $kb
	) = (
		$self-> {shaftBreadth}, $self-> {vertical},
		abs($self-> {max} - $self-> {min}) || 1, $self-> {min},
		$self-> {tickVal}, $self-> {tickLen}, $self-> {tickTxt},
		$self-> {tickAlign}, $self->{knobBreadth},
	);
	if ( $ta == tka::Normal) {
		$ta = 1;
	} elsif ( $ta == tka::Alternative) {
		$ta = 2;
	} else {
		$ta = 3;
	}

	unless ( $self-> transparent) {
		$canvas-> color( $clr[1]);
		$canvas-> bar(0,0,@size);
	}
	$sb = ( $v ? $size[0] : $size[1]) / 6 unless $sb;
	$sb = 2 unless $sb;

	my ($br, $bh, $mw, $bw);
	if ( $v ) {
		$bh = $canvas-> font-> height;
		$br = $size[1] - 2 * $bh - 2;
	} else {
		$mw = $canvas-> font-> width;
		$bw = $mw + $self-> {borderWidth};
		$br  = $size[0] - 2 * $bw - 2;
	}

	# do we have to remove small dashes?
	my $remove_dashes_shorter_than = 0;
	my $check_dashes = sub {
		my ( $height, $set_threshold ) = @_;
		my $lastval = -1_000_000;
		for ( my $i = 1; $i < scalar @{$tval} - 1; $i++) {
			next if $$tlen[$i] > $height || $$tlen[$i] < $remove_dashes_shorter_than;
			my $val = int( abs( $$tval[$i] - $min) * ( $br - 3) / $range + .5);
			$remove_dashes_shorter_than = $set_threshold, last if abs($val - $lastval) < 4;
			$lastval = $val;
		}
	};
	if ( $self->{scheme} == ss::Thermometer || $self->{scheme} == ss::Axis ) {
		$check_dashes->(5, 5);
		$check_dashes->(12, 12);
	} elsif ( $self->{scheme} == ss::Axis ) {
		$check_dashes->(3, 3);
	} else {
		$check_dashes->(12, 12);
	}

	if ( $v) {
		my $bw  = int(( $size[0] - $sb) / 2 + .5);
		return if $size[1] <= $kb * ($self-> {readOnly} ? 1 : 0) + 2 * $bh + 2;

		$canvas-> translate((( $ta == 1) ? 1 : -1) * ( $bw - $sb - $kb), 0)
			if $ta < 3;
		$canvas-> rect3d(
			$bw, $bh, $bw + $sb - 1, $bh + $br - 1, 1,
			@c3d, $cht[1]
		), return unless $range;

		my $val = $bh + 1 + abs( $self-> {value} - $min) * ( $br - 3) / $range;
		if ( $self-> {ribbonStrip}) {
			$canvas-> rect3d( $bw, $bh, $bw + $sb - 1, $bh + $br - 1, 1, @c3d);
			$canvas-> color( $cht[0]);
			$canvas-> bar( $bw + 1, $bh + 1, $bw + $sb - 2, $val);
			$canvas-> color( $cht[1]);
			$canvas-> bar( $bw + 1, $val + 1, $bw + $sb - 2, $bh + $br - 2);
		} else {
			$canvas-> rect3d( $bw, $bh, $bw + $sb - 1, $bh + $br - 1,
				1, @c3d, $cht[1]);
			$canvas-> color( $clr[0]);
			$canvas-> line( $bw + 1, $val, $bw + $sb - 2, $val)
				if $self-> {readOnly};
		}
		my $i;
		my @tr = $self->translate;
		my @texts;
		for my $glyph_delta ( @glyph_deltas ) {
			my ( $color, $delta_x, $delta_y ) = @$glyph_delta;
			$canvas-> color( $color );
			$self->translate($tr[0] + $delta_x, $tr[1] + $delta_y);
			for ( $i = 0; $i < scalar @{$tval}; $i++) {
				my $val = $bh + 1 + abs( $$tval[$i] - $min) * ( $br - 3) / $range;
				if ( $$tlen[ $i]) {
					next if
						defined($remove_dashes_shorter_than) &&
						$remove_dashes_shorter_than > $$tlen[$i] &&
						$i != 0 && $i != $#$tval;
					$canvas-> line(
						$bw + $sb + 3, $val,
						$bw + $sb + $$tlen[ $i] + 3, $val
					) if $ta & 2;
					$canvas-> line(
						$bw - 4, $val,
						$bw - 4 - $$tlen[ $i], $val
					) if $ta & 1;
				}
				push @texts, [
					$$ttxt[ $i],
					( $ta == 2) ?
						$bw + $sb + $$tlen[ $i] + 5 :
						$bw - $$tlen[ $i] - 5 - $canvas-> get_text_width( $$ttxt[ $i]),
					$val - $bh / 2
				] if defined $$ttxt[ $i];
			}
			my $size = $size[1] - $bh - 2;
			my $fh   = $bh + 1;
			if ($size < $fh) {
				@texts = ();
			} elsif ( $size < $fh * 2 || @texts == 1) {
				@texts = ($texts[0]);
			} elsif ( $size < $fh * 3 || @texts == 2) {
				@texts = @texts[0,-1];
			} else {
				my @t = ($texts[0]);
				$size -= $fh * 1.5;
				my $y = $texts[0][2] + $fh;
				for my $t ( @texts[1 .. $#texts - 1] ) {
					next if $t->[2] < $y;
					last if $t->[2] > $size;
					push @t, $t;
					$y = $t->[2] + $fh;
				}
				@texts = (@t, $texts[-1]);
			}
			$canvas->text_shape_out(@$_) for @texts;
		}
		unless ( $self-> {readOnly}) {
			my @jp = map { int( $_ + .5 ) } (
				$bw - 4,       $val - $kb / 2,
				$bw - 4,       $val + $kb / 2,
				$bw + $sb + 1, $val + $kb / 2,
				$bw + $sb + 1 + $kb/2, $val,
				$bw + $sb + 1, $val - $kb / 2,
			);
			my $rgn = Prima::Region->new( polygon => \@jp);
			$rgn->offset( $canvas->translate );
			$canvas-> region( $rgn );
			if ( $flat ) {
				$canvas-> color( $self->{prelight} ? $prelight : $clr[1]);
				$canvas-> fillpoly([@jp[0..9,0,1]]);
				$canvas-> color( 0x404040 );
				$canvas-> polyline([@jp[0..9,0,1]]);
			} else {
				$canvas-> new_gradient(
					palette  => [ $c3d[0], ($self->{prelight} ? $prelight : $clr[1]) ],
					poly     => [0,0,0.3,0.7,1,1],
					vertical => 0,
				)-> bar( $jp[0]+2,$jp[1]+2,$jp[6]-2,$jp[3]-2);
				$canvas-> color( 0x404040);
				$canvas-> polyline([@jp[6..9,0,1]]);
				$canvas-> color( $c3d[1]);
				$canvas-> polyline([$jp[0]+1,$jp[1]+1,$jp[2]+1,$jp[3]-1,$jp[4],$jp[5]-1,$jp[6]-1,$jp[7]]);
				$canvas-> line($jp[0]+2, $jp[7]-1, $jp[6]-2, $jp[7]-1);
				$canvas-> color( $c3d[0]);
				$canvas-> polyline([$jp[6]-1,@jp[7,8],$jp[9]+1,$jp[0],$jp[1]+1,@jp[2..7]]);
				$canvas-> line($jp[0]+2, $jp[7]+1, $jp[6]-1, $jp[7]+1);
			}
		}
	} else {
		my $bh  = int(( $size[1] - $sb) / 2 + .5);
		my $fh = $canvas-> font-> height;
		return if $size[0] <= $kb * ($self-> {readOnly} ? 1 : 0) + 2 * $bw + 2;

		$canvas-> translate( 0, (( $ta == 1) ? -1 : 1) * ( $bh - $sb - $kb))
			if $ta < 3;
		$canvas-> rect3d( $bw, $bh, $bw + $br - 1, $bh + $sb - 1, 1, @c3d, $cht[1]), return
			unless $range;
		my $val = $bw + 1 + abs( $self-> {value} - $min) * ( $br - 3) / $range;

		if ( $self-> {ribbonStrip}) {
			$canvas-> rect3d( $bw, $bh, $bw + $br - 1, $bh + $sb - 1, 1, @c3d);
			$canvas-> color( $cht[0]);
			$canvas-> bar( $bw+1, $bh+1, $val, $bh + $sb - 2);
			$canvas-> color( $cht[1]);
			$canvas-> bar( $val+1, $bh+1, $bw + $br - 2, $bh + $sb - 2);
		} else  {
			$canvas-> rect3d( $bw, $bh, $bw + $br - 1, $bh + $sb - 1, 1, @c3d, $cht[1]);
			$canvas-> color( $clr[0]);
			$canvas-> line( $val, $bh+1, $val, $bh + $sb - 2) if $self-> {readOnly};
		}
		my $i;

		my @texts;
		my @tr = $self->translate;
		for my $glyph_delta ( @glyph_deltas ) {
			my ( $color, $delta_x, $delta_y ) = @$glyph_delta;
			$canvas-> color( $color );
			$self->translate($tr[0] + $delta_x, $tr[1] + $delta_y);
			for ( $i = 0; $i < scalar @{$tval}; $i++) {
				my $val = int( 1 + $bw + abs( $$tval[$i] - $min) * ( $br - 3) / $range + .5);
				if ( $$tlen[ $i]) {
					next if
						defined($remove_dashes_shorter_than) &&
						$remove_dashes_shorter_than > $$tlen[$i] &&
						$i != 0 && $i != $#$tval;
					$canvas-> line( $val, $bh + $sb + 3, $val, $bh + $sb + $$tlen[ $i] + 3)
						if $ta & 1;
					$canvas-> line( $val, $bh - 4, $val, $bh - 4 - $$tlen[ $i])
						if $ta & 2;
				}

				next unless defined $$ttxt[ $i];
				my $tw = int( $canvas-> get_text_width( $$ttxt[ $i]) / 2 + .5);
				my $x = $val - $tw;
				next if $x >= $size[0] or $val + $tw < 0;
				push @texts, [
					$$ttxt[$i], $val, $tw,
					( $ta == 2) ? $bh - $$tlen[ $i] - 5 - $fh : $bh + $sb + $$tlen[ $i] + 5,
					$size[0]
				];
			}


			if ( @texts) {
				# see that leftmost val fits
				if ( $texts[0]->[1] - $texts[0]->[2] < 0) {
					$texts[0]->[1] = $texts[0]->[2];
					shift @texts
						if $texts[0]->[1] + $texts[0]->[2] > $size[0];
					goto NO_LABELS unless @texts;
				}

				# see that rightmost text fits
				my ( $rightmost_val, $rightmost_label_width) = (
					$texts[-1]->[1], $texts[-1]->[2]);
				$rightmost_val = $size[0] - 1 - $rightmost_label_width
					if $rightmost_val > $size[0] - 1 - $rightmost_label_width;
				if ( 1 < @texts and $rightmost_val < 0) {
					# skip it
					pop @texts;
					goto NO_LABELS unless @texts;
				} else {
					$texts[-1]->[1] = $rightmost_val;
					my $lv = 2 * $rightmost_label_width + $mw;
					$$_[-1] -= $lv for @texts[0..$#texts-1];
					$texts[-1][-1] += $mw;
				}

				# draw labels
				my $lastx = 0;
				for ( @texts) {
					my ( $text, $val, $half_width, $y, $xlim) = @$_;
					my $x = $val - $half_width;
					next if $x < $lastx or $x < 0 or $val + $half_width >= $xlim;
					$lastx = $val + $half_width + $mw;
					$canvas-> text_shape_out( $text, $x, $y);
				}
			}
			NO_LABELS:
		}

		unless ( $self-> {readOnly}) {
			my @jp = map { int($_ + .5) } (
				$val - $kb / 2, $bh - 2,
				$val - $kb / 2, $bh + $sb + 3,
				$val + $kb / 2, $bh + $sb + 3,
				$val + $kb / 2, $bh - 2,
				$val,           $bh - $kb / 2 - 2,
			);
			my $rgn = Prima::Region->new( polygon => \@jp);
			$rgn->offset( $canvas->translate );
			$canvas-> region( $rgn );
			if ( $flat) {
				$canvas-> color( $self->{prelight} ? $prelight : $clr[1]);
				$canvas-> fillpoly([ @jp[8,9,0..9] ]);
				$canvas-> color( 0x404040 );
				$canvas-> polyline([ @jp[8,9,0..9] ]);
			} else {
				$canvas-> new_gradient(
					palette  => [ ($self->{prelight} ? $prelight : $clr[1]), $c3d[0] ],
					poly     => [0,0,0.7,0.3,1,1],
					vertical => 1,
				)-> bar( $jp[0]+2,$jp[9],$jp[4]-2,$jp[3]);
				$canvas-> color( 0x404040 );
				$canvas-> polyline([@jp[4..9]]);
				$canvas-> color( $c3d[0]);
				$canvas-> polyline([
					@jp[8,9,0..3],$jp[4]-1,$jp[5],
					$jp[6]-1,$jp[7],$jp[8],$jp[9]+1
				]);
				$canvas-> line($jp[8]-1,$jp[3]-2,$jp[8]-1,$jp[9]) if $kb > 10;
				$canvas-> color( $c3d[1]);
				$canvas-> polyline([$jp[8],$jp[9]+1,$jp[0]+1,$jp[1],$jp[2]+1,$jp[3]-1,$jp[4]-2,$jp[5]-1]);
				$canvas-> line($jp[8]+1,$jp[3]-2,$jp[8]+1,$jp[9]) if $kb > 10;
			} 
		}
	}
}

sub on_fontchanged
{
	my $self = shift;
	$self->update_geom_sizes;
	$self->repaint;
}

sub update_geom_sizes
{
	my $self = shift;
	my $maxtlen = 0;
	for ( @{ $self->{tickLen}}) {
		$maxtlen = $_ if $maxtlen < $_;
	}
	$maxtlen *= 2 if $self->tickAlign == tka::Dual;
	if ( $self->vertical ) {
		return unless $self->autoWidth;
		my $maxtwid = 0;
		$self->begin_paint_info;
		for ( grep { defined } @{ $self->{tickTxt}}) {
			my $w = $self->get_text_width($_);
			$maxtwid = $w if $maxtwid < $w;
		}
		$self->end_paint_info;
		my $x = $maxtlen + $maxtwid * 2 + $self->shaftBreadth + $self->borderWidth + 5 + $self->knobBreadth;
		$self->geomWidth($x);
	} else {
		return unless $self->autoHeight;
		my $y = $maxtlen + $self->font->height * 2 + $self->shaftBreadth + $self->borderWidth + 5 + $self->knobBreadth;
		$self->geomHeight($y);
	}
}

sub pos2info
{
	my ( $self, $x, $y) = @_;
	my @size = $self-> size;
	return if $self-> {max} == $self-> {min};
	if ( $self-> {vertical}) {
		my $bh  = $self-> font-> height;
		my $val =
			$bh +
			1 +
			abs( $self-> {value} - $self-> {min}) *
				( $size[1] - 2 * $bh - 5) /
				( abs($self-> {max} - $self-> {min}) || 1);
		my $ret1 =
			$self-> {min} +
			( $y - $bh - 1) *
				abs($self-> {max} - $self-> {min}) /
				(( $size[1] - 2 * $bh - 5) || 1);

		if ( $y < $val - $self->knobBreadth / 2 or $y >= $val + $self->knobBreadth / 2) {
			return 0, $ret1;
		} else {
			return 1, $ret1, $y - $val;
		}
	} else {
		my $bw = $self-> font-> width + $self->{borderWidth};
		my $val =
			$bw +
			1 +
			abs( $self-> {value} - $self-> {min}) *
				( $size[0] - 2 * $bw - 5) /
				(abs($self-> {max} - $self-> {min}) || 1);
		my $ret1 =
			$self-> {min} +
			( $x - $bw - 1) *
				abs($self-> {max} - $self-> {min}) /
				(( $size[0] - 2 * $bw - 5) || 1);

		if ( $x < $val - $self->knobBreadth / 2 or $x >= $val + $self->knobBreadth / 2) {
			return 0, $ret1;
		} else {
			return 1, $ret1, $x - $val;
		}
	}
}

sub repaint_value_change
{
	my ($self, $value_old, $value_new) = @_;
	my @size = $self-> size;
	my $sb = $self-> {shaftBreadth};
	if ( $self-> {vertical}) {
		$sb = $size[0] / 6 unless $sb;
		$sb = 2 unless $sb;
		my $bh = $self-> font-> height;
		my $bw  = ( $size[0] - $sb) / 2;
		my $v1  = $bh + 1 + abs( $value_new - $self-> {min}) *
			( $size[1] - 2 * $bh - 5) / (abs($self-> {max} - $self-> {min})||1);
		my $v2  = $bh + 1 + abs( $value_old - $self-> {min}) *
			( $size[1] - 2 * $bh - 5) / (abs($self-> {max} - $self-> {min})||1);
		( $v2, $v1) = ( $v1, $v2) if $v1 > $v2;
		my $kb = $self-> knobBreadth / 2;
		my $xd = 0;
		$xd = (( $self-> {tickAlign} == tka::Normal) ? 1 : -1) *
			( $bw - $sb - $self->knobBreadth)
				if $self-> {tickAlign} != tka::Dual;
		$self-> invalidate_rect(
			map { int($_ + .5) }
			$bw - 4 + $xd, $v1 - $kb, $bw + $sb * 2 + 3 + $xd, $v2 + $kb + 1
		);
	} else {
		$sb = $size[1] / 6 unless $sb;
		$sb = 2 unless $sb;
		my $bw = $self-> font-> width + $self-> {borderWidth};
		my $bh  = ( $size[1] - $sb) / 2;
		my $v1  = $bw + 1 + abs( $value_new - $self-> {min}) *
			( $size[0] - 2 * $bw - 5) / (abs($self-> {max} - $self-> {min})||1);
		my $v2  = $bw + 1 + abs( $value_old - $self-> {min}) *
			( $size[0] - 2 * $bw - 5) / (abs($self-> {max} - $self-> {min})||1);
		( $v2, $v1) = ( $v1, $v2) if $v1 > $v2;
		my $kb = $self-> knobBreadth / 2;
		my $yd = 0;
		$yd = (( $self-> {tickAlign} == tka::Normal) ? -1 : 1) *
			( $bh - $sb - $self->knobBreadth)
				if $self-> {tickAlign} != tka::Dual;
		$self-> invalidate_rect(
			map { int($_ + .5) }
			$v1 - $kb, $bh - $kb - 2 + $yd,
			$v2 + $kb + 1, $bh + $sb + 5 + $yd
		);
	}
}

sub repaint_knob { $_[0]->repaint_value_change(($_[0]->{value}) x 2)}

sub on_mousedown
{
	my ( $self, $btn, $mod, $x, $y) = @_;
	return if $self-> {readOnly};
	return if $self-> {mouseTransaction};
	return if $btn != mb::Left;
	my ($info, $pos, $ap) = $self-> pos2info( $x, $y);
	return unless defined $info;
	delete $self->{prelight};
	if ( $info == 0) {
		$self-> value( $pos);
		return;
	}
	$self-> {aperture} = $ap;
	$self-> {mouseTransaction} = 1;
	$self-> capture(1);
	$self-> clear_event;
}

sub on_mouseup
{
	my ( $self, $btn, $mod, $x, $y) = @_;
	return if $btn != mb::Left;
	return unless $self-> {mouseTransaction};
	$self-> {mouseTransaction} = undef;
	$self-> capture(0);
	$self-> notify( 'Change') unless $self-> {autoTrack};
}

sub on_mousemove
{
	my ( $self, $mod, $x, $y) = @_;
	unless ($self-> {mouseTransaction}) {
		if ( $self-> enabled ) {
			my ($prelight) = $self-> pos2info( $x, $y);
			$prelight = (!defined($prelight) || ($prelight != 1)) ? undef : 1;
			if (($prelight // 0) != ($self->{prelight} // 0)) {
				$self->{prelight} = $prelight;
				$self->repaint_knob;
			}
		}
		return;
	}
	$self-> {vertical} ? $y : $x   -= $self-> {aperture};
	my ( $info, $pos) = $self-> pos2info( $x, $y);
	return unless defined $info;
	my $ov = $self-> {value};
	$self-> {suppressNotify} = 1 unless $self-> {autoTrack};
	$self-> value( $pos);
	$self-> {suppressNotify} = 0;
	$self-> notify(q(Track)) if !$self-> {autoTrack} && $ov != $self-> {value};
}

sub on_mouseenter
{
	my $self = shift;
	$self-> fader_in_mouse_enter;
	$self-> {mouse_in} = 1;
}

sub on_mouseleave
{
	my $self = shift;
	$self-> repaint_knob if defined( delete $self->{prelight} );
	$self-> fader_out_mouse_leave;
}

sub on_fadeout { delete shift->{mouse_in} }

sub on_keydown
{
	my ( $self, $code, $key, $mod) = @_;
	return if $self-> {readOnly};
	if ( $key == kb::Home || $key == kb::PgUp) {
		$self-> value( $self-> {vertical} ? $self-> {max} : $self-> {min});
		$self-> clear_event;
		return;
	}
	if ( $key == kb::End || $key == kb::PgDn) {
		$self-> value( $self-> {vertical} ? $self-> {min} : $self-> {max});
		$self-> clear_event;
		return;
	}
	if ( $key == kb::Left || $key == kb::Right || $key == kb::Up || $key == kb::Down) {
		my $s = $self-> {step};
		$self-> clear_event;
		$self-> set_next_value(( $key == kb::Left || $key == kb::Down) ? -$s : $s);
	}
}

sub set_vertical
{
	$_[0]-> {vertical} = $_[1];
	$_[0]-> update_geom_sizes;
	$_[0]-> repaint;
}

sub set_tick_align
{
	my ( $self, $ta) = @_;
	$ta = tka::Normal if $ta != tka::Alternative and $ta != tka::Dual;
	return if $ta == $self-> {tickAlign};
	$self-> {tickAlign} = $ta;
	$self-> update_geom_sizes;
	$self-> repaint;
}

sub set_ribbon_strip
{
	$_[0]-> {ribbonStrip} = $_[1];
	$_[0]-> repaint;
}

sub set_shaft_breadth
{
	my ( $self, $sb) = @_;
	$sb = 0 if $sb < 0;
	return if $sb == $self-> {shaftBreadth};
	$self-> {shaftBreadth} = $sb;
	$self-> update_geom_sizes;
	$self-> repaint;
}

sub set_bound
{
	my ( $self, $val, $bound) = @_;
	$self-> {$bound} = $val;
	$self-> scheme($self-> {scheme}) if defined $self-> {scheme};
	$self-> repaint;
}

sub value
{
	if ($#_) {
		my ( $self, $value) = @_;
		my ( $min, $max) = ( $self-> {min}, $self-> {max});
		my $old = $self-> {value};
		if ( $self-> {snap}) {
			my ( $minDist, $thatVal, $i) = ( abs( $min - $max));
			my $tval = $self-> {tickVal};
			for ( $i = 0; $i < scalar @{$tval}; $i++) {
				my $j = $$tval[ $i];
				$minDist = abs(($thatVal = $j) - $value)
					if abs( $j - $value) < $minDist;
			}
			$value = $thatVal if defined $thatVal;
		} elsif ( $self-> {step} != 0 ) {
			$value = int ( $value / $self-> {step} ) * $self-> {step};
		}
		$value = $min if $value < $min;
		$value = $max if $value > $max;
		return if $old == $value;
		$self-> {value} = $value;
		$self->repaint_value_change($old, $value);
		$self-> notify(q(Change)) unless $self-> {suppressNotify};
	} else {
		return $_[0]-> {value};
	}
}
sub vertical    {($#_)?$_[0]-> set_vertical    ($_[1]):return $_[0]-> {vertical};}
sub tickAlign   {($#_)?$_[0]-> set_tick_align  ($_[1]):return $_[0]-> {tickAlign};}
sub ribbonStrip {($#_)?$_[0]-> set_ribbon_strip($_[1]):return $_[0]-> {ribbonStrip};}
sub shaftBreadth{($#_)?$_[0]-> set_shaft_breadth($_[1]):return $_[0]-> {shaftBreadth};}

sub knobBreadth
{
	return $_[0]->{knobBreadth} unless $#_;
	my ( $self, $kb) = @_;
	$kb = 4 if $kb < 4;
	$kb &= ~1; # must divide by 2
	return if $kb == $self-> {knobBreadth};
	$self-> {knobBreadth} = $kb;
	$self-> update_geom_sizes;
	$self-> repaint;
}

sub borderWidth
{
	return $_[0]-> {borderWidth} unless $#_;
	my ( $self, $bw) = @_;
	$bw = 0 if $bw < 0;
	$self-> {borderWidth} = $bw;
	$self-> update_geom_sizes;
	$self-> repaint;
}

package Prima::CircularSlider;
use vars qw(@ISA);
@ISA = qw(
	Prima::AbstractSlider
	Prima::Widget::Fader
	Prima::Widget::MouseScroller
);

{
my %RNT = (
	%{Prima::AbstractSlider-> notification_types()},
	%{Prima::Widget::Fader-> notification_types()},
	Stringify  => nt::Action,
);
sub notification_types { return \%RNT; }
}

sub profile_default
{
	return {
		%{$_[ 0]-> SUPER::profile_default},
		buttons        => 1,
		stdPointer     => 0,
		buttonWidth    => 10,
	}
}

sub profile_check_in
{
	my ( $self, $p, $default) = @_;

	my $sc = $::application->uiScaling;
	$p->{$_} = ( exists($p->{$_}) ? $p->{$_} : $default->{$_} ) * $sc for qw(buttonWidth);
	$self-> SUPER::profile_check_in( $p, $default);
}

sub init
{
	my $self = shift;
	$self-> {$_}=0 for qw( buttons pressState circX circY br butt1X butt1Y butt2X buttonWidth);
	$self-> {string} = '';
	my %profile = $self-> SUPER::init( @_);
	$self-> $_($profile{$_}) for qw( buttons stdPointer buttonWidth);
	$self-> reset;
	return %profile;
}

sub setup
{
	$_[0]-> SUPER::setup;
	$_[0]-> notify(q(Stringify), $_[0]-> {value}, \$_[0]-> {string});
	$_[0]-> repaint;
}

sub set_text
{
	my ( $self, $caption) = @_;
	$self-> SUPER::set_text( $caption );
	$self-> {accel} = lc($1) if $caption =~ /~([a-z0-9])/i;
	$self-> repaint;
}

sub reset
{
	my $self = $_[0];
	my @size = $self-> size;
	my $fh  = $self-> font-> height;
	my $bw  = $self->buttonWidth;
	my $bw_fh = ( $bw > $fh ) ? $bw : $fh;
	my $br  = ($size[0] > ( $size[1] - $bw_fh)) ? ( $size[1] - $bw_fh) : $size[0];
	$self->begin_paint_info;

	# first calculate a minimum viable dial radius
	my $tx1 = $self->get_text_width( $self-> min, 1 );
	my $tx2 = $self->get_text_width( $self-> max, 1 );
	$tx1 = $tx2 if $tx1 < $tx2;
	$tx1 = $fh if $tx1 < $fh;
	$tx1 /= 2;
	$tx1 += 4 + 10;
	my $min_viable_rad = $tx1 / 2 * 1.1;
	my $rad = $self-> {radius} = ($min_viable_rad < $br/2) ? $min_viable_rad : ($br/2);

	# circle center
	$self-> {br}        = $br;
	$self-> {circX}     = int($size[0]/2 + .5);
	$self-> {circY}     = int(($size[1] + $bw_fh) / 2 + .5);

	my $i;
	my ( $tval, $tlen, $ttxt) = ( $self-> {tickVal}, $self-> {tickLen}, $self-> {tickTxt});
	my @ext = (0,0,0,0);
	for ( $i = 0; $i < scalar @{$tval}; $i++) {
		my $r = $rad + 3 + $$tlen[ $i];
		my ( $cos, $sin) = $self-> offset2data( $$tval[$i]);
		if ( $$tlen[$i]) {
			my @outer = ($r * $cos, $r * $sin);
			$ext[0] = $outer[0] if $ext[0] > $outer[0];
			$ext[1] = $outer[1] if $ext[1] > $outer[1];
			$ext[2] = $outer[0] if $ext[2] < $outer[0];
			$ext[3] = $outer[1] if $ext[3] < $outer[1];
		}
		$r += 3;
		if ( defined $$ttxt[ $i]) {
			my $w = $self-> get_text_width( $$ttxt[ $i], 1);
			my $y = $r * $sin - $fh / 2 * ( 1 - $sin);
			my $x = $r * $cos - ( 1 - $cos) * $w / 2;
			my $r = $x + $w;
			my $t = $y + $fh;
			$ext[0] = $x if $ext[0] > $x;
			$ext[1] = $y if $ext[1] > $y;
			$ext[2] = $r if $ext[2] < $r;
			$ext[3] = $t if $ext[3] < $t;
		}
	}
	$ext[$_] = int($ext[$_] - .5) for 0,1;
	$ext[$_] = int($ext[$_] + .5) for 2,3;

	my @sz = ( $ext[2] - $ext[0], $ext[3] - $ext[1] );
	my @d = (
		$self->{circX} + $ext[0],
		$self->{circY} + $ext[1],
		$size[0] - $self->{circX} - $ext[2],
		$size[1] - $self->{circY} - $ext[3],
	);
	$self-> {show_scale} = ! grep { $_ < 0 } @d;

GROW_CIRCLE:
	@ext = (0,0,0,0) unless $self->{show_scale};

	# can grow the circle?
	$ext[0] = -$rad if $ext[0] > -$rad;
	$ext[1] = -$rad if $ext[1] > -$rad;
	$ext[2] =  $rad if $ext[2] <  $rad;
	$ext[3] =  $rad if $ext[3] <  $rad;
	$ext[$_] -= 2 for 0,1;
	$ext[$_] += 2 for 2,3;
	@sz = ( $ext[2] - $ext[0], $ext[3] - $ext[1] );

	if ( $sz[0] < $size[0] && $sz[1] < $size[1] - $bw - $fh) {
		my @d = (
			$self->{circX} + $ext[0],
			$self->{circY} + $ext[1],
			$size[0] - $self->{circX} - $ext[2],
			$size[1] - $self->{circY} - $ext[3],
		);
		my $min = $d[0];
		for ( @d ) {
			$min = $_ if $min > $_;
		}
		$min--;
		if ( $min > 0 ) {
			$self->{radius} += $min;
			$ext[$_] -= $min for 0,1;
			$ext[$_] += $min for 2,3;
		}
	}

	# buttons X location
	$self-> {butt1X}    = int( $size[0] / 2 - $self->{radius} - $bw / 2 + .5);
	$self-> {butt2X}    = int( $size[0] / 2 + $self->{radius} - $bw / 2 + .5);
	if ($self->{butt1X} < 1) {
		$self->{butt2X} += $self->{butt1X} - 2;
		$self->{butt1X} = 1;
	}
	if ( $self->{butt1X} + $bw + 1 > $self->{butt2X} ) {
		my $d = $bw - $self->{butt2X} + $self->{butt1X};
		$self->{butt1X} -= $d / 2 + 1;
		$self->{butt2X} += $d / 2 + 1;
	}

	# Y location for title and buttons
	my $lowest = $self->{circY} + $ext[1];
	my $fd     = $self->font->descent;
	$self-> {textY} = ($lowest > $fh + 2) ? ($lowest - $fh) / 2 + 1 : 2;
	$self-> {textY} += $fd;
	$self-> {butt1Y} = ($lowest > $bw + 2) ? ($lowest - $bw) / 2 + 1 : 2;
	$self-> {show_text} = 1;
	my $title_width = $self->get_text_width($self->text, 1);
	if ( $title_width > $size[0] ) {
		$self->{show_text} = 0;
	} elsif ( $title_width > $self->{butt2X} - $self->{butt1X} - $bw - 2 ) {
		if ( $title_width + 2 + $bw * 2 < $size[0] ) {
			# move buttons aparts by x to accomodate title
			$self->{butt1X} = ($size[0] - $title_width) / 2 - $bw - 1;
			$self->{butt2X} = ($size[0] + $title_width) / 2 + 1;
		} elsif ( $lowest > $fh + $bw + 2 ) {
			# draw buttons and title on separate lines
			my $d = ($bw_fh + 1 ) / 2;
			$self->{textY} -= $d;
			$self->{butt1Y} += $d;
		} else {
			$self->{show_text} = 0;
		}
	}

	$self->{show_dial} = $self->{radius} >= $min_viable_rad;
	if ( !$self->{show_dial} && $self->{show_scale} ) {
		# try to grow the circle again
		$self->{show_scale} = 0;
		goto GROW_CIRCLE;
	}

	$self->end_paint_info;

	# hints
	if (
		$self->{show_text} && 
		!$self->{show_scale} && 
		$self->{show_dial} &&
		$self->{textY} + $fh > $self->{circY} - $self->{radius}
	) {
		# if text is over the expanded dial ( when @ext is empty ), move it or hide
		$self->{textY} = $fd;
		if ( $self->{textY} + $fh > $self->{circY} - $self->{radius}) {
			$self->{show_text} = 0;
		}
	}
	if ( !$self->{show_text} && $self->{butt1Y} + $bw > $size[1] ) {
		# no text, don't need to fit buttons together with the text
		$self->{butt1Y} = ( $size[1] - $bw ) / 2;
	}
	if ( !$self->{show_dial} ) {
		# do not obscure the value as much as possible
		$self->{show_text} = 0
			if $self->{show_text} && $fh + $bw + $fh > $size[1];
		$self->{butt1Y} = $self->{textY} = 0;
	}
	$self->{valueY} = $self->{circY} - $fh / 2;
	if ($self->{valueY} + $fh - 2 > $size[1]) {
		$self->{valueY} = 0;
		if ( $self->{butt1X} + $bw + 2 >= $self->{butt2X} ) {
			$self->{butt1X} = 1;
			$self->{butt2X} = $size[0] - $bw - 1;
		}
	}
}

sub offset2pt
{
	my ( $self, $width, $height, $value, $radius) = @_;
	my $a = 225 * 3.14159 / 180 - ( 270 * 3.14159 / 180) * ( $value - $self-> {min}) /
		(abs( $self-> {min} - $self-> {max})||1);
	return $width + $radius * cos($a), $height + $radius * sin($a);
}

sub offset2data
{
	my ( $self, $value) = @_;
	my $a = 225 * 3.14159 / 180 - ( 270 * 3.14159 / 180) * abs( $value - $self-> {min})/
		(abs( $self-> {min} - $self-> {max})||1);
	return cos($a), sin($a);
}

sub effective_dial_diameter
{
	my $self = shift;
	my $radx = $self->{radius};
	my $drad = 5;
	for my $lw ( 2..4) {
		$radx -= 100;
		last if $radx < 0;
		$drad++;
	}
	return $self->{radius} * 2 - $drad;
}

sub on_paint
{
	my ( $self, $canvas) = @_;
	my @clr;
	my $prelight;
	if ( $self->enabled ) {
		@clr = ( $self-> color, $self-> backColor);
		$prelight = $self->fader_prelight_color($self->map_color($clr[1])) if $self->{prelight};
	} else {
		@clr = ( $self-> disabledColor, $self-> disabledBackColor);
	}
	my @c3d  = ( $self-> dark3DColor, $self-> light3DColor);
	my @cht  = ( $self-> hiliteColor, $self-> hiliteBackColor);
	my @size = $canvas-> size;
	my ( $range, $min, $tval, $tlen, $ttxt, $bw) =
	( abs($self-> {max} - $self-> {min}), $self-> {min}, $self-> {tickVal},
	$self-> {tickLen}, $self-> {tickTxt}, $self->{buttonWidth} );

	$canvas-> color( $clr[1]);
	$canvas-> bar( 0, 0, @size) if !$self-> transparent && !defined $self-> {singlePaint};
	my $fh  = $canvas-> font-> height;
	my $br  = $self-> {br};
	my $rad = $self-> {radius};
	my @cpt = ( $self-> {circX}, $self-> {circY}, $rad*2+1, $rad*2+1);
	my $flat = $self->skin eq 'flat';

	goto AFTER_DIAL unless $self->{show_dial};
	if ( defined $self-> {singlePaint}) {
		my $drad = $self->effective_dial_diameter;
		$canvas-> color( $prelight ) if $self->{prelight};
		$canvas-> fill_ellipse( @cpt[0..1], $drad, $drad);
		$canvas-> color( $clr[0]);
	} else {
		if ($self->{prelight}) {
			$canvas-> color( $prelight );
			$canvas-> fill_ellipse( @cpt[0..1], $rad*2-5, $rad*2-5);
		}

		my $radx = $rad;
		my $da   = 0;
		my $dp   = 2;
		$canvas-> lineWidth(2);
		for my $lw (2..4) {
			next if $flat;
			$canvas-> color( $c3d[1]);
			$canvas-> arc( @cpt[0..1], $cpt[2]-$dp, $cpt[3]-$dp, 65 + $da, 235 - $da);
			$canvas-> color( $c3d[0]);
			$canvas-> arc( @cpt[0..1], $cpt[2]-$dp, $cpt[3]-$dp, 255 + $da, 405 - $da);
			$radx -= 100;
			$da += 20;
			$dp++;
			last if $radx < 0;
		}
		$canvas-> lineWidth(0);
		$canvas-> color( $clr[0]);
		$canvas-> antialias(1);
		$canvas-> lineWidth(1) if $canvas-> antialias;
		$canvas-> ellipse( @cpt);
		$canvas-> lineWidth(0);
		$canvas-> antialias(0);
	}

	if ( $self-> {stdPointer}) {
		my $dev = $range * 0.03;
		my @j = (
			$self-> offset2pt( @cpt[0,1], $self-> {value}, $rad * 0.8),
			$self-> offset2pt( @cpt[0,1], $self-> {value} + $dev, $rad * 0.6),
			$self-> offset2pt( @cpt[0,1], $self-> {value} - $dev, $rad * 0.6),
		);
		$self-> fillpoly( \@j);
	} else {
		my $knob = $::application->uiScaling * 3;
		$knob += $rad / 50;
		my @cxt = ( $self-> offset2pt( @cpt[0,1], $self-> {value}, $rad - $knob * 1.5), 4, 4);
		$canvas->antialias(1);
		$canvas-> color( $c3d[0]);
		if ( $flat ) {
			$canvas-> fill_ellipse( @cxt[0..1], $knob+1, $knob+1);
		} else {
			$canvas-> lineWidth(($rad > 50) ? 2 : 1);
			$canvas-> arc( @cxt[0..1], $knob, $knob, 65, 235);
			$canvas-> color((
				cl::distance( $canvas->map_color($c3d[1]), $canvas->map_color($clr[1])) > 
				cl::distance( $canvas->map_color($c3d[1]), 0)) ?
					$c3d[1] : 0);
			$canvas-> arc( @cxt[0..1], $knob, $knob, 255, 405);
			$canvas-> lineWidth(0);
		}
		$canvas->antialias(0);
	}
AFTER_DIAL:
	$canvas-> color( $clr[0]);

	if ( $self-> {show_scale} && !defined $self-> {singlePaint}) {
		my $i;
		$canvas-> antialias(1);
		$canvas-> lineWidth(1) if $canvas->antialias;
		for ( $i = 0; $i < scalar @{$tval}; $i++) {
			my $r = $rad + 3 + $$tlen[ $i];
			my ( $cos, $sin) = $self-> offset2data( $$tval[$i]);
			$canvas-> line( $self-> offset2pt( @cpt[0,1], $$tval[$i], $rad + 3),
				$cpt[0] + $r * $cos, $cpt[1] + $r * $sin
			) if $$tlen[ $i];
			$r += 3;
			if ( defined $$ttxt[ $i]) {
				my $y = $cpt[1] + $r * $sin - $fh / 2 * ( 1 - $sin);
				my $x = $cpt[0] + $r * $cos -
					( 1 - $cos) *
					$canvas-> get_text_width( $$ttxt[ $i], 1) / 2;
				$canvas-> text_shape_out( $$ttxt[ $i], $x, $y);
			}
		}
		$canvas-> lineWidth(0);
		$canvas-> antialias(0);
	}

	my $ttw = $canvas-> get_text_width( $self-> {string}, 1);
	$canvas-> text_shape_out( $self-> {string}, ( $size[0] - $ttw) / 2, $self->{valueY});
	return if defined $self-> {singlePaint};

	my $text = $self->text;
	$text =~ s/\~//;
	$ttw = $canvas-> get_text_width( $text, 1);
	$canvas-> draw_text( $self->text,
		( $size[0] - $ttw) / 2, $self->{textY},
		( $size[0] + $ttw) / 2, $self->{textY} + $fh, 
		dt::DrawMnemonic|dt::NoWordWrap|dt::Default)
			if $self->{show_text};

	if ( $self-> {buttons}) {
		my $s = $self-> {pressState};
		my @cbd = reverse @c3d;
		my $at  = 0;
		$at = 1, @cbd = reverse @cbd if $s & 1;

		$canvas-> rect3d(
			$self-> { butt1X}, $self-> { butt1Y}, $self-> { butt1X} + $bw,
			$self-> { butt1Y} + $bw, 1, @cbd, $clr[1]
		);
		$canvas-> line(
			$self-> { butt1X} + 2 + $at, $self-> { butt1Y} + $bw / 2 - $at,
			$self-> { butt1X} - 2 + + $bw + $at, $self-> {butt1Y} + $bw / 2 - $at
		);

		@cbd = reverse @c3d; $at = 0;
		$at = 1, @cbd = reverse @cbd if $s & 2;
		$canvas-> rect3d(
			$self-> { butt2X}, $self-> { butt1Y}, $self-> { butt2X} + $bw,
			$self-> { butt1Y} + $bw, 1, @cbd, $clr[1]
		);
		$canvas-> line(
			$self-> { butt2X} + 2 + $at, $self-> { butt1Y} + $bw / 2 - $at,
			$self-> { butt2X} - 2 + + $bw + $at, $self-> {butt1Y} + $bw / 2 - $at
		);
		$canvas-> line(
			$self-> { butt2X} + $bw / 2 + $at, $self-> { butt1Y} + 2 - $at,
			$self-> { butt2X} + $bw / 2 + $at, $self-> { butt1Y} - 2 - $at + $bw
		);
	}

	$canvas-> rect_focus(
		( $size[0] - $ttw) / 2 - 1, $self->{textY} - 1,
		( $size[0] + $ttw) / 2 + 1, $self->{textY} + $fh + 1
	) if $self->{show_text} && $self-> focused && ( length( $self-> text) > 0);
}

sub on_keydown
{
	my ( $self, $code, $key, $mod) = @_;
	return if $self-> {readOnly};
	if ( $key == kb::Home || $key == kb::PgUp) {
		$self-> value( $self-> {min});
		$self-> clear_event;
		return;
	}
	if ( $key == kb::End || $key == kb::PgDn) {
		$self-> value( $self-> {max});
		$self-> clear_event;
		return;
	}
	if ( $key == kb::Left || $key == kb::Right || $key == kb::Up || $key == kb::Down) {
		my $s = $self-> {step};
		$self-> clear_event;
		$self-> set_next_value(( $key == kb::Left || $key == kb::Down) ? -$s : $s);
	}
}

sub on_translateaccel
{
	my ( $self, $code, $key, $mod) = @_;
	if (
		defined $self-> {accel} &&
		($key == kb::NoKey) &&
		lc chr $code eq $self-> { accel}
	) {
		$self-> clear_event;
		$self-> select;
	}
}

sub xy2val
{
	my ( $self, $x, $y) = @_;
	$x -= $self-> {circX};
	$y -= $self-> {circY};
	my $a  = atan2( $y, $x);
	my $pi = atan2( 0, -1);
	$a += $pi / 2;
	$a += $pi * 2 if $a < 0;
	$a = $self-> {min} + abs( $self-> {max} - $self-> {min}) * ( $pi * 1.75 - $a) * 2 / ( 3 * $pi);
	my $s = $self-> {step};
	$a = int( $a) if int( $s) - $s == 0;
	my $inCircle = ( abs($x) < $self-> {radius} + 3 and abs($y) < $self-> {radius} + 3);
	return $a, $inCircle;
}

sub on_mousedown
{
	my ( $self, $btn, $mod, $x, $y) = @_;
	return if $self-> {readOnly};
	return if $self-> {mouseTransaction};
	return if $btn != mb::Left;
	my @butt = (
		$self-> {butt1X}, $self-> {butt1Y},
		$self-> {butt2X}, $self-> {butt1X} + $self->buttonWidth,
		$self-> {butt1Y} + $self->buttonWidth, $self-> {butt2X} + $self->buttonWidth
	);
	if ( $self-> {buttons} and $y >= $butt[1] and $y < $butt[4]) {
		if ( $x >= $butt[0] and $x < $butt[3]) {
			$self-> {pressState} = 1;
			$self-> invalidate_rect( @butt[0..1], $butt[3] + 1, $butt[4] + 1);
		}
		if ( $x >= $butt[2] and $x < $butt[5]) {
			$self-> {pressState} = 2;
			$self-> invalidate_rect( $butt[2], $butt[1], $butt[5] + 1, $butt[4] + 1);
		}
		if ( $self-> {pressState} > 0) {
			$self-> {mouseTransaction} = $self-> {pressState};
			$self-> update_view;
			$self-> capture(1);
			$self-> scroll_timer_start;
			$self-> scroll_timer_semaphore(0);
			$self-> value( $self-> value +
				$self-> step * (($self-> {pressState} == 1) ? -1 : 1));
			return;
		}
	}
	return unless $self->{show_dial};

	my ( $val, $inCircle) = $self-> xy2val( $x, $y);
	return unless $inCircle;
	$self-> {mouseTransaction} = 3;
	$self-> capture(1);
	$self-> value( $val);
	$self-> clear_event;
}

sub on_mouseup
{
	my ( $self, $btn, $mod, $x, $y) = @_;
	return if $btn != mb::Left;
	return unless $self-> {mouseTransaction};
	my @butt = (
		$self-> {butt1X}, $self-> {butt1Y}, $self-> {butt2X},
		$self-> {butt1X} + $self->buttonWidth, $self-> {butt1Y} + $self->buttonWidth,
		$self-> {butt2X} + $self->buttonWidth
	);
	$self-> scroll_timer_stop;
	$self-> {pressState} = 0;
	if ( $self-> {mouseTransaction} == 1) {
		$self-> invalidate_rect( @butt[0..1], $butt[3] + 1, $butt[4] + 1);
		$self-> update_view;
	}
	if ( $self-> {mouseTransaction} == 2) {
		$self-> invalidate_rect( $butt[2], $butt[1], $butt[5] + 1, $butt[4] + 1);
		$self-> update_view;
	}
	my $mt = $self-> {mouseTransaction};
	$self-> {mouseTransaction} = undef;
	$self-> capture(0);
	$self-> notify( 'Change') if $mt == 3 && !$self-> {autoTrack};
}

sub on_mousemove
{
	my ( $self, $mod, $x, $y) = @_;
	unless ($self-> {mouseTransaction}) {
		if ( $self-> enabled ) {
			my ( undef, $prelight) = $self-> xy2val( $x, $y);
			if (($prelight // 0) != ($self->{prelight} // 0)) {
				if ( $prelight ) {
					$self->fader_in_mouse_enter;
					$self->{prelight} = $prelight;
				} else {
					$self->fader_out_mouse_leave;
				}
			}
		}
		return;
	}
	if ( $self-> {mouseTransaction} == 3) {
		my $ov = $self-> {value};
		$self-> {suppressNotify} = 1 unless $self-> {autoTrack};
		$self-> value( $self-> xy2val( $x, $y));
		$self-> {suppressNotify} = 0;
		$self-> notify(q(Track)) if !$self-> {autoTrack} && $ov != $self-> {value};
	} elsif ( $self-> {pressState} > 0) {
		$self-> scroll_timer_start unless $self-> scroll_timer_active;
		return unless $self-> scroll_timer_semaphore;
		$self-> scroll_timer_semaphore(0);
		$self-> value( $self-> value +
			$self-> step * (( $self-> {mouseTransaction} == 1) ? -1 : 1));
	} else {
		$self-> scroll_timer_stop;
	}
}

sub on_mouseleave  { shift-> fader_out_mouse_leave }
sub on_fadeout     { delete shift->{prelight} }
sub on_faderepaint { shift->repaint_circle }

sub on_mouseclick
{
	my $self = shift;
	$self-> clear_event;
	return unless pop;
	$self-> clear_event unless $self-> notify( "MouseDown", @_);
}

sub on_size        { $_[0]-> reset; }
sub on_fontchanged { $_[0]-> reset; }
sub on_enter { $_[0]-> repaint; }
sub on_leave { $_[0]-> repaint; }

sub on_stringify
{
	my ( $self, $value, $sref) = @_;
	$$sref = $value;
	$self-> clear_event;
}

sub set_buttons
{
	$_[0]-> {buttons} = $_[1];
	$_[0]-> repaint;
}

sub set_std_pointer
{
	$_[0]-> {stdPointer} = $_[1];
	$_[0]-> repaint;
}

sub stdPointer  {($#_)?$_[0]-> set_std_pointer ($_[1]):return $_[0]-> {stdPointer};}
sub buttons     {($#_)?$_[0]-> set_buttons     ($_[1]):return $_[0]-> {buttons};}

sub repaint_circle
{
	my $self = shift;
	return unless $self->{show_dial};

	my $buffer = Prima::DeviceBitmap->new(
		size      => [ $self-> size ],
		type      => dbt::Pixmap,
		font      => $self->font,
	);
	return $self->repaint unless $buffer;

	$self-> {singlePaint} = 1;
	$self-> notify( Paint => $buffer );
	$self-> {singlePaint} = undef;

	my $drad = $self->effective_dial_diameter;
	$self-> begin_paint;
	$self-> region( $self-> new_path-> ellipse( $self->{circX}, $self->{circY}, $drad, $drad)->region);
	$self-> put_image( 0,0,$buffer );
	$self-> end_paint;
}

sub value
{
	return $_[0]-> {value} unless $#_;
	my ( $self, $value) = @_;
	my ( $min, $max) = ( $self-> {min}, $self-> {max});
	my $old = $self-> {value};
	$value = $min if $value < $min;
	$value = $max if $value > $max;
	if ( $self-> {snap}) {
		my ( $minDist, $thatVal, $i) = ( abs( $min - $max));
		my $tval = $self-> {tickVal};
		for ( $i = 0; $i < scalar @{$tval}; $i++) {
			my $j = $$tval[ $i];
			$minDist = abs(($thatVal = $j) - $value) if abs( $j - $value) < $minDist;
		}
		$value = $thatVal if defined $thatVal;
	} elsif ( $self-> {step} != 0 ) {
		$value = int ( $value / $self-> {step} ) * $self-> {step};
	}
	return if $old == $value;

	$self-> {value} = $value;
	$self-> notify(q(Stringify), $value, \$self-> {string});
	$self-> repaint_circle;
	$self-> notify(q(Change)) unless $self-> {suppressNotify};
}

sub buttonWidth
{
	return $_[0]->{buttonWidth} unless $#_;
	my ( $self, $bw) = @_;
	$bw = 1 if $bw < 1;
	return if $bw == $self-> {buttonWidth};
	$self-> {buttonWidth} = $bw;
	$self-> repaint;
}

package Prima::ProgressBar;
use vars qw(@ISA);
@ISA = qw(Prima::Widget);

my $TIMER_SILENT_PERIOD = 2000;
my $TIMER_ACTIVE_PERIOD = 10;
my $TAB_STEP            = 10;
my $INDENT              = 1;
my $USE_ANIMATION;

sub profile_default
{
	return {
		%{$_[ 0]-> SUPER::profile_default},
		buffered  => 1,
		color     => cl::Green,
		max       => 100,
		min       => 0,
		value     => 0,
	}
}

sub init
{
	my $self = shift;
	$self->{$_} = 0 for qw( value min max );
	$self->{cache} = {
		size    => [0,0],
	};
	$self->{tabmode} = 'silent';
	$self->{tabpos}  = 0;
	my %profile = $self-> SUPER::init(@_);
	$self->$_($profile{$_}) for qw( min max value);

	$USE_ANIMATION //= $self->can_draw_alpha;

	$self->insert( 'Prima::Timer' =>
		name        => 'Timer',
		delegations => ['Tick'],
	) if $USE_ANIMATION;
	$self-> next_tick if $self-> visible;

	return %profile;
}

sub create_tab
{
	my ( $self, $x, $y ) = @_;

	my $tab_mask = Prima::Image->new(
		size      => [ int($x / 5 + .5), 1 ],
		type      => im::Byte,
		backColor => cl::White,
	);
	$tab_mask-> clear;
	$tab_mask-> put_image(0,0,$tab_mask,rop::SrcOut | rop::DstAlpha | ( 128 << rop::DstAlphaShift ) );

	my $tabend_mask = Prima::Image->new(
		size => [ $y * 2, 1 ],
		type => im::Byte,
		color => cl::Black,
	);
	$tabend_mask->new_gradient(
		palette => [cl::Black, cl::White, cl::Black],
	)->bar(0, 0, $y * 2, 1, 1);
	my $tabend = $tabend_mask->to_colormask(cl::Black);

	$tab_mask-> put_image_indirect( $tabend_mask, 0, 0, $y, 0, $y, 1, $y, 1, rop::SrcOver | rop::ConstantColor);
	$tab_mask-> put_image_indirect( $tabend_mask, $tab_mask-> width - $y, 0, 0, 0, $y, 1, $y, 1, rop::SrcOver | rop::ConstantColor);

	$self->{cache}->{tab}  = $tab_mask-> to_colormask(cl::White)-> bitmap;
	$self->{cache}->{tabx} = $tab_mask-> width;
}

sub recalc_images
{
	my ( $self, $x, $y ) = @_;

	$x ||= 1;
	$y ||= 1;
	my $cache = $self->{cache};
	return if $cache->{size}->[0] == $x && $cache->{size}->[1] == $y;

	my $recalc_x = $cache->{size}->[1] != $y;
	if ( !$recalc_x && $cache->{size}->[0] != $x ) {
		my $tabx = $x / 5;
		my $diff = abs( $cache->{tabx} - $tabx ) / $tabx;
		$recalc_x = 1 if $diff < 0.8 || $diff > 1.2;
	}

	$self->create_tab( $x, $y ) if $recalc_x;
}

sub next_tick
{
	my $self = shift;

	return unless $USE_ANIMATION;

	my $timer = $self-> Timer;
	if ( $self->{tabmode} eq 'silent' ) {
		if ( $timer-> get_active ) {
			$self->{tabmode} = 'show';
			$self->{tabpos}  = - $self->{cache}->{tabx};
			$timer->timeout( $TIMER_ACTIVE_PERIOD );
		} else {
			$timer->timeout( $TIMER_SILENT_PERIOD );
		}
		$timer->start;
	} elsif ( $self->{tabpos} < $self-> width ) {
		$self->{tabpos} += $TAB_STEP;
		$self->repaint;
	} else {
		$self->{tabmode} = 'silent';
		$timer->timeout( $TIMER_SILENT_PERIOD );
		$timer->start;
		$self->repaint;
	}
}

sub on_size
{
	my ( $self, $ox, $oy, $x, $y ) = @_;
	$self->recalc_images( $x, $y );
}

sub on_hide
{
	my $self = shift;
	$self->Timer1->stop;
	$self->{tabmode} = 'silent';
}

sub on_show
{
	shift->next_tick;
}

sub on_paint
{
	my ($self,$canvas) = @_;

	my ($xa1, $xa2, $xb1, $xb2, $y1, $y2);

	my @sz = $self-> size;
	my $indent = $INDENT;
	my $range  = $self->{max} - $self->{min};
	$y1 = $indent;
	$y2 = $sz[1] - 1;
	if ( $self->{value} == $self->{min} || $sz[0] == 0 || $sz[1] == 0 || $range == 0) {
		$xa1 = $xa2 = -1;
	} else {
		$xa1 = $indent;
		$xa2 = ( $self->{value} == $self->{max} ) ?
			$sz[0] - $indent :
			(( $sz[0] - $indent * 2 ) * $self->{value} / $range + $indent);
	}
	if ( $self->{value} == $self->{max} || $sz[0] == 0 || $sz[1] == 0 || $range == 0) {
		$xb1 = $xb2 = -1;
	} else {
		$xb1 = ( $xa2 < 0 ) ? $indent : ( $xa2 + 1 );
		$xb2 = $sz[0] - $indent;
	}

	$canvas-> new_gradient(
		palette => [ cl::Black, $self->color, cl::White ],
		poly    => [ 0, 0.25, 1, 0.75, 0.75, 0.25 + 0.5 * 0.75 ],
	)-> bar( $xa1, $y1, $xa2, $y2 ) if $xa1 > 0;

	$canvas-> new_gradient(
		palette => [ cl::Black, cl::Gray, cl::White ],
		poly    => [ 0, 0.25, 1, 0.75, 0.75, 0.25 + 0.5 * 0.75 ],
	)-> bar( $xb1, $y1, $xb2, $y2 ) if $xb1 > 0;

	$canvas-> color(cl::Gray);
	$canvas-> rectangle( 0, 0, $sz[0] - 1, $sz[1] - 1);

	if ( $self->{tabmode} eq 'show' && $xa1 > 0) {
		$canvas->clipRect(0, 0, $xa2, $sz[1]);
		$canvas->put_image( $self->{tabpos}, $_, $self->{cache}->{tab}, rop::Blend ) for 0 .. $sz[1];
	}
}

sub set_bounds
{
	my ( $self, $min, $max) = @_;
	$max = $min if $max < $min;
	( $self-> { min}, $self-> { max}) = ( $min, $max);
	$self-> value( $max) if $self-> {value} > $max;
	$self-> value( $min) if $self-> {value} < $min;
}

sub value
{
	return $_[0]-> {value} unless $#_;
	my $v = $_[1] < $_[0]-> {min} ? $_[0]-> {min} : ($_[1] > $_[0]-> {max} ? $_[0]-> {max} : $_[1]);
	return if $v == $_[0]->{value};
	$_[0]-> {value} = $v;
	$_[0]-> repaint;
}

sub min       {($#_)?$_[0]-> set_bounds($_[1], $_[0]-> {'max'})  : return $_[0]-> {min};}
sub max       {($#_)?$_[0]-> set_bounds($_[0]-> {'min'}, $_[1])  : return $_[0]-> {max};}

sub Timer_Tick { shift-> next_tick }

1;

=pod

=head1 NAME

Prima::Sliders - sliding bars, spin buttons, dial widgets, etc

=head1 DESCRIPTION

The module contains a set of unrelated widget classes that provide input and/or
output of an integer value. That is the only thing common in these classes, which are:

	Prima::AbstractSpinButton
		Prima::SpinButton
		Prima::AltSpinButton

	Prima::SpinEdit

	Prima::Gauge
	Prima::PrigressBar

	Prima::AbstractSlider
		Prima::Slider
		Prima::CircularSlider

=head1 Prima::AbstractSpinButton

Provides a generic interface to the spin-button class functionality that includes
events and range definition properties. Neither C<Prima::AbstractSpinButton> nor
its descendants store the integer value. These provide a mere possibility for
the user to send the incrementing and decrementing commands.

The class is not usable directly.

=head2 Properties

=over

=item state INTEGER

The property manages a common internal state that doesn't have an exact
meaning, as it is only defined in the descendant classes.  For example, the
state can be set to non-zero when the user performs a mouse drag action.

=back

=head2 Events

=over

=item Increment DELTA

Called when the user presses a part of the widget that is responsible for
incrementing or decrementing commands. DELTA is an integer value
that indicates how the associated value must be modified.

=item TrackEnd

Called when the user finished the mouse transaction.

=back

=head1 Prima::SpinButton

=for podview <img src="spinbutton.gif">

=for html <p><img src="https://raw.githubusercontent.com/dk/Prima/master/pod/Prima/spinbutton.gif">

A rectangular spin button that consists of three parts, divided horizontally.
The upper and the lower parts are push buttons associated with singular
increment and decrement commands. The middle part, when dragged by the mouse,
fires the C<Increment> events with delta value, based on the vertical position
of the mouse pointer.

=head1 Prima::AltSpinButton

=for podview <img src="altspinbutton.gif">

=for html <p><img src="https://raw.githubusercontent.com/dk/Prima/master/pod/Prima/altspinbutton.gif">

A rectangular spin button that consists of two push-buttons, associated with
singular increment and decrement commands. Compared to C<Prima::SpinButton>,
the class is a bit less functional but has a more stylish look.

=head1 Prima::SpinEdit

=for podview <img src="spinedit.gif">

=for html <p><img src="https://raw.githubusercontent.com/dk/Prima/master/pod/Prima/spinedit.gif">

The widget contains a numerical input line and a spin button.  The input line
value can be changed in three ways - either as a direct traditional keyboard
input, as a result of the spin button actions, or as the mouse wheel response.
The class provides properties for value storage and range selection.

=head2 Properties

=over

=item allowEmpty BOOLEAN

If set, allows an empty string as a valid value

Default value: false

=item circulate BOOLEAN

Selects the value modification rule when the increment or decrement action hits
a range limit. If 1, the value is changed to the opposite limit value ( for
example, if the value is 100 in the range 2-100, and the user clicks on the 'increment'
button, the value is changed to 2 ).

If 0, the value does not change.

Default value: 0

=item editClass STRING

Assigns the input line class.

A create-only property.

Default value: C<Prima::InputLine>

=item editDelegations ARRAY

Assigns the input line list of the notifications.

A create-only property.

=item editProfile HASH

Assigns a hash of properties passed to the input line during the creation.

A create-only property.

=item max INTEGER

Sets the upper limit for C<value>.

Default value: 100.

=item min INTEGER

Sets the lower limit for C<value>.

Default value: 0

=item pageStep INTEGER

Determines the multiplication factor for incrementing and decrementing
actions of the mouse wheel.

Default value: 10

=item spinClass STRING

Assigns the spin-button class.

A create-only property.

Default value: C<Prima::AltSpinButton>

=item spinProfile ARRAY

Assigns the spin-button list of the delegated notifications.

A create-only property.

=item spinDelegations HASH

Assigns a hash of properties passed to the spin-button during the creation.

A create-only property.

=item step INTEGER

Determines the multiplication factor for incrementing and decrementing
actions of the spin-button.

Default value: 1

=item value INTEGER

Selects the integer value in the range from C<min> to C<max>. The value is
reflected in the input line.

Default value: 0.

=back

=head2 Methods

=over

=item set_bounds MIN, MAX

Simultaneously sets both C<min> and C<max> values.

=back

=head2 Events

=over

=item Change

Called when C<value> is changed.

=back

=head1 Prima::Gauge

=for podview <img src="gauge.gif">

=for html <p><img src="https://raw.githubusercontent.com/dk/Prima/master/pod/Prima/gauge.gif">

An output-only widget class, displays a progress bar and an eventual percentage string.
Useful as a progress indicator.

=head2 Properties

=over

=item indent INTEGER

Selects the width of the border around the widget.

Default value: 1

=item max INTEGER

Sets the upper limit for C<value>.

Default value: 100.

=item min INTEGER

Sets the lower limit for C<value>.

Default value: 0

=item relief INTEGER

Selects the style of the border around the widget. Can be one of the
following C<gr::XXX> constants:

	gr::Sink    - 3d sunken look
	gr::Border  - uniform black border
	gr::Raise   - 3d raised look

Default value: C<gr::Sink>.

=item threshold INTEGER

Selects the threshold value used to determine if the changes to C<value>
are reflected immediately or are deferred until the value is changed more
significantly. When 0, all calls to C<value> result in an immediate
repaint request.

Default value: 0

=item value INTEGER

Selects the integer value between C<min> and C<max>, reflected in the progress bar and
eventual text.

Default value: 0.

=item vertical BOOLEAN

If 1, the widget is drawn vertically and the progress bar moves from bottom to top.
If 0, the widget is drawn horizontally and the progress bar moves from left to right.

Default value: 0

=back

=head2 Methods

=over

=item set_bounds MIN, MAX

Simultaneously sets both C<min> and C<max> values.

=back

=head2 Events

=over

=item Stringify VALUE, REF

Converts the integer VALUE into a string format and stores it in the REF scalar reference.
Default stringifying conversion is identical to a call to C<sprintf("%2d%%")>.

=back

=head1 Prima::ProgressBar

=for podview <img src="progressbar.png">

=for html <p><img src="https://raw.githubusercontent.com/dk/Prima/master/pod/Prima/progressbar.png">

Displays a progress bar

=head2 Properties

=over

=item max INTEGER

Sets the upper limit for C<value>.

Default value: 100.

=item min INTEGER

Sets the lower limit for C<value>.

Default value: 0

=item value INTEGER

Selects the integer value between C<min> and C<max>, reflected in the progress bar and
an eventual text.

Default value: 0.

=back

=head2 Methods

=over

=item set_bounds MIN, MAX

Simultaneously sets both C<min> and C<max> values.

=back

=head1 Prima::AbstractSlider

The class provides the basic functionality of a sliding bar, equipped with I<tick
marks>. The tick marks are supposed to be drawn alongside the main sliding axis
or the dialing circle, and provide visual feedback for the user.

The class is not usable directly.

=head2 Properties

=over

=item autoTrack BOOLEAN

A boolean flag, selects the way notifications are executed when the user
mouse-drags the sliding bar. If 1, the C<Change> notification is executed as
soon as C<value> is changed. If 0, C<Change> is deferred until the user
finishes the mouse drag; instead, the C<Track> notification is executed when the
bar is moved.

This property can be used when the C<Change> notification handler performs very
slowly, so the eventual fast mouse interactions would not thrash down the program.

Default value: 1

=item increment INTEGER

A step range value used in C<scheme> for marking the key ticks.
See L<scheme> for details.

Default value: 10

=item max INTEGER

Sets the upper limit for C<value>.

Default value: 100.

=item min INTEGER

Sets the lower limit for C<value>.

Default value: 0

=item readOnly BOOLEAN

If 1, the user cannot change the value by moving the bar or otherwise.

Default value: 0

=item ticks ARRAY

Selects the tick marks representation along the sliding axis or the dialing
circle.  ARRAY consists of hashes, each for one tick. The hash must contain at
least a C<value> key with an integer value. The two additional keys C<height> and
C<text>, select the height of a tick mark in pixels, and the text is drawn near
the mark, correspondingly.

If ARRAY is C<undef>, no ticks are drawn.

=item scheme INTEGER

C<scheme> is a property that creates a set of tick marks using one of the
predefined scale designs selected by the C<ss::XXX> constants.  Each constant
produces a different scale; some make use of the C<increment> integer property that
selects a step that is used to place additional text marks.  As an example, the
C<ss::Thermometer> design with the default C<min>, C<max>, and C<increment>
values would look like this:

	0   10   20        100
	|    |    |          |
	|||||||||||||||....|||

The module defines the following constants:

	ss::Axis           - 5 minor ticks per increment
	ss::Gauge          - 1 tick per increment
	ss::StdMinMax      - 2 ticks at the ends of the bar
	ss::Thermometer    - 10 minor ticks per increment, longer text ticks

When the C<tick> property is explicitly set, C<scheme> is reset to C<undef>.

=item snap BOOLEAN

If 1, C<value> cannot accept values that are not on the tick scale.  When such
a value is attempted to be set, it is rounded to the closest tick mark.  If 0,
C<value> can accept any integer value in the range from C<min> to C<max>.

Default value: 0

=item step INTEGER

An integer delta for singular increment and decrement commands, and
also a threshold for C<value> when the C<snap> value is 0.

Default value: 1

=item value INTEGER

Selects an integer value between C<min> and C<max> and the corresponding sliding bar
position.

Default value: 0.

=back

=head2 Events

=over

=item Change

Called when the C<value> value is changed, with one exception:
if the user moves the sliding bar while C<autoTrack> is 0, the C<Track>
notification is called instead.

=item Track

Called when the user moves the sliding bar while the C<autoTrack> value is 0;
this notification is a substitute to C<Change>.

=back

=head1 Prima::Slider

=for podview <img src="slider.gif">

=for html <p><img src="https://raw.githubusercontent.com/dk/Prima/master/pod/Prima/slider.gif">

Presents a linear sliding bar, movable along a linear shaft.

=head2 Properties

=over

=item borderWidth INTEGER

In horizontal mode, sets extra margin space between the slider line and the
widget boundaries. Can be used for fine-tuning text labels from C<ticks()>,
where the default spacing (0) or spacing procedure (drop overlapping labels)
does not produce decent results.

=item ribbonStrip BOOLEAN

If 1, the parts of the shaft are painted with different colors to increase
visual feedback. If 0, the shaft is painted with the single default background color.

Default value: 0

=item shaftBreadth INTEGER

The breadth of the shaft in pixels.

Default value: 6

=item tickAlign INTEGER

One of the C<tka::XXX> constants that correspond to the position of the tick marks:

	tka::Normal        - ticks are drawn on the left or the top of the shaft
	tka::Alternative   - ticks are drawn on the right or at the bottom of the shaft
	tka::Dual          - ticks are drawn both ways

The ticks' orientation ( left or top, right or bottom ) is dependent on the C<vertical>
property value.

Default value: C<tka::Normal>

=item vertical BOOLEAN

If 1, the widget is drawn vertically, and the slider moves from bottom to top.
If 0, the widget is drawn horizontally, and the slider moves from left to right.

Default value: 0

=back

=head2 Methods

=over

=item pos2info X, Y

Translates integer coordinates pair ( X, Y ) into the value corresponding to the scale,
and returns three scalars:

=over

=item info INTEGER

If C<undef>, the user-driven positioning is not possible ( C<min> equals to C<max> ).

If 1, the point is located on the slider.

If 0, the point is outside the slider.

=item value INTEGER

If C<info> is 0 or 1, contains the corresponding C<value>.

=item aperture INTEGER

Offset in pixels along the shaft axis.

=back

=back

=head1 Prima::CircularSlider

=for podview <img src="circularslider.gif">

=for html <p><img src="https://raw.githubusercontent.com/dk/Prima/master/pod/Prima/circularslider.gif">

Presents a slider widget with a dialing circle and two increment/decrement buttons.
The tick marks are drawn around the perimeter of the dial; the current value
is displayed in the center of the dial.

=head2 Properties

=over

=item buttons BOOLEAN

If 1, the increment / decrement buttons are shown at the bottom of the dial,
and the user can change the value either by the dial or by the buttons.
If 0, the buttons are not shown.

Default values: 0

=item stdPointer BOOLEAN

Determines the style of a value indicator ( pointer ) on the dial.
If 1, it is drawn as a black triangular mark.
If 0, it is drawn as a small circular knob.

Default value: 0

=back

=head2 Methods

=over

=item offset2data VALUE

Converts integer value in the range from C<min> to C<max> into
the corresponding angle, and returns two floating-point values:
cosine and sine of the angle.

=item offset2pt X, Y, VALUE, RADIUS

Converts integer value in the range from C<min> to C<max> into the
point coordinates, with the RADIUS and dial center coordinates
X and Y. Return the calculated point coordinates
as two integers in the (X,Y) format.

=item xy2val X, Y

Converts widget coordinates X and Y into value in the range from C<min>
to C<max> and returns two scalars: the value and the boolean flag,
which is set to 1 if the (X,Y) point is inside the dial circle,
and to 0 otherwise.

=back

=head2 Events

=over

=item Stringify VALUE, REF

Converts integer VALUE into a string format and stores it in the REF scalar reference.
The resulting string is displayed in the center of the dial.

The default conversion routine simply copies VALUE to REF as is.

=back

=head1 AUTHOR

Dmitry Karasik, E<lt>dmitry@karasik.eu.orgE<gt>,
Anton Berezin E<lt>tobez@tobez.orgE<gt>.

=head1 SEE ALSO

L<Prima>, F<examples/fontdlg.pl>

=cut
