view release on metacpan or  search on metacpan

bin/ManCen  view on Meta::CPAN

}

sub win_ptremove
{
   my $w = $_[0];
   my @pt = @{$w-> {lastPopupPoint}};
   my ( $min, $max) = $w-> win_getseriesrange;
   my $from = $w-> {fileNum};
   my $to   = $w->{ini}->{forwardLookup} ? $max : $min;
   my $n = @{$w->{points}};
   
   my $ptIdx = $w-> rpt_is( @pt);
   die "Internal error $ptIdx $n | @pt" if !defined $ptIdx || $ptIdx >= $n;
   if ( $to == $from) {
      # single frame case
      $w-> rpt_toggle( @pt);
      $w-> IV-> repaint;
      $w-> sb_text("Deleted point referred only to the current file");
      return;
   }   
   # multiple frame case
   return unless $w-> win_saveframe;
   $ptIdx = $w-> rpt_is( @pt); # points might be rearranged
   
   return if Prima::MsgBox::message( "This will delete point [$pt[0], $pt[1]] from the current file up to and including ".
       $w-> win_formfilename( $to) . ", heading " . 
        ( $w->{ini}->{forwardLookup} ? "forwards" : "backwards") .
       ". Proceed?", mb::OkCancel) != mb::OK;
   my $curr = $w-> {fileNum};
   my %cendata = ( $curr => [@{$w->{points}}]);
#   print "init cendata: $curr to @{$cendata{$curr}}\n"; 

   my $userAborted = 0;
   my $ok = 1;
   my $statwin = $w-> insert( Dialog =>
      centered    => 1,
      text        => 'Processing...',
      size        => [ 300, 60],
      onKeyDown   => sub {
         my ( $self, $code, $key, $mod) = @_;
         if ( $key == kb::Esc &&
            ( Prima::MsgBox::message("Abort process?", mb::OKCancel|mb::Warning) == mb::OK)) {
            $userAborted = 1;
            $_[0]-> text('Cancelling');
         }
      },
      onClose     => sub {
         $_[0]-> clear_event;
         return if Prima::MsgBox::message("Abort process?", mb::OKCancel|mb::Warning) != mb::OK;
         $userAborted = 1;
         $_[0]-> text('Cancelling');
      },
   );

   my $g = $statwin-> insert( Gauge =>
      origin => [ 5, 5],
      size   => [ $statwin-> width - 10, $statwin-> height - 10],
      min    => 0,
      max    => ( abs( $to - $curr) - 1) * 2,
      value  => 0,
      font   => {height => $statwin-> height - 16},
   );

   my $jump;
   my @ambiguity;
   $statwin-> execute_shared;
   my $incr = $w-> {ini}->{forwardLookup} ? 1 : -1;
      
   while ( $curr != $to + $incr) {
      # loading cen file
      my $cenname = $w-> win_extname( $w-> win_formfilename( $curr));
      if ( $curr != $w->{fileNum}) { # avoid re-reading current .cen
         if ( open F, "< $cenname") {
            $cendata{$curr} = $w-> rpt_read( *F);
            close F;
 #          print "added cendata: $curr to @{$cendata{$curr}}\n"; 
         } else {
            Prima::MsgBox::message("Cannot open $cenname. Aborting process");
            $ok = 0;
            last;
         }   
      
         # checking 
         if ( @{$cendata{$curr}} != $n) {
            my $x = @{$cendata{$curr}};
            my $fj = $w-> win_formfilename( $curr);
            $jump = $fj if Prima::MsgBox::message(<<EOF, mb::YesNoCancel|mb::Error);
$cenname has inconsistent number of points ($x vs $n).
Process aborted, no files were changed. Jump to $fj?
EOF
            $ok = 0;
            last;
         }   
         
         my @res = $w-> valid_comm_series( $cendata{$curr}, $cendata{$curr - $incr});
         if ( @res) {
            my $fj = $w-> win_formfilename( $curr - $incr);
            $jump = $fj if Prima::MsgBox::message("Distance ambiguity detected between $cenname and " .
               $w-> win_extname( $w-> win_formfilename( $curr - $incr)) . 
               ". Process aborted, no files were changed. Jump to $fj?",
               mb::YesNoCancel|mb::Error) == mb::Yes;
            @ambiguity = (
               $cendata{$curr}-> [$res[1] * 2],
               $cendata{$curr}-> [$res[1] * 2 + 1],
               $cendata{$curr - $incr}-> [$res[0] * 2],
               $cendata{$curr - $incr}-> [$res[0] * 2 + 1],
               $cendata{$curr - $incr}-> [$res[1] * 2],
               $cendata{$curr - $incr}-> [$res[1] * 2 + 1],
            );
            $ok = 0;
            last;
         } 
      }
      # deleting the point
      my @rxdata = @{$cendata{$curr}};
      splice( @rxdata, $ptIdx, 2);
      
      # saving backing data
      if ( @rxdata) {
         if ( open F, "> $cenname.bak") {
            $w-> rpt_write( *F, \@rxdata);

bin/ManCen  view on Meta::CPAN

      }
   }
}

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

sub win_extraschanged
{
   my $w = $_[0];
   $w-> win_untemp;
   $w-> SUPER::win_extraschanged;
   $w-> sb_points();
}


sub win_extpathchanged
{
   my $w = $_[0];
   if ( defined $w-> {file}) {
      my $i;
      my @pt = defined $w-> {points} ? @{$w->{points}} : ();
      $w-> win_closeextras;
      $w-> win_closeframe;
      $w-> win_newframe;
      for ( $i = 0; $i < scalar @pt; $i += 2) {
         $w-> rpt_add( $pt[$i], $pt[ $i+1]);
      }
      $w-> win_newextras;
      $w-> win_extraschanged;
      $w-> IV-> repaint;
   }
}

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

   $self-> win_pointerchanged();
   my $scale = $::application-> uiScaling;
   $scale = 1 if $scale < 1;

   my $tb  = $self-> ToolBar;
   my $cck = $tb-> insert( Label =>
      origin      => [ 120 * $scale, 1],
      size        => [ $tb-> width - 138 * $scale, 36 * $scale],
      name        => 'PointRef',
      text        => '0:0',
      growMode    => gm::Client,
      transparent => 1,
      color       => $self-> {ini}-> {Color_Label},
      alignment   => ta::Right,
      valignment  => ta::Center,
      font        => { style => fs::Bold },
   );
   $tb-> insert( Widget =>
      origin      => [ $tb-> width - 18 * $scale, 1],
      size        => [ 16 * $scale, 36 * $scale],
      transparent => 1,
      growMode    => gm::Right,
      name        => 'Lookup',
      onPaint     => sub {
         my ( $self, $canvas) = @_;
         my ( $x, $y) = $canvas-> size;
         $canvas-> color( $w-> {ini}-> {Color_Label});
         my @pt = $w-> {ini}-> {forwardLookup} ? (
            0, 0.6, 0.5, 0.6, 0.5, 0.75, 0.9, 0.5, 0.5, 0.25, 0.5, 0.4, 0, 0.4
         ) : (
            0.9, 0.6, 0.9, 0.4, 0.5, 0.4, 0.5, 0.25, 0, 0.5, 0.5, 0.75, 0.5, 0.6
         );
         my $i;
         for ( $i = 0; $i < scalar @pt; $i+=2) {
            $pt[$i]   *= $x;
            $pt[$i+1] *= $y;
         }
         $canvas-> fillpoly( \@pt );
      },
   );
}

sub win_pointerchanged
{
   my  $w = $_[0];

   if ( $w-> {ini}-> {StdPointerShape}) {
      $w-> IV-> pointer( cr::Arrow);
      return;
   }

   my $color = $w-> {ini}-> {Color_Pointer};
   my ( $cx, $cy) = ( $::application-> get_system_value( sv::XPointer), $::application-> get_system_value( sv::YPointer));
   my $ic = Prima::Image-> create(
      width  => $cx,
      height => $cy,
      type   => im::Mono,
      palette => [0,0,0, $color & 0xFF, ( $color >> 8) & 0xFF, ( $color >> 16) & 0xFF],
   );
   $ic-> begin_paint;
   $ic-> color( cl::Black);
   $ic-> bar( 0, 0, $cx, $cx);
   $ic-> color( $color ? $color : cl::White);
   my ( $c2x, $c2y) = ( int($cx/2), int($cy/2));
   $ic-> line( 0, $c2y, $c2x - 2, $c2y);
   $ic-> line( $c2x + 2, $c2y, $cx - 1, $c2y);
   $ic-> line( $c2x, 0, $c2x, $c2y - 2);
   $ic-> line( $c2x, $c2y + 2, $c2x, $cy - 1);
   $ic-> end_paint;
   my $mc = Prima::Image-> create(
      width  => $cx,
      height => $cy,
      type   => im::BW,
      preserveType  => 1,
   );
   $mc-> begin_paint;