App-PLab

 view release on metacpan or  search on metacpan

lib/App/PLab/ImageApp.pm  view on Meta::CPAN

sub Dir_Change
{
   my ( $self, $dir) = @_;
   my $w = $self-> owner;
   my $mask = $self-> {mask};
   my @files = grep { /$mask/i; } $dir-> files( 'reg');
   @files = sort {uc($a) cmp uc($b)} @files if $self->{sorted};

   my %vecs = ();
   my $nums = $w-> {cypherMask};
   for (@files)
   {
      next unless /^(.+)(\d{$nums})\.([^\.]*)$/;
      my ($sername, $num, $ext) = ($1, $2, $3);
      $vecs{ $sername} = [ pack( "b1000", "0" x 100), $ext] unless exists $vecs{ $sername};
      vec( $vecs{ $sername}->[0], $num, 1) = 1;
   }
   my @series = ();
   my $max = 10 ** $nums - 1;
   for my $sername (sort keys %vecs)
   {
      my ($j, $k);
      my $s = unpack( b1000 => $vecs{ $sername}->[0]);    # to exploit string functions
      $j = index( $s, '1');
      while ( $j >= 0)
      {
         $k = index( $s, '0', $j);
         if ( $k < 0)
         {
            $s = '';
            push @series, [ $sername , $vecs{ $sername}->[1],
               sprintf("%0${nums}d",$j), sprintf("%0${nums}d",$max)] if $j < $max;
         }
         else
         {
            $s = ('0' x $k) . substr( $s, $k);
            push @series, [ $sername , $vecs{ $sername}->[1],
               sprintf("%0${nums}d",$j), sprintf("%0${nums}d",$k - 1)] if $j < $k - 1;
         }
         $j = index( $s, '1');
      }
   }

   $self-> {series} = [@series];
   $self-> Files-> items([ map { "$$_[0]$$_[2].$$_[1]"} @series]);
   $self-> Directory_FontChanged( $self-> Directory);
}

sub Files_DrawItem
{
   my ( $dlg, $me, $canvas, $index, $left, $bottom, $right, $top, $hilite, $focused) = @_;
   return unless $dlg-> {series};
   my $backColor = $hilite ? $me-> hiliteBackColor : $me-> backColor;
   my $color = $hilite ? $me-> hiliteColor : cl::Fore | wc::ListBox;
   $canvas-> color($backColor);
   $canvas-> bar( $left, $bottom, $right, $top);
   $canvas-> color($color);
   my @ser    = @{$dlg->{series}->[$index]};
   my $text   = "$ser[0]$ser[2].$ser[1]";
   my $series = "$ser[2]-$ser[3]";
   my $font   = $canvas-> font;
   my $h = $canvas-> font-> height;
   my $w = $canvas-> get_text_width( $text);
   $canvas-> text_out( $text, $left + 2, ($top + $bottom + 1 - $h) / 2);
   $canvas-> font( height => $canvas-> font-> height - 2, pitch => fp::Fixed, style => fs::Bold);
   $h = $canvas-> font-> height;
   my $x = $left + $canvas-> get_text_width('  ') + $w;
   $w = $canvas-> get_text_width( "9");
   $canvas-> text_out( $series, $x + 1, ($top + $bottom + 1 - $h) / 2);
   $canvas-> rectangle( $x, ($top + $bottom + 1 - $h) / 2, $x + $w * length( $series) + 2, ($top + $bottom + $h) / 2);
   $canvas-> font( $font);
}

sub Files_MeasureItem
{
   my ( $dlg, $self, $index, $sref) = @_;
   $$sref = $self->get_text_width( $self-> get_item_text( $index)) + $self->get_text_width('m') * 8;
   $self-> clear_event;
}

package  App::PLab::TrDeviceBitmap;
use vars qw(@ISA);
@ISA = qw(Prima::DeviceBitmap);

sub translate
{
   unless ( $#_) {
      my @a = $_[0]-> SUPER::translate;
      if ( $_[0]-> {override}) {
         $a[$_] -= $_[0]-> {override}->[$_] for 0,1;
      }
      return @a;
   }
   my ( $self, $trx, $try) = @_;
   if ( $self-> {override}) {
      $trx += $self-> {override}-> [0];
      $try += $self-> {override}-> [1];
   }
   $self-> SUPER::translate( $trx, $try);
}

sub clipRect
{
   unless ( $#_) {
      my @a = $_[0]-> SUPER::clipRect;
      if ( $_[0]-> {override}) {
         $a[$_]   -= $_[0]-> {override}->[$_] for 0,1;
         $a[$_+2] -= $_[0]-> {override}->[$_] for 0,1;
      }
      return @a;
   }
   my ( $self, $trx, $try, $tax, $tay) = @_;
   if ( $self-> {override}) {
      $trx += $self-> {override}-> [0];
      $try += $self-> {override}-> [1];
      $tax += $self-> {override}-> [0];
      $tay += $self-> {override}-> [1];
   }
   $self-> SUPER::clipRect( $trx, $try, $tax, $tay);
}

package App::PLab::MagnifyingGlassWidget;
use vars qw(@ISA);
@ISA = qw(Prima::Widget);

sub profile_default
{
   my $def = $_[ 0]-> SUPER::profile_default;
   my %prf = (
      width     => 154,
      height    => 102,

lib/App/PLab/ImageApp.pm  view on Meta::CPAN

   ], [ CheckBox =>
      origin => [ 110, 28],
      size => [ 374, 36],
      name => 'UseDef',
      text => '~Use default save path',
      onClick => sub {
         $_[0]-> owner-> Path-> enabled( !$_[0]-> checked);
      },
      hint => 'Default path is where image file located',
   ], [ InputLine =>
      origin => [ 10, 10],
      size   => [ 341, 20],
      name   => 'Path',
   ], [ SpeedButton =>
      origin => [ 354, 10],
      name => 'VB::Button1',
      size => [ 26, 20],
      text => '...',
      borderWidth => 1,
      hint    => 'Select custom directory where additional files will be saved',
      onClick => sub {
         my $d = defined $w->{dirpt} ? $w->{dirpt} : Prima::ChDirDialog-> create;
         $w->{dirpt} = $d;
         $d-> directory( $_[0]-> owner-> Path-> text);
         if ( $d-> execute != mb::Cancel) {
            $_[0]-> owner-> UseDef-> uncheck;
            $_[0]-> owner-> Path-> enabled(1);
            $_[0]-> owner-> Path-> text( $d-> directory);
         }
      },
   ]);

   $nb-> insert_to_page( 0,
   [ Label =>
      origin => [ 230, 94],
      size   => [ 135, 20],
      text   => 'Status line delay (sec)',
   ], [ SpinEdit => 
      origin => [ 230, 72],
      size   => [ 135, 20],
      min    => 1,
      max    => 60,
      step   => 1,
      name   => 'StatusDelay',
   ]);

# Colors and appearance
   $nb-> insert_to_page( 1, CheckBox =>
      origin => [ 10, 60],
      text   => 'Show ~hints',
      name   => 'ShowHint',
      hint   => 'Enables these little pop-ups like the one you are looking at right now',
   );

   my $optColors  = $w-> opt_colors;
   my @colorNames = map { $optColors->{$_}->[1] } sort keys %$optColors;
   my @colorKeys  = map { "Color_$_" } sort keys %$optColors;
   if ( scalar keys %$optColors) {
      my $x1 = $nb-> insert_to_page( 1, ComboBox =>
         origin => [ 10, 10],
         size   => [ 170, $nb-> font-> height + 2],
         style  => cs::DropDownList,
         name   => 'NameSel',
         items  => \@colorNames,
         onChange => sub {
            my $colors = $dlg-> {page2}-> {colors};
            $nbpages-> {deprecate} = 1;
            $nbpages-> ColorSel-> value( $$colors[ $w->{nameSelFoc} = $_[0]-> focusedItem]);
            $nbpages-> {deprecate} = undef;
         },
      );
      $nb-> insert_to_page( 1, Label =>
         origin => [ 10, 12 + $x1-> height],
         size   => [ 300, 28],
         text   => 'Color setup',
         focusLink => $x1,
      );
      $nb-> insert_to_page( 1, ColorComboBox =>
         name   => 'ColorSel',
         origin => [ 190, 10],
         size   => [ 56, $nb-> font-> height + 2],
         onChange => sub {
	    my $self = shift;
            if ( !$nbpages-> {deprecate} && $self->enabled) {
               my $colors = $dlg-> {page2}-> {colors};
               $$colors[ $nbpages-> NameSel-> focusedItem] = $self-> value;
               my $i;
               for ( $i = 0; $i < scalar @colorKeys; $i++) {
                  $w->{ini}->{$colorKeys[$i]} = $colors->[$i];
               }
               $w-> opt_colormount;
               $w-> IV-> repaint;
            }
         },
      );
   }

# Keys
   my $optKeys = $w-> opt_keys;
   my %o_items;
   for ( keys %$optKeys) {
      m/^([A-Z][a-z]*)/;
      push( @{$o_items{$1}}, [$_]);
   }
   $nb-> insert_to_page( 2, [ StringOutline  =>  
      origin => [ 10, 58],
      size   => [ 200, 222],
      name   => 'KeyList',
      items  => [ map {[ $_, $o_items{$_}]} sort keys %o_items ],
      onSelectItem => sub {
         my ( $me, $foc) = @_;
         my ( $item, $lev) = $_[0]-> get_item( $foc);
         return unless $item;
         $w-> {keyMappings_change} = 1;
         unless ( ref($item->[1])) {
            my $key = $_[0]-> get_item_text( $item);
            my $x = $w-> {keyMappings}-> {"Key_$key"};
            $nbpages-> KeySelector-> enabled(1);
            $nbpages-> KeySelector-> key( $w-> {keyMappings}-> {"Key_$key"} );
            $nbpages-> KeyDescription-> text( $optKeys-> {$key}-> [1] );
            $nbpages-> KeySelector-> show;
         } else {
            $nbpages-> KeySelector-> hide;
            $nbpages-> KeySelector-> enabled(0);
            $nbpages-> KeyDescription-> text( '');
         }
         delete $w-> {keyMappings_change};
      },
  ], [ KeySelector =>  
      origin => [ 220, 110],
      size   => [ 150, 170],
      name   => 'KeySelector',
      visible => 0,
      onChange => sub {
         return if $w-> {keyMappings_change};
         my $kl = $nbpages-> KeyList;
         my ( $item, $lev) = $kl-> get_item( $kl-> focusedItem);
         return unless $item;
         my $okey = $kl-> get_item_text( $item);
         my $key = "Key_$okey";
         my $value = $_[0]-> key; 

lib/App/PLab/ImageApp.pm  view on Meta::CPAN

              "\nDo you want to use it anyway?",
              mb::YesNo|mb::Warning) != mb::Yes;
      }
   }

   return 1;
}

sub opt_proppop
{
   my ( $w, $dlg, $nb, $nbpages, $mr) = @_;

   if ( $mr) {
# General
      my $x = $nbpages-> Path-> text;
      $x =~ s/^\s+//;
      $x =~ s/\s+$//;
      if ( $x eq '.' || $x eq '..' || length( $x) == 0) {
         $nbpages-> UseDef-> check;
      }
      $w->{ini}->{extSaveDir} = $nbpages-> UseDef-> checked ?
         '' : $nbpages-> Path-> text;
      $w->{ini}->{silentExtDir} = 0 unless length $w->{ini}->{extSaveDir};
      $w-> win_extpathchanged if $w->{ini}->{extSaveDir} ne $dlg->{page0}->{extSaveDir};

      my $newmask = $nbpages-> RG_SeriesType-> RG_Long-> checked ? 3 : 2;
      if ( $newmask != $w-> {cypherMask}) {
         $w-> {cypherMask} = $newmask;
         $w-> win_closeextras;
         $w-> win_newextras;
         $w-> win_extraschanged;
      }
      $w->{ini}->{statusDelay} = $nbpages-> StatusDelay-> value;
# Hints
      $::application-> showHint( $w-> {ini}-> {showHint} = $nbpages-> ShowHint-> checked);
# Keys 
      $w-> winmenu_updatemappings;
   } else {
# Colors
      if ( $dlg-> {page2}-> {csave}) {
         $w-> {ini}-> {$_} = $dlg->{page2}->{csave}-> {$_} for keys %{$dlg->{page2}->{csave}};
         $w-> opt_colormount;
         $w-> IV-> repaint;
      }
# Keys      
      $w-> {keyMappings} = $w-> {keyMappings_save};
      $nbpages-> KeyList-> notify(q(SelectItem), $nbpages-> KeyList-> focusedItem);
   }
   delete $w-> {keyMappings_save};
}

sub opt_properties
{
   my $w = $_[0];
   unless ( $w-> {propertySheet}) {
      my $dlg = Prima::Window-> create(
         size     => [ 420, 460],
         text     => 'Properties',
         owner    => $w,
         ownerShowHint => 0,
#        font     => $::application-> get_message_font,
         %dlgProfile,
      );
      my $nb;

      $w-> dlg_okcancel( $dlg);
      $dlg-> OK-> set(
         modalResult => 0,
         onClick => sub {
            $dlg-> ok if $w-> opt_propvalid( $dlg, $nb, $nb-> Notebook);
         },
      );
      $nb = $dlg-> insert( TabbedNotebook =>
         origin    => [ 5, 66],
         size      => [ 410, 392],
         growMode  => gm::Client,
         pageCount => 2,
         tabs      => ['General', 'Appearance', 'Keys'],
         name      => 'Notebook',
      );
      $w-> opt_propcreate( $dlg, $nb, $nb-> Notebook);
      $w-> {propertySheet} = $dlg;
   }
   my $dlg     = $w-> {propertySheet};
   my $nb      = $dlg-> Notebook;
   my $nbpages = $nb-> Notebook;

   $w-> opt_proppush( $dlg, $nb, $nbpages);
   $w-> iv_cancelmode( $w-> IV);
   $w-> opt_proppop( $dlg, $nb, $nbpages, $dlg-> execute == mb::OK);
}

# OPT_END
# IV


sub IV_MouseDown
{
   my ( $w, $self, $btn, $mod, $x, $y) = @_;

   {
      my @r = $self-> get_active_area;
      $self-> clear_event, return if $x < $r[0] or $x >= $r[2] or $y < $r[1] or $y >= $r[3];
   }

   $self-> clear_event, return if !$ImageApp::testing and !defined $w-> IV-> image;

   my $ms = $self-> get_mouse_state;
   my $lr = mb::Left | mb::Right;
   if ((( $ms & $lr) == $lr) or ( $btn == mb::Middle)) {
      defined $w-> {magnify} ? $w-> iv_cancelmagnify( $self) : $w-> iv_magnify( $self),
      return;
   }

   if (( $btn == mb::Right) and ( !defined $self->{transaction})) {
      $self-> {dragData} = [ $x, $y, $self-> deltas];
      $w-> iv_entermode( $self, 3);
      $self-> {savePointer} = $self->pointer;
      $self-> pointer( $ico);
      $self-> clear_event;
      return;

lib/App/PLab/ImageApp.pm  view on Meta::CPAN

   my $scale = $::application-> uiScaling;
   $scale = 1 if $scale < 1;

   $w-> insert( "Panel",
      text      => "",
      name      => "ToolBar",
      origin    => [ 2, $y - 2 - 38 * $scale],
      size      => [ $x - 4, 38 * $scale],
      raise     => 1,
      image     => App::PLab::ImageAppGlyphs::image( bga::tile_m),
      growMode  => gm::GrowHiX | gm::GrowLoY,
   );

   my %btn_profile = (
     glyphs      => 2,
     text        => "",
     selectable  => 0,
     transparent => 1,
     flat        => 1,
     size        => [ map { $_ * $scale } 36, 36],
     borderWidth => 1,
   );

   $w-> ToolBar-> insert(
      [ SpeedButton =>
         origin    => [1, 1],
         image     => App::PLab::ButtonGlyphs::icon( bg::fldropen),
         hint      => 'Open file',
         onClick   => sub { $w-> win_openfile; },
         %btn_profile,
      ],
      [ SpeedButton =>
         name    => "PrevImage",
         origin  => [42 * $scale, 1],
         image   => App::PLab::ImageAppGlyphs::icon( bga::prev),
         enabled => 0,
         hint    => 'Previous image',
         onClick => sub { $w-> win_prevfile; },
         %btn_profile,
      ],
      [ SpeedButton =>
         name    => "NextImage",
         origin  => [78 * $scale, 1],
         image   => App::PLab::ImageAppGlyphs::icon( bga::next),
         enabled => 0,
         hint    => 'Next image',
         onClick => sub { $w-> win_nextfile; },
         %btn_profile,
      ],
   );

   $w-> insert( "Panel",
      text  => "",
      name     => "StatusBar",
      rect     => [0, 0, $w-> width, 22],
      indent   => 2,
      raise    => 0,
      buffered => 1,
      growMode => gm::GrowHiX,
      font     => { name => "System VIO", height => 18,},
   );


   $w-> insert( 'App::PLab::TrImageViewer' =>
      name     => "IV",
      rect     => [ 2, $w-> StatusBar-> height + 2, $x - 2, $y - $w-> ToolBar-> height - 8],
      hScroll  => 1,
      vScroll  => 1,
      growMode => gm::Client,
      delegations => [qw(Size MouseUp MouseDown MouseMove Paint)],
      widgetClass => wc::Window,
   );
   return %profile;
}

1;

=pod

=head1 NAME

App::PLab::ImageApp - ancient stuff, please move along, nothing to see here

=cut