view release on metacpan or  search on metacpan

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

$iPick->set_data_type('Pick_xt');
$there_is_old_data = $iPick->get4data_type();

if ($there_is_old_data) {
    print("Old picks already exist.\n");
    print(
        "Delete \(\"rm \*old\*\"\)or Save        old picks, and then restart\n\n"
    );
    exit;
}


=head2 Display

     data first time

=cut

if ( !$there_is_old_data ) {

     print("NEW PICKS\n");

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

    $iPick->number_of_tries($false);
    $iPick->gather_num($gather);

    $iPick->iSelect_xt();

=head2 Create Main Window 

 Start event-driven loop
 Interaction with user
 initialize values
 If picks are new, show
 message on how to pick data

=cut

=head2 Decide whether to 

	PICK or move on to NEXT GATHER
	Place windows (2) near the left side
	of the screen
     
	Changing geometry of the toplevel window
	my $h = $mw->screenheight();
	my $w = $mw->screenwidth();
	print("width and height of screen are $w,$h\n\n");
	print("geometry of screen is $geom\n\n");

=cut

    $mw = MainWindow->new;
    $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);