App-PLab

 view release on metacpan or  search on metacpan

bin/MorphometryI  view on Meta::CPAN

      $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);
}

sub win_entersubplace
{
   my $w = $_[0];
   $w-> {savePointer} = $::application-> pointer;
   $::application-> pointer( cr::Wait);
   return defined $w-> {mirrorImage} ? $w-> {mirrorImage} : $w-> IV-> image;
}

sub win_leavesubplace
{
   my $w = $_[0];
   $::application-> pointer( $w-> {savePointer});
   $w-> {mirrorImage} = $w-> IV-> image unless defined $w-> {mirrorImage};
   $w-> IV-> image( $_[1]);
   $w-> {recWindow}-> RestoreBtn-> enabled( 1) if $w-> {recWindow};
   $w-> {savePointer} = undef;
}

sub win_restore
{
   my ( $w, $i) = @_;
   $w-> IV-> repaint, return unless defined $w-> {mirrorImage};
   $w-> IV-> image($w-> {mirrorImage});
   $w-> {mirrorImage} = undef;
   $w-> {recWindow}-> RestoreBtn-> enabled( 0) if $w-> {recWindow};
}

sub win_syncrecdata
{
   my $w = $_[0];
   return unless $w-> {recWindow};
   my $r = $w-> {recWindow};
   my $i = $w-> {ini};
   $i-> {UFThreshold}  = $r-> Union-> value;
   $i-> {BinThreshold} = $r-> Binary-> value;
   $i-> {EdgeSize}     = $r-> Edge-> value;
   $i-> {MinArea}      = $r-> Min-> value;
   $i-> {MaxArea}      = $r-> Max-> value;
}

sub win_validate
{
   my ( $w, $silent) = @_;
   my ( $min, $max, $edge);
   my ( $umax, $umin, $j, $iptr);

   return unless defined $w-> {file};

   $w-> win_syncrecdata;
   $umin = $w-> {ini}-> {MinArea};
   $umax = $w-> {ini}-> {MaxArea};

   unless ( $silent) {
      $w-> iv_cancelmode( $w-> IV);
      $iptr = $::application-> pointer;
      $::application-> pointer( cr::Wait);
   }

   my @is = $w-> IV-> image-> size;

   for ( $j = 0; $j < 2; $j++) {

      if ( $j == 0) {
         $min = $umin;
         $max = $umax;
      } else {
         $min = 0;
         $max = $is[0] * $is[1];
      }

      $edge = $w-> {ini}-> {EdgeSize};

      my $i = Prima::Image-> create(
         width        => $is[0],
         height       => $is[1],
         type         => im::BW,
         preserveType => 1,
      );

      $i-> begin_paint;
      $i-> color( cl::Black);
      $i-> bar(0,0,@is);
      $i-> color( cl::White);
      my $k;
      my $lastLW = 0;

      if ( defined $w-> {lineStorage}) {
         my $wwl  = $w->{lineStorage}->[$j];
         my $wwlw = $w->{lwStorage}  ->[$j];
         next unless defined $wwl;
         for ( $k = 0; $k < @$wwl; $k++) {
            $i-> lineWidth( $$wwlw[$k]), $lastLW = $$wwlw[$k] if $lastLW != $$wwlw[$k];
            $i-> polyline( $$wwl[ $k]);
         }
      }
      $i-> end_paint;
      $i-> type( im::Byte);

      $i = Prima::IPA::Global::fill_holes( $i,
         edgeSize => $edge,
      );

bin/MorphometryI  view on Meta::CPAN

}

use constant PI => 4 * atan2 1, 1;

sub win_calcbasicparameters
{
   my $w = shift;

   # input: xy array
   # output in array context: (area,perimeter,formfactor,xcen,ycen,fxcen,fycen)
   # initialization:
   my ($xCalib, $yCalib) = ( $w-> {ini}-> {XCalibration}, $w-> {ini}-> {YCalibration});

   # algorithm
   my $xflag = 1;
   my( @x, @y);
   for (@_) {
      push @x, $_ if $xflag;
      push @y, $_ unless $xflag;
      $xflag = !$xflag;
   }
   return () unless @x;
   unless ($x[$#x] == $x[0] && $y[$#y] == $y[0]) {
      push @x, $x[0];
      push @y, $y[0];
   }
   my ($xyCalib,$xxCalib,$yyCalib) = ($xCalib*$yCalib,$xCalib*$xCalib,$yCalib*$yCalib);
   my ($area,$perimeter,$xcen,$ycen,$fxcen,$fycen,$ff) = (0,0,0,0,0,0,0,0,0);
   for my $i ( 1..$#x) {
      $area += $xyCalib * ($x[$i-1] * $y[$i] - $x[$i] * $y[$i-1]);
      my $dx = $x[$i-1] - $x[$i];
      my $dy = $y[$i-1] - $y[$i];
      $perimeter += sqrt( $xxCalib * $dx * $dx + $yyCalib * $dy *$dy);
      $xcen += $x[$i];
      $ycen += $y[$i];
      $fxcen += $xCalib * $x[$i];
      $fycen += $yCalib * $y[$i];
   }
   $area = abs( $area / 2);
   $ff = 4 * PI * $area / $perimeter / $perimeter
      if $perimeter > 0;
   $xcen /= @x;
   $ycen /= @y;
   $fxcen /= @x;
   $fycen /= @y;
   return ($area,$perimeter,$ff,$xcen,$ycen,$fxcen,$fycen);
}


sub win_saveframe
{
   my $w = $_[0];
   my $xmlname = $w-> win_extname( $w-> {file});

   return 1 unless $w-> {modified};

   if ( open F, "> $xmlname") {
      my $waitPtr = $::application-> pointer;
      $::application-> pointer( cr::Wait);
      $w-> sb_text("saving $xmlname");
      $w-> win_validate(1);
      $w-> win_syncrecdata;
      my $image = $w-> IV-> image;
      if ( $w->{ini}->{CalcBrightness} && $w->{ini}->{EqualBrightness}) {
         # subtracting low frequencies
         $w-> sb_text("Equalizing background ...");
         my $i1 = Prima::IPA::Global::butterworth( $image, 
            low        => 1,
            homomorph  => 0,
            power      => 2,
            cutoff     => 20,
            boost      => 0.7,
            spatial    => 1,
            lowquality => 1,
         );
         $i1-> type( $image-> type);
         $image = Prima::IPA::Point::subtract( $image, $i1);
         $w-> sb_text("saving $xmlname");
      }   
         

      my ( $iname, $ix, $iy, $path, $datestr, $xc, $yc, $objects, $i) = (
         $w->{file}, $image-> size, $w->{ini}->{path}, scalar(gmtime(time)),
         $w->{ini}->{XCalibration}, $w->{ini}->{YCalibration}, 0
      );
      $iname =~ m{[/\\]([^/\\]*)$};
      $iname = $1;

      for ( $i = 0; $i < 2; $i++) {
         my $ptr = $w-> {lineStorage}->[$i];
         next unless defined $ptr;
         $objects += scalar @$ptr;
      }
      $objects += scalar @{$w-> {points}} / 2 if defined $w-> {points};
      my $objCount = 0;

print F <<HEADER;
<?xml version="1.0"?>
<!DOCTYPE morphology_data SYSTEM "morphology_data.dtd">
<!-- This is a generated file.  Do not edit! -->
<morphology_data
  imagename    = "$iname"
  imagewidth   = "$ix"
  imageheight  = "$iy"
  directory    = "$path"
  creator      = "MorphologyI"
  creationdate = "$datestr"
  xcalib       = "$xc"
  ycalib       = "$yc"
  objects      = "$objects"
>

HEADER

      for ( $i = 0; $i < 2; $i++) {
         my $ptr = $w-> {lineStorage}->[$i];
         next unless defined $ptr;
         my $type = $w-> menu-> text( $i);
         $type =~ s[\~][]g;
         $type = lc $type;
         for ( @$ptr) {

bin/MorphometryI  view on Meta::CPAN

   my ( $w, $x, $y) = @_;
   $w-> {points} = [] unless defined $w-> {points};
   $w = $w->{points};
   my $i = 0;
   my $found = undef;
   for ( $i = 0; $i < scalar @$w; $i+=2) {
      my ( $ax, $ay) = @$w[$i,$i+1];
      $found = $i, last if abs( $ax - $x) < $App::PLab::ImageAppWindow::pointClickTolerance &&
       abs( $ay - $y) < $App::PLab::ImageAppWindow::pointClickTolerance;
   }
   defined $found ? splice( @$w, $i, 2) : push( @$w, $x, $y);
   return !defined $found;
}

sub rpt_clear
{
   $_[0]-> {points} = undef;
}

sub rptex_clear
{
   $_[0]-> {extraPoints} = undef;
}

# RPT_END
# IV

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

   $w-> SUPER::IV_MouseDown( $self, $btn, $mod, $x, $y);
   return unless $self-> eventFlag;

   $self-> clear_event, return if $btn != mb::Left;

   if ($self->{transaction}) {
      if ( $self->{transaction} == 2) {
         my ( $ax, $ay) = $self-> screen2point( $x, $y);
         $self-> {transaction} = 1;
         $w-> pt_add( $ax, $ay);
         $w-> sb_text( "Freehand: $ax $ay");
         $w-> modified( 1);
         $self-> repaint;
      }
      $self-> clear_event;
      return;
   }

   unless ( $self->{drawmode}) {
      my ( $ax, $ay) = $self-> screen2point( $x, $y);
      if ( $w-> rpt_toggle( $ax, $ay)) {
         $self-> begin_paint;
         $self-> color( $w->{pointColor});
         my $p = ( 6 * $self-> zoom < 1) ? 1 : ( 6 * $self-> zoom);
         $self-> fill_ellipse( $x, $y, $p, $p);
         $self-> end_paint;
         $w-> sb_text( "New reference point: $ax $ay");
      } else {
         my $p = ( 32 * $self-> zoom < 1) ? 1 : ( 32 * $self-> zoom);
         $self-> invalidate_rect( $x - $p, $y - $p, $x + $p, $y + $p);
         $w-> sb_text( "Reference point deleted: $ax $ay");
      }
      $w-> modified( 1);
      $self-> clear_event;
      return;
   }

   {
      #starting freehand session
      $w-> iv_entermode( $self, 1);
      $w-> pt_start;
      my ( $ax, $ay) = $self-> screen2point( $x, $y);
      $w-> pt_add( $ax, $ay);
      $w-> modified( 1);
      $w-> sb_text( "Freehand: $ax $ay");
   }
   $self-> clear_event;
}

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

   if ( $btn == mb::Right and ( $self-> {transaction})) {
      $w-> iv_cancelmode( $self) if $self-> {transaction} == 2;
      $self-> clear_event;
      return;
   }
}

sub IV_MouseUp
{
   my ( $w, $self, $btn, $mod, $x, $y) = @_;
   return unless $self->{transaction};
   $w-> SUPER::IV_MouseUp( $self, $btn, $mod, $x, $y);
   return unless $self-> eventFlag;
   if ( $btn == mb::Left and $self-> {transaction} == 1) {
      $self-> {transaction} = 2;
      $self-> {xors} = undef;
      $w-> sb_text("Lineplot:");
      $self-> clear_event;
   }
}

sub IV_MouseMove
{
   my ( $w, $self, $mod, $x, $y) = @_;
   unless ( $self->{transaction}) {
      if (( $mod & km::Shift) && defined $self-> image) {
         my $i = $self-> image;
         my $pix = $i-> pixel( $self-> screen2point( $x, $y));
         $w-> sb_text((( $i-> type & im::BPP) > 8) ?
            sprintf("%02x %02x %02x", ($pix>>16)&0xFF, ($pix>>8)&0xFF, $pix&0xFF) :
            $pix
         ) if $pix != cl::Invalid;
      }
   }
   $w-> SUPER::IV_MouseMove( $self, $mod, $x, $y);
   return unless $self-> eventFlag && $self-> {transaction};
   if ( $self-> {transaction} == 1) {

bin/MorphometryI  view on Meta::CPAN

   my @p = split( ' ', $w->{ini}->{RecWindowPos});
   my @as = $::application-> size;
   my @ss = $self-> size;
   for ( 0..1) {
      $p[$_] = 100 unless defined $p[$_];
      $p[$_] = 0 if $p[$_] < -$ss[$_] + 100;
      $p[$_] = $as[$_] - $ss[$_] - 30 if $p[$_] > $as[$_] - $ss[$_] - 30;
   }

   $self-> origin( @p);
   $self-> visible(1);
   return %profile;
}

sub cleanup
{
   my $self = $_[0];
   my $w = $self-> owner;
   $w-> {recWindow} = undef;
   my $i = $w-> {ini};
   $i-> {RecWindowPos}  = join( ' ', $self-> origin);
   $i-> {UFThreshold} = $self-> Union-> value;
   $i-> {BinThreshold} = $self-> Binary-> value;
   $i-> {EdgeSize} = $self-> Edge-> value;
   $i-> {MinArea}  = $self-> Min-> value;
   $i-> {MaxArea}  = $self-> Max-> value;
   $self-> SUPER::cleanup();
}

package Run;

my $wfil = App::PLab::ImageAppWindow::winmenu_file();
splice( @{$$wfil[1]}, -2, 0,
   [],
   [ EditImport      => "~Import contours" => q(win_importextras)],
   [ '-EditOptCalib' => "~Recalculate series"  => q(opt_changecalib)],
   [ EditCalcStats   => "~Calculate statistics"  => q(opt_statistics)],
);

my $wedt = App::PLab::ImageAppWindow::winmenu_edit();
splice( @{$$wedt[2]}, 0, 0,
   [ '-Undo1' => "~Undo drawing" => "BkSp" => kb::Backspace , sub {},],
   [ '-Undo2' => "~Group undo" => "Alt+BkSp" => km::Alt|kb::Backspace , sub {},],
   [ '-Undo3' => "Undo ~dialog" => "Alt+U" => '@U' => sub {},],
   [ EditClearAll => "Clear all ~drawings"  => sub {
      $_[0]-> iv_cancelmode( $_[0]-> IV);
      $_[0]-> pt_clear;
      $_[0]-> IV-> repaint;
      $_[0]-> modified( 1);
   }, ],
   [ EditRemovePoints => "Clear all ~points"    => sub {
      $_[0]-> rpt_clear;
      $_[0]-> IV-> repaint;
      $_[0]-> modified( 1);
   }, ],
   [],
   [ '-EditToggleMode' => "~Toggle points <-> drawings" => 'F11'=>'F11' => sub { $_[0]-> iv_cancelmode( $_[0]-> IV); $_[0]-> iv_togglemode( $_[0]-> IV)}],
   [],
   [ 'EditInvertImage' => '~Invert image' => sub { $_[0]-> win_set_negative( $_[0]-> {ini}-> {InvertImage} ? 0 : 1); } ],
   [ '-EditValidate' => "~Validate contours" => 'Ctrl+Enter'=> km::Ctrl|kb::Enter ,
       sub { $_[0]-> win_validate(0) }],
   [ EditRecSetup => "Recognition ~setup"  => sub { $_[0]-> win_showrec; }, ],
   [ '-EditApplyContours' => "~Apply contours" => 'Alt+Enter'=> km::Alt|kb::Enter , q(win_applycontours)],
   [],
   [ 'EditHack' => "~Outline convex ~hull" => q(win_outline_convex_hull)],
);

my $w = MorphoWindow-> create(
   visible   => 0,
   menuItems => [
      $wfil,
      $wedt,
      App::PLab::ImageAppWindow::winmenu_view(),
      [],["~Help" => [
         [ HelpAbout =>  "~About" => sub {Prima::MsgBox::message("PLab application series, Morphometry I, version $App::PLab::VERSION", mb::OK|mb::Information)}],
         [ HelpPlabApps => "~PLab Apps" => sub { $_[0]-> open_help(); }],
         [ HelpContents => "~Contents" => sub { $_[0]-> open_help("MorphometryI"); }],
      ]],
   ],
   accelItems => [
      ( map {[ "lw$_" => $_ => "Alt+$_" => "\@$_" => q(win_objectlwmenuaction)]} 1..9),
   ],
);
$w-> IV-> delegations(['MouseClick', 'Paint']);

$w-> sb_text("Started OK");
$w-> visible(1);
$w-> select;

$w-> win_showrec if $w-> {ini}-> {RecWindowVisible};
$w-> menu-> EditInvertImage-> check if $w-> {ini}-> {InvertImage};
$w-> win_extwarn;

run Prima;