App-SeismicUnixGui

 view release on metacpan or  search on metacpan

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

     data first time

=cut	

print("NEW PICKS\n");
$message->set('iSpectralAnalysis');
$message->gather_num($NaN);
$message->instructions('firstSpectralAnalysis');

=head2 Print

  configuration
  my @config = $mw->configure();
  print Pretty @config;


=cut

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

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


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

MainLoop;     # for Tk widgets


=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 $iSA
  delete output of previous semblance
  plus more callbacks following...


=cut

sub set_pick {
    my $pick = 'pick';
    $pick_rb->configure( -state => 'normal' );
    $iSA_Tk->{_prompt} = $pick;
    print("Picking...\n");
    $iSA->select();
}

=head2 sub set_calc

      -PRESS the CALC button
=cut

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

=head2 Delete 

   the previous display

=cut

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

    $iSA->xtract();
    $iSA->analyze();

}

=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' );
    $iSA_Tk->{_prompt} = $exit;
    print("Good bye.\n");
    $xk->kill_this('suximage');
    $xk->kill_this('suxwigb');
    $mw->destroy() if Tk::Exists($mw);
    exit 1;
}



( run in 0.583 second using v1.01-cache-2.11-cpan-39bf76dae61 )