view release on metacpan or  search on metacpan

bin/PrAverB  view on Meta::CPAN

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

sub win_newextras
{
   my $w = $_[0];
   $w-> SUPER::win_newextras;

   my $pabname = $w-> win_extname( $w->{file});
   if ( open F, "< $pabname") {
      $_ = <F>;
      return unless /Average\sbrightness\sdata/;
      return unless /extinfo/;
      my $i;
      LOOP: while (<F>) {
         my $comments;
         chomp;
         if ( /\#(.*)/) {
            $comments = $1;
            # print "got comments:$comments\n";
            s/\#.*//;
         }
         next unless length $_;
         my @dp = split(' ', $_);
         # print "got data:@dp\n";
         next unless $dp[0] =~ /^\d+$/;
         next unless defined $comments;
         @dp = split(' ', $comments);
         # print "got split comments:@dp\n";
         for ( @dp) {
            next LOOP unless /^[\d\.]+$/;
         }
         # print "@dp:ok!\n";
         $i++;
         my $threshold = shift @dp;
         next if $threshold < 0 || $threshold > 255;
         my $fig = $w-> fig_add( @dp);
         $fig-> {number} = $i;
         $fig-> {threshold} = $threshold;
      }
      close F;
   }
}


sub win_printframe
{
   my ( $w, $usedlg) = @_;
   if ( $usedlg) {
      my $d = $w-> {printerDialog};
      $w-> {printerDialog} = $d = Prima::PrintSetupDialog-> create( owner => $w) unless $d;
      $w-> iv_cancelmode( $w-> IV);
      return unless $d-> execute;
   }
   my $p = $::application-> get_printer;
   $p-> font-> size( 9);
   if ( !$p-> begin_doc) {
      Prima::MsgBox::message_box( $w->name, "Error starting print document", mb::Ok|mb::Error);
      return;
   }
   my $ww = Prima::Window-> create(
      borderIcons => 0,
      borderStyle => bs::None,
      size        => [300, 100],
      centered    => 1,
   );
   $ww-> insert( Label =>
      x_centered  => 1,
      text        => 'Printing...',
      font        => {size => 18},
      height      => $ww-> height,
      bottom      => 0,
      valignment  => ta::Center,
   );
   $ww-> bring_to_front;
   $ww-> update_view;

   my @sz = $p-> size;
   my $i = $w-> IV-> image;
   my @isz = $i-> size;
   my ( $x, $y) = ( $sz[0] / $isz[0], $sz[1] / $isz[1]);
   my $z = $x < $y ? $x : $y;
   $p-> stretch_image( 0, 0, $isz[0] * $z, $isz[1] * $z, $i);
   my $fh = $p-> font-> height;

   for ( @{$w-> {rects}}) {
      my @rc = @{$_->{rect}};
      $_ *= $z for @rc;
      push @rc, @rc[0,1];
      $p-> color( cl::White);
      $p-> fillpoly( \@rc);
      $p-> color( cl::Black);
      $p-> polyline( \@rc);
      @rc = @{$_->{bounds}};
      $_ *= $z for @rc;
      $p-> text_out( $_-> {number},
         ( $rc[2] + $rc[0] - $p-> get_text_width( $_->{number})) / 2,
         ( $rc[3] + $rc[1] - $fh) / 2
      );
   }

   $p-> end_doc;
   $ww-> destroy;
}


sub win_saveframe
{
   my $w = $_[0];
   my $i;
   my $f = $w-> {file};
   my $sr = scalar @{$w-> {rects}};
   my $lt = scalar localtime;
   my $pabname = $w-> win_extname( $f);
   if ( open F, "> $pabname") {
      print F <<SD;
# Average brightness data for $f, $sr points, extinfo
# $lt
#
# N    AveB         SumB          Area          # ignore this altogether
#
SD

      for ( sort { $a-> compare_to( $b) } @{$w-> {rects}}) {
         $i++;
         my ( $i1, $imask, $i2) = $w-> fig_getspots( $_);
         my $t    = $_-> {threshold};
         my $mask = Prima::IPA::Point::threshold( $i2, minvalue => $t, maxvalue => 255);
         my $a2   = Prima::IPA::Point::mask( $mask, mismatch => $i2);
         my $area  = $mask-> sum / 255;
         my $sum2 = $a2-> sum;
         my $ave  = $area ? $sum2 / $area : 0;
         printf F "%-3d %-14.8g %-14.8g %-14.8g", $i, $ave, $sum2, $area;
         print F "# $t @{$_->{rect}}\n";
      }
      close F;
      $w-> modified( 0);
   } else {
      return 0 if Prima::MsgBox::message_box( $::application-> name,
         "Error saving file $pabname. Ignore changes?", mb::YesNo|mb::Warning) == mb::No;
   }
   return 1;
}