1package Prima::Dialog::ImageDialog; 2 3use strict; 4use warnings; 5use Prima qw(ImageViewer ComboBox Label Dialog::FileDialog); 6 7sub filtered_codecs 8{ 9 my $codecs = defined($_[0]) ? $_[0] : Prima::Image-> codecs; 10 return map { 11 my $n = uc $_-> {fileExtensions}->[0]; 12 my $x = join( ';', map {"*.$_"} @{$_-> {fileExtensions}}); 13 [ "$n - $_->{fileType}" => $x ] 14 } sort { 15 $a-> {fileExtensions}->[0] cmp $b-> {fileExtensions}->[0] 16 } @$codecs; 17} 18 19sub filtered_codecs2all 20{ 21 my $codecs = defined($_[0]) ? $_[0] : Prima::Image-> codecs; 22 return join(';', map {"*.$_"} map { @{$_-> {fileExtensions}}} @$codecs) 23} 24 25package Prima::Dialog::ImageOpenDialog; 26use vars qw( @ISA); 27@ISA = qw(Prima::Dialog::OpenDialog); 28use Prima::sys::FS; 29 30{ 31my %RNT = ( 32 %{Prima::Dialog-> notification_types()}, 33 HeaderReady => nt::Default, 34 DataReady => nt::Default, 35); 36 37sub notification_types { return \%RNT; } 38} 39 40 41sub profile_default { 42 my $codecs = [ grep { $_-> {canLoad} } @{Prima::Image-> codecs}]; 43 return { 44 %{$_[ 0]-> SUPER::profile_default}, 45 preview => 1, 46 sizeMin => [380,400], 47 text => 'Open image', 48 filter => [ 49 ['Images' => Prima::Dialog::ImageDialog::filtered_codecs2all( $codecs)], 50 ['All files' => '*'], 51 Prima::Dialog::ImageDialog::filtered_codecs($codecs), 52 ], 53 } 54} 55 56 57sub init 58{ 59 my $self = shift; 60 $self-> {preview} = 0; 61 my %profile = $self-> SUPER::init(@_); 62 63 my $pk = $self-> insert( ImageViewer => 64 origin => [ 524, 120], 65 name => 'PickHole', 66 borderWidth=> 2, 67 alignment => ta::Center, 68 valignment => ta::Center, 69 growMode => gm::GrowLoX | gm::GrowLoY, 70 hScroll => 0, 71 vScroll => 0, 72 zoomPrecision => 1000, 73 ); 74 $pk-> size(($self-> Cancel-> width) x 2); # force square dimension 75 76 $self-> insert( ScrollBar => 77 origin => [ $pk-> left, $pk-> top + 2], 78 width => $pk-> width, 79 selectable => 1, 80 tabStop => 1, 81 name => 'FrameSelector', 82 designScale => undef, 83 visible => 0, 84 value => 0, 85 delegations => ['Change'], 86 growMode => gm::GrowLoX | gm::GrowLoY, 87 ); 88 89 $self-> {Preview} = $self-> insert( CheckBox => 90 origin => [ 524, 80], 91 text => '~Preview', 92 size => [ 96, 36], 93 name => 'Preview', 94 delegations => [qw(Click)], 95 growMode => gm::GrowLoX | gm::GrowLoY, 96 ); 97 98 $self-> insert( Label => 99 origin => [ 524, 5], 100 size => [ 96, 76], 101 name => 'Info', 102 text => '', 103 alignment => ta::Center, 104 valignment => ta::Top, 105 wordWrap => 1, 106 growMode => gm::GrowLoX | gm::GrowHiY, 107 ); 108 109 $self-> preview( $profile{preview}); 110 $self-> {frameIndex} = 0; 111 return %profile; 112} 113 114 115sub update_preview 116{ 117 my $self = $_[0]; 118 my $i = $self-> PickHole; 119 my $j = $self-> Info; 120 my $s = $self-> FrameSelector; 121 122 $i-> image( undef); 123 $j-> text(''); 124 $s-> hide unless $s-> {block}; 125 $self-> {frameIndex} = 0; 126 return unless $self-> preview; 127 128 my $x = $self-> Files; 129 $x = $x-> get_items( $x-> focusedItem); 130 $i-> image( undef); 131 return unless defined $x; 132 133 $x = $self-> directory . $x; 134 return unless _f $x; 135 136 $x = Prima::Icon-> load( $x, 137 loadExtras => 1, 138 wantFrames => 1, 139 iconUnmask => 1, 140 index => $s-> {block} ? $s-> value : 0, 141 ); 142 return unless defined $x; 143 144 $i-> image( $x); 145 my @szA = $x-> size; 146 my @szB = $i-> get_active_area(2); 147 my $xx = $szB[0]/$szA[0]; 148 my $yy = $szB[1]/$szA[1]; 149 my $codecs = $x-> codecs; 150 $i-> zoom( $xx < $yy ? $xx : $yy); 151 my $text = $szA[0].'x'.$szA[1].'x'. ($x-> type & im::BPP) . " bpp ". 152 $codecs-> [$x-> {extras}-> {codecID}]-> {fileShortType}; 153 $text .= ',grayscale' if $x-> type & im::GrayScale; 154 if ( $x-> {extras}-> {frames} > 1) { 155 unless ( $s-> {block}) { 156 $text .= ",$x->{extras}->{frames} frames"; 157 $s-> {block} = 1; 158 $s-> set( 159 visible => 1, 160 max => $x-> {extras}-> {frames} - 1, 161 value => 0, 162 ); 163 $s-> {block} = 0; 164 } else { 165 $text .= ",frame ". ($s-> value + 1) . " of $x->{extras}->{frames}"; 166 $self-> {frameIndex} = $s-> value; 167 } 168 } 169 $j-> text( $text); 170} 171 172 173sub preview 174{ 175 return $_[0]-> {Preview}-> checked unless $#_; 176 $_[0]-> {Preview}-> checked( $_[1]); 177 $_[0]-> update_preview; 178} 179 180sub Preview_Click 181{ 182 $_[0]-> update_preview; 183} 184 185sub on_endmodal 186{ 187 my $self = $_[0]; 188 my $i = $self-> PickHole; 189 $i-> image(undef); 190} 191 192 193sub Files_SelectItem 194{ 195 my ( $self, $lst) = @_; 196 $self-> SUPER::Files_SelectItem( $lst); 197 $self-> update_preview if $self-> preview; 198} 199 200sub Dir_Change 201{ 202 my ( $self, $lst) = @_; 203 $self-> SUPER::Dir_Change( $lst); 204 $self-> update_preview if $self-> preview; 205} 206 207sub FrameSelector_Change 208{ 209 my ( $self, $fs) = @_; 210 return if $fs-> {block}; 211 my $v = $fs-> value; 212 $fs-> {block} = 1; 213 $self-> update_preview; 214 $fs-> {block} = 0; 215} 216 217sub PreviewImage_HeaderReady 218{ 219 my ( $self, $image) = @_; 220 $self-> notify(q(HeaderReady), $image); 221} 222 223sub PreviewImage_DataReady 224{ 225 my ( $self, $image, $x, $y, $w, $h) = @_; 226 $self-> notify(q(DataReady), $x, $y, $w, $h); 227} 228 229sub load 230{ 231 my ( $self, %profile) = @_; 232 return undef unless defined $self-> execute; 233 $profile{loadExtras} = 1 unless exists $profile{loadExtras}; 234 $profile{index} = $self-> {frameIndex}; 235 my %im_profile; 236 237 if ( $self-> get_notify_sub('HeaderReady') || $self-> get_notify_sub('DataReady')) { 238 $im_profile{name} = 'PreviewImage'; 239 $im_profile{delegations} = [ $self, qw(HeaderReady DataReady)]; 240 } 241 my $img = Prima::Image-> new( %im_profile); 242 my $pv = $profile{progressViewer}; 243 $pv-> watch_load_progress($img) if $pv; 244 my @r = $img-> load( $self-> fileName, %profile); 245 $pv-> unwatch_load_progress if $pv; 246 unless ( defined $r[-1]) { 247 Prima::MsgBox::message("Error loading " . $self-> fileName . ":$@"); 248 pop @r; 249 return undef unless scalar @r; 250 } 251 return undef, Prima::MsgBox::message( "Empty image") unless scalar @r; 252 return $r[0] if !wantarray && ( 1 == scalar @r); 253 return @r; 254} 255 256package Prima::Dialog::ImageSaveDialog; 257use vars qw( @ISA); 258@ISA = qw(Prima::Dialog::SaveDialog); 259 260sub profile_default { 261 my $codecs = [ grep { $_-> {canSave} } @{Prima::Image-> codecs}]; 262 return { 263 %{$_[ 0]-> SUPER::profile_default}, 264 text => 'Save image', 265 filter => [ Prima::Dialog::ImageDialog::filtered_codecs($codecs) ], 266 image => undef, 267 filterDialog => 1, 268 noTestFileCreate => 1, 269 } 270} 271 272sub init 273{ 274 my $self = shift; 275 my %profile = $self-> SUPER::init(@_); 276 $self-> {ConvertTo} = $self-> insert( ComboBox => 277 origin => [ 524, 80], 278 items => [], 279 enabled => 0, 280 name => 'ConvertTo', 281 style => cs::DropDownList, 282 size => [ 96, 25], 283 growMode => gm::GrowLoX, 284 ); 285 $self-> insert( Label => 286 origin => [ 524, 110], 287 text => '~Convert to:', 288 size => [ 96, 20], 289 name => 'ConvertToLabel', 290 focusLink => $self-> {ConvertTo}, 291 growMode => gm::GrowLoX, 292 ); 293 $self-> {UseFilter} = $self-> insert( CheckBox => 294 origin => [ 524, 20], 295 text => '~Use filter', 296 size => [ 96, 36], 297 name => 'UseFilter', 298 delegations => [qw(Click)], 299 growMode => gm::GrowLoX, 300 ); 301 302 $self-> {codecFilters} = []; 303 $self-> {allCodecs} = Prima::Image-> codecs; 304 $self-> {codecs} = [ 305 sort { $a-> {fileExtensions}->[0] cmp $b-> {fileExtensions}->[0] } 306 grep { $_-> {canSave}} @{$self-> {allCodecs}} 307 ]; 308 my $codec = $self-> {codecs}-> [$self-> filterIndex]; 309 310 $self-> image( $profile{image}); 311 $self-> filterDialog( $profile{filterDialog}); 312 $self-> ExtensionsLabel-> text("Sav~e as type ($codec->{fileShortType})"); 313 314 return %profile; 315} 316 317sub on_destroy 318{ 319 for ( @{$_[0]-> {codecFilters}}) { 320 next unless $_; 321 $_-> destroy; 322 } 323} 324 325sub update_conversion 326{ 327 my ( $self, $codec) = @_; 328 my $i = $self-> {image}; 329 my $x = $self-> {ConvertTo}; 330 my $xl = $self-> ConvertToLabel; 331 332 $x-> items([]); 333 $x-> text(''); 334 $x-> enabled(0); 335 $xl-> enabled(0); 336 return unless $i; 337 338 my $t = $i-> type; 339 my @st = @{$codec-> {types}}; 340 return unless @st; 341 342 my $max = 0; 343 my $j = 0; 344 for ( @st) { 345 return if $_ == $t; 346 $max = $j if ( $st[$max] & im::BPP) < ( $_ & im::BPP); 347 $j++; 348 } 349 for ( @st) { 350 my $x = ( 1 << ( $_ & im::BPP)); 351 $x = '24-bit' if $x == 16777216; 352 $x .= ' gray' if $_ & im::GrayScale; 353 $x .= ' colors'; 354 $_ = $x; 355 } 356 357 $x-> items( \@st); 358 $x-> focusedItem( $max); 359 $x-> enabled(1); 360 $xl-> enabled(1); 361} 362 363sub Ext_Change 364{ 365 my ( $self, $ext) = @_; 366 $self-> SUPER::Ext_Change( $ext); 367 my $codec = $self-> {codecs}-> [ $self-> filterIndex]; 368 my $old = $self-> Name->text; 369 my $new = $codec->{fileExtensions}->[0]; 370 if ( $old =~ /\.\w+$/ ) { 371 $old =~ s/\.\w+$/.$new/; 372 $self-> Name->text($old); 373 } 374 $self-> ExtensionsLabel-> text("Sav~e as type ($codec->{fileShortType})"); 375 $self-> update_conversion( $codec); 376} 377 378sub filterDialog 379{ 380 return $_[0]-> {UseFilter}-> checked unless $#_; 381 $_[0]-> {UseFilter}-> checked( $_[1]); 382} 383 384sub image 385{ 386 return $_[0]-> {image} unless $#_; 387 my ( $self, $image) = @_; 388 $self-> {image} = $image; 389 if ( 390 $image && 391 exists($image-> {extras}) && 392 (ref($image-> {extras}) eq 'HASH') && 393 defined($image-> {extras}-> {codecID}) 394 ) { 395 my $c = $self-> {allCodecs}-> [$image-> {extras}-> {codecID}]; 396 my $i = 0; 397 for ( @{$self-> {codecs}}) { 398 $self-> filterIndex( $i) if $_ == $c; 399 $i++; 400 } 401 $self-> update_conversion( $c); 402 } 403} 404 405sub on_endmodal 406{ 407 $_[0]-> SUPER::on_endmodal(); 408 $_[0]-> image( undef); # just freeing the reference 409} 410 411sub save 412{ 413 my ( $self, $image, %profile) = @_; 414 my $ret; 415 my $dup; 416 return 0 unless $image; 417 418 $dup = $image; 419 my $extras = $image-> {extras}; 420 $self-> image( $image); 421 422 goto EXIT unless defined $self-> execute; 423 424 unlink $self-> fileName unless $self-> noTestFileCreate; 425 426 $image-> {extras} = { map { $_ => $extras-> {$_} } keys %$extras } ; 427 428 my $fi = $self-> filterIndex; 429 my $codec = $self-> {codecs}-> [ $fi]; 430 431 432# loading filter dialog, if any 433 if ( $self-> filterDialog) { 434 unless ( $self-> {codecFilters}-> [ $fi]) { 435 if ( 436 $image && 437 $codec && 438 length($codec-> {module}) && 439 length( $codec-> {package}) 440 ) { 441 my $x = "use $codec->{module};"; 442 eval $x; 443 if ($@) { 444 Prima::MsgBox::message( 445 "Error invoking $codec->{fileShortType} filter dialog:$@" 446 ); 447 } elsif ( $codec->{package}->can('save_dialog')) { 448 $self-> {codecFilters}-> [$fi] = 449 $codec-> {package}-> save_dialog( $codec); 450 } 451 } 452 } 453 } 454 455 if ( $self-> ConvertTo-> enabled) { 456 $dup = $image-> dup; 457 $dup-> type( $codec-> {types}-> [ $self-> ConvertTo-> focusedItem]); 458 } 459 460# invoking filter dialog 461 if ( $self-> filterDialog && $self-> {codecFilters}-> [ $fi]) { 462 my $dlg = $self-> {codecFilters}-> [ $fi]; 463 $dlg-> notify( q(Change), $codec, $dup); 464 unless ( $dlg-> execute == mb::OK) { 465 $self-> cancel; 466 goto EXIT; 467 } 468 } 469 470# selecting codec 471 my $j = 0; 472 for ( @{$self-> {allCodecs}}) { 473 $dup-> {extras}-> {codecID} = $j, last if $_ == $codec; 474 $j++; 475 } 476 477 if ( $dup-> save( $self-> fileName, %profile)) { 478 $ret = 1; 479 } else { 480 Prima::MsgBox::message("Error saving " . $self-> fileName . ":$@"); 481 } 482 483EXIT: 484 $self-> image( undef); 485 $image-> {extras} = $extras; 486 return $ret; 487} 488 4891; 490 491=head1 NAME 492 493Prima::Dialog::ImageDialog - file open and save dialogs. 494 495=head1 DESCRIPTION 496 497The module provides dialogs specially adjusted for image 498loading and saving. 499 500=head1 Prima::Dialog::ImageOpenDialog 501 502Provides a preview feature, allowing the user to view the image file before 503loading, and the selection of a frame index for the multi-framed image files. 504Instead of C<execute> call, the L<load> method is used to invoke the dialog and 505returns the loaded image as a C<Prima::Image> object. The loaded object by 506default contains C<{extras}> hash variable set, which contains extra 507information returned by the loader. See L<Prima::image-load> for more 508information. 509 510=head2 SYNOPSIS 511 512 use Prima qw(Application Dialog::ImageDialog); 513 my $dlg = Prima::Dialog::ImageOpenDialog-> new; 514 my $img = $dlg-> load; 515 return unless $img; 516 print "$_:$img->{extras}->{$_}\n" for sort keys %{$img-> {extras}}; 517 518=for podview <img src="imagedlg.gif"> 519 520=for html <p><img src="https://raw.githubusercontent.com/dk/Prima/master/pod/Prima/imagedlg.gif"> 521 522=head2 Proprties 523 524=over 525 526=item preview BOOLEAN 527 528Selects if the preview functionality is active. 529The user can switch it on and off interactively. 530 531Default value: 1 532 533=back 534 535=head2 Methods 536 537=over 538 539=item load %PROFILE 540 541Executes the dialog, and, if successful, loads the image file and frame 542selected by the user. Returns the loaded image as a C<Prima::Image> object. 543PROFILE is a hash, passed to C<Prima::Image::load> method. In particular, it 544can be used to disable the default loading of extra information in C<{extras}> 545variable, or to specify a non-default loading option. For example, 546C<{extras}-E<gt>{className} = 'Prima::Icon'> would return the loaded image as 547an icon object. See L<Prima::image-load> for more. 548 549C<load> can report progressive image loading to the caller, and/or to an 550instance of C<Prima::ImageViewer>, if desired. If either (or both) 551C<onHeaderReady> and C<onDataReady> notifications are specified, these are 552called from the respective event handlers of the image being loaded ( see 553L<Prima::image-load/"Loading with progress indicator"> for details). If 554profile key C<progressViewer> is supplied, its value is treated as a 555C<Prima::ImageViewer> instance, and it is used to display image loading 556progress. See L<Prima::ImageViewer/watch_load_progress>. 557 558=back 559 560=head2 Events 561 562=over 563 564=item HeaderReady IMAGE 565 566See L<Prima::Image/HeaderReady>. 567 568=item DataReady IMAGE, X, Y, WIDTH, HEIGHT 569 570See L<Prima::Image/DataReady>. 571 572=back 573 574=head1 Prima::Dialog::ImageSaveDialog 575 576Provides a save dialog where the user can select image format, 577the bit depth and other format-specific options. The format-specific 578options can be set if a dialog for the file format is provided. 579The standard toolkit dialogs reside under in C<Prima::Image> namespace, 580in F<Prima/Image> subdirectory. For example, C<Prima::Image::gif> provides 581the selection of transparency color, and C<Prima::Image::jpeg> the image 582quality control. If the image passed to the L<image> property contains 583C<{extras}> variable, the data are read and used as the default values. 584In particular, C<{extras}-E<gt>-{codecID}> field, responsible for the 585file format, if present, affects the default file format selection. 586 587=head2 SYNOPSIS 588 589 my $dlg = Prima::Dialog::ImageSaveDialog-> create; 590 return unless $dlg-> save( $image ); 591 print "saved as ", $dlg-> fileName, "\n"; 592 593=head2 Properties 594 595=over 596 597=item image IMAGE 598 599Selects the image to be saved. This property is to be used 600for the standard invocation of dialog, via C<execute>. It is not 601needed when the execution and saving is invoked via L<save> method. 602 603=back 604 605=head2 Methods 606 607=over 608 609=item save IMAGE, %PROFILE 610 611Invokes the dialog, and, if the execution was successful, saves 612the IMAGE according to the user selection and PROFILE hash. 613PROFILE is not used for the default options, but is passed 614directly to C<Prima::Image::save> call, possibly overriding 615selection of the user. 616Returns 1 in case of success, 0 in case of error. 617If the error occurs, the user is notified before the method returns. 618 619=back 620 621=head1 AUTHOR 622 623Dmitry Karasik, E<lt>dmitry@karasik.eu.orgE<gt>. 624 625=head1 SEE ALSO 626 627L<Prima>, L<Prima::Window>, L<Prima::codecs>, L<Prima::image-load>, 628L<Prima::Image>, L<Prima::Dialog::FileDialog>, L<Prima::ImageViewer>, F<examples/iv.pl>. 629 630=cut 631