view release on metacpan or  search on metacpan

lib/App/SeismicUnixGui/big_streams/iPick.pl  view on Meta::CPAN

=head2 sub  set_next

  In this case $self is empty
  1. increment gather
     Exit if beyond last gather 
  2. reset prompt
  3. Otherwise display the first semblance
  4 ... see following callbacks

=cut

sub set_next {

    my ($self) = @_;
    print("Next...\n");
    $next_rb->configure( -state => 'normal' );
    my $next = '';
    $iPick_Tk->{_prompt} = $next;
    $gather = $gather + $gather_inc;

    print("new gather is $gather \n\n");

=head2  Delete output 

   of previous top mute

=cut

    # $xk->kill_this('suximage');
    # $xk->kill_this('suxwigb');
    # $xk->kill_this('xgraph');

    if ( $gather > $last_gather ) {
        set_exit();

    }
    elsif ( $gather <= $last_gather ) {

=head2 Display

       update gather number in memory
       first x,t again
       Show user message
       Select the xt values
=cut

        $iPick->gather_num($gather);
        $iPick->iPicks_message('first_pick_xt');
        $iPick->iPicks_select_xt();

    }
    else {
        print("iPick.pl, unexpected gather number\n");
    }

}

=head2  sub  set_exit

  say goodbye 
  clear old images
  kill window
  stop script

=cut

sub set_exit {

    my ($self) = @_;
    my $exit = 'exit';
    $exit_rb->configure( -state => 'normal' );
    $iPick_Tk->{_prompt} = $exit;

    print("Good bye.\n");
    print("Not continuing to next gather\n");

    # $xk->kill_this('suximage');
    # $xk->kill_this('suxwigb');
    # $xk->kill_this('xgraph');

    $mw->destroy() if Tk::Exists($mw);
    exit 1;

}