App-SeismicUnixGui
view release on metacpan or search on metacpan
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
else {
return ();
print(
"immodpg,_get_initialVp_dz4gui, _get_initial_model gives bad values \n"
);
}
}
else {
print("immodpg,_get_initialVp_dz4gui,missing layer\\n");
return ();
}
return ();
}
=head2 sub _messages
Show warnings or errors in a message box
Message box is defined in main where it is
also made invisible (withdraw)
Here we turn on the message box (deiconify, raise)
The message does not release the program
until OK is clicked and wait variable changes from yes
to no.
=cut
sub _messages {
my ( $run_name, $number ) = @_;
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");
}
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
$immodpg->{_refVPtop} = \@VPtop;
}
elsif ( $name eq 'Vbot' ) {
# print("immodpg, _setVp_dz,immodpg->{_Vbot_current}= $immodpg->{_Vbot_current}\n");
# print("immodpg, _setVp_dz,immodpg->{_layer_current}= $immodpg->{_layer_current}\n");
my $refVPbot = $immodpg->{_refVPbot};
my @VPbot = @$refVPbot;
$VPbot[$layer_index] = $value;
# print("immodpg, _setVp_dz,Vbot,VPbot[$layer_index]=$VPbot[$layer_index]\n");
$immodpg->{_refVPbot} = \@VPbot;
}
elsif ( $name eq 'Vbot_upper_layer' ) {
my $refVPbot = $immodpg->{_refVPbot};
my @VPbot = @$refVPbot;
$VPbot[ ( $layer_index - 1 ) ] = $value;
# print("immodpg, _setVp_dz,Vbot_upper_layer,VPbot[($layer_index-1)]=$VPbot[($layer_index-1)]\n");
$immodpg->{_refVPbot} = \@VPbot;
}
elsif ( $name eq 'thickness_m' ) {
my $ref_dz = $immodpg->{_ref_dz};
my @dz = @$ref_dz;
$dz[$layer_index] = $value;
# print("immodpg, _setVp_dz, dz: dz[$layer_index]=$dz[$layer_index]\n");
$immodpg->{_ref_dz} = \@dz;
}
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");
}
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
}
} # end for loop
if ( $error_switch eq $on ) {
# print("immodpg,set_model_control, CORRUPT MODEL\n");
$immodpg->{_model_error} = $error_switch;
}
return ($result);
}
else {
print("immodpg, _set_model_control, error with layer number\n");
return ($result);
}
}
else {
print("immodpg, _set_model_control, unexpected model error\n");
return ($result);
}
}
=head2 _set_model_layer
Set the number of layers in
mmodpg
=cut
sub _set_model_layer {
my ($model_layer_number) = @_;
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
}
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
$immodpg->{_VbotNtop_factorEntry} = $widget_h->{_VbotNtop_factorEntry};
$immodpg->{_clip4plotEntry} = $widget_h->{_clip4plotEntry};
$immodpg->{_layerEntry} = $widget_h->{_layerEntry};
$immodpg->{_thickness_mEntry} = $widget_h->{_thickness_mEntry};
$immodpg->{_thickness_increment_mEntry} =
$widget_h->{_thickness_increment_mEntry};
$immodpg->{_upper_layerLabel} = $widget_h->{_upper_layerLabel};
$immodpg->{_lower_layerLabel} = $widget_h->{_lower_layerLabel};
$immodpg->{_mw} = $widget_h->{_mw};
# $immodpg->{_message_box_w} = $widget_h->{_message_box_w};
# $immodpg->{_message_upper_frame} = $widget_h->{_message_upper_frame};
# $immodpg->{_message_lower_frame} = $widget_h->{_message_lower_frame};
# $immodpg->{_message_label_w} = $widget_h->{_message_label_w};
# $immodpg->{_message_box_wait} = $widget_h->{_message_box_wait};
# $immodpg->{_message_ok_button} = $widget_h->{_message_ok_button};
# print("immodpg, set_widgets, immodpg->{_message_box_w}: $immodpg->{_message_box_w}\n");
# print("immodpg, set_widgets, OK\n");
return ();
}
else {
print("immodpg, set_widgets, unexpected\n");
}
}
=head2 sub set_base_file_name
=cut
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 );
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
}
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");
}
( run in 1.071 second using v1.01-cache-2.11-cpan-39bf76dae61 )