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