view release on metacpan or  search on metacpan

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

    $mw = MainWindow->new;
    $mw->geometry("400x50+40+0");
    $mw->title("Interactive Top Mute");
    $mw->configure( -background => $var->{_my_purple} );

    $calc_rb = $mw->Radiobutton(
        -text       => 'CALC',
        -background => $var->{_my_yellow},
        -value      => 'calc',
        -variable   => \$rb_value,
        -command    => [ \&set_calc ]
    )->pack( -side => 'left' );

    $next_rb = $mw->Radiobutton(
        -text       => 'NEXT',
        -background => $var->{_my_yellow},
        -value      => 'next',
        -variable   => \$rb_value,
        -command    => [ \&set_next ]
    )->pack( -side => 'left' );

    $pick_rb = $mw->Radiobutton(
        -text       => 'PICK',
        -background => $var->{_my_yellow},
        -value      => 'pick',
        -variable   => \$rb_value,
        -command    => [ \&set_pick ]
    )->pack( -side => 'left' );
    $saveNcont_rb = $mw->Radiobutton(
        -text       => 'Save and Continue',
        -background => $var->{_my_yellow},
        -value      => 'saveNcont',
        -variable   => \$rb_value,
        -command    => [ \&set_saveNcont ]
    )->pack( -side => 'left' );

    $exit_rb = $mw->Radiobutton(
        -text       => 'EXIT',
        -background => $var->{_my_yellow},
        -value      => 'exit',
        -variable   => \$rb_value,
        -command    => [ \&set_exit ]
    )->pack( -side => 'left' );

    MainLoop;     # for Tk widgets
}   # for new data


=head2 Set the prompt

 value according
 to which button is pressed
 then exit the MainLoop
 destroy the main window after the prompt
 is properly set

=cut  

=head2 sub set_pick

 callbacks

  send gather number to $iTM
  delete output of previous semblance
  plus more callbacks following...


=cut

sub set_pick {
    my $pick = 'pick';
    $pick_rb->configure( -state => 'normal' );
    $iTM_Tk->{_prompt} = $pick;

    print("Picking...\n");

    $iTM->gather_num($gather);

=head2 Delete output 

  of previous muting

=cut

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

=head2 

    -replot 1st data 
    -PICK X-T pairs
    -Increment number of tries to make
       data display interact with user
       (number_of_tries = 1)

=cut

    $iTM->iTM_message('pre_pick_mute');
    $number_of_tries++;
    $iTM->number_of_tries($number_of_tries);
    $iTM->iTM_Select_tr_Sumute_top();

}

=head2 sub set_calc

      -PRESS the CALC button
      -Increment number of tries to make
          display and show old picks
         (if number_of_tries >1)

=cut

sub set_calc {
    my $calc = 'calc';
    $calc_rb->configure( -state => 'normal' );
    $iTM_Tk->{_prompt} = $calc;
    print("Calculating...\n");

=head2 Delete 

   the previous display

=cut

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

    $iTM->iPicks2par();
    $iTM->iTM_Save_top_mute_picks();
    $iTM->iTM_Apply_top_mute();
    $number_of_tries++;
    $iTM->number_of_tries($number_of_tries);

=head2 Message 

       to halt flow
       when number_of_tries >0

=cut

    $iTM->iTM_message('post_pick_mute');
}


=head2 sub set_saveNcont

   same as next

=cut

sub set_saveNcont {
    my $saveNcont = 'saveNcont';
    $saveNcont_rb->configure( -state => 'normal' );
    $iTM_Tk->{_prompt} = $saveNcont;
    print("Saving and Continuing...\n");

    #$iTM->icp_sorted2oldpicks();
    &set_next();

}


=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 {
    print("Next...\n");
    $next_rb->configure( -state => 'normal' );
    my $next = '';
    $iTM_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();
    }

=head2 Display

       update gather number in memory
       first top mute
       Show user message
       Select the mute values
=cut

    $iTM->gather_num($gather);
    $iTM->iTM_message('first_top_mute');
    $iTM->iTM_Select_tr_Sumute_top();

}

=head2  sub set_exit

  saying goodbye 
  clear old images
  kill window
  stop script

=cut

sub set_exit {
    my $exit = 'exit';
    $exit_rb->configure( -state => 'normal' );
    $iTM_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;