App-SeismicUnixGui
view release on metacpan or search on metacpan
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
my $run_name_message = message_director->new();
my $message = $run_name_message->immodpg($number);
my $message_box = $immodpg->{_message_box_w};
my $message_label = $immodpg->{_message_label_w};
my $message_box_wait = $immodpg->{_message_box_wait};
my $message_ok_button = $immodpg->{_message_ok_button};
# print("1 immodpg,_messages, message_box=$message_box\n");
$message_box->title($run_name);
$message_label->configure( -textvariable => \$message, );
$message_box->deiconify();
$message_box->raise();
$message_ok_button->waitVariable( \$message_box_wait );
return ();
}
=head2 sub _setVbot
Verify another lock file does not exist and
only then:
Create another lock file
while change file is written
that prevents fortran file from reading.
Then, delete the lock file
Avoids crash between asynchronous
reading (fortran) and
writing (Perl) of files
=cut
sub _setVbot {
my ($Vbot) = @_;
if ( looks_like_number($Vbot)
&& $immodpg->{_isVbot_changed_in_gui} eq $yes )
{
=head2 instantiate classes
=cut
my $files = manage_files_by2->new();
my $control = control->new();
=head2 Define local
variables
=cut
my @X;
my $Vbot_file = $immodpg->{_Vbot_file};
my $test = $no;
my $outbound = $IMMODPG_INVISIBLE . '/' . $Vbot_file;
my $outbound_locked = $outbound . '_locked';
for ( my $i = 0 ; $test eq $no ; $i++ ) {
if ( not( $files->does_file_exist( \$outbound_locked ) ) ) {
my $format = $var_immodpg->{_format_string};
$X[0] = $empty_string;
$files->write_1col_aref( \@X, \$outbound_locked, \$format );
$X[0] = $Vbot;
$format = $var_immodpg->{_format_real};
$files->write_1col_aref( \@X, \$outbound, \$format );
unlink($outbound_locked);
$test = $yes;
} # if
} # for
}
elsif ( $immodpg->{_isVbot_changed_in_gui} eq $no ) {
# NADA
}
else {
print("immodpg, _setVbot, unexpected answer\n");
}
return ();
}
=head2 sub _setVbot_upper_layer
Verify another lock file does not exist and
only then:
Create another lock file
while change file is written
that prevents fortran file from reading.
Then, delete the lock file
Avoids crash between asynchronous
reading (fortran) and
writing (Perl) of files
_setVbot_upper_layer
=cut
sub _setVbot_upper_layer {
my ($Vbot_upper_layer) = @_;
if ( $Vbot_upper_layer ne $empty_string
&& $immodpg->{_isVbot_upper_layer_changed_in_gui} eq $yes )
{
=head2 instantiate classes
=cut
my $files = manage_files_by2->new();
my $control = control->new();
=head2 Define local
variables
=cut
my @X;
my $Vbot_upper_layer_file = $immodpg->{_Vbot_upper_layer_file};
my $test = $no;
my $outbound = $IMMODPG_INVISIBLE . '/' . $Vbot_upper_layer_file;
my $outbound_locked = $outbound . '_locked';
for ( my $i = 0 ; $test eq $no ; $i++ ) {
if ( not( $files->does_file_exist( \$outbound_locked ) ) ) {
my $format = $var_immodpg->{_format_string};
$X[0] = $empty_string;
$files->write_1col_aref( \@X, \$outbound_locked, \$format );
$X[0] = $Vbot_upper_layer;
$format = $var_immodpg->{_format_real};
$files->write_1col_aref( \@X, \$outbound, \$format );
unlink($outbound_locked);
$test = $yes;
} # if
} # for
}
elsif ( $immodpg->{_isVbot_upper_layer_changed_in_gui} eq $no ) {
# NADA
}
else {
print("immodpg, _setVbot_upper_layer, unexpected answer\n");
}
return ();
}
=head2 sub _setVbotNtop_factor
Verify another lock file does not exist and
only then:
Create another lock file
while change file is written
that prevents fortran file from reading.
Then, delete the lock file
Avoids crash between asynchronous
reading (fortran) and
writing (Perl) of files
_setVbotNtop_factor
=cut
sub _setVbotNtop_factor {
my ($VbotNtop_factor) = @_;
if ( $VbotNtop_factor ne $empty_string
&& $immodpg->{_isVbotNtop_factor_changed_in_gui} eq $yes )
{
=head2 instantiate classes
=cut
my $files = manage_files_by2->new();
my $control = control->new();
=head2 Define local
variables
=cut
my @X;
my $VbotNtop_factor_file = $immodpg->{_VbotNtop_factor_file};
my $test = $no;
my $outbound = $IMMODPG_INVISIBLE . '/' . $VbotNtop_factor_file;
my $outbound_locked = $outbound . '_locked';
for ( my $i = 0 ; $test eq $no ; $i++ ) {
if ( not( $files->does_file_exist( \$outbound_locked ) ) ) {
my $format = $var_immodpg->{_format_string};
$X[0] = $empty_string;
$files->write_1col_aref( \@X, \$outbound_locked, \$format );
$X[0] = $VbotNtop_factor;
$format = ' 0.0';
$files->write_1col_aref( \@X, \$outbound, \$format );
unlink($outbound_locked);
$test = $yes;
} # if
} # for
}
elsif ( $immodpg->{_isVbotNtop_factor_changed_in_gui} eq $no ) {
# NADA
}
else {
print("immodpg, _setVbotNtop_factor, unexpected answer\n");
}
return ();
}
=head2 sub _setVbotNtop_multiply
Verify another lock file does not exist and
only then:
Create another lock file
while change file is written
that prevents fortran file from reading.
Then, delete the lock file
Avoids crash between asynchronous
reading (fortran) and
writing (Perl) of files
_setVbotNtop_multiply
=cut
sub _setVbotNtop_multiply {
my ($self) = @_;
if ( looks_like_number( $immodpg->{_Vbot_multiplied} )
&& looks_like_number( $immodpg->{_Vtop_multiplied} )
&& looks_like_number( $immodpg->{_Vbot_current} )
&& looks_like_number( $immodpg->{_Vtop_current} ) )
{
=head2 instantiate classes
=cut
my $files = manage_files_by2->new();
my $control = control->new();
=head2 Define local
variables
=cut
my @X;
my $file = $immodpg->{_VbotNtop_multiply_file};
my $test = $no;
my $outbound = $IMMODPG_INVISIBLE . '/' . $file;
my $outbound_locked = $outbound . '_locked';
for ( my $i = 0 ; $test eq $no ; $i++ ) {
if ( not( $files->does_file_exist( \$outbound_locked ) ) ) {
my $format = $var_immodpg->{_format_string};
$X[0] = $empty_string;
$files->write_1col_aref( \@X, \$outbound_locked, \$format );
$X[0] = $immodpg->{_Vbot_multiplied};
$X[1] = $immodpg->{_Vtop_multiplied};
$format = $var_immodpg->{_format_real};
$files->write_1col_aref( \@X, \$outbound, \$format );
unlink($outbound_locked);
$test = $yes;
} # if
} # for
}
else {
print("immodpg, _setVbotNtop_multiply, unexpected answer\n");
}
return ();
}
=head2 sub _setVincrement
Verify another lock file does not exist and
only then:
Create another lock file
while change file is written
that prevents fortran file from reading.
Then, delete the lock file
Avoids crash between asynchronous
reading (fortran) and
writing (Perl) of files
=cut
sub _setVincrement {
my ($Vincrement) = @_;
if ( $Vincrement ne $empty_string
&& $immodpg->{_isVincrement_changed_in_gui} eq $yes )
{
=head2 instantiate classes
=cut
my $files = manage_files_by2->new();
my $control = control->new();
=head2 Define local
variables
=cut
my @X;
my $Vincrement_file = $immodpg->{_Vincrement_file};
my $test = $no;
my $outbound = $IMMODPG_INVISIBLE . '/' . $Vincrement_file;
my $outbound_locked = $outbound . '_locked';
for ( my $i = 0 ; $test eq $no ; $i++ ) {
if ( not( $files->does_file_exist( \$outbound_locked ) ) ) {
my $format = $var_immodpg->{_format_string};
$X[0] = $empty_string;
$files->write_1col_aref( \@X, \$outbound_locked, \$format );
$X[0] = $Vincrement;
$format = $var_immodpg->{_format51f};
$files->write_1col_aref( \@X, \$outbound, \$format );
unlink($outbound_locked);
$test = $yes;
} # if
} # for
}
elsif ( $immodpg->{_isVincrement_changed_in_gui} eq $no ) {
# NADA
}
else {
print("immodpg, _setVincrement, unexpected answer\n");
}
return ();
}
=head2 sub _set_control
Correct improper values
=cut
sub _set_control {
my ( $name, $value ) = @_;
if ( length($name)
&& length($value) )
{
# print("immodpg, _set_control, name=$name, value=$value\n");
if ( $name eq 'Vtop' ) {
if ( $value < 0 ) {
$immodpg->{_control_value} = 10;
# print("immodpg, _set_control, new corrected Vtop=$immodpg->{_control_value}\n");
}
else {
$immodpg->{_control_value} = $value;
}
}
elsif ( $name eq 'Vbot' ) {
if ( $value < 0 ) {
$immodpg->{_control_value} = 10;
# print("immodpg, _set_control, new corrected Vbot=$immodpg->{_control_value}\n");
}
else {
$immodpg->{_control_value} = $value;
}
}
elsif ( $name eq 'Vbot_upper_layer' ) {
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
}
else {
print("immodpg,_setVp_dz, unexpected name \n");
}
}
else {
print("immodpg, _setVp_dz, missing variable\n");
print("immodpg, _setVp_dz, name=$name\n");
print("immodpg, _setVp_dz, value = $value\n");
print("immodpg, _setVp_dz, _refVPtop = @{$immodpg->{_refVPtop}}\n");
print("immodpg, _setVp_dz, _refVPbot = @{$immodpg->{_refVPbot}}\n");
print("immodpg, _setVp_dz, _dz = $immodpg->{_dz}\n");
}
return ();
}
=head2 sub _setVtop
Verify another lock file does not exist and
only then:
Create another lock file
while change file is written
that prevents fortran file from reading.
Then, delete the lock file
Avoids crash between asynchronous
reading (fortran) and
writing (Perl) of files
=cut
sub _setVtop {
my ($Vtop) = @_;
if ( looks_like_number($Vtop)
&& $immodpg->{_isVtop_changed_in_gui} eq $yes )
{
# print("immodpg,_setVtop,write out fortran value of Vtop\n");
=head2 instantiate classes
=cut
my $files = manage_files_by2->new();
my $control = control->new();
=head2 Define local
variables
=cut
my @X;
my $Vtop_file = $immodpg->{_Vtop_file};
my $test = $no;
my $outbound = $IMMODPG_INVISIBLE . '/' . $Vtop_file;
my $outbound_locked = $outbound . '_locked';
for ( my $i = 0 ; $test eq $no ; $i++ ) {
if ( not( $files->does_file_exist( \$outbound_locked ) ) ) {
my $format = $var_immodpg->{_format_string};
$X[0] = $empty_string;
$files->write_1col_aref( \@X, \$outbound_locked, \$format );
$X[0] = $Vtop;
$format = $var_immodpg->{_format_real};
$files->write_1col_aref( \@X, \$outbound, \$format );
unlink($outbound_locked);
$test = $yes;
} # if
} # for
}
elsif ( $immodpg->{_isVtop_changed_in_gui} eq $no ) {
# NADA
print("immodpg, _setVtop, no change\n");
}
else {
print("immodpg, _setVtop, unexpected answer\n");
}
return ();
}
=head2 sub _setVtop_lower_layer
Verify another lock file does not exist and
only then:
Create another lock file
while change file is written
that prevents fortran file from reading.
Then, delete the lock file
Avoids crash between asynchronous
reading (fortran) and
writing (Perl) of files
=cut
sub _setVtop_lower_layer {
my ($Vtop_lower_layer) = @_;
if ( looks_like_number($Vtop_lower_layer)
&& $immodpg->{_isVtop_lower_layer_changed_in_gui} eq $yes )
{
=head2 instantiate classes
=cut
my $files = manage_files_by2->new();
my $control = control->new();
=head2 Define local
variables
=cut
my @X;
my $Vtop_lower_layer_file = $immodpg->{_Vtop_lower_layer_file};
my $test = $no;
my $outbound = $IMMODPG_INVISIBLE . '/' . $Vtop_lower_layer_file;
my $outbound_locked = $outbound . '_locked';
for ( my $i = 0 ; $test eq $no ; $i++ ) {
if ( not( $files->does_file_exist( \$outbound_locked ) ) ) {
my $format = $var_immodpg->{_format_string};
$X[0] = $empty_string;
$files->write_1col_aref( \@X, \$outbound_locked, \$format );
$X[0] = $Vtop_lower_layer;
$format = $var_immodpg->{_format_real};
$files->write_1col_aref( \@X, \$outbound, \$format );
unlink($outbound_locked);
$test = $yes;
} # if
} # for
}
elsif ( $immodpg->{_isVtop_lower_layer_changed_in_gui} eq $no ) {
# NADA
}
else {
print("immodpg, _setVtop_lower_layer, unexpected answer\n");
}
return ();
}
=head2 sub _set_change
Verify another lock file does not exist and
only then:
Create another lock file
while change file is written
that prevents fortran file from reading.
Then, delete the lock file
Avoids crash between asynchronous
reading (fortran) and
writing (Perl) of files
=cut
sub _set_change {
my ($yes_or_no) = @_;
if ( length($yes_or_no)
&& length( $immodpg->{_change_file} ) )
{
# print("immodpg, _set_change, yes_or_no:$yes_or_no\n");
=head2 instantiate classes
=cut
my $files = manage_files_by2->new();
my $control = control->new();
=head2 Define local
variables
=cut
my @X;
my $test = $yes;
my $change = $immodpg->{_change_file};
my $outbound = $IMMODPG_INVISIBLE . '/' . $change;
my $outbound_locked = $outbound . '_locked';
my $format = $var_immodpg->{_format_string};
my $count = 0;
my $max_counts = 1000;
for (
my $i = 0 ;
( $test eq $yes ) and ( $count < $max_counts ) ;
$i++
)
{
# print("1. immodpg,_set_change, in loop count=$count \n");
if ( not( $files->does_file_exist( \$outbound_locked ) ) ) {
$X[0] = $empty_string;
$files->write_1col_aref( \@X, \$outbound_locked, \$format );
# print("immodpg, _set_change, outbound_locked=$outbound_locked\n");
# print("immodpg, _set_change, IMMODPG_INVISIBLE=$IMMODPG_INVISIBLE\n");
# print("immodpg, _set_change, created empty locked file=$X[0]\n");
# print("immodpg, _set_change, outbound=$outbound\n");
# print("immodpg, _set_change, IMMODPG_INVISIBLE=$IMMODPG_INVISIBLE\n");
# do not overwrite a waiting change (= yes)
my $response_aref = $files->read_1col_aref( \$outbound );
my $ans = @{$response_aref}[0];
if ( $ans eq $yes ) {
# do not overwrite a waiting change (= yes)
# print("2. immodpg, _set_change, SKIP\n");
# print("immodpg, _set_change,do not overwrite change_file\n");
unlink($outbound_locked);
}
elsif ( $ans eq $no ) {
# overwrite change_file(=no) with no or yes
$X[0] = $yes_or_no;
$files->write_1col_aref( \@X, \$outbound, \$format );
# print("immodpg, _set_change, overwrite change file with $X[0]\n");
unlink($outbound_locked);
# print("3. immodpg, _set_change, delete locked file\n");
# print("4. immodpg, _set_change, yes_or_no=$X[0]\n");
$test = $no;
}
else {
print("immodpg, _set_change, unexpected result \n");
} # test change_file's content
}
else {
# print("immodpg,_set_change, locked change file\n");
$count++; # governor on finding an unlocked change_file
} # if unlocked file is missing and change_file is free
$count++; # governor on checking for a change_file = yes
} # for
}
else {
print("immodpg, _set_change, missing values\n");
}
return ();
}
=head2 sub _set_clip
Verify another lock file does not exist and
only then:
Create another lock file
while change file is written
that prevents fortran file from reading.
Then, delete the lock file
Avoids crash between asynchronous
reading (fortran) and
writing (Perl) of files
=cut
sub _set_clip {
my ($clip) = @_;
if ( $clip ne $empty_string
&& $immodpg->{_is_clip_changed_in_gui} eq $yes )
{
=head2 instantiate classes
=cut
my $files = manage_files_by2->new();
my $control = control->new();
=head2 Define local
variables
=cut
my @X;
my $clip_file = $immodpg->{_clip_file};
my $test = $no;
my $outbound = $IMMODPG_INVISIBLE . '/' . $clip_file;
my $outbound_locked = $outbound . '_locked';
for ( my $i = 0 ; $test eq $no ; $i++ ) {
if ( not( $files->does_file_exist( \$outbound_locked ) ) ) {
my $format = $var_immodpg->{_format_string};
$X[0] = $empty_string;
$files->write_1col_aref( \@X, \$outbound_locked, \$format );
$X[0] = $clip;
$format = $var_immodpg->{_format51f};
$files->write_1col_aref( \@X, \$outbound, \$format );
# print("immodpg, _set_clip, output clip = $clip\n");
unlink($outbound_locked);
$test = $yes;
} # if
} # for
}
elsif ( $immodpg->{_is_clip_changed_in_gui} eq $no ) {
# NADA
}
else {
print("immodpg, _set_clip, unexpected answer\n");
}
return ();
}
=head2 sub _set_thickness_m
Verify another lock file does not exist and
only then:
Create another lock file
while change file is written
that prevents fortran file from reading.
Then, delete the lock file
Avoids crash between asynchronous
reading (fortran) and
writing (Perl) of files
=cut
sub _set_thickness_m {
my ($thickness_m) = @_;
if ( $thickness_m ne $empty_string
&& $immodpg->{_is_thickness_m_changed_in_gui} eq $yes )
{
=head2 instantiate classes
=cut
my $files = manage_files_by2->new();
my $control = control->new();
=head2 Define local
variables
=cut
my @X;
my $thickness_m_file = $immodpg->{_thickness_m_file};
my $test = $no;
my $outbound = $IMMODPG_INVISIBLE . '/' . $thickness_m_file;
my $outbound_locked = $outbound . '_locked';
for ( my $i = 0 ; $test eq $no ; $i++ ) {
if ( not( $files->does_file_exist( \$outbound_locked ) ) ) {
my $format = $var_immodpg->{_format_string};
$X[0] = $empty_string;
$files->write_1col_aref( \@X, \$outbound_locked, \$format );
$X[0] = $thickness_m;
$format = $var_immodpg->{_format51f};
$files->write_1col_aref( \@X, \$outbound, \$format );
unlink($outbound_locked);
$test = $yes;
} # if
} # for
}
elsif ( $immodpg->{_is_thickness_m_changed_in_gui} eq $no ) {
# NADA
}
else {
print("immodpg, _set_thickness_m, unexpected answer\n");
}
return ();
}
=head2 sub _set_thickness_increment_m
Verify another lock file does not exist and
only then:
Create another lock file
while change file is written
that prevents fortran file from reading.
Then, delete the lock file
Avoids crash between asynchronous
reading (fortran) and
writing (Perl) of files
=cut
sub _set_thickness_increment_m {
my ($thickness_increment_m) = @_;
if ( $thickness_increment_m ne $empty_string
&& $immodpg->{_is_layer_changed_in_gui} eq $yes )
{
=head2 instantiate classes
=cut
my $files = manage_files_by2->new();
my $control = control->new();
=head2 Define local
variables
=cut
my @X;
my $thickness_increment_m_file =
$immodpg->{_thickness_increment_m_file};
my $test = $no;
my $outbound = $IMMODPG_INVISIBLE . '/' . $thickness_increment_m_file;
my $outbound_locked = $outbound . '_locked';
for ( my $i = 0 ; $test eq $no ; $i++ ) {
if ( not( $files->does_file_exist( \$outbound_locked ) ) ) {
my $format = $var_immodpg->{_format_string};
$X[0] = $empty_string;
$files->write_1col_aref( \@X, \$outbound_locked, \$format );
$X[0] = $thickness_increment_m;
print("thickness_increment_m=$thickness_increment_m\n");
$format = $var_immodpg->{_format51f};
$files->write_1col_aref( \@X, \$outbound, \$format );
unlink($outbound_locked);
$test = $yes;
} # if
} # for
}
elsif ( $immodpg->{_is_layer_changed_in_gui} eq $no ) {
# NADA
}
else {
print("immodpg, _set_thickness_increment_m, unexpected answer\n");
}
return ();
}
=head2 sub _fortran_layer
set layer
Verify another lock file does not exist and
only then:
Create another lock file
while change file is written
that prevents fortran file from reading.
Then, delete the lock file
Avoids crash between asynchronous
reading (fortran) and
writing (Perl) of files
=cut
sub _fortran_layer {
my ($layer) = @_;
if ( $layer ne $empty_string
&& $immodpg->{_is_layer_changed_in_gui} eq $yes )
{
=head2 instantiate classes
=cut
my $files = manage_files_by2->new();
my $control = control->new();
=head2 Define local
variables
=cut
my @X;
my $layer_file = $immodpg->{_layer_file};
my $test = $no;
my $outbound = $IMMODPG_INVISIBLE . '/' . $layer_file;
my $outbound_locked = $outbound . '_locked';
for ( my $i = 0 ; $test eq $no ; $i++ ) {
# print("in loop \n");
if ( not( $files->does_file_exist( \$outbound_locked ) ) ) {
my $format = $var_immodpg->{_format_string};
$X[0] = $empty_string;
$files->write_1col_aref( \@X, \$outbound_locked, \$format );
$X[0] = $layer;
$format = $var_immodpg->{_format_integer};
$files->write_1col_aref( \@X, \$outbound, \$format );
unlink($outbound_locked);
$test = $yes;
} # if
} # for
}
elsif ( $immodpg->{_is_layer_changed_in_gui} eq $no ) {
# NADA
}
else {
print("immodpg, _fortran_layer, unexpected answer\n");
}
return ();
}
=head2 sub set_working_model_bin
=cut
sub _set_working_model_bin {
my ($self) = @_;
# print("l3171 $immodpg->{_working_model_bin_opt} \n");
_set_option($change_working_model_bin_opt);
_set_change($yes);
return ();
}
=head2 sub set_working_model_text
=cut
sub _set_working_model_text {
_set_option($change_working_model_text_opt);
_set_change($yes);
return ();
}
=head2 sub _set_clip_control
value adjusts to current
clip value in use
=cut
sub _set_clip_control {
my ($control_clip) = @_;
my $result;
if ( length($control_clip) ) {
$immodpg->{_control_clip} = $control_clip;
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
if ( $model_layer_number != 0
&& length($model_layer_number) )
{
$immodpg->{_model_layer_number} = $model_layer_number;
}
else {
print("immodpg, _set_model_layer, unexpected layer# \n");
}
# print("immodpg, _set_model_layer,model layer# =$immodpg->{_model_layer_number}\n");
return ();
}
=head2 sub _set_option
Verify another lock file does not exist and
only then:
Create another lock file
while change file is written
that prevents fortran file from reading.
Then, delete the lock file
Avoids crash between asynchronous
reading (fortran) and
writing (Perl) of files
=cut
sub _set_option {
my ($option) = @_;
# print("1.immodpg,_set_option,option:$option\n");
if ( defined($option)
&& $immodpg->{_option_file} ne $empty_string )
{
=head2 instantiate classes
=cut
my $files = manage_files_by2->new();
my $control = control->new();
=head2 Define local
variables
=cut
my @X;
my $option_file = $immodpg->{_option_file};
my $test = $no;
my $outbound = $IMMODPG_INVISIBLE . '/' . $option_file;
my $outbound_locked = $outbound . '_locked';
for ( my $i = 0 ; $test eq $no ; $i++ ) {
# print("immodpg,_set_option, in loop \n");
if ( not( $files->does_file_exist( \$outbound_locked ) ) ) {
my $format = $var_immodpg->{_format_string};
$X[0] = $empty_string;
$files->write_1col_aref( \@X, \$outbound_locked, \$format );
$X[0] = $option;
$format = $var_immodpg->{_format2i};
# print("2.immodpg,_set_option,option:$option\n");
$files->write_1col_aref( \@X, \$outbound, \$format );
unlink($outbound_locked);
$test = $yes;
} # if
} # for
}
elsif ( $immodpg->{_is_option_changed} eq $no ) {
# NADA
}
else {
print("immodpg, _set_option, unexpected answer\n");
}
return ();
}
=head2 sub _updateVbot
keep tabs on Vbot values
and changes in the values in the
GUI
Also updates an shared copy
of the model properties
use App::SeismicUnixGui::misc::control '0.0.3' method to check for bad values;
=cut
sub _updateVbot {
my ($self) = @_;
if ( looks_like_number( $immodpg->{_Vbot_current} )
and looks_like_number( $immodpg->{_Vbot_prior} )
&& $immodpg->{_Vbot_current} != $immodpg->{_Vbot_prior} )
{
# CASE Vbot has changed
$immodpg->{_isVbot_changed_in_gui} = $yes;
$immodpg->{_Vbot_prior} = $immodpg->{_Vbot_current};
# print("immodpg, _updateVbot, has changed\n");
# print("1. immodpg,_updateVbot,Vbot_current=$immodpg->{_Vbot_current}\n");
# print("1. immodpg,_updateVbot,Vbot_prior=$immodpg->{_Vbot_prior}\n");
_set_control( 'Vbot', $immodpg->{_Vbot_current} );
$immodpg->{_Vbot_current} = _get_control('Vbot');
_setVp_dz( 'Vbot', $immodpg->{_Vbot_current} );
return ();
}
elsif ( $immodpg->{_Vbot_current} == $immodpg->{_Vbot_prior} ) {
# CASE Vbot is unchanged
# print("immodpg, _updateVbot, unchanged\n");
$immodpg->{_isVbot_changed_in_gui} = $no;
# print("2. immodpg,_updateVbot,Vbot_current=$immodpg->{_Vbot_current}\n");
# print("2. immodpg,_updateVbot,Vbot_prior=$immodpg->{_Vbot_prior}\n");
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
$immodpg->{_thickness_increment_m};
$immodpg->{_thickness_increment_m_current} =
$immodpg->{_thickness_increment_m_default};
$immodpg->{_thickness_increment_m_prior} =
$immodpg->{_thickness_increment_m_default};
$immodpg->{_in_thickness_increment_m} = $no;
$immodpg->{_outside_thickness_increment_m} = $yes;
}
=head2 sub setVbot_minus
update Vbot value in gui
update private value in this module
output option for immodpg.for
=cut
sub setVbot_minus {
my ($self) = @_;
if ( length( $immodpg->{_VbotEntry} )
and looks_like_number( $immodpg->{_Vincrement_current} ) )
{
my $Vbot = ( $immodpg->{_VbotEntry} )->get();
if ( looks_like_number($Vbot) ) {
my $Vincrement = ( $immodpg->{_VincrementEntry} )->get();
my $newVbot = $Vbot - $Vincrement;
_set_control( 'Vbot', $newVbot );
$newVbot = _get_control('Vbot');
$immodpg->{_Vbot_prior} = $immodpg->{_Vbot_current};
$immodpg->{_Vbot_current} = $newVbot;
$immodpg->{_VbotEntry}->delete( 0, 'end' );
$immodpg->{_VbotEntry}->insert( 0, $newVbot );
# $immodpg->{_isVbot_changed_in_gui} = $yes;
# _checkVbot(); # todo
_updateVbot();
if ( $immodpg->{_isVbot_changed_in_gui} eq $yes ) {
# for fortran program to read
_set_option($Vbot_minus_opt);
_set_change($yes);
# print("immodpg, setVbot_minus, Vbot is changed: $yes \n");
# print("immodpg, setVbot_minus,option:$Vbot_minus_opt\n");
# print("immodpg, setVbot_minus, V=$immodpg->{_Vbot_current}\n");
}
else {
# negative cases are reset by fortran program
# and so eliminate need to read locked files
# while use of locked files helps most of the time
# creation and deletion of locked files in perl are not
# failsafe
#
# print("immodpg, setVbot_minus, same Vbot NADA\n");
}
}
else {
print("immodpg, setVbot_minus, Vbot value missing\n");
}
}
else {
print("immodpg, setVbot_minus, missing widget or Vincrement\n");
# print("immodpg, setVbot_minus, VbotEntry=$immodpg->{_VbotEntry}\n");
# print("immodpg, setVbot_minus, Vincrement=$immodpg->{_Vincrement_current}\n");
}
return ();
}
=head2 sub setVbot_plus
update Vbot value in gui
update private value in this module
output option for immodpg.for
=cut
sub setVbot_plus {
my ($self) = @_;
if ( length( $immodpg->{_VbotEntry} )
&& looks_like_number( $immodpg->{_Vincrement_current} ) )
{
my $Vbot = ( $immodpg->{_VbotEntry} )->get();
if ( looks_like_number($Vbot) ) {
my $Vincrement = ( $immodpg->{_VincrementEntry} )->get();
my $newVbot = $Vbot + $Vincrement;
_set_control( 'Vbot', $newVbot );
$newVbot = _get_control('Vbot');
$immodpg->{_Vbot_prior} = $immodpg->{_Vbot_current};
$immodpg->{_Vbot_current} = $newVbot;
$immodpg->{_VbotEntry}->delete( 0, 'end' );
$immodpg->{_VbotEntry}->insert( 0, $newVbot );
# $immodpg->{_isVbot_changed_in_gui} = $yes;
# _checkVbot(); #todo
_updateVbot();
# print("immodpg, setVbot_plus, new Vbot= $newVbot\n");
# print("immodpg, setVbot_plus, Vincrement= $Vincrement\n");
if ( $immodpg->{_isVbot_changed_in_gui} eq $yes ) {
# for fortran program to read
_set_option($Vbot_plus_opt);
_set_change($yes);
# print("immodpg, setVbot_plus, Vbot_plus_opt:$Vbot_plus_opt \n");
}
else {
# negative cases are reset by fortran program
# and so eliminate need to read locked files
# while use of locked files helps most of the time
# creation and deletion of locked files in perl are not
# failsafe
#
# print("immodpg, setVbot_plus, same Vbot NADA\n");
}
}
else {
print("immodpg, setVbot_plus, Vbot value missing\n");
}
}
else {
print("immodpg, setVbot_plus, missing widget or Vincrement\n");
# print("immodpg, setVbot_plus, VbotEntry=$immodpg->{_VbotEntry}\n");
# print("immodpg, setVbot_plus, Vincrement=$immodpg->{_Vincrement}\n");
}
return ();
}
=head2 sub setVtop_minus
update Vtop value in gui
update private value in this module
output option for immodpg.for
=cut
sub setVtop_minus {
my ($self) = @_;
if ( length( $immodpg->{_VtopEntry} )
&& looks_like_number( $immodpg->{_Vincrement_current} ) )
{
my $Vtop = ( $immodpg->{_VtopEntry} )->get();
if ( looks_like_number($Vtop) ) {
my $Vincrement = ( $immodpg->{_VincrementEntry} )->get();
my $newVtop = $Vtop - $Vincrement;
_set_control( 'Vtop', $newVtop );
$newVtop = _get_control('Vtop');
$immodpg->{_Vtop_prior} = $immodpg->{_Vtop_current};
$immodpg->{_Vtop_current} = $newVtop;
$immodpg->{_VtopEntry}->delete( 0, 'end' );
$immodpg->{_VtopEntry}->insert( 0, $newVtop );
# $immodpg->{_isVtop_changed_in_gui} = $yes;
# _checkVtop(); #todo
_updateVtop();
if ( $immodpg->{_isVtop_changed_in_gui} eq $yes ) {
# for fortran program to read
_set_option($Vtop_minus_opt);
_set_change($yes);
# print("immodpg, setVtop_minus,option:$Vtop_minus_opt\n");
# print("immodpg, setVtop_minus, V=$immodpg->{_Vtop_current}\n");
}
else {
# negative cases are reset by fortran program
# and so eliminate need to read locked files
# while use of locked files helps most of the time
# creation and deletion of locked files in perl are not
# failsafe
#
print("immodpg, setVtop_minus, same Vtop NADA\n");
}
}
else {
print("immodpg, setVtop_minus, Vtop value missing\n");
}
}
else {
print("immodpg, setVtop_minus, missing widget or Vincrement\n");
print("immodpg, setVtop_minus, VtopEntry=$immodpg->{_VtopEntry}\n");
print(
"immodpg, setVtop_minus, Vincrement=$immodpg->{_Vincrement_current}\n"
);
}
return ();
}
=head2 sub setVtop_plus
update Vtop value in gui
update private value in this module
output option for immodpg.for
=cut
sub setVtop_plus {
my ($self) = @_;
# print("0. immodpg, setVtop_plus, VtopEntry=$immodpg->{_VtopEntry}\n");
if ( length( $immodpg->{_VtopEntry} )
&& length( $immodpg->{_VincrementEntry} ) )
{
# print("1. immodpg, setVtop_plus, VtopEntry=$immodpg->{_VtopEntry}\n");
my $Vtop = ( $immodpg->{_VtopEntry} )->get();
if ( looks_like_number($Vtop) ) {
my $Vincrement = ( $immodpg->{_VincrementEntry} )->get();
my $newVtop = $Vtop + $Vincrement;
$immodpg->{_Vtop_prior} = $immodpg->{_Vtop_current};
$immodpg->{_Vtop_current} = $newVtop;
_set_control( 'Vtop', $immodpg->{_Vtop_current} );
$immodpg->{_Vtop_current} = _get_control('Vtop');
$newVtop = $immodpg->{_Vtop_current};
$immodpg->{_VtopEntry}->delete( 0, 'end' );
$immodpg->{_VtopEntry}->insert( 0, $newVtop );
# $immodpg->{_isVtop_changed_in_gui} = $yes;
# _checkVtop(); #todo
_updateVtop();
# print("immodpg, setVtop_plus, $immodpg->{_Vtop_current}= $immodpg->{_Vtop_current}\n");
# print("immodpg, setVtop_plus, Vincrement= $Vincrement\n");
# print("2. immodpg, setVtop_plus, VtopEntry=$immodpg->{_VtopEntry}\n");
if ( $immodpg->{_isVtop_changed_in_gui} eq $yes ) {
# for fortran program to read
_set_option($Vtop_plus_opt);
_set_change($yes);
# print("immodpg, setVtop_plus,option:$Vtop_plus_opt\n");
# print("immodpg, setVtop_plus, V=$immodpg->{_Vtop_current}\n");
}
else {
# print("immodpg, setVtop_plus, VtopEntry=$immodpg->{_VtopEntry}\n");
# print("immodpg, setVtop_plus, Vincrement=$immodpg->{_Vincrement_current}\n");
# negative cases are reset by fortran program
# and so eliminate need to read locked files
# while use of locked files helps most of the time
# creation and deletion of locked files in perl are not
# failsafe
#
# print("immodpg, setVtop_plus, same Vtop NADA\n");
}
}
else {
print("immodpg, setVtop_plus, Vtop value missing\n");
# print("immodpg, setVtop_plus, VtopEntry=$immodpg->{_VtopEntry}\n");
# print("immodpg, setVtop_plus, Vincrement=$immodpg->{_Vincrement_current}\n");
}
}
else {
print("immodpg, setVtop_plus, missing widget or Vincrement\n");
print("immodpg, setVtop_plus, VtopEntry=$immodpg->{_VtopEntry}\n");
print(
"immodpg, setVtop_plus, Vincrement=$immodpg->{_Vincrement_current}\n"
);
}
return ();
}
=head2 sub cdp
=cut
sub cdp {
my ( $self, $cdp ) = @_;
if ($cdp) {
$immodpg->{_cdp} = $cdp;
$immodpg->{_note} = $immodpg->{_note} . ' cdp=' . $immodpg->{_cdp};
$immodpg->{_Step} = $immodpg->{_Step} . ' cdp=' . $immodpg->{_cdp};
}
else {
print("immodpg, cdp, missing cdp,\n");
}
}
=head2 sub clean_trash
delete remaining locked files
reset default files as well
=cut
sub clean_trash {
my ($self) = @_;
use File::stat;
my $xk = xk->new();
my $files = manage_files_by2->new();
my ( $outbound_locked, $outbound );
my @X;
my $Vbot_file = $immodpg->{_Vbot_file};
my $VbotNtop_factor_file = $immodpg->{_VbotNtop_factor_file};
my $Vbot_upper_layer_file = $immodpg->{_Vbot_upper_layer_file};
my $Vincrement_file = $immodpg->{_Vincrement_file};
my $Vtop_file = $immodpg->{_Vtop_file};
my $Vtop_lower_layer_file = $immodpg->{_Vtop_lower_layer_file};
my $change_file = $immodpg->{_change_file};
my $clip_file = $immodpg->{_clip_file};
my $immodpg_model = $immodpg->{_immodpg_model};
my $layer_file = $immodpg->{_layer_file};
my $option_file = $immodpg->{_option_file};
my $thickness_m_file = $immodpg->{_thickness_m_file};
my $thickness_increment_m_file = $immodpg->{_thickness_increment_m_file};
# kill previous processes
$xk->set_process('immodpg1.1');
$xk->kill_process();
$xk->set_process('pgxwin_server');
# print("immodpg,exit: kill pgxwin_server\n");
$xk->kill_process();
# deleted lock files
$outbound_locked = $IMMODPG_INVISIBLE . '/' . $Vbot_file . '_locked';
unlink($outbound_locked);
$outbound_locked =
$IMMODPG_INVISIBLE . '/' . $VbotNtop_factor_file . '_locked';
unlink($outbound_locked);
$outbound_locked =
$IMMODPG_INVISIBLE . '/' . $Vbot_upper_layer_file . '_locked';
unlink($outbound_locked);
$outbound_locked = $IMMODPG_INVISIBLE . '/' . $Vincrement_file . '_locked';
unlink($outbound_locked);
$outbound_locked = $IMMODPG_INVISIBLE . '/' . $Vtop_file . '_locked';
unlink($outbound_locked);
$outbound_locked =
$IMMODPG_INVISIBLE . '/' . $Vtop_lower_layer_file . '_locked';
unlink($outbound_locked);
$outbound_locked = $IMMODPG_INVISIBLE . '/' . $change_file . '_locked';
# print("immodpg, clean_trash, delete $outbound_locked\n");
unlink($outbound_locked);
$outbound_locked = $IMMODPG_INVISIBLE . '/' . $clip_file . '_locked';
unlink($outbound_locked);
$outbound_locked = $IMMODPG . '/' . $immodpg_model . '_locked';
unlink($outbound_locked);
$outbound_locked = $IMMODPG_INVISIBLE . '/' . $layer_file . '_locked';
unlink($outbound_locked);
$outbound_locked = $IMMODPG_INVISIBLE . '/' . $option_file . '_locked';
unlink($outbound_locked);
$outbound_locked = $IMMODPG_INVISIBLE . '/' . $thickness_m_file . '_locked';
unlink($outbound_locked);
$outbound_locked =
$IMMODPG_INVISIBLE . '/' . $thickness_increment_m_file . '_locked';
unlink($outbound_locked);
# reset files to their default options
$outbound = $IMMODPG_INVISIBLE . '/' . $change_file;
unlink($outbound);
my $format = $var_immodpg->{_format_string};
$X[0] = $immodpg->{_change_default};
$files->write_1col_aref( \@X, \$outbound, \$format );
_fortran_layer( $immodpg->{_layer_default} );
_set_option( $immodpg->{_option_default} );
_set_change( $immodpg->{_change_default} );
# delete empty files (including surviving lock files)
# remove weird, locked files from the current directory
my $CD = `pwd`;
$files->set_directory($CD);
$files->clear_empty_files();
# remove weird lock files from the main directory
$files->set_directory($IMMODPG);
$files->clear_empty_files();
# remove weird lock files from the IMMODPG_INVISIBLE
$files->set_directory($IMMODPG_INVISIBLE);
$files->clear_empty_files();
return ();
}
=head2 sub clear
=cut
sub clear {
$immodpg->{_base_file_name} = '';
$immodpg->{_cdp} = '';
$immodpg->{_invert} = '';
$immodpg->{_lmute} = '';
$immodpg->{_smute} = '';
$immodpg->{_sscale} = '';
$immodpg->{_scaled_par} = '';
$immodpg->{_tnmo} = '';
$immodpg->{_upward} = '';
$immodpg->{_vnmo} = '';
$immodpg->{_voutfile} = '';
$immodpg->{_Step} = '';
$immodpg->{_note} = '';
}
=head2 subroutine exit
=cut
sub exit {
my $xk = xk->new();
$xk->set_process('pgxwin_server');
# print("immodpg,exit: kill pgxwin_server\n");
$xk->kill_process();
$xk->set_process('immodpg1.1');
# print("immodpg,exit: kill immodpg1.1\n");
$xk->kill_process();
$xk->set_process('immodpg');
$xk->kill_process();
# print("immodpg,exit: Goodbye!\n");
return ();
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
}
else {
print("immodpg,get_replacement4missing,unexpected value\n");
}
}
else {
print("immodpg, get_replacement4missing, missing replacement\n");
}
return ();
}
=head2 sub setVbot
When you enter or leave
check what the current Vbot value is
compared to former Vbot values.
Vtop value is updated for immodpg.for
through a message in file= "Vbot"
=cut
sub setVbot {
my ($self) = @_;
if ( length( $immodpg->{_VbotEntry} ) ) {
$immodpg->{_Vbot_current} = ( $immodpg->{_VbotEntry} )->get();
_set_control( 'Vbot', $immodpg->{_Vbot_current} );
$immodpg->{_Vbot_current} = _get_control('Vbot');
my $newVbot = $immodpg->{_Vbot_current};
$immodpg->{_VbotEntry}->delete( 0, 'end' );
$immodpg->{_VbotEntry}->insert( 0, $newVbot );
_checkVbot();
_updateVbot();
if ( length( $immodpg->{_isVbot_changed_in_gui} )
&& $immodpg->{_isVbot_changed_in_gui} eq $yes )
{
# for fortran program to read
# print("immodpg, set_Vbot, Vbot is changed: $yes \n");
# print("immodpg, setVbot,option:$Vbot_opt\n");
# print("immodpg, setVbot, V=$immodpg->{_Vbot_current}\n");
_setVbot( $immodpg->{_Vbot_current} );
_set_option($Vbot_opt);
_set_change($yes);
}
else {
# negative cases are reset by fortran program
# and so eliminate need to read locked files
# while use of locked files helps most of the time
# creation and deletion of locked files in perl are not
# failsafe
# print("immodpg, setVbot, same Vbot NADA\n");
}
}
else {
}
}
=head2 sub setVbot_upper_layer
When you enter or leave a field,
check what the current Vbot_upper_layer value is
compared to former Vbot_upper_layer values
Vtop value is updated in immodpg.for
through a message in file= "Vbot_lower"
(&_setVbot_upper_layer)
=cut
sub setVbot_upper_layer {
my ($self) = @_;
# for convenience
my $layer_current = $immodpg->{_layer_current};
my $newVbot_upper_layer;
if ( length( $immodpg->{_Vbot_upper_layerEntry} ) ) {
$immodpg->{_Vbot_upper_layer_current} =
( $immodpg->{_Vbot_upper_layerEntry} )->get();
my $Vbot_upper_layer_current = $immodpg->{_Vbot_upper_layer_current};
# print("1. immodpg, setVbot_upper_layer, immodpg->{_Vbot_upper_layer_current}=$Vbot_upper_layer_current\n");
if ( length $Vbot_upper_layer_current
and looks_like_number($Vbot_upper_layer_current)
and $layer_current > 0 )
{
# print("immodpg, setVbot_upper_layer, immodpg->{_Vbot_upper_layer_current}=$immodpg->{_Vbot_upper_layer_current}\n");
_set_control( 'Vbot_upper_layer',
$immodpg->{_Vbot_upper_layer_current} );
$immodpg->{_Vbot_upper_layer_current} =
_get_control('Vbot_upper_layer');
$newVbot_upper_layer = $immodpg->{_Vbot_upper_layer_current};
# print("2. immodpg, setVbot_upper_layer, newVbot_upper_layer=$newVbot_upper_layer\n");
$immodpg->{_Vbot_upper_layerEntry}->delete( 0, 'end' );
$immodpg->{_Vbot_upper_layerEntry}
->insert( 0, $newVbot_upper_layer );
_checkVbot_upper_layer();
_updateVbot_upper_layer();
if ( $immodpg->{_isVbot_upper_layer_changed_in_gui} eq $yes ) {
# for fortran program to read
_setVbot_upper_layer( $immodpg->{_Vbot_upper_layer_current} );
_set_option($Vbot_upper_layer_opt);
_set_change($yes);
# print("immodpg, setVbot_upper_layer,option:$Vbot_upper_layer_opt\n");
# print("immodpg, setVbot_upper_layer,V= $immodpg->{_Vbot_upper_layer_current}\n");
}
else {
# negative cases are reset by fortran program
# and so eliminate need to read locked files
# while use of locked files helps most of the time
# creation and deletion of locked files in perl are not
# failsafe
# print("immodpg, setVbot_upper_layer, same Vbot NADA\n");
}
}
else {
# print("immodpg, setVbot_upper_layer, Velocity is empty in non-layer NADA\n");
}
}
else {
}
}
=head2 setVbotNVtop_lower_layer_minus
update Vbot value in gui
update Vtop_lower_layer value in gui
update private value in this module
output option for immodpg.for
=cut
sub setVbotNVtop_lower_layer_minus {
my ($self) = @_;
if ( looks_like_number( $immodpg->{_Vincrement_current} )
&& length( $immodpg->{_Vtop_lower_layerEntry} )
&& length( $immodpg->{_VbotEntry} ) )
{
my $Vbot = ( $immodpg->{_VbotEntry} )->get();
my $Vtop_lower_layer = ( $immodpg->{_Vtop_lower_layerEntry} )->get();
my $Vincrement = ( $immodpg->{_VincrementEntry} )->get();
if ( looks_like_number($Vtop_lower_layer)
&& looks_like_number($Vbot) )
{
my $newVtop_lower_layer = $Vtop_lower_layer - $Vincrement;
my $newVbot = $Vbot - $Vincrement;
_set_control( 'Vtop', $newVtop_lower_layer );
$newVtop_lower_layer = _get_control('Vtop');
_set_control( 'Vbot', $newVbot );
$newVbot = _get_control('Vbot');
$immodpg->{_Vtop_lower_layer_prior} =
$immodpg->{_Vtop_lower_layer_current};
$immodpg->{_Vtop_lower_layer_current} = $newVtop_lower_layer;
$immodpg->{_Vbot_prior} = $immodpg->{_Vbot_current};
$immodpg->{_Vbot_current} = $newVbot;
$immodpg->{_Vtop_lower_layerEntry}->delete( 0, 'end' );
$immodpg->{_Vtop_lower_layerEntry}
->insert( 0, $newVtop_lower_layer );
$immodpg->{_VbotEntry}->delete( 0, 'end' );
$immodpg->{_VbotEntry}->insert( 0, $newVbot );
# $immodpg->{_isVtop_lower_layer_changed_in_gui} = $yes;
# $immodpg->{_isVbot_changed_in_gui} = $yes;
# _checkVbot(); #todo
_updateVbot();
# _checkVtop_lower_layer(); #todo
_updateVtop_lower_layer();
if ( $immodpg->{_isVtop_lower_layer_changed_in_gui} eq $yes
&& $immodpg->{_isVbot_changed_in_gui} eq $yes )
{
# for fortran program to read
# print("immodpg, setVbotNVtop_lower_layer_minus, Vbot is changed: $yes \n");
_set_option($VbotNVtop_lower_layer_minus_opt);
_set_change($yes);
# print("immodpg, setVbotNVtop_lower_layer_minus,option:$VbotNVtop_lower_layer_minus_opt\n");
# print("immodpg, setVbotNVtop_lower_layer_minus, V=$immodpg->{_Vtop_lower_layer_current}\n");
}
else {
# negative cases are reset by fortran program
# and so eliminate need to read locked files
# while use of locked files helps most of the time
# creation and deletion of locked files in perl are not
# failsafe
#
# print("immodpg, setVbotNVtop_lower_layer_minus, same Vbot and Vtop_lower_layer; NADA\n");
}
}
else {
print(
"immodpg, setVbotNVtop_lower_layer_minus, Vbot or Vtop_lower_layer value missing\n"
);
}
}
else {
print(
"immodpg, setVbotNVtop_lower_layer_minus, missing widget or Vincrement\n"
);
# print("immodpg, setVtopNVtop_lower_layer_minus, Vtop_lower_layerEntry=$immodpg->{_Vtop_lower_layerEntry}\n");
# print("immodpg, setVtopNVtop_lower_layer_minus, Vincrement=$immodpg->{_Vincrement_current}\n");
}
return ();
}
=head2 setVbotNVtop_lower_layer_plus
update Vbot value in gui
update Vtop_lower_layer value in gui
update private value in this module
output option for immodpg.for
=cut
sub setVbotNVtop_lower_layer_plus {
my ($self) = @_;
if ( looks_like_number( $immodpg->{_Vincrement_current} )
&& length( $immodpg->{_Vtop_lower_layerEntry} )
&& length( $immodpg->{_VbotEntry} ) )
{
my $Vbot = ( $immodpg->{_VbotEntry} )->get();
my $Vtop_lower_layer = ( $immodpg->{_Vtop_lower_layerEntry} )->get();
my $Vincrement = ( $immodpg->{_VincrementEntry} )->get();
if ( looks_like_number($Vtop_lower_layer)
&& looks_like_number($Vbot) )
{
my $newVtop_lower_layer = $Vtop_lower_layer + $Vincrement;
my $newVbot = $Vbot + $Vincrement;
_set_control( 'Vbot', $newVbot );
$newVbot = _get_control('Vbot');
_set_control( 'Vtop', $newVtop_lower_layer );
$newVtop_lower_layer = _get_control('Vtop');
$immodpg->{_Vtop_lower_layer_prior} =
$immodpg->{_Vtop_lower_layer_current};
$immodpg->{_Vtop_lower_layer_current} = $newVtop_lower_layer;
$immodpg->{_Vbot_prior} = $immodpg->{_Vbot_current};
$immodpg->{_Vbot_current} = $newVbot;
$immodpg->{_Vtop_lower_layerEntry}->delete( 0, 'end' );
$immodpg->{_Vtop_lower_layerEntry}
->insert( 0, $newVtop_lower_layer );
$immodpg->{_VbotEntry}->delete( 0, 'end' );
$immodpg->{_VbotEntry}->insert( 0, $newVbot );
# $immodpg->{_isVtop_lower_layer_changed_in_gui} = $yes;
# $immodpg->{_isVbot_changed_in_gui} = $yes;
_checkVbot(); # todo
_updateVbot();
_checkVtop_lower_layer(); # todo
_updateVtop_lower_layer();
# print("immodpg, setVbotNVtop_lower_layer_plus, new Vtop_lower_layer= $newVtop_lower_layer\n");
# print("immodpg, setVbotNVtop_lower_layer_plus, Vincrement= $Vincrement\n");
if ( $immodpg->{_isVtop_lower_layer_changed_in_gui} eq $yes
&& $immodpg->{_isVbot_changed_in_gui} eq $yes )
{
# for fortran program to read
# print("immodpg, setVbotNVtop_lower_layer_plus, Vbot is changed: $yes \n");
_set_option($VbotNVtop_lower_layer_plus_opt);
_set_change($yes);
# print("immodpg, setVbotNVtop_lower_layer_plus,option:$VbotNVtop_lower_layer_plus_opt\n");
# print("immodpg, setVbotNVtop_lower_layer_plus, V=$immodpg->{_Vtop_lower_layer_current}\n");
}
else {
# negative cases are reset by fortran program
# and so eliminate need to read locked files
# while use of locked files helps most of the time
# creation and deletion of locked files in perl are not
# failsafe
#
# print("immodpg, setVbotNVtop_lower_layer_plus, same Vbot and Vtop_lower_layer; NADA\n");
}
}
else {
print(
"immodpg, setVbotNVtop_lower_layer_plus, Vbot or Vtop_lower_layer value missing\n"
);
}
}
else {
print(
"immodpg, setVbotNVtop_lower_layer_plus, missing widget or Vincrement\n"
);
# print("immodpg, setVtopNVtop_lower_layer_plus, Vtop_lower_layerEntry=$immodpg->{_Vtop_lower_layerEntry}\n");
print(
"immodpg, setVtopNVtop_lower_layer_plus, Vincrement=$immodpg->{_Vincrement_current}\n"
);
}
return ();
}
=head2 sub setVtopNVbot_upper_layer_minus
update Vtop value in gui
update Vbot_upper_layer value in gui
update private value in this module
output option for immodpg.for
=cut
sub setVtopNVbot_upper_layer_minus {
my ($self) = @_;
# print("layer_current = $immodpg->{_layer_current};\n");
if (
looks_like_number( $immodpg->{_Vincrement_current} )
&& length( $immodpg->{_Vbot_upper_layerEntry} )
&& length( $immodpg->{_VtopEntry} )
)
{
my $Vtop = ( $immodpg->{_VtopEntry} )->get();
my $Vbot_upper_layer = ( $immodpg->{_Vbot_upper_layerEntry} )->get();
my $Vincrement = ( $immodpg->{_VincrementEntry} )->get();
my $layer_current = $immodpg->{_layer_current};
if ( looks_like_number($Vbot_upper_layer) && looks_like_number($Vtop)
and $layer_current > 1 )
{
my $newVbot_upper_layer = $Vbot_upper_layer - $Vincrement;
my $newVtop = $Vtop - $Vincrement;
_set_control( 'Vbot', $newVbot_upper_layer );
$newVbot_upper_layer = _get_control('Vbot');
_set_control( 'Vtop', $newVtop );
$newVtop = _get_control('Vtop');
$immodpg->{_Vbot_upper_layer_prior} =
$immodpg->{_Vbot_upper_layer_current};
$immodpg->{_Vbot_upper_layer_current} = $newVbot_upper_layer;
$immodpg->{_Vtop_prior} = $immodpg->{_Vtop_current};
$immodpg->{_Vtop_current} = $newVtop;
$immodpg->{_Vbot_upper_layerEntry}->delete( 0, 'end' );
$immodpg->{_Vbot_upper_layerEntry}
->insert( 0, $newVbot_upper_layer );
$immodpg->{_VtopEntry}->delete( 0, 'end' );
$immodpg->{_VtopEntry}->insert( 0, $newVtop );
# $immodpg->{_isVbot_upper_layer_changed_in_gui} = $yes;
# $immodpg->{_isVtop_changed_in_gui} = $yes;
# print("immodpg, setVtopNVbot_upper_layer_minus, new Vbot_upper_layer= $newVbot_upper_layer\n");
# print("immodpg, setVtopNVbot_upper_layer_minus, Vincrement= $Vincrement\n");
# _checkVtop(); #todo
_updateVtop();
# _checkVbot_upper_layer(); #todo
_updateVbot_upper_layer();
if ( $immodpg->{_isVbot_upper_layer_changed_in_gui} eq $yes
&& $immodpg->{_isVtop_changed_in_gui} eq $yes )
{
# for fortran program to read
# print("immodpg, setVtopNVbot_upper_layer_minus, Vbot is changed: $yes \n");
_set_option($VtopNVbot_upper_layer_minus_opt);
_set_change($yes);
# print("immodpg, setVtopNVbot_upper_layer_minus,option:$VtopNVbot_upper_layer_minus_opt\n");
# print("immodpg, setVtopNVbot_upper_layer_minus, V=$immodpg->{_Vbot_upper_layer_current}\n");
}
else {
# negative cases are reset by fortran program
# and so eliminate need to read locked files
# while use of locked files helps most of the time
# creation and deletion of locked files in perl are not
# failsafe
#
# print("immodpg, setVtopNVbot_upper_layer_minus, same Vtop and Vbot_upper_layer; NADA\n");
}
}
else {
# print("immodpg, setVtopNVbot_upper_layer_minus, Vtop or Vbot_upper_layer value missing-NADA\n");
}
}
else {
print(
"immodpg, setVtopNVbot_upper_layer_minus, missing widget or Vincrement\n"
);
# print("immodpg, setVtopNVbot_upper_layer_minus, Vbot_upper_layerEntry=$immodpg->{_Vbot_upper_layerEntry}\n");
# print("immodpg, setVtopNVbot_upper_layer_minus, Vincrement=$immodpg->{_Vincrement_current}\n");
}
return ();
}
=head2 sub setVtopNVbot_upper_layer_plus
update Vtop value in gui
update Vbot_upper_layer value in gui
update private value in this module
output option for immodpg.for
=cut
sub setVtopNVbot_upper_layer_plus {
my ($self) = @_;
if (
looks_like_number( $immodpg->{_Vincrement_current} )
&& length( $immodpg->{_Vbot_upper_layerEntry} )
&& length( $immodpg->{_VtopEntry} )
)
{
my $Vtop = ( $immodpg->{_VtopEntry} )->get();
my $Vbot_upper_layer = ( $immodpg->{_Vbot_upper_layerEntry} )->get();
my $Vincrement = ( $immodpg->{_VincrementEntry} )->get();
my $layer_current = $immodpg->{_layer_current};
if ( looks_like_number($Vbot_upper_layer) && looks_like_number($Vtop)
and $layer_current > 1 )
{
my $newVbot_upper_layer = $Vbot_upper_layer + $Vincrement;
my $newVtop = $Vtop + $Vincrement;
_set_control( 'Vbot', $newVbot_upper_layer );
$newVbot_upper_layer = _get_control('Vbot');
_set_control( 'Vtop', $newVtop );
$newVtop = _get_control('Vtop');
$immodpg->{_Vbot_upper_layer_prior} =
$immodpg->{_Vbot_upper_layer_current};
$immodpg->{_Vbot_upper_layer_current} = $newVbot_upper_layer;
$immodpg->{_Vtop_prior} = $immodpg->{_Vtop_current};
$immodpg->{_Vtop_current} = $newVtop;
$immodpg->{_Vbot_upper_layerEntry}->delete( 0, 'end' );
$immodpg->{_Vbot_upper_layerEntry}
->insert( 0, $newVbot_upper_layer );
$immodpg->{_VtopEntry}->delete( 0, 'end' );
$immodpg->{_VtopEntry}->insert( 0, $newVtop );
# $immodpg->{_isVbot_upper_layer_changed_in_gui} = $yes;
# $immodpg->{_isVtop_changed_in_gui} = $yes;
# _checkVtop(); #todo
_updateVtop();
# _checkVbot_upper_layer(); # todo
_updateVbot_upper_layer();
# print("immodpg, setVtopNVbot_upper_layer_plus, new Vbot_upper_layer= $newVbot_upper_layer\n");
# print("immodpg, setVtopNVbot_upper_layer_plus, Vincrement= $Vincrement\n");
if ( $immodpg->{_isVbot_upper_layer_changed_in_gui} eq $yes
&& $immodpg->{_isVtop_changed_in_gui} eq $yes )
{
# for fortran program to read
# print("immodpg, setVtopNVbot_upper_layer_plus, Vbot is changed: $yes \n");
_set_option($VtopNVbot_upper_layer_plus_opt);
_set_change($yes);
# print("immodpg, setVtopNVbot_upper_layer_plus,option:$VtopNVbot_upper_layer_plus_opt\n");
# print("immodpg, setVtopNVbot_upper_layer_plus, V=$immodpg->{_Vbot_upper_layer_current}\n");
}
else {
# negative cases are reset by fortran program
# and so eliminate need to read locked files
# while use of locked files helps most of the time
# creation and deletion of locked files in perl are not
# failsafe
#
# print("immodpg, setVtopNVbot_upper_layer_plus, same Vtop and Vbot_upper_layer; NADA\n");
}
}
else {
# print("immodpg, setVtopNVbot_upper_layer_plus, Vtop or Vbot_upper_layer value missing NADA\n");
}
}
else {
print(
"immodpg, setVtopNVbot_upper_layer_plus, missing widget or Vincrement\n"
);
# print("immodpg, setVtopNVbot_upper_layer_plus, Vbot_upper_layerEntry=$immodpg->{_Vbot_upper_layerEntry}\n");
# print("immodpg, setVtopNVbot_upper_layer_plus, Vincrement=$immodpg->{_Vincrement}\n");
}
return ();
}
=head2 sub setVincrement
When you enter or leave
check what the current Vincrement value is
compared to former Vincrement values
=cut
sub setVincrement {
my ($self) = @_;
if ( length( $immodpg->{_VincrementEntry} ) ) {
$immodpg->{_Vincrement_current} = $immodpg->{_VincrementEntry}->get();
# print("1. immodpg, setVincrement ,immodpg->{_Vincrement_current}:$immodpg->{_Vincrement_current}\n");
_set_control( 'Vincrement', $immodpg->{_Vincrement_current} );
$immodpg->{_Vincrement_current} = _get_control('Vincrement');
my $newVincrement = $immodpg->{_Vincrement_current};
# print("2. immodpg, setVincrement,immodpg->{_Vincrement_current}:$immodpg->{_Vincrement_current}\n");
$immodpg->{_VincrementEntry}->delete( 0, 'end' );
$immodpg->{_VincrementEntry}->insert( 0, $newVincrement );
_checkVincrement();
_updateVincrement();
_write_config();
if ( $immodpg->{_isVincrement_changed_in_gui} eq $yes ) {
# for fortran program to read
# print("immodpg, setVincrement, Vincrement is changed: $yes \n");
# print("immodpg, setVincrement,option:$changeVincrement_opt\n");
# print("immodpg, setVincrement, $immodpg->{_Vincrement_current}\n");
_setVincrement( $immodpg->{_Vincrement_current} );
_set_option($changeVincrement_opt);
_set_change($yes);
}
else {
# negative cases are reset by fortran program
# and so eliminate need to read locked files
# while use of locked files helps most of the time
# creation and deletion of locked files in perl are not
# failsafe
# print("immodpg, setVincrement, same Vincrement NADA\n");
}
}
else {
print("immodpg, setVincrement, missing value\n");
}
}
=head2 sub setVtop
When you enter or leave,
check what the current Vtop value is
compared to former Vtop values
Vtop value is updated in immodpg.for
through a message in file= "Vtop"
(&_setVtop)
=cut
sub setVtop {
my ($self) = @_;
if ( length( $immodpg->{_VtopEntry} ) ) {
$immodpg->{_Vtop_current} = ( $immodpg->{_VtopEntry} )->get();
_set_control( 'Vtop', $immodpg->{_Vtop_current} );
$immodpg->{_Vtop_current} = _get_control('Vtop');
my $newVtop = $immodpg->{_Vtop_current};
$immodpg->{_VtopEntry}->delete( 0, 'end' );
$immodpg->{_VtopEntry}->insert( 0, $newVtop );
_checkVtop();
_updateVtop();
if ( $immodpg->{_isVtop_changed_in_gui} eq $yes ) {
# for fortran program to read
# print("immodpg, set_Vtop, Vtop is changed: $yes \n");
# $immodpg->{_VtopEntry}->delete( 0, 'end');
# $immodpg->{_VtopEntry}->insert( 0, $newVtop );
_setVtop( $immodpg->{_Vtop_current} );
_set_option($changeVtop_opt);
_set_change($yes);
# print("immodpg, setVtop,option:$changeVtop_opt\n");
# print("immodpg, setVtop, V=$immodpg->{_Vtop_current}\n");
}
else {
# negative cases are reset by fortran program
# and so eliminate need to read locked files
# while use of locked files helps most of the time
# creation and deletion of locked files in perl are not
# failsafe
# print("immodpg, setVtop, same Vtop NADA\n");
}
}
else {
print("immodpg, setVtop, _Vtop value missing\n");
print("immodpg, setVtop, Vtop=$immodpg->{_Vtop}\n");
}
}
=head2 sub setVtop_lower_layer
When you enter or leave
check what the current Vtop_lower_layer value is
compared to former Vtop_lower_layer values
Vtop value is updated in immodpg.for
through a message in file= "Vtop_lower_layer"
(&_setVtop_lower_layer)
=cut
sub setVtop_lower_layer {
my ($self) = @_;
my $newVtop_lower_layer;
# my $isVtop_lower_layer_changed = $immodpg->{_isVtop_lower_layer_changed_in_gui};
if ( length( $immodpg->{_Vtop_lower_layerEntry} ) ) {
$immodpg->{_Vtop_lower_layer} =
( $immodpg->{_Vtop_lower_layerEntry} )->get();
_set_control( 'Vtop_lower_layer', $immodpg->{_Vtop_lower_layer} );
$immodpg->{_Vtop_lower_layer} = _get_control('Vtop_lower_layer');
$newVtop_lower_layer = $immodpg->{_Vtop_lower_layer};
$immodpg->{_Vtop_lower_layerEntry}->delete( 0, 'end' );
$immodpg->{_Vtop_lower_layerEntry}->insert( 0, $newVtop_lower_layer );
_checkVtop_lower_layer();
_updateVtop_lower_layer();
if ( $immodpg->{_isVtop_lower_layer_changed_in_gui} eq $yes ) {
# for fortran program to read
# print(" immodpg, set_Vtop_lower_layer, newVtop_lower_layer = $newVtop_lower_layer\n");
# $immodpg->{_Vtop_lower_layerEntry}->delete( 0, 'end' );
# $immodpg->{_Vtop_lower_layerEntry}->insert( 0, $newVtop_lower_layer);
_setVtop_lower_layer( $immodpg->{_Vtop_lower_layer_current} );
_set_option($Vtop_lower_layer_opt);
_set_change($yes);
# print("immodpg, setVtop_lower_layer,option:$Vtop_lower_layer_opt\n");
}
else {
# negative cases are reset by fortran program
# and so eliminate need to read locked files
# while use of locked files helps most of the time
# creation and deletion of locked files in perl are not
# failsafe
# print("immodpg, setVtop_lower_layer, same Vtop_lower_layer NADA\n");
}
}
else {
("immodpg, setVtop_lower_layer, missing widget\n");
}
}
=head2 sub setVbotNtop_factor
When you enter or leave
check what the current VbotNtop_factor value is
compared to former VbotNtop_factor values
=cut
sub setVbotNtop_factor {
my ($self) = @_;
if ( length( $immodpg->{_VbotNtop_factorEntry} ) ) {
$immodpg->{_VbotNtop_factor_current} =
$immodpg->{_VbotNtop_factorEntry}->get();
# print("1, immodpg, setVbotNtop_factor,immodpg->{_VbotNtop_factor_current}: $immodpg->{_VbotNtop_factor_current} \n");
_set_control( 'VbotNtop_factor', $immodpg->{_VbotNtop_factor_current} );
$immodpg->{_VbotNtop_factor_current} = _get_control('VbotNtop_factor');
my $newVbotNtop_factor = $immodpg->{_VbotNtop_factor_current};
# print("2. immodpg, setVbotNtop_factor,newVbotNtop_factor:$newVbotNtop_factor\n");
$immodpg->{_VbotNtop_factorEntry}->delete( 0, 'end' );
$immodpg->{_VbotNtop_factorEntry}->insert( 0, $newVbotNtop_factor );
_checkVbotNtop_factor();
_updateVbotNtop_factor();
_write_config();
if ( $immodpg->{_isVbotNtop_factor_changed_in_gui} eq $yes ) {
_setVbotNtop_factor( $immodpg->{_VbotNtop_factor_current} );
_set_option($changeVbotNtop_factor_opt);
_set_change($yes);
# print("immodpg, setVbotNtop_factor,option:$changeVbotNtop_factor_opt\n");
}
else {
_set_change($no);
# print("immodpg, setVbotNtop_factor, same VbotNtop_factor_opt NADA\n");
}
}
else {
print("immodpg, setVbotNtop_factor, bad factor or widget\n");
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
sub setVbotNtop_minus {
my ($self) = @_;
if ( length( $immodpg->{_VbotEntry} )
&& length( $immodpg->{_VtopEntry} ) )
{
my $Vbot = ( $immodpg->{_VbotEntry} )->get();
my $Vtop = ( $immodpg->{_VtopEntry} )->get();
my $Vincrement = $immodpg->{_VincrementEntry}->get();
if ( looks_like_number($Vbot)
&& looks_like_number($Vtop)
&& looks_like_number($Vincrement) )
{
my $newVbot = $Vbot - $Vincrement;
_set_control( 'Vbot', $newVbot );
$newVbot = _get_control('Vbot');
$immodpg->{_Vbot_prior} = $immodpg->{_Vbot_current};
$immodpg->{_Vbot_current} = $newVbot;
$immodpg->{_VbotEntry}->delete( 0, 'end' );
$immodpg->{_VbotEntry}->insert( 0, $newVbot );
_updateVbot();
my $newVtop = $Vtop - $Vincrement;
_set_control( 'Vtop', $newVtop );
$newVtop = _get_control('Vtop');
$immodpg->{_Vtop_prior} = $immodpg->{_Vtop_current};
$immodpg->{_Vtop_current} = $newVtop;
$immodpg->{_VtopEntry}->delete( 0, 'end' );
$immodpg->{_VtopEntry}->insert( 0, $newVtop );
_updateVtop();
# print("immodpg, setVbotNtop_minus, new Vbot= $newVbot\n");
# print("immodpg, setVbotNtop_minus, new Vtop= $newVtop\n");
# print("immodpg, setVbotNtop_minus, Vincrement= $Vincrement\n");
if ( $immodpg->{_isVbot_changed_in_gui} eq $yes
&& $immodpg->{_isVtop_changed_in_gui} eq $yes )
{
# for fortran program to read
_set_option($VbotNtop_minus_opt);
_set_change($yes);
# print("immodpg, setVbotNtop_minus, VbotNtop_minus_opt:$VbotNtop_minus_opt \n");
}
else {
# negative cases are reset by fortran program
# and so eliminate need to read locked files
# while use of locked files helps most of the time
# creation and deletion of locked files in perl are not
# failsafe
#
# print("immodpg, setVbotNtop_minus, same VbotNtop NADA\n");
}
}
else {
print("immodpg, setVbotNtop_minus, VbotNtop value missing\n");
}
}
else {
print("immodpg, setVbotNtop_minus, missing widget or Vincrement\n");
# print("immodpg, setVbotNtop_minus, Vincrement=$immodpg->{_Vincrement}\n");
}
return ();
}
=head2 sub setVbotNtop_plus
update Vbot and Vtop values in gui
update private svalue in this module
output option for immodpg.for
=cut
sub setVbotNtop_plus {
my ($self) = @_;
if ( length( $immodpg->{_VbotEntry} )
&& length( $immodpg->{_VtopEntry} ) )
{
my $Vbot = ( $immodpg->{_VbotEntry} )->get();
my $Vtop = ( $immodpg->{_VtopEntry} )->get();
my $Vincrement = $immodpg->{_VincrementEntry}->get();
if ( looks_like_number($Vbot)
&& looks_like_number($Vtop)
&& looks_like_number($Vincrement) )
{
my $newVbot = $Vbot + $Vincrement;
_set_control( 'Vbot', $newVbot );
$newVbot = _get_control('Vbot');
$immodpg->{_Vbot_prior} = $immodpg->{_Vbot_current};
$immodpg->{_Vbot_current} = $newVbot;
$immodpg->{_VbotEntry}->delete( 0, 'end' );
$immodpg->{_VbotEntry}->insert( 0, $newVbot );
_updateVbot();
my $newVtop = $Vtop + $Vincrement;
_set_control( 'Vtop', $newVtop );
$newVtop = _get_control('Vtop');
$immodpg->{_Vtop_prior} = $immodpg->{_Vtop_current};
$immodpg->{_Vtop_current} = $newVtop;
$immodpg->{_VtopEntry}->delete( 0, 'end' );
$immodpg->{_VtopEntry}->insert( 0, $newVtop );
_updateVtop();
# print("immodpg, setVbotNtop_plus, new Vbot= $newVbot\n");
# print("immodpg, setVbotNtop_plus, new Vtop= $newVtop\n");
# print("immodpg, setVbotNtop_plus, Vincrement= $Vincrement\n");
if ( $immodpg->{_isVbot_changed_in_gui} eq $yes
&& $immodpg->{_isVtop_changed_in_gui} eq $yes )
{
# for fortran program to read
_set_option($VbotNtop_plus_opt);
_set_change($yes);
# print("immodpg, setVbotNtop_plus, VbotNtop_plus_opt:$VbotNtop_plus_opt \n");
}
else {
# negative cases are reset by fortran program
# and so eliminate need to read locked files
# while use of locked files helps most of the time
# creation and deletion of locked files in perl are not
# failsafe
#
# print("immodpg, setVbotNtop_plus, same VbotNtop NADA\n");
}
}
else {
print("immodpg, setVbotNtop_plus, VbotNtop value missing\n");
}
}
else {
print("immodpg, setVbotNtop_plus, missing widget or Vincrement\n");
print("immodpg, setVbotNtop_plus, Vincrement=$immodpg->{_Vincrement}\n");
}
return ();
}
=head2 sub invert
=cut
sub invert {
my ( $self, $invert ) = @_;
if ( $invert ne $empty_string ) {
$immodpg->{_invert} = $invert;
$immodpg->{_note} =
$immodpg->{_note} . ' invert=' . $immodpg->{_invert};
$immodpg->{_Step} =
$immodpg->{_Step} . ' invert=' . $immodpg->{_invert};
}
else {
print("immodpg, invert, missing invert,\n");
}
}
=head2 sub lmute
=cut
sub lmute {
my ( $self, $lmute ) = @_;
if ($lmute) {
$immodpg->{_lmute} = $lmute;
$immodpg->{_note} = $immodpg->{_note} . ' lmute=' . $immodpg->{_lmute};
$immodpg->{_Step} = $immodpg->{_Step} . ' lmute=' . $immodpg->{_lmute};
}
else {
print("immodpg, lmute, missing lmute,\n");
}
}
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
return ();
}
=head2 sub set_thickness_m_minus
update _thickness_m value in gui
update private value in this module
output option for immodpg.for
=cut
sub set_thickness_m_minus {
my ($self) = @_;
if ( length( $immodpg->{_thickness_mEntry} )
&& looks_like_number( $immodpg->{_thickness_increment_m} ) )
{
my $thickness_m = ( $immodpg->{_thickness_mEntry} )->get();
if ( looks_like_number($thickness_m) ) {
my $thickness_increment_m =
( $immodpg->{_thickness_increment_mEntry} )->get();
my $new_thickness_m = $thickness_m - $thickness_increment_m;
_set_control( 'thickness_m', $new_thickness_m );
$new_thickness_m = _get_control('thickness_m');
$immodpg->{_thickness_m_prior} = $immodpg->{_thickness_m_current};
$immodpg->{_thickness_m_current} = $new_thickness_m;
$immodpg->{_thickness_mEntry}->delete( 0, 'end' );
$immodpg->{_thickness_mEntry}->insert( 0, $new_thickness_m );
# print("immodpg, set new _thickness_m= $new_thickness_m\n");
# print("immodpg, set_thickness_m_minus, thickness_increment_m= $thickness_increment_m\n");
# _check_thickness_m(); #todo
_update_thickness_m();
$immodpg->{_is_thickness_m_changed_in_gui} = $yes;
if ( $immodpg->{_is_thickness_m_changed_in_gui} eq $yes ) {
# for fortran program to read
# print("immodpg, set_thickness_m_minus, _thickness_m is changed: $yes \n");
# _set_thickness_m( $immodpg->{_thickness_m_current} );
_set_option($thickness_m_minus_opt);
_set_change($yes);
# print("immodpg, set_thickness_m_minus,option:$thickness_m_minus_opt\n");
# print("immodpg, set_thickness_m_minus, V=$immodpg->{_thickness_m_current}\n");
}
else {
# negative cases are reset by fortran program
# and so eliminate need to read locked files
# while use of locked files helps most of the time
# creation and deletion of locked files in perl are not
# failsafe
#
# print("immodpg, set_thickness_m_minus, same _thickness_m NADA\n");
}
}
else {
print(
"immodpg, set_thickness_m_minus, _thickness_m value missing\n");
# print("immodpg, set_thickness_m_minus, _thickness_mEntry=$immodpg->{_thickness_mEntry}\n");
# print("immodpg, set_thickness_m_minus, thickness_increment_m=$immodpg->{_thickness_increment_m}\n");
}
}
else {
print(
"immodpg, set_thickness_m_minus, missing widget or thickness_increment_m\n"
);
}
return ();
}
=head2 sub set_thickness_m_plus
update _thickness_m value in gui
update private value in this module
output option for immodpg.for
=cut
sub set_thickness_m_plus {
my ($self) = @_;
if ( length( $immodpg->{_thickness_mEntry} )
&& looks_like_number( $immodpg->{_thickness_increment_m} ) )
{
my $thickness_m = ( $immodpg->{_thickness_mEntry} )->get();
if ( looks_like_number($thickness_m) ) {
my $thickness_increment_m =
( $immodpg->{_thickness_increment_mEntry} )->get();
my $new_thickness_m = $thickness_m + $thickness_increment_m;
_set_control( 'thickness_m', $new_thickness_m );
$new_thickness_m = _get_control('thickness_m');
$immodpg->{_thickness_m_prior} = $immodpg->{_thickness_m_current};
$immodpg->{_thickness_m_current} = $new_thickness_m;
$immodpg->{_thickness_mEntry}->delete( 0, 'end' );
$immodpg->{_thickness_mEntry}->insert( 0, $new_thickness_m );
# print("immodpg, set_thickness_m_plus, set new _thickness_m= $new_thickness_m\n");
_check_thickness_m(); #todo
_update_thickness_m();
$immodpg->{_is_thickness_m_changed_in_gui} = $yes;
if ( $immodpg->{_is_thickness_m_changed_in_gui} eq $yes ) {
# for fortran program to read
# print("immodpg, set_thickness_m_plus, _thickness_m is changed: $yes \n");
# _set_thickness_m( $immodpg->{_thickness_m_current} );
_set_option($thickness_m_plus_opt);
_set_change($yes);
# print("immodpg, set_thickness_m_plus,option:$_thickness_m_plus_opt\n");
# print("immodpg, set_thickness_m_plus, dz=$immodpg->{_thickness_m_current}\n");
}
else {
# print("immodpg, set_thickness_m_plus, _thickness_mEntry=$immodpg->{_thickness_mEntry}\n");
# print("immodpg, set_thickness_m_plus, thickness_increment_m=$immodpg->{_thickness_increment_m}\n");
# negative cases are reset by fortran program
# and so eliminate need to read locked files
# while use of locked files helps most of the time
# creation and deletion of locked files in perl are not
# failsafe
#
# print("immodpg, set_thickness_m_plus, same _thickness_m NADA\n");
}
}
else {
print(
"immodpg, set_thickness_m_plus, _thickness_m value missing\n");
# print("immodpg, set_thickness_m_plus, _thickness_mEntry=$immodpg->{_thickness_mEntry}\n");
# print("immodpg, set_thickness_m_plus, thickness_increment_m=$immodpg->{_thickness_increment_m}\n");
}
}
else {
print(
"immodpg, set_thickness_m_plus, missing widget or thickness_increment_m\n"
);
}
return ();
}
=head2 sub set_update
Save all values in the immodpg
gui to immodpg.config
=cut
sub set_update {
my ($self) = @_;
print("immodpg, set_update\n");
setVincrement();
set_thickness_increment_m();
set_thickness_m();
setVbotNtop_factor();
set_clip();
setVbot();
setVtop();
setVbot_upper_layer();
setVtop_lower_layer();
set_layer();
_set_simple_model_text();
_set_working_model_bin();
_set_working_model_text();
}
sub set_widgets {
my ( $self, $widget_h ) = @_;
if ($widget_h) {
# print("immodpg, set_widgets, widget_ ->{_mw}: $widget_h ->{_mw}\n");
$immodpg->{_VbotEntry} = $widget_h->{_VbotEntry};
$immodpg->{_Vbot_upper_layerEntry} =
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
sub set_base_file_name {
my ( $self, $base_file_name ) = @_;
if ( $base_file_name ne $empty_string ) {
$immodpg->{_base_file_name} = $base_file_name;
print("header_values,set_base_file_name,$immodpg->{_base_file_name}\n");
}
else {
print("header_values,set_base_file_name, missing base file name\n");
}
return ();
}
=head2 sub set_change
verify another lock file does not exist and
only then:
create another lock file
while change file is written.
that revents fortran file from reading
Then delete lock file
Aavoids crash between asynchronous
reading (fortran) and
writing (Perl) of files
=cut
sub set_change {
my ( $self, $yes_or_no ) = @_;
# print("immodpg, set_change, yes_or_no:$yes_or_no\n");
if ( defined($yes_or_no)
&& $immodpg->{_change_file} ne $empty_string )
{
=head2 instantiate classes
=cut
my $files = manage_files_by2->new();
my $control = control->new();
=head2 Define local
variables
=cut
my @X;
my $change = $immodpg->{_change_file};
my $test = $yes;
my $outbound = $IMMODPG_INVISIBLE . '/' . $change;
my $outbound_locked = $outbound . '_locked';
my $format = $var_immodpg->{_format_string};
my $count = 0;
my $max_counts = $var_immodpg->{_loop_limit};
for (
my $i = 0 ;
( $test eq $yes ) and ( $count < $max_counts ) ;
$i++
)
{
# print("1. immodpg,set_change, in loop count=$count \n");
if ( not( $files->does_file_exist( \$outbound_locked ) ) ) {
$X[0] = $empty_string;
$files->write_1col_aref( \@X, \$outbound_locked, \$format );
# print("immodpg, set_change, outbound_locked=$outbound_locked\n");
# print("immodpg, set_change, IMMODPG_INVISIBLE=$IMMODPG_INVISIBLE\n");
# print("immodpg, set_change, created empty locked file=$X[0]\n");
# print("immodpg, set_change, outbound=$outbound\n");
# print("immodpg, set_change, IMMODPG_INVISIBLE=$IMMODPG_INVISIBLE\n");
# do not overwrite a waiting change (= yes)
my $response_aref = $files->read_1col_aref( \$outbound );
my $ans = @{$response_aref}[0];
if ( $ans eq $yes ) {
# do not overwrite a waiting change (= yes)
# print("2. immodpg, set_change, SKIP\n");
# print("immodpg, set_change,do not overwrite change_file\n");
unlink($outbound_locked);
}
elsif ( $ans eq $no ) {
# overwrite change_file(=no) with no or yes
$X[0] = $yes_or_no;
$files->write_1col_aref( \@X, \$outbound, \$format );
# print("immodpg, set_change, overwrite change file with $X[0]\n");
unlink($outbound_locked);
# print("3. immodpg, set_change, delete locked file\n");
# print("4. immodpg, set_change, yes_or_no=$X[0]\n");
$test = $no;
}
else {
print("immodpg, set_change, unexpected result \n");
} # test change_file's content
}
else {
# print("immodpg,_set_change, locked change file\n");
$count++; # governor on finding an unlocked change_file
} # if unlocked file is missing and change_file is free
$count++; # governor on checking for a change_file = yes
} # for
}
else {
print("immodpg, set_change, missing values\n");
}
return ();
} # sub
=head2 sub set_clip_control
value adjusts to current
clip value in use
=cut
sub set_clip_control {
my ( $self, $control_clip ) = @_;
my $result;
if ( length($control_clip)
&& $control_clip > 0 )
{
$immodpg->{_control_clip} = $control_clip;
# print("immodpg,set_clip_control, control_clip=$immodpg->{_control_clip}\n");
}
elsif ( not( length($control_clip) ) ) {
# print("immodpg,_set_clip_control, empty string\n");
$immodpg->{_control_clip} = $control_clip;
}
else {
print("immodpg,set_clip_control, missing value\n");
}
return ();
}
=head2 sub set_option
Verify another lock file does not exist and
only then:
Create another lock file
while change file is written
that prevents fortran file from reading.
Then, delete the lock file
Avoids crash between asynchronous
reading (fortran) and
writing (Perl) of files
=cut
sub set_option {
my ( $self, $option ) = @_;
if ( looks_like_number($option)
&& $immodpg->{_option_file} ne $empty_string )
{
=head2 instantiate classes
=cut
my $files = manage_files_by2->new();
my $control = control->new();
=head2 Define local
variables
=cut
my @X;
my $option_file = $immodpg->{_option_file};
my $test = $no;
my $outbound = $IMMODPG_INVISIBLE . '/' . $option_file;
my $outbound_locked = $outbound . '_locked';
for ( my $i = 0 ; $test eq $no ; $i++ ) {
if ( not( $files->does_file_exist( \$outbound_locked ) ) ) {
my $format = $var_immodpg->{_format_string};
$X[0] = $empty_string;
$files->write_1col_aref( \@X, \$outbound_locked, \$format );
$X[0] = $option;
$format = $var_immodpg->{_format_integer};
# print("immodpg,set_option,option=$option\n");
$files->write_1col_aref( \@X, \$outbound, \$format );
unlink($outbound_locked);
$test = $yes;
} # if
} # for
}
elsif ( $immodpg->{_is_option_changed} eq $no ) {
# NADA
}
else {
print("immodpg, set_option, unexpected answer\n");
}
return ();
}
=head2 sub smute
=cut
sub smute {
my ( $self, $smute ) = @_;
if ($smute) {
$immodpg->{_smute} = $smute;
$immodpg->{_note} = $immodpg->{_note} . ' smute=' . $immodpg->{_smute};
$immodpg->{_Step} = $immodpg->{_Step} . ' smute=' . $immodpg->{_smute};
}
else {
print("immodpg, smute, missing smute,\n");
}
}
=head2 sub sscale
=cut
sub sscale {
my ( $self, $sscale ) = @_;
if ($sscale) {
$immodpg->{_sscale} = $sscale;
$immodpg->{_note} =
$immodpg->{_note} . ' sscale=' . $immodpg->{_sscale};
$immodpg->{_Step} =
$immodpg->{_Step} . ' sscale=' . $immodpg->{_sscale};
}
else {
print("immodpg, sscale, missing sscale,\n");
}
}
=head2 sub set_thickness_m
When you enter or leave,
check what the current thickness_m value is
compared to former thickness_m values
thickness_m value is updated in immodpg.for
through a message in file="thickness_m"
($_set_thickness_m)
=cut
sub set_thickness_m {
my ($self) = @_;
if ( looks_like_number( $immodpg->{_thickness_m_current} ) ) {
_set_control( 'thickness_m', $immodpg->{_thickness_m_current} );
$immodpg->{_thickness_m_current} = _get_control('thickness_m');
_check_thickness_m();
_update_thickness_m();
if ( length( $immodpg->{_is_thickness_m_changed_in_gui} )
&& $immodpg->{_is_thickness_m_changed_in_gui} eq $yes )
{
# for fortran program to read
# print("immodpg, set_thickness_m, thickness_m is changed: $yes \n");
_set_thickness_m( $immodpg->{_thickness_m_current} );
_set_option($change_thickness_m_opt);
_set_change($yes);
}
else {
# negative cases are reset by fortran program
# and so eliminate need to read locked files
# while use of locked files helps most of the time
# creation and deletion of locked files in perl are not
# failsafe
# print("immodpg, set_thickness_m, same thickness_m NADA\n");
}
}
else {
print("immodpg, set_thickness_m, _thickness_m value missing\n");
print(
"immodpg, set_thickness_m, thickness_m=$immodpg->{_thickness_m}\n");
}
}
=head2 sub set_thickness_increment_m
When you enter or leave
check what the current thickness_increment_m value is
compared to former thickness_increment_m values
thickness_increment_m value is updated in immodpg.for
through a message in file= "thickness_increment_m"
(&_set_thickness_increment_m)
=cut
sub set_thickness_increment_m {
my ($self) = @_;
# print("immodpg, set_thickness_increment_m, self, $self\n");
if ( length( $immodpg->{_thickness_increment_mEntry} ) ) {
$immodpg->{_thickness_increment_m_current} =
( $immodpg->{_thickness_increment_mEntry} )->get();
_set_control( 'thickness_increment_m',
$immodpg->{_thickness_increment_m_current} );
$immodpg->{_thickness_increment_m_current} =
_get_control('thickness_increment_m');
my $new_thickness_increment_m =
$immodpg->{_thickness_increment_m_current};
$immodpg->{_thickness_increment_mEntry}->delete( 0, 'end' );
$immodpg->{_thickness_increment_mEntry}
->insert( 0, $new_thickness_increment_m );
# print("immodpg, set_thickness_increment_m, $immodpg->{_thickness_increment_mEntry}\n");
_check_thickness_increment_m();
_update_thickness_increment_m_in_gui();
_write_config();
if ( $immodpg->{_is_layer_changed_in_gui} eq $yes ) {
print(
"immodpg, set_thickness_increment_m, thickness_increment_m is changed: $yes \n"
);
_set_thickness_increment_m(
$immodpg->{_thickness_increment_m_current} );
_set_option($change_thickness_increment_m_opt);
_set_change($yes);
( run in 3.216 seconds using v1.01-cache-2.11-cpan-13bb782fe5a )