App-PLab
6 results

 view release on metacpan or  search on metacpan

bin/PrAverB  view on Meta::CPAN 

   $canvas-> polyline(\@r);
   if ( defined $me->{number}) {
      $canvas-> text_out( $me->{number}, $iv-> point2screen( $me->{bounds}->[0], $me->{bounds}->[1]));
   }
   if ( $w-> {selectedRect} && $me == $w-> {selectedRect} && !$iv->{transaction}) {
      my $c = $canvas-> color;
      my $pc = $w->{ini}->{Color_Selection} + 0;
      $pc = ~($pc) & 0xFFFFFF;
      $canvas-> color( $pc);
      $canvas-> rop( rop::XorPut);
      @r = $me-> get_screen_bounds;
      my $hw = $r[0]+($r[2]-$r[0])/2;
      my $hh = $r[1]+($r[3]-$r[1])/2;
      if ( $me->{state} == 0) {
         $canvas-> bar( $r[0],$r[1],$r[0]+4,$r[1]+4);
         $canvas-> bar( $hw-2,$r[1],$hw+2,$r[1]+4);
         $canvas-> bar( $r[2]-5,$r[1],$r[2]-1,$r[1]+4);
         $canvas-> bar( $r[0],$r[3]-5,$r[0]+4,$r[3]-1);
         $canvas-> bar( $hw-2,$r[3]-5,$hw+2,$r[3]-1);
         $canvas-> bar( $r[2]-5,$r[3]-5,$r[2]-1,$r[3]-1);
         $canvas-> bar( $r[0],$hh-2,$r[0]+4,$hh+2);
         $canvas-> bar( $r[2]-5,$hh-2,$r[2]-1,$hh+2);
      } else {
         $canvas-> arc( $r[0]+16, $r[1]+16, 8, 8, 180, 270);
         $canvas-> arc( $r[0]+16, $r[3]-16, 8, 8, 90, 180);
         $canvas-> arc( $r[2]-16, $r[3]-16, 8, 8, 0, 90);
         $canvas-> arc( $r[2]-16, $r[1]+16, 8, 8, 270, 360);
         $canvas-> line( $r[0]+2, $hh - 5, $r[0]+2, $hh + 5);
         $canvas-> line( $hw - 5, $r[1]+2, $hw + 5, $r[1]+2);
         $canvas-> line( $r[2]-2, $hh - 5, $r[2]-2, $hh + 5);
         $canvas-> line( $hw - 5, $r[3]-2, $hw + 5, $r[3]-2);
      }
      $r[0] += 3;
      $r[1] += 3;
      $r[2] -= 3;
      $r[3] -= 3;
      $canvas-> rectangle( @r);
      $canvas-> rop( rop::CopyPut);
      $canvas-> color( $c);
   }
}

sub compare_to
{
   my @d  = map {
      my $g = $_[0]-> {bounds}-> [$_] - $_[1]-> {bounds}->[$_];
      $g = 0 if abs($g) < 8; # XXX
      $g;
   } 0,1;
   return ($d[1] != 0) ? -$d[1] : $d[0];
}

package AveWindow;
use vars qw(@ISA);
@ISA = qw(App::PLab::ImageAppWindow);

sub win_inidefaults
{
   my $w = $_[0];
   return (
      $w-> SUPER::win_inidefaults,
      PropShowMode    => '1',
   );
}


sub on_create
{
   my $self = $_[0];
   my $w    = $_[0];
   $self-> SUPER::on_create;
   $self-> {dataExt} = 'pab';
   $w-> {selectedRect} = undef;
   $w-> {rects} = [];

   $w-> insert( Popup =>
      autoPopup => 0,
      selected => 0,
      name => 'FigurePopup',
      items => [
         ['~Duplicate' => 'Ctrl+D' => kb::NoKey => q(win_figdup)],
         ['De~lete' => 'Del' => kb::NoKey => q(win_figdelete)],
         ['~Properties' => sub { $w-> fig_propdialog( $w-> {selectedRect})}],
      ],
   );
   my $scale = $::application-> uiScaling;
   $scale = 1 if $scale < 1;

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

   $w-> ToolBar-> insert(
      [ SpeedButton =>
         origin    => [ 114 * $scale, 1],
         image     => App::PLab::ButtonGlyphs::icon( bg::floppy),
         hint      => 'Save file',
         enabled   => 0,
         name      => "FileSave",
         onClick   => sub { $w-> win_saveframe; },
         %btn_profile,
      ],
      [ SpeedButton =>
         origin    => [ 150 * $scale, 1],
         image     => App::PLab::ButtonGlyphs::icon( bg::print),
         hint      => 'Print',
         enabled   => 0,
         name      => "FilePrint",
         onClick   => sub { $w-> win_printframe(0); },
         %btn_profile,
      ],
   );
}


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 =>

bin/PrAverB  view on Meta::CPAN 

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

sub win_figrenumber
{
   my $w = $_[0];
   my $i = 0;
   my $needRepaint = 0;
   for ( sort { $a-> compare_to( $b) } @{$w-> {rects}}) {
      $i++;
      $needRepaint = 1 if !$needRepaint && defined $_-> {number} && $_-> {number} != $i;
      $_-> {number} = $i;
   }
   return $needRepaint;
}

sub win_figdelete
{
   my ( $w) = @_;
   return unless $w->{selectedRect};
   $w->{selectedRect}-> destroy;
   $w-> modified( 1);
   $w-> {rects}->[-1]-> select if @{$w-> {rects}};
   $w-> pointer( cr::Default);
}

sub win_figdup
{
   my ( $w) = @_;
   return unless $w->{selectedRect};
   my @rc = @{$w->{selectedRect}->{rect}};
   my $x = $w-> fig_add( map { $_ += 20} @rc);
   $w-> modified( 1);
   $x-> select;
}


sub win_figclear
{
   my ( $w) = @_;
   $w-> fig_clear;
   $w-> IV-> repaint;
   $w-> pointer( cr::Default);
   $w-> modified( 1);
}

sub win_framechanged
{
   my $w = $_[0];
   $w-> SUPER::win_framechanged;
   $w-> menu-> FilePrint-> enabled( defined $w-> {file});
   $w-> menu-> FileSave-> enabled( defined $w-> {file});
   $w-> ToolBar-> FilePrint-> enabled( defined $w-> {file});
   $w-> ToolBar-> FileSave-> enabled( defined $w-> {file});
}

# FIG

sub fig_clear
{
   $_[0]-> {selectedRect} = undef;
   $_[0]-> {rects} = [];
}

sub fig_add
{
   my $w = shift;
   my $obj = new Figure @_;
   push @{$w-> {rects}}, $obj;
   $obj->{index} = scalar(@{$w-> {rects}}) - 1;
   $obj->{owner} = $w;
   $obj->{IV}    = $w-> IV;
   return $obj;
}

sub fig_propdialog
{
   my $i2 = undef if 0;
   my ($w, $me) = @_;
   my $d = $w-> {figPropDlg};
   my ($i1,$imask);
   ( $i1, $imask, $i2) = $w-> fig_getspots( $me);
   unless ( $d) {
       my $selpoint = sub {
          my ( $d, $item) = @_;
          $d-> menu-> checked( $w->{ini}->{PropShowMode}, 0);
          $d-> menu-> checked( $item, 1);
          $w->{ini}->{PropShowMode} = $item;
          $d-> Threshold-> notify(q(Change)); # force changes
       };

       $d = Prima::Dialog-> create(
          size => [ 400, 320],
          text => 'Spot properties',
          owner => $w,
          menuItems => [
             ['~Options' => [
                ['1' => '~Positive' => 'Ctrl+P' => '^P' =>$selpoint],
                ['2' => '~Negative' => 'Ctrl+N' => '^N' =>$selpoint],
                ['3' => '~Mask'     => 'Ctrl+M' => '^M' =>$selpoint],
             ]],
          ],
          %App::PLab::ImageAppWindow::dlgProfile,
       );
       $d-> menu-> check( $w->{ini}->{PropShowMode});
       $d-> insert( Button =>
          origin => [ 10, 10],
          size   => [ 56, 36],
          default => 1,
          text    => '~Ok',

bin/PrAverB  view on Meta::CPAN 


sub IV_xorrect
{
   my ( $w, $self) = @_;
   my @r = @{$self->{xorData}};
   my $pc = $w->{ini}->{Color_Selection} + 0;
   $pc = ~($pc) & 0xFFFFFF;
   $self-> begin_paint;
   $self-> set(
      linePattern => lp::Dash,
      color       => $pc,
      rop         => rop::XorPut,
   );
   $self-> polyline( [ @r, @r[0,1]] );
   $self-> end_paint;
}

sub IV_xorpoly
{
   my ( $w, $self) = @_;
   my $pc = $w-> backColor;
   my @r = @{$self->{xorPolyData}};
   $self-> begin_paint;
   $self-> set(
      linePattern => lp::Dash,
      color       => $pc,
      rop         => rop::XorPut,
   );
   $self-> polyline( [ @r, @r[0,1]] );
   $self-> end_paint;
}


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

   if ( !$self->{transaction})
   {
      my ( $ax, $ay) = $self-> screen2point( $x, $y);
      for ( @{$w-> {rects}}) {
         if ( $_-> on_mousedown( $w, $self, $btn, $mod, $x, $y, $ax, $ay)) {
            $self-> clear_event;
            return;
         }
      }

      if ( $btn == mb::Left) {
         $self-> {transaction} = tran::init;
         $w-> iv_cancelmagnify( $self);
         $self-> capture( 1);
         $self-> {anchor} = [ $x, $y];
         $self-> {xorData} = [ $x, $y, $x, $y, $x, $y, $x, $y];
         $w-> IV_xorrect( $self);
         $self-> clear_event;
         $w-> sb_text( "Draw a region");
         return;
      }
   }

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

   $self-> clear_event;
}


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

   return if $self->{transaction};
   my ( $ax, $ay) = $self-> screen2point( $x, $y);
   for ( @{$w-> {rects}}) {
      if ( $_-> on_mouseclick( $w, $self, $btn, $mod, $x, $y, $ax, $ay, $dbl)) {
         $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 ( $self->{transaction} == tran::init && $btn == mb::Left) {
      $self-> {transaction} = undef;
      $self-> capture( 0);
      $w-> IV_xorrect( $self);
      $self-> clear_event;
      if ( $self-> {anchor}->[0] != $x && $self-> {anchor}->[1] != $y) {
         my $ix = $w-> fig_add( $self-> screen2point( @{$self-> {xorData}}));
         $self-> {xorData} = [(-1)x4];
         $w-> {selectedRect} = $ix;
      } else {
         $w-> {selectedRect} = undef;
      }
      $self-> repaint;
      return;
   }

   if ( $w-> {selectedRect} && $self-> {transaction})
   {
      my ( $ax, $ay) = $self-> screen2point( $x, $y);
      if ( $w-> {selectedRect}-> on_mouseup( $w, $self, $btn, $mod, $x, $y, $ax, $ay)) {
         $self-> clear_event;
         return;
      }
   }
}

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

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

   if ( $self->{transaction} && $self->{transaction} == tran::init) {
      $w-> IV_xorrect( $self);
      $self-> {xorData}-> [3] = $y;
      $self-> {xorData}-> [4] = $x;
      $self-> {xorData}-> [5] = $y;
      $self-> {xorData}-> [6] = $x;
      $w-> IV_xorrect( $self);
      $self-> clear_event;
      return;
   }

   if ( $w-> {selectedRect} && $w-> {selectedRect}-> on_mousemove( $w, $self, $mod, $x, $y)) {
      $self-> clear_event;
      return;
   }
}

sub IV_Paint
{
   my ( $w, $self, $canvas) = @_;
   $self-> on_paint( $canvas);
   my $r = $w-> {rects};
   my $z = $self-> zoom;
   $canvas-> color( $w-> {ini}->{Color_AreaBorder});
   $canvas-> translate(0,0);
   for ( @$r) {
      $_-> on_paint( $w, $self, $canvas);
   }
}

# OPT

sub opt_colors
{
   return {
     'Selection'  => [ cl::Gray, 'Selection'],
     'AreaBorder' => [ cl::Cyan, 'Area border'],
   };
}

sub opt_keys
{
   return {
      %{$_[0]-> SUPER::opt_keys()},
      FileSave       => [ kb::F2,              'Save frame layout'],
      FilePrint      => [ '^P',                'Print current frame layout'],
      EditDuplicate  => [ '^D',                'Duplicate selected rectange'], 
      EditDelete     => [ kb::Delete       ,   'Delete selected rectange'], 
      EditDeleteAll  => [ kb::NoKey        ,   'Delete all rectanges'], 
   },
}


# OPT_END


package Run;

my $wfile = App::PLab::ImageAppWindow::winmenu_file();
splice( @{$$wfile[1]}, 8, 0,
   [],
   ['-FileSave'  => "~Save"     => q(win_saveframe)],
   ['-FilePrint' => "~Print..." => sub { $_[0]-> win_printframe(1); }],
);


my $wedt = App::PLab::ImageAppWindow::winmenu_edit();
splice( @{$$wedt[2]}, 0, 0,
   [ EditDuplicate => "~Duplicate"    => q(win_figdup)],
   [ EditDelete    => "De~lete"       => q(win_figdelete)],
   [ EditDeleteAll => "Delete ~all"   => q(win_figclear), ],
   [],
);

my $w = AveWindow-> create(
   menuItems => [
      $wfile,
      $wedt,
      App::PLab::ImageAppWindow::winmenu_view(),
   ],
);


$w-> IV-> delegations(['Paint', 'MouseClick']);
$w-> sb_text("Started OK");
$w-> visible(1);
$w-> select;

$w-> win_extwarn;


run Prima;



( run in 1.569 second using v1.01-cache-2.11-cpan-98e64b0badf )