view release on metacpan or  search on metacpan

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

    $mw->geometry("400x50+40+0");
    $mw->title("Interactive Picking");

    $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 $iPick
	delete output of previous displays

=cut

sub set_pick {

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

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

    $iPick->gather_num($gather);

=item Delete output 

  of previous muting

=cut

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

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

=cut

    $message->set('iPick_xt');
    $message->gather_num($gather);
    $message->instructions('pre_pick_xt');
    $number_of_tries++;
    $iPick->number_of_tries($number_of_tries);

    # print("1. iPick.pl,set_pick,number_of_tries: $number_of_tries\n");

    if ( $number_of_tries >= 2 ) {

        # print("2. iPick.pl,set_pick,number_of_tries: $number_of_tries\n");
        $iPick->iPicks_shownNselect();

    }
    elsif ( $number_of_tries == 1 ) {

        # print("3. iPick.pl,set_pick,number_of_tries: $number_of_tries\n");
        $iPick->iPicks_select_xt();

    }
    else {
        print("iPick.pl,bad number of tries\n");
    }

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

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

=head2 Delete 

   the previous display

=cut

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

    $iPick->iPicks_par();
    $iPick->iPicks_sort();
    $number_of_tries++;
    $iPick->number_of_tries($number_of_tries);
    $iPick->iPicks_shownNselect();
    $iPick->iPicks_save();

=head2 Message 

       to halt flow
       when number_of_tries >0

=cut

    $message->set('iPick_xt');
    $message->gather_num($gather);
    $message->instructions('post_pick_xt');

}


=head2 sub  set_saveNcont

   same as next

=cut

sub set_saveNcont {

    my ($self) = @_;
    my $saveNcont = 'saveNcont';
    $saveNcont_rb->configure( -state => 'normal' );
    $iPick_Tk->{_prompt} = $saveNcont;
    print("Saving and Continuing...\n");

    &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 {

    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 {