App-PLab

 view release on metacpan or  search on metacpan

bin/PrLenS  view on Meta::CPAN

            $self-> repaint;
         }
         $w-> show_stats( undef, 1);
      }
      $self-> clear_event;
      return;
   }
   
   if ( $btn == mb::Right && ($mod & km::Ctrl)) {
      $mod &= !km::Ctrl;
   }
   $w-> SUPER::IV_MouseDown( $self, $btn, $mod, $x, $y); 
}

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 if !defined $w-> {binfo} || !defined $w-> {markState} || $w-> {markState} != 16;

   if ( $w->{ binfo}->{ drawMode} == 1) {
      my ( $bn) = $w->{ binfo}->{ branchNumber};
      my ( $ox, $oy) = @{ $w->{ branches}->[ $bn]->[ -1]};
      my ( $ax, $ay) = $self-> screen2point( $x, $y);
      my ( $ms) = $self->get_mouse_state;
      if ( ( scalar( @{ $w->{ branches}->[ $bn]}) == 1) || ( ( $ms & mb::Left) == mb::Left)) {
         push @{ $w->{ branches}->[ $bn]}, [ int($ax), int($ay)];
         $w->{ binfo}->{ removeLastPoint} = 0;
         $w-> {binfo}-> {firstDraw} = 1;
      }
      else {
         return unless $w-> {binfo}-> {firstDraw};
         @{ $w->{ branches}->[ $bn]->[ -1]} = ( $ax, $ay);
         $w->{ binfo}->{ removeLastPoint} = 1;
      }
      if ( scalar( @{ $w->{ branches}->[ $bn]}) > 1) {
         my ( $ex, $ey) = @{ $w->{ branches}->[ $bn]->[ -1]};
         my ( $bx, $by) = @{ $w->{ branches}->[ $bn]->[ -2]};
         my ( $left, $bottom, $right, $top) = ( $ox, $oy, $ox, $oy);
         $left = $ex if $left > $ex;
         $left = $bx if $left > $bx;
         $bottom = $ey if $bottom > $ey;
         $bottom = $by if $bottom > $by;
         $right = $ex if $right < $ex;
         $right = $bx if $right < $bx;
         $top = $ey if $top < $ey;
         $top = $by if $top < $by;
         $self-> invalidate_rect( $self-> point2screen( $left, $bottom, $right + 1, $top + 1));
      }
   }
   else{
      my ( $mindist, $bn, $i);
      my ( $rr);
      for ( $i = 0; $i <= $#{ $w->{ branches}}; $i++) {
         my ( $lmd, $j);
         my ( $left, $bottom, $right, $top) = ( @{ $w->{ branches}->[ $i]->[ 0]}, @{ $w->{ branches}->[ $i]->[ 0]});
         for ( $j = 0; $j < $#{ $w->{ branches}->[ $i]}; $j++) {
            my ( $x1, $y1, $x2, $y2) = ( @{ $w->{ branches}->[ $i]->[ $j]},
                                         @{ $w->{ branches}->[ $i]->[ $j + 1]});
            my ( $dist) = point_line_distance( $x1, $y1, $x2, $y2, $self-> screen2point($x, $y));
            $lmd = $dist unless defined $lmd;
            $lmd = $dist if $lmd > $dist;
            $left = $x1 if $left > $x1;
            $left = $x2 if $left > $x2;
            $bottom = $y1 if $bottom > $y1;
            $bottom = $y2 if $bottom > $y2;
            $right = $x1 if $right < $x1;
            $right = $x2 if $right < $x2;
            $top = $y1 if $top < $y1;
            $top = $y2 if $top < $y2;
         }
         if ( ( ! defined( $mindist)) || ( $mindist > $lmd)) {
            $mindist = $lmd;
            $bn = $i;
            $rr = [ $left, $bottom, $right + 1, $top + 1];
         }
      }
      if ( defined( $mindist) && ( $mindist <= 10)) {
         if ( ( ! defined( $w->{ binfo}->{ nearestBranch})) || ( $w->{ binfo}->{ nearestBranch} != $bn)) {
            $w->{ binfo}->{ nearestBranch} = $bn;
            $self-> invalidate_rect( $self-> point2screen( @{ $w->{ binfo}->{ prevActiveRect}})) 
               if defined $w->{ binfo}->{ prevActiveRect};
            $self->invalidate_rect( $self-> point2screen( @$rr));
            $w->{ binfo}->{ prevActiveRect} = $rr;
         }
      }
      elsif ( defined $w->{ binfo}->{ nearestBranch}) {
         undef $w->{ binfo}->{ nearestBranch};
         $self->invalidate_rect( $self-> point2screen( @{ $w->{ binfo}->{ prevActiveRect}}))
            if defined $w->{ binfo}->{ prevActiveRect};
         undef $w->{ binfo}->{ prevActiveRect};
      }
   }
}

sub IV_MouseClick
{
   my ( $w, $self, $btn, $mod, $x, $y, $dbl) = @_;
   
   $self-> clear_event;
   return unless defined $w-> {file};

   if ( $dbl && $btn == mb::Right && !( $mod & km::Ctrl)) {
      $w-> reset_mark_state(( $mod & km::Shift) ? 'prev' : 'next');
      return;
   }

   return unless $btn == mb::Left;
   return unless defined $w-> {markState};
   my ( $ax, $ay) = $self-> screen2point( $x, $y);
   return unless ( $ax >= 0 && $ay >= 0 && $ax < $w->{IVx} && $ay < $w->{IVy});
   my $ary = undef;
   $ary = ($w->{ markState} == 16) ? $w-> {branches} : $w-> {$w-> {layers}->[$w-> {markState}]};
   return unless defined $ary;

   if ( $w->{ markState} == 16) {
      if ( ! $w->{ binfo}->{ drawMode}) {
         $w-> initiate_draw_mode( $x, $y);
      }

      my ( $bn) = $w->{ binfo}->{ branchNumber};
      push @{ $w->{ branches}->[ $bn]}, [ int($ax), int($ay)];
      $w->{ binfo}->{ removeLastPoint} = 1;
      $w-> modified(1);
   }
   else {
      my ($i,$x1,$x2,$y1,$y2);


      # search for an existing point
      for ( $i = 0; $i < scalar @$ary; $i++)
      {
         ($x1,$y1) = split ' ', $$ary[$i];
         ($x2,$y2) = map { $_ + 6; } ($x1,$y1);
         ($x1,$y1) = map { $_ - 6; } ($x1,$y1);
         last if $ax >= $x1 && $ax <= $x2 && $ay >= $y1 && $ay <= $y2;
      }

      $w-> modified( 1); 
      my $layer = ucfirst $w-> {layers}->[$w-> {markState}];
      if ( $i < scalar @$ary)
      {
         # removing existing point
         ($ax, $ay) = split(' ', splice( @$ary, $i, 1));
         $w-> {"n$layer"}--;
         $w-> {"total$layer"}--;
      }
      else
      {
         # adding new point
	 $ax = int($ax);
	 $ay = int($ay);
         push @$ary, "$ax $ay";
         $w-> {"n$layer"}++;
         $w-> {"total$layer"}++;
      }
      my $zp = $self-> zoom * $w->{ini}->{PointSize};
      $zp = 4 if $zp < 4;
      ($x1, $x2, $y1, $y2) = map { ($_ - $zp - 2, $_ + $zp + 2); } ($ax,$ay);
      $self-> invalidate_rect( $self-> point2screen( $x1, $y1, $x2, $y2));
   }
   $w-> update_state;
}

sub update_state
{
   my $w = $_[0];
   my $cp = $w-> ToolBar-> CellsProcesses;
   if ( !defined $w-> {file})
   {
      $w-> sb_text( "No file loaded");
      $cp-> text( "???:???");
   }
   else
   { 
       my $text1 = '';
       my @text2;
       for ( @{$w->{layers}}) {
          my $u = ucfirst $_;
          $text1 .= "$u: ".$w->{"n$u"}." (".$w->{"total$u"}.") ";
          next if $_ eq 'cells';
          push @text2, "(" . ($w->{totalCells} ? sprintf("%.4g",$w->{"total$u"} / $w->{totalCells}) 
                                               : "NONE") . ")";
       }
       $w-> sb_text( $text1 . ' Ratio: '. join(',',@text2));
       $cp-> text( join( ':', map { sprintf "%03d", $w->{ 'n' . ucfirst $_} } @{$w->{layers}}));
   }
   $w-> show_stats( undef, 1);
}


sub IV_Paint
{
   my ( $w, $self, $canvas) = @_;

   my $image = $self-> {image};
   $self-> {image} = $w-> {preprocessedImage} if $w-> {preprocessedImage};
   $self-> on_paint( $canvas);
   $self-> {image} = $image;

   return unless $image;
   
   my $z  = $self-> zoom;
   my $zp = $z * $w->{ini}->{PointSize};
   $zp = 4 if $zp < 4;
   $canvas-> translate( $self-> point2screen( 0, 0));
   my ($x, $y, $iw, $ih) = ( $self-> size, $image-> size);
   my $dx = sprintf( '%d', $iw / 20);
   my $dy = sprintf( '%d', $ih / 20);
   my $szy = sprintf( '%d', ($ih - 2 * $dy) / $w-> {ini}-> {nLines});

   $dx *= $z;
   $dy *= $z;
   $iw *= $z;
   $ih *= $z;
   $szy *= $z;
   
   $canvas-> set( lineWidth => 2, color => $w-> {ini}-> {Color_Frame});
   $canvas-> line( $dx, $dy, $iw - $dx, $dy);
   $canvas-> line( $iw - $dx, $dy, $iw - $dx, 0);



( run in 0.901 second using v1.01-cache-2.11-cpan-39bf76dae61 )