view release on metacpan or  search on metacpan

bin/MorphometryI  view on Meta::CPAN

      StatPath         => '.',
      CalcOptions      => $calcopt,
      FrameWidth       => 0,
      FrameColor       => 0,
      InvertImage      => 0,
   );
}


sub on_create
{
   my $self = $_[0];

   $self-> SUPER::on_create;

   my $w = $self;
   $w-> {dataExt} = 'xml';
   my $i = $w-> {ini};
   my $xref = [
      ['*0' => "~Features"   => \&win_objectsetsmenuaction],
      ['1'  => "~Background" => \&win_objectsetsmenuaction],
      ['2'  => "~Remove"     => \&win_objectsetsmenuaction],
      [],
      [ LineWidthIncrement =>  '~Increase line width' => sub {
         $_[0]-> win_objectlwmenuaction( 'lw'.($_[0]-> {ini}-> {'LW'.$_[0]-> {currentSet}} + 1));
      }],
      [ LineWidthDecrement => '~Decrease line width' => sub {
         $_[0]-> win_objectlwmenuaction( 'lw'.($_[0]-> {ini}-> {'LW'.$_[0]-> {currentSet}} - 1));
      }],
   ];
   $w-> {setColors}      = [ qw( Color_Features Color_Background Color_Remove)];
   $w-> menu-> insert( [[ "~Object sets" => $xref]], 'edit' , 6);
   $w-> {currentSet} = 0;
   $w-> pt_init();
   my $iv = $w-> IV;
   my $bone = $iv-> {bone};
   $bone-> backColor( $w-> {ini}-> {$w-> {setColors}->[$w-> {currentSet}]});
   $bone-> set( onMouseClick => sub {
      my ( $cs, $mx) = ( $w-> {currentSet} + 1, scalar @{$w-> {setColors}});
      $cs = 0 if $cs >= $mx;
      $w-> win_objectsetsmenuaction($cs);
      $_[0]-> clear_event;
   });
   my $scale = $::application-> uiScaling;
   $scale = 1 if $scale < 1;

   my $cck = $self-> ToolBar-> insert(
       SpeedButton =>
       name        => "Contours",
       origin      => [120 * $scale, 1],
       size        => [ 36 * $scale, 36 * $scale],
       image       => App::PLab::ImageAppGlyphs::icon( bga::drawprocesses),
       enabled     => 0,
       checkable   => 1,
       checked     => 1,
       hint        => 'Toggle contours tickmarks drawing',
       onClick     => sub { $self-> iv_togglemode( $iv)},
       glyphs      => 2,
       text        => "",
       selectable  => 0,
       transparent => 1,
       flat        => 1,
       borderWidth => 1,
       glyphs => 1,
   );

   $self-> ToolBar-> insert(
       SpeedButton =>
       name        => "CalcStatistics",
       origin      => [ 162 * $scale, 1],
       size        => [ 36 * $scale, 36 * $scale],
       image       => App::PLab::ImageAppGlyphs::icon( bga::calcstatistics),
       enabled     => 1,
       hint        => 'Calculate statistics',
       onClick     => sub { $self-> opt_statistics(); },
       text        => "",
       selectable  => 0,
       transparent => 1,
       flat        => 1,
       borderWidth => 1,
   );
   $iv-> {drawmode} = $cck-> checked ? 1 : undef;
   init_convex( $w->{ini}->{NumberOfRotations});
}

sub on_destroy
{
   my ($w,$i) = ($_[0],$_[0]->{ini});
   $i-> {RecWindowVisible} = defined $w-> {recWindow} ? 1 : 0;
   $w-> SUPER::on_destroy;
}

sub win_closeframe
{
   my $w = $_[0];
   $w-> SUPER::win_closeframe;
   $w-> pt_clear_all();
   $w-> rpt_clear();
}

sub win_framechanged
{
   my $w = $_[0];
   $w-> SUPER::win_framechanged;
   $w-> {mirrorImage} = undef;
   my $i = $w-> IV-> image;
   my $canApply = defined $i && $i-> type == im::Byte;
   $w-> menu-> EditToggleMode-> enabled( defined $i);
   $w-> menu-> EditApplyContours-> enabled( $canApply);
   $w-> menu-> EditValidate-> enabled( defined $i);
   $w-> menu-> EditImport-> enabled( defined $i);
   $w-> ToolBar-> Contours-> enabled( defined $i);
   if ( $w-> {recWindow}) {
      my $r = $w-> {recWindow};
      if ( defined $i) {
         my @sz = $i-> size;
         $r-> Min-> max( $sz[0] * $sz[1]);
         $r-> Max-> max( $sz[0] * $sz[1]);
         $r-> Edge-> max(int(($sz[0] < $sz[1] ? $sz[0] : $sz[1]) / 2));
      }
      $r-> ApplyBtn-> enabled( $canApply);
      $r-> RestoreBtn-> enabled( $canApply && defined $w-> {mirrorImage});
      $r-> Preview1-> enabled( $canApply);
      $r-> Preview2-> enabled( $canApply);
      $r-> Preview3-> enabled( $canApply);
   }
   $w-> pt_newset;
}

sub win_showrec
{
   my $w = $_[0];
   if ( $w-> {recWindow}) {
      $w-> {recWindow}-> bring_to_front;
      $w-> {recWindow}-> select;
      return;
   }
   $w-> {recWindow} = PropRollup-> create( owner => $w);