1package Prima::Dialog::ColorDialog;
2
3use strict;
4use warnings;
5use Prima qw(Sliders Label Buttons ComboBox ScrollBar);
6use vars qw( @ISA $colorWheel $colorWheelShape);
7@ISA = qw( Prima::Dialog);
8
9{
10my %RNT = (
11	%{Prima::Dialog-> notification_types()},
12	BeginDragColor => nt::Command,
13	EndDragColor   => nt::Command,
14);
15
16sub notification_types { return \%RNT; }
17}
18
19my $shapext = Prima::Application-> get_system_value( sv::ShapeExtension);
20
21sub hsv2rgb
22{
23	my ( $h, $s, $v) = @_;
24	$v = 1 if $v > 1;
25	$v = 0 if $v < 0;
26	$s = 1 if $s > 1;
27	$s = 0 if $s < 0;
28	$v *= 255;
29	return $v, $v, $v if $h == -1;
30	my ( $r, $g, $b, $i, $f, $w, $q, $t);
31	$h -= 360 if $h >= 360;
32	$h /= 60;
33	$i = int( $h);
34	$f = $h - $i;
35	$w = $v * (1 - $s);
36	$q = $v * (1 - ($s * $f));
37	$t = $v * (1 - ($s * (1 - $f)));
38
39	if ( $i == 0) {
40		return $v, $t, $w;
41	} elsif ( $i == 1) {
42		return $q, $v, $w;
43	} elsif ( $i == 2) {
44		return $w, $v, $t;
45	} elsif ( $i == 3) {
46		return $w, $q, $v;
47	} elsif ( $i == 4) {
48		return $t, $w, $v;
49	} else {
50		return $v, $w, $q;
51	}
52}
53
54sub rgb2hsv
55{
56	my ( $r, $g, $b) = @_;
57	my ( $h, $s, $v, $max, $min, $delta);
58	$r /= 255;
59	$g /= 255;
60	$b /= 255;
61	$max = $r;
62	$max = $g if $g > $max;
63	$max = $b if $b > $max;
64	$min = $r;
65	$min = $g if $g < $min;
66	$min = $b if $b < $min;
67	$v = $max;
68	$s = $max ? ( $max - $min) / $max : 0;
69	return -1, $s, $v unless $s;
70
71	$delta = $max - $min;
72	if ( $r == $max) {
73		$h = ( $g - $b) / $delta;
74	} elsif ( $g == $max) {
75		$h = 2 + ( $b - $r) / $delta;
76	} else {
77		$h = 4 + ( $r - $g) / $delta;
78	}
79	$h *= 60;
80	$h += 360 if $h < 0;
81	return $h, $s, $v;
82}
83
84sub xy2hs
85{
86	my ( $x, $y, $c) = @_;
87	my ( $d, $r, $rx, $ry, $h, $s);
88	( $rx, $ry) = ( $x - $c, $y - $c);
89	my $c2 = $c * $c;
90	$d = $c2 * ( $rx*$rx + $ry*$ry - $c2);
91
92	$r = sqrt( $rx*$rx + $ry*$ry);
93
94	$h = $r ? atan2( $rx/$r, $ry/$r) : 0;
95
96	$s = $r / $c;
97	$h = $h * 57.295779513 + 180;
98
99	$s = 1 if $s > 1;
100
101	return $h, $s, $d > 0;
102}
103
104sub hs2xy
105{
106	my ( $self, $h, $s) = @_;
107	my ( $r, $a) = ( 128 * $s, ($h - 180) / 57.295779513);
108	return map { $self->{scaling} * $_ } 128 + $r * sin( $a), 128 + $r * cos( $a);
109}
110
111sub create_wheel
112{
113	my ($id, $pix, $color)   = @_;
114	my $imul = 256 * $pix / $id;
115	my $i = Prima::DeviceBitmap-> create(
116		width  => 256 * $pix,
117		height => 256 * $pix,
118		name => '',
119	);
120
121	my ( $y1, $x1) = ($id,$id);
122	my  $d0 = $id / 2;
123
124	$i-> begin_paint;
125	$i-> color( cl::Black);
126	$i-> bar( 0, 0, $i-> width, $i-> height);
127
128	my ( $y, $x);
129
130	for ( $y = 0; $y < $y1; $y++) {
131		for ( $x = 0; $x < $x1; $x++) {
132			my ( $h, $s, $ok) = xy2hs( $x, $y, $d0);
133			next if $ok;
134			my ( $r, $g, $b) = hsv2rgb( $h, $s, 1);
135			$i-> color( $b | ($g << 8) | ($r << 16));
136			$i-> bar(
137				$x * $imul, $y * $imul,
138				( $x + 1) * $imul - 1, ( $y + 1) * $imul - 1
139			);
140		}
141	}
142	$i-> end_paint;
143
144
145	my $a = Prima::DeviceBitmap-> create(
146		width  => 256 * $pix,
147		height => 256 * $pix,
148		name   => 'ColorWheel',
149	);
150
151	$a-> begin_paint;
152	$a-> color( $color);
153	$a-> bar( 0, 0, $a-> size);
154	$a-> rop( rop::XorPut);
155	$a-> put_image( 0, 0, $i);
156	$a-> rop( rop::CopyPut);
157	$a-> color( cl::Black);
158	$a-> fill_ellipse(
159		128 * $pix, 128 * $pix,
160		(256 * $pix) - $imul * 2 - 1,
161		(256 * $pix) - $imul * 2 - 1
162	);
163	$a-> rop( rop::XorPut);
164	$a-> put_image( 0, 0, $i);
165	$a-> end_paint;
166
167	$i-> destroy;
168
169	return $a;
170}
171
172sub create_wheel_shape
173{
174	return unless $shapext;
175	my ($id, $pix) = @_;
176	my $imul = 256 * $pix / $id;
177	my $a = Prima::Image-> create(
178		width => 256 * $pix,
179		height => 256 * $pix,
180		type => im::BW,
181	);
182	$a-> begin_paint;
183	$a-> color( cl::Black);
184	my $last = 256 * $pix - 1;
185	$a-> bar( 0, 0, $last, $last);
186	$a-> color( cl::White);
187	$a-> fill_ellipse( 128 * $pix, 128 * $pix, $last - $imul * 2, $last - $imul * 2);
188	$a-> end_paint;
189	return $a;
190}
191
192sub profile_default
193{
194	return {
195		%{$_[ 0]-> SUPER::profile_default},
196
197		width         => 348,
198		height        => 450,
199		centered      => 1,
200		visible       => 0,
201		scaleChildren => 1,
202		designScale   => [7, 16],
203		text          => 'Select color',
204
205		quality       => 0,
206		value         => cl::White,
207	}
208}
209
210sub init
211{
212	my $self = shift;
213	my %profile = $self-> SUPER::init(@_);
214	$self-> {setTransaction} = undef;
215
216	my $c = $self-> {value} = $profile{value};
217	$self-> {quality} = 0;
218	my ( $r, $g, $b) = cl::to_rgb( $c);
219	my ( $h, $s, $v) = rgb2hsv( $r, $g, $b);
220	$s *= 255;
221	$v *= 255;
222	$h = int($h);
223	$s = int($s);
224	$v = int($v);
225
226	my $dx = $Prima::Widget::default_font_box[0] / ($self-> designScale)[0];
227	my $dy = $Prima::Widget::default_font_box[1] / ($self-> designScale)[1];
228	my $pix = ( $dx < $dy ) ? $dx : $dy;
229	$colorWheel = create_wheel(32, $pix, $self-> backColor) unless $colorWheel;
230	$colorWheelShape = create_wheel_shape(32, $pix) unless $colorWheelShape;
231
232	$self-> {wheel} = $self-> insert( Widget =>
233		designScale    => undef,
234		origin         => [
235			20 * $dx  + ($dx - $pix) * 256 / 2,
236			172 * $dy + ($dy - $pix) * 256 / 2
237		],
238		width          => 256 * $pix,
239		height         => 256 * $pix,
240		name           => 'Wheel',
241		shape          => $colorWheelShape,
242		ownerBackColor => 1,
243		syncPaint      => 1,
244		delegations    => [qw(Paint MouseDown MouseUp MouseMove)],
245	);
246
247	$self-> {scaling} = $pix;
248
249	$self-> {roller} = $self-> insert( Widget =>
250		origin    => [ 288, 164],
251		width     => 48,
252		height    => 272,
253		buffered  => 1,
254		name      => 'Roller',
255		ownerBackColor => 1,
256		delegations    => [qw(Paint MouseDown MouseUp MouseMove)],
257	);
258
259	# RGB
260	my %rgbprf = (
261		width    => 72,
262		max      => 255,
263		onChange => sub { RGB_Change( $_[0]-> owner, $_[0]);},
264	);
265	$self-> {R} = $self-> insert( SpinEdit =>
266		origin   => [40,120],
267		value    => $r,
268		name     => 'R',
269		%rgbprf,
270	);
271	my %labelprf = (
272		width      => 20,
273		autoWidth  => 0,
274		autoHeight => 0,
275		valignment => ta::Center,
276	);
277	$self-> insert( Label =>
278		origin     => [ 20, 120],
279		focusLink  => $self-> {R},
280		text       => 'R:',
281		%labelprf,
282	);
283	$self-> {G} = $self-> insert( SpinEdit =>
284		origin   => [148,120],
285		value    => $g,
286		name     => 'G',
287		%rgbprf,
288	);
289	$self-> insert( Label =>
290		origin     => [ 126, 120],
291		focusLink  => $self-> {G},
292		text       => 'G:',
293		%labelprf,
294	);
295	$self-> {B} = $self-> insert( SpinEdit =>
296		origin   => [256,120],
297		value    => $b,
298		name     => 'B',
299		%rgbprf,
300	);
301	$self-> insert( Label =>
302		origin     => [ 236, 120],
303		focusLink  => $self-> {B},
304		text       => 'B:',
305		%labelprf,
306	);
307
308	$rgbprf{onChange} = sub { HSV_Change( $_[0]-> owner, $_[0])};
309	$self-> {H} = $self-> insert( SpinEdit =>
310		origin   => [ 40,78],
311		value    => $h,
312		name     => 'H',
313		%rgbprf,
314		max      => 360,
315	);
316	$self-> insert( Label =>
317		origin     => [ 20, 78],
318		focusLink  => $self-> {H},
319		text       => 'H:',
320		%labelprf,
321	);
322	$self-> {S} = $self-> insert( SpinEdit =>
323		origin   => [ 146,78],
324		value    => int($s),
325		name     => 'S',
326		%rgbprf,
327	);
328	$self-> insert( Label =>
329		origin     => [ 126, 78],
330		focusLink  => $self-> {S},
331		text       => 'S:',
332		%labelprf,
333	);
334	$self-> {V} = $self-> insert( SpinEdit =>
335		origin   => [ 256,78],
336		value    => int($v),
337		name     => 'V',
338		%rgbprf,
339	);
340	$self-> insert( Label =>
341		origin     => [ 236, 78],
342		focusLink  => $self-> {V},
343		text       => 'V:',
344		%labelprf,
345	);
346	$self-> insert( Button =>
347		text        => '~OK',
348		origin      => [ 20, 20],
349		modalResult => mb::OK,
350		default     => 1,
351	);
352
353	$self-> insert( Button =>
354		text        => 'Cancel',
355		origin      => [ 126, 20],
356		modalResult => mb::Cancel,
357	);
358	$self-> {R}-> select;
359	$self-> quality( $profile{quality});
360
361	$self-> Roller_Repaint if $self-> {quality};
362	return %profile;
363}
364
365sub on_destroy
366{
367	$colorWheelShape = undef;
368}
369
370sub on_begindragcolor
371{
372	my ( $self, $property) = @_;
373	$self-> {old_text} = $self-> text;
374	$self-> {wheel}-> pointer( cr::DragMove);
375	$self-> text( "Apply $property...");
376}
377
378sub on_enddragcolor
379{
380	my ( $self, $property, $widget) = @_;
381
382	$self-> {wheel}-> pointer( cr::Default);
383	$self-> text( $self-> {old_text});
384	if ( $widget) {
385		$property = $widget-> can( $property);
386		$property-> ( $widget, $self-> value) if $property;
387	}
388	delete $self-> {old_text};
389}
390
391use constant Hue    => 1;
392use constant Sat    => 2;
393use constant Lum    => 4;
394use constant Roller => 8;
395use constant Wheel  => 16;
396use constant All    => 31;
397
398sub RGB_Change
399{
400	my ($self, $pin) = @_;
401	return if $self-> {setTransaction};
402	$self-> {setTransaction} = 1;
403	$self-> {RGBPin} = $pin;
404	my ( $r, $g, $b) = cl::to_rgb( $self-> {value});
405	$r = $self-> {R}-> value if $pin == $self-> {R};
406	$g = $self-> {G}-> value if $pin == $self-> {G};
407	$b = $self-> {B}-> value if $pin == $self-> {B};
408	$self-> value( cl::from_rgb( $r, $g, $b));
409	undef $self-> {RGBPin};
410	undef $self-> {setTransaction};
411}
412
413sub HSV_Change
414{
415	my ($self, $pin) = @_;
416	return if $self-> {setTransaction};
417	$self-> {setTransaction} = 1;
418	my ( $h, $s, $v);
419	$self-> {HSVPin} = Hue | Lum | Sat | ( $pin == $self-> {V} ? (Wheel|Roller) : 0);
420	$h = $self-> {H}-> value      ;
421	$s = $self-> {S}-> value / 255;
422	$v = $self-> {V}-> value / 255;
423	$self-> value( cl::from_rgb( hsv2rgb( $h, $s, $v)));
424	undef $self-> {HSVPin};
425	undef $self-> {setTransaction};
426}
427
428sub Wheel_Paint
429{
430	my ( $owner, $self, $canvas) = @_;
431	$canvas-> put_image( 0, 0, $colorWheel);
432	my ( $x, $y) = $owner-> hs2xy( $owner-> {H}-> value, $owner-> {S}-> value/273);
433	$canvas-> color( cl::White);
434	$canvas-> rop( rop::XorPut);
435	if ( $shapext) {
436		my @sz = $canvas-> size;
437		$canvas-> linePattern( lp::DotDot);
438		$canvas-> line( $x, 0, $x, $sz[1]);
439		$canvas-> line( 0, $y, $sz[0], $y);
440	} else {
441		$canvas-> lineWidth( 3);
442		$canvas-> ellipse( $x, $y, 13, 13);
443	}
444}
445
446sub Wheel_MouseDown
447{
448	my ( $owner, $self, $btn, $mod, $x, $y) = @_;
449	return if $self-> {mouseTransation};
450	return if $btn != mb::Left;
451	my $scale = $owner->{scaling};
452	my ( $h, $s, $ok) = xy2hs( $x-9*$scale, $y-9*$scale, 119*$scale);
453	return if $ok;
454	$self-> {mouseTransation} = $btn;
455	$self-> capture(1);
456	if ( $btn == mb::Left) {
457		if ( $mod == ( km::Ctrl | km::Alt)) {
458			$self-> {drag_color} = 'disabledColor';
459		} elsif ( $mod == ( km::Ctrl | km::Alt | km::Shift)) {
460			$self-> {drag_color} = 'disabledBackColor';
461		} elsif ( $mod == ( km::Ctrl | km::Shift)) {
462			$self-> {drag_color} = 'hiliteColor';
463		} elsif ( $mod == ( km::Alt | km::Shift)) {
464			$self-> {drag_color} = 'hiliteBackColor';
465		} elsif ( $mod & km::Ctrl) {
466			$self-> {drag_color} = 'color';
467		} elsif ( $mod & km::Alt) {
468			$self-> {drag_color} = 'backColor';
469		} else {
470			$self-> notify( "MouseMove", $mod, $x, $y);
471		}
472
473		$owner-> notify( 'BeginDragColor', $self-> {drag_color})
474			if $self-> {drag_color};
475	}
476}
477
478sub Wheel_MouseMove
479{
480	my ( $owner, $self, $mod, $x, $y) = @_;
481	return if !$self-> {mouseTransation} or $self-> {drag_color};
482	my $scale = $owner->{scaling};
483	my ( $h, $s, $ok) = xy2hs( $x-9*$scale, $y-9*$scale, 119*$scale);
484	$owner-> {setTransaction} = 1;
485	$owner-> {HSVPin} = Lum|Hue|Sat;
486	$owner-> {H}-> value( int( $h));
487	$owner-> {S}-> value( int( $s * 255));
488	$owner-> value( cl::from_rgb( hsv2rgb( int($h), $s, $owner-> {V}-> value/255)));
489	$owner-> {HSVPin} = undef;
490	$owner-> {setTransaction} = undef;
491}
492
493sub Wheel_MouseUp
494{
495	my ( $owner, $self, $btn, $mod, $x, $y) = @_;
496	return unless $self-> {mouseTransation};
497	$self-> {mouseTransation} = undef;
498	$self-> capture(0);
499	if ( $self-> {drag_color}) {
500		$owner-> notify('EndDragColor', $self-> {drag_color},
501			$::application-> get_widget_from_point( $self-> client_to_screen( $x, $y)));
502		delete $self-> {drag_color};
503	}
504}
505
506sub Roller_Paint
507{
508	my ( $owner, $self, $canvas) = @_;
509	my @size = $self-> size;
510	$canvas-> clear;
511	my $i;
512	my $step = 8 * $owner->{scaling};
513	my ( $h, $s, $v, $d) = ( $owner-> {H}-> value, $owner-> {S}-> value,
514		$owner-> {V}-> value, ($size[1] - $step * 2) / 32);
515	$s /= 255;
516	$v /= 255;
517	my ( $r, $g, $b);
518
519	for $i (0..31) {
520		( $r, $g, $b) = hsv2rgb( $h, $s, $i / 31);
521		$canvas-> color( cl::from_rgb( $r, $g, $b));
522		$canvas-> bar( $step, $step + $i * $d, $size[0] - $step, $step + ($i + 1) * $d);
523	}
524
525	$canvas-> color( cl::Black);
526	$canvas-> rectangle( $step, $step, $size[0] - $step, $size[1] - $step);
527	$d = int( $v * ($size[1]-$step * 2));
528	$canvas-> rectangle( 0, $d, $size[0]-1, $d + $step * 2 - 1);
529	$canvas-> color( $owner-> {value});
530	$canvas-> bar( 1, $d + 1, $size[0]-2, $d + $step * 2 - 2);
531	$self-> {paintPoll} = 2 if exists $self-> {paintPoll};
532}
533
534sub Roller_Repaint
535{
536	my $owner = $_[0];
537	my $roller = $owner-> {roller};
538	if ( $owner-> {quality}) {
539		my ( $h, $s, $v) = ( $owner-> {H}-> value, $owner-> {S}-> value, $owner-> {V}-> value);
540		$s /= 255;
541		$v /= 255;
542		my ( $i, $r, $g, $b);
543		my @pal;
544
545		for ( $i = 0; $i < 32; $i++) {
546			( $r, $g, $b) = hsv2rgb( $h, $s, $i / 31);
547			push ( @pal, $b, $g, $r);
548		}
549		( $r, $g, $b) = cl::to_rgb( $owner-> {value});
550		push ( @pal, $b, $g, $r);
551
552		$roller-> {paintPoll} = 1;
553		$roller-> palette([@pal]);
554		$roller-> repaint if $roller-> {paintPoll} != 2;
555		delete $roller-> {paintPoll};
556	} else {
557		$roller-> repaint;
558	}
559}
560
561
562sub Roller_MouseDown
563{
564	my ( $owner, $self, $btn, $mod, $x, $y) = @_;
565	return if $self-> {mouseTransation};
566	$self-> {mouseTransation} = 1;
567	$self-> capture(1);
568	$self-> notify( "MouseMove", $mod, $x, $y);
569}
570
571sub Roller_MouseMove
572{
573	my ( $owner, $self, $mod, $x, $y) = @_;
574	return unless $self-> {mouseTransation};
575	$owner-> {setTransaction} = 1;
576	$owner-> {HSVPin} = Hue|Sat|Wheel|Roller;
577	my $step = 8 * $owner->{scaling};
578	$owner-> value( cl::from_rgb( hsv2rgb(
579		$owner-> {H}-> value, $owner-> {S}-> value/255,
580		($y - $step) / ( $self-> height - $step * 2))));
581	$owner-> {HSVPin} = undef;
582	$owner-> {setTransaction} = undef;
583	$self-> update_view;
584}
585
586sub Roller_MouseUp
587{
588	my ( $owner, $self, $btn, $mod, $x, $y) = @_;
589	return unless $self-> {mouseTransation};
590	$self-> {mouseTransation} = undef;
591	$self-> capture(0);
592}
593
594
595sub set_quality
596{
597	my ( $self, $quality) = @_;
598	return if $quality == $self-> {quality};
599	$self-> {quality} = $quality;
600	$self-> {roller}-> palette([]) unless $quality;
601	$self-> Roller_Repaint;
602}
603
604sub set_value
605{
606	my ( $self, $value) = @_;
607	return if $value == $self-> {value} and ! $self-> {HSVPin};
608	$self-> {value} = $value;
609	my $st = $self-> {setTransaction};
610	$self-> {setTransaction} = 1;
611	my $rgb = $self-> {RGBPin} || 0;
612	my $hsv = $self-> {HSVPin} || 0;
613	my ( $r, $g, $b) = cl::to_rgb( $value);
614	my ( $h, $s, $v) = rgb2hsv( $r, $g, $b);
615	$s = int( $s*255);
616	$v = int( $v*255);
617	$self-> {R}-> value( $r) if $self-> {R} != $rgb;
618	$self-> {G}-> value( $g) if $self-> {G} != $rgb;
619	$self-> {B}-> value( $b) if $self-> {B} != $rgb;
620	$self-> {H}-> value( int($h)) unless $hsv & Hue;
621	$self-> {S}-> value( int($s)) unless $hsv & Sat;
622	$self-> {V}-> value( int($v)) unless $hsv & Lum;
623	$self-> {wheel}-> repaint unless $hsv & Wheel;
624	if ( $hsv & Roller) {
625		$self-> {roller}-> repaint;
626	} else {
627		$self-> Roller_Repaint;
628	}
629	$self-> {setTransaction} = $st;
630	$self-> notify(q(Change));
631}
632
633sub value        {($#_)?$_[0]-> set_value        ($_[1]):return $_[0]-> {value};}
634sub quality      {($#_)?$_[0]-> set_quality      ($_[1]):return $_[0]-> {quality};}
635
636package Prima::ColorComboBox;
637use vars qw(@ISA);
638@ISA = qw(Prima::ComboBox);
639
640{
641my %RNT = (
642	%{Prima::Widget-> notification_types()},
643	Colorify => nt::Action,
644);
645
646sub notification_types { return \%RNT; }
647}
648
649
650sub profile_default
651{
652	my %sup = %{$_[ 0]-> SUPER::profile_default};
653	my @std = Prima::Application-> get_default_scrollbar_metrics;
654	my $scaling = $::application-> uiScaling;
655	return {
656		%sup,
657		style            => cs::DropDownList,
658		height           => $sup{ editHeight},
659		value            => cl::White,
660		width            => 56 * $scaling,
661		literal          => 0,
662		colors           => 20 + 128,
663		editClass        => 'Prima::Widget',
664		listClass        => 'Prima::Widget',
665		editProfile      => {
666			selectingButtons => 0,
667		},
668		listProfile      => {
669			width    => $scaling * 78 + $std[0],
670			height   => $scaling * 130,
671			growMode => 0,
672		},
673	};
674}
675
676sub profile_check_in
677{
678	my ( $self, $p, $default) = @_;
679	$p-> { style} = cs::DropDownList;
680	$self-> SUPER::profile_check_in( $p, $default);
681}
682
683sub init
684{
685	my $self    = shift;
686	my %profile = @_;
687	$self-> {value} = $profile{value};
688	$self-> {colors} = $profile{colors};
689	@{$profile{listDelegations}} = grep { $_ ne 'SelectItem' } @{$profile{listDelegations}};
690	push ( @{$profile{listDelegations}}, qw(Create Paint MouseDown MouseMove MouseLeave));
691	push ( @{$profile{editDelegations}}, qw(Paint MouseDown Enter Leave Enable Disable KeyDown MouseEnter MouseLeave));
692	%profile = $self-> SUPER::init(%profile);
693	$self-> colors( $profile{colors});
694	$self-> value( $profile{value});
695	return %profile;
696}
697
698sub InputLine_KeyDown
699{
700	my ( $combo, $self, $code, $key) = @_;
701	$combo-> listVisible(1), $self-> clear_event if $key == kb::Down;
702	return if $key != kb::NoKey;
703	$self-> clear_event;
704}
705
706sub InputLine_Paint
707{
708	my ( $combo, $self, $canvas, $w, $h, $focused) =
709		($_[0],$_[1],$_[2],$_[1]-> size, $_[1]-> focused);
710	my $back = $self-> enabled ? $self-> backColor : $self-> disabledBackColor;
711	my $clr  = $combo-> value;
712	$clr = $combo->prelight_color($clr) if $self->{prelight};
713	$clr = $back if $clr == cl::Invalid;
714	$canvas-> rect3d( 0, 0, $w-1, $h-1, 1, $self-> light3DColor, $self-> dark3DColor);
715	$canvas-> color( $back);
716	$canvas-> rectangle( 1, 1, $w - 2, $h - 2);
717	$canvas-> rectangle( 2, 2, $w - 3, $h - 3);
718	$canvas-> color( $clr);
719	$canvas-> fillPattern([(0xEE, 0xBB) x 4]) unless $self-> enabled;
720	$canvas-> bar( 3, 3, $w - 4, $h - 4);
721	$canvas-> rect_focus(2, 2, $w - 3, $h - 3) if $focused;
722}
723
724sub InputLine_MouseDown
725{
726	# this code ( instead of listVisible(!listVisible)) is formed so because
727	# ::InputLine is selectable, and unwilling focus() could easily hide
728	# listBox automatically. Manual focus is also supported by
729	# selectingButtons == 0.
730	my ( $combo, $self)  = @_;
731	my $lv = $combo-> listVisible;
732	$combo-> listVisible(!$lv);
733	$self-> focus if $lv;
734	$self-> clear_event;
735}
736
737sub InputLine_Enable  { $_[1]-> repaint };
738sub InputLine_Disable { $_[1]-> repaint };
739sub InputLine_Enter   { $_[1]-> repaint; }
740
741sub InputLine_Leave
742{
743	$_[0]-> listVisible(0) if $Prima::ComboBox::capture_mode;
744	$_[1]-> repaint;
745}
746
747
748sub InputLine_MouseWheel
749{
750	my ( $self, $widget, $mod, $x, $y, $z) = @_;
751
752	my $v = $self-> value;
753	$z = $z / 120 * 16;
754	my ( $r, $g, $b) = ( $v >> 16, ($v >> 8) & 0xff, $v & 0xff);
755	if ( $mod & km::Shift) {
756		$r += $z;
757	} elsif ( $mod & km::Ctrl) {
758		$g += $z;
759	} elsif ( $mod & km::Alt) {
760		$b += $z;
761	} else {
762		$r += $z;
763		$g += $z;
764		$b += $z;
765	}
766	for ( $r, $g, $b) {
767		$_ = 0 if $_ < 0;
768		$_ = 255 if $_ > 255;
769	}
770	$self-> value( $r * 65536 + $g * 256 + $b);
771	$widget-> clear_event;
772}
773
774sub InputLine_MouseEnter
775{
776	my ($self, $widget) = @_;
777	if ( !$widget->capture && $self->enabled) {
778		$widget->{prelight} = 1;
779		$widget->repaint;
780	}
781}
782
783sub InputLine_MouseLeave
784{
785	my ($self, $widget) = @_;
786	if ( !$widget->capture && $self->enabled) {
787		delete $widget->{prelight};
788		$widget->repaint;
789	}
790}
791
792sub List_Create
793{
794	my ($combo,$self) = @_;
795	$self-> {scaling} = $::application-> uiScaling;
796	$combo-> {btn} = $self-> insert( Button =>
797		origin     => [ map { $_ * $self->{scaling} } 3, 3],
798		width      => $self-> width - 6 * $self->{scaling},
799		height     => $self->{scaling} * 28,
800		text       => '~More...',
801		selectable => 0,
802		name       => 'MoreBtn',
803		onClick    => sub { $combo-> MoreBtn_Click( @_)},
804	);
805
806	my $c = $combo-> colors;
807	$combo-> {scr} = $self-> insert( ScrollBar =>
808		origin     => [ 75 * $self->{scaling}, $combo-> {btn}-> height + 8 * $self->{scaling}],
809		top        => $self-> height - 3 * $self->{scaling},
810		vertical   => 1,
811		name       => 'Scroller',
812		max        => $c > 20 ? $c - 20 : 0,
813		partial    => 20,
814		step       => 4,
815		pageStep   => 20,
816		whole      => $c,
817		delegations=> [ $combo, 'Change'],
818	);
819}
820
821
822sub List_Paint
823{
824	my ( $combo, $self, $canvas) = @_;
825	my ( $w, $h) = $self-> size;
826	my @c3d = ( $self-> light3DColor, $self-> dark3DColor);
827	$canvas-> rect3d( 0, 0, $w-1, $h-1, 1, @c3d, cl::Back)
828		unless exists $self-> {inScroll};
829	my $i;
830	my $sc = $self->{scaling};
831	my $pc = 18 * $sc;
832	my $dy = $combo-> {btn}-> height;
833
834	my $maxc = $combo-> colors;
835	my $shft = $combo-> {scr}-> value;
836	for ( $i = 0; $i < 20; $i++) {
837		next if $i >= $maxc;
838		my $X = $i % 4;
839		my $Y = int($i / 4);
840		my ( $x, $y) = ($X * $pc + 3 * $sc, (4 - $Y) * $pc + 9 * $sc + $dy);
841		my $clr = 0;
842		$combo-> notify('Colorify', $i + $shft, \$clr);
843
844		my @c = @c3d;
845		@c = reverse @c if
846			$self->{prelight} &&
847			$self->{prelight}->[0] == $X &&
848			$self->{prelight}->[1] == $Y;
849		$canvas-> rect3d( $x, $y, $x + $pc - 2 * $sc, $y + $pc - 2 * $sc, 1, @c, $clr);
850	}
851}
852
853sub list_pos2xy
854{
855	my ( $combo, $self, $x, $y) = @_;
856	$x -= 3 * $self->{scaling};
857	$y -= $combo-> {btn}-> height + 9 * $self->{scaling};
858	return if $x < 0 || $y < 0;
859	my $pc = 18 * $self->{scaling};
860	$x = int($x / $pc);
861	$y = int($y / $pc);
862	return if $x > 3 * $self->{scaling} || $y > 4 * $self->{scaling};
863	$y = 4 - $y;
864	my $shft = $combo-> {scr}-> value;
865	my $maxc = $combo-> colors;
866	my $xcol = $shft + $x + $y * 4;
867	return if $xcol >= $maxc;
868
869	return $x, $y, $xcol;
870}
871
872sub List_MouseDown
873{
874	my ( $combo, $self, $btn, $mod, $x, $y) = @_;
875	my $xcol;
876	($x, $y, $xcol) = $combo->list_pos2xy($self, $x, $y);
877	return unless defined $x;
878	$combo-> listVisible(0);
879	my $xval = 0;
880	$combo-> notify('Colorify', $xcol, \$xval);
881	$combo-> value( $xval);
882}
883
884sub List_MouseMove
885{
886	my ( $combo, $self, $mod, $x, $y) = @_;
887	my $xcol;
888	($x, $y, $xcol) = $combo->list_pos2xy($self, $x, $y);
889	if ( defined $xcol ) {
890		return if
891			defined $self->{prelight} &&
892			$self->{prelight}->[0] == $x &&
893			$self->{prelight}->[1] == $y;
894		$self->{prelight} = [ $x, $y ];
895	} else {
896		return unless defined $self->{prelight};
897		delete $self->{prelight};
898	}
899	$self->repaint;
900}
901
902sub List_MouseLeave
903{
904	my ($self, $widget) = @_;
905	if ( !$widget->capture && $self->enabled) {
906		delete $widget->{prelight};
907		$widget->repaint;
908	}
909}
910
911sub MoreBtn_Click
912{
913	my ($combo,$self) = @_;
914	my $d;
915	$combo-> listVisible(0);
916	$d = Prima::Dialog::ColorDialog-> create(
917		text  => 'Mixed color palette',
918		value => $combo-> value,
919	);
920	$combo-> value( $d-> value) if $d-> execute != mb::Cancel;
921	$d-> destroy;
922}
923
924sub Scroller_Change
925{
926	my ($combo,$self) = @_;
927	$self = $combo-> List;
928	$self-> {inScroll} = 1;
929	my $s = $::application-> uiScaling;
930	$self-> invalidate_rect(
931		3*$s, $combo-> {btn}-> top+6*$s,
932		$self-> width - $combo-> {scr}-> width,
933		$self-> height - 3*$s,
934	);
935	delete $self-> {inScroll};
936}
937
938
939sub set_style { $_[0]-> raise_ro('set_style')}
940
941sub set_value
942{
943	my ( $self, $value) = @_;
944	return if $value == $self-> {value};
945	$self-> {value} = $value;
946	$self-> notify(q(Change));
947	$self-> {edit}-> repaint;
948}
949
950sub set_colors
951{
952	my ( $self, $value) = @_;
953	return if $value == $self-> {colors};
954	$self-> {colors} = $value;
955	my $scr = $self-> {list}-> {scr};
956	$scr-> set(
957		max        => $value > 20 ? $value - 20 : 0,
958		whole      => $value,
959	) if $scr;
960	$self-> {list}-> repaint;
961}
962
963
964my @palColors = (
965	0xffffff,0x000000,0xc6c3c6,0x848284,
966	0xff0000,0x840000,0xffff00,0x848200,
967	0x00ff00,0x008200,0x00ffff,0x008284,
968	0x0000ff,0x000084,0xff00ff,0x840084,
969	0xc6dfc6,0xa5cbf7,0xfffbf7,0xa5a2a5,
970);
971
972
973sub on_colorify
974{
975	my ( $self, $index, $sref) = @_;
976	if ( $index < 20) {
977		$$sref = $palColors[ $index];
978	} else {
979		my $i = $index - 20;
980		my ( $r, $g, $b);
981		if ( $i < 64) {
982			( $r, $g, $b) = Prima::Dialog::ColorDialog::hsv2rgb(
983				$i * 4, 0.25 + ($i % 4) * 0.25, 1
984			);
985		} else {
986			( $r, $g, $b) = Prima::Dialog::ColorDialog::hsv2rgb(
987				$i * 4, 1, 0.25 + ($i % 4) * 0.25
988			);
989		}
990		$$sref = $b | $g << 8 | $r << 16;
991	}
992	$self-> clear_event;
993}
994
995
996sub value        {($#_)?$_[0]-> set_value       ($_[1]):return $_[0]-> {value};  }
997sub colors       {($#_)?$_[0]-> set_colors      ($_[1]):return $_[0]-> {colors};  }
998
999
10001;
1001
1002=pod
1003
1004=head1 NAME
1005
1006Prima::Dialog::ColorDialog - standard color selection facilities
1007
1008=head1 SYNOPSIS
1009
1010	use Prima qw(Dialog::ColorDialog Application);
1011
1012	my $p = Prima::Dialog::ColorDialog-> create(
1013		quality => 1,
1014	);
1015	printf "color: %06x", $p-> value if $p-> execute == mb::OK;
1016
1017=for podview <img src="colordlg.png">
1018
1019=for html <p><img src="https://raw.githubusercontent.com/dk/Prima/master/pod/Prima/colordlg.png">
1020
1021=head1 DESCRIPTION
1022
1023The module contains two packages, C<Prima::Dialog::ColorDialog> and C<Prima::ColorComboBox>,
1024used as standard tools for interactive color selection. C<Prima::ColorComboBox> is
1025a modified combo widget, which provides selecting from predefined palette but also can
1026invoke C<Prima::Dialog::ColorDialog> window.
1027
1028=head1 Prima::Dialog::ColorDialog
1029
1030=head2 Properties
1031
1032=over
1033
1034=item quality BOOLEAN
1035
1036Used to increase visual quality of the dialog if run on paletted displays.
1037
1038Default value: 0
1039
1040=item value COLOR
1041
1042Selects the color, represented by the color wheel and other dialog controls.
1043
1044Default value: C<cl::White>
1045
1046=back
1047
1048=head2 Methods
1049
1050=over
1051
1052=item hsv2rgb HUE, SATURATION, LUMINOSITY
1053
1054Converts color from HSV to RGB format and returns three integer values, red, green,
1055and blue components.
1056
1057=item rgb2hsv RED, GREEN, BLUE
1058
1059Converts color from RGB to HSV format and returns three numerical values, hue, saturation,
1060and luminosity components.
1061
1062=item xy2hs X, Y, RADIUS
1063
1064Maps X and Y coordinate values onto a color wheel with RADIUS in pixels.
1065The code uses RADIUS = 119 for mouse position coordinate mapping.
1066Returns three values, - hue, saturation and error flag. If error flag
1067is set, the conversion has failed.
1068
1069=item hs2xy HUE, SATURATION
1070
1071Maps hue and saturation onto 256-pixel wide color wheel, and
1072returns X and Y coordinates of the corresponding point.
1073
1074=item create_wheel SHADES, BACK_COLOR
1075
1076Creates a color wheel with number of SHADES given,
1077drawn on a BACK_COLOR background, and returns a C<Prima::DeviceBitmap> object.
1078
1079=item create_wheel_shape SHADES
1080
1081Creates a circular 1-bit mask, with radius derived from SHAPES.
1082SHAPES must be same as passed to L<create_wheel>.
1083Returns C<Prima::Image> object.
1084
1085=back
1086
1087=head2 Events
1088
1089=over
1090
1091=item BeginDragColor $PROPERTY
1092
1093Called when the user starts dragginh a color from the color wheel by with left
1094mouse button and combination of Alt, Ctrl, and Shift keys. $PROPERTY is one
1095of C<Prima::Widget> color properties, and depends on combination of keys:
1096
1097	Alt              backColor
1098	Ctrl             color
1099	Alt+Shift        hiliteBackColor
1100	Ctrl+Shift       hiliteColor
1101	Ctrl+Alt         disabledColor
1102	Ctrl+Alt+Shift   disabledBackColor
1103
1104Default action reflects the property to be changes in the dialog title
1105
1106=item Change
1107
1108The notification is called when the L<value> property is changed, either
1109interactively or as a result of direct call.
1110
1111=item EndDragColor $PROPERTY, $WIDGET
1112
1113Called when the user releases the mouse drag over a Prima widget.
1114Default action sets C<< $WIDGET->$PROPERTY >> to the current color value.
1115
1116=back
1117
1118=head2 Variables
1119
1120=over
1121
1122=item $colorWheel
1123
1124Contains cached result of L<create_wheel> call.
1125
1126=item $colorWheelShape
1127
1128Contains cached result of L<create_wheel_shape> call.
1129
1130=back
1131
1132=head1 Prima::ColorComboBox
1133
1134=head2 Events
1135
1136=over
1137
1138=item Colorify INDEX, COLOR_PTR
1139
1140C<nt::Action> callback, designed to map combo palette index into a RGB color.
1141INDEX is an integer from 0 to L<colors> - 1, COLOR_PTR is a reference to a
1142result scalar, where the notification is expected to write the resulting color.
1143
1144=back
1145
1146=head2 Properties
1147
1148=over
1149
1150=item colors INTEGER
1151
1152Defines amount of colors in the fixed palette of the combo box.
1153
1154=item value COLOR
1155
1156Contains the color selection as 24-bit integer value.
1157
1158=back
1159
1160=head1 SEE ALSO
1161
1162L<Prima>, L<Prima::ComboBox>, F<examples/cv.pl>.
1163
1164=head1 AUTHOR
1165
1166Dmitry Karasik, E<lt>dmitry@karasik.eu.orgE<gt>.
1167
1168=cut
1169