updated results from the CPAN

updated

App-SeismicUnixGui

view release on metacpan or search on metacpan

lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN

	{

		# 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");
		return ();

	}
	else {
		print("immodpg, _updateVbot, unexpected\n");
		return ();
	}
}

=head2 sub _updateVbot_upper_layer

keep tabs on upper layer Vbottom values
and changes in the values in the 
GUI
current layer must >0

=cut

sub _updateVbot_upper_layer {

	my ($self) = @_;

#	print("mmodpg, _updateVbot_upper_layer, Vbot_upper_layer_current=..$immodpg->{_Vbot_upper_layer_current}..\n");
	if (   looks_like_number( $immodpg->{_Vbot_upper_layer_current} )
		&& $immodpg->{_layer_current} > 0
		&& $immodpg->{_Vbot_upper_layer_current} !=
		$immodpg->{_Vbot_upper_layer_prior} )
	{

		# CASE Vbot_upper_layer changed
		$immodpg->{_isVbot_upper_layer_changed_in_gui} = $yes;
		$immodpg->{_Vbot_upper_layer_prior} =
		  $immodpg->{_Vbot_upper_layer_current};

# print("immodpg, _updateVbot_upper_layer, updated to $immodpg->{_Vbot_upper_layer_current}\n");
# print("immodpg,_updateVbot_upper_layer,Vbot_upper_layer_current=$immodpg->{_Vbot_upper_layer_current}\n");
# print("immodpg,_updateVbot_upper_layer,Vbot_upper_layer_prior=$immodpg->{_Vbot_upper_layer_prior}\n");
		_set_control( 'Vbot_upper_layer',
			$immodpg->{_Vbot_upper_layer_current} );
		$immodpg->{_Vbot_upper_layer_current} =
		  _get_control('Vbot_upper_layer');

		_setVp_dz( 'Vbot_upper_layer', $immodpg->{_Vbot_upper_layer_current} );
		return ();

	}
	elsif ( looks_like_number( $immodpg->{_Vbot_upper_layer_current} )
		&& $immodpg->{_Vbot_upper_layer_current} ==
		$immodpg->{_Vbot_upper_layer_prior} )
	{

		# CASE Vbot_upper_layer is unchanged
		# print("immodpg, _updateVbot_upper_layer, unchanged\n");
		$immodpg->{_isVbot_upper_layer_changed_in_gui} = $no;

# print("immodpg,_updateVbot_upper_layer,Vbot_upper_layer_prior=$immodpg->{_Vbot_upper_layer_prior}\n");
		return ();

	}
	elsif ( not( looks_like_number( $immodpg->{_Vbot_upper_layer_current} ) ) )
	{

# CASE Vbot_upper_layer is unchanged
#		print("immodpg, _updateVbot_upper_layer, no value in Vbot_upper_layer NADA\n");
# print("immodpg,_updateVbot_upper_layer,Vbot_upper_layer_prior=$immodpg->{_Vbot_upper_layer_prior}\n");
		return ();

	}
	else {
		print("immodpg, _updateVbot_upper_layer, unexpected\n");

#		print("immodpg,_updateVbot_upper_layer,Vbot_upper_layer_current=$immodpg->{_Vbot_upper_layer_current}\n");
		return ();
	}
}

=head2 sub _update_Vincrement

keep tabs on Vincrement values
and changes in the values in the  
GUI

=cut

sub _updateVincrement {

	my ($self) = @_;

	if ( looks_like_number( $immodpg->{_Vincrement_current} )
		&& $immodpg->{_Vincrement_current} != $immodpg->{_Vincrement_prior} )
	{

		# CASE Vincrement changed
		$immodpg->{_Vincrement_current} = $immodpg->{_Vincrement_current};
		$immodpg->{_isVincrement_changed_in_gui} = $yes;

# print("immodpg, _updateVincrement, updated to $immodpg->{_Vincrement_current}\n");

#		print("immodpg,_updateVincrement,Vincrement_current=$immodpg->{_Vincrement_current}\n");
#		print("immodpg,_updateVincrement,Vincrement_prior=$immodpg->{_Vincrement_prior}\n");
		return ();

	}
	elsif ( $immodpg->{_Vincrement_current} == $immodpg->{_Vincrement_prior} ) {

		# CASE Vincrement is unchanged
		# print("immodpg, _updateVincrement, unchanged\n");
		$immodpg->{_isVincrement_changed_in_gui} = $no;

# print("immodpg,_updateVincrement,Vincrement_current=$immodpg->{_Vincrement_current}\n");
# print("immodpg,_updateVincrement,Vincrement_prior=$immodpg->{_Vincrement_prior}\n");
		return ();

	}
	else {
		print("immodpg, _updateVincrement, unexpected\n");
		return ();
	}
}

=head2 sub _updateVtop

keep tabs on Vtop values
and changes in the values in the  
GUI
Also updates an shared copy
of the model properties

=cut

sub _updateVtop {

	my ($self) = @_;

	if ( looks_like_number( $immodpg->{_Vtop_current} )
		&& $immodpg->{_Vtop_current} != $immodpg->{_Vtop_prior} )
	{

		# CASE Vtop changed
		$immodpg->{_isVtop_changed_in_gui} = $yes;
		$immodpg->{_Vtop_prior}            = $immodpg->{_Vtop_current};

	   #		print("immodpg, _updateVtop, updated to $immodpg->{_Vtop_current}\n");
	   #		print("immodpg,_updateVtop,Vtop_current=$immodpg->{_Vtop_current}\n");
	   #		print("immodpg,_updateVtop,Vtop_prior=$immodpg->{_Vtop_prior}\n");

		_set_control( 'Vtop', $immodpg->{_Vtop_current} );
		$immodpg->{_Vtop_current} = _get_control('Vtop');
		_setVp_dz( 'Vtop', $immodpg->{_Vtop_current} );

		return ();

	}
	elsif ( $immodpg->{_Vtop_current} == $immodpg->{_Vtop_prior} ) {

		# CASE Vtop is unchanged
		#		print("immodpg, _updateVtop, unchanged\n");
		$immodpg->{_isVtop_changed_in_gui} = $no;

	   #		print("immodpg,_updateVtop,Vtop_current=$immodpg->{_Vtop_current}\n");
	   #		print("immodpg,_updateVtop,Vtop_prior=$immodpg->{_Vtop_prior}\n");
		return ();

	}
	else {
		print("immodpg, _updateVtop, unexpected\n");
		return ();
	}
}

=head2 sub _updateVtop_lower_layer

keep tabs on Vtop_lower_layer values
and changes in the values in the  
GUI
Also updates an shared copy
of the model properties

=cut

sub _updateVtop_lower_layer {

	my ($self) = @_;

	if ( looks_like_number( $immodpg->{_Vtop_lower_layer_current} )
		&& $immodpg->{_Vtop_lower_layer_current} !=
		$immodpg->{_Vtop_lower_layer_prior} )
	{

# CASE Vtop changed
#		print("immodpg, _updateVtop_lower_layer, Vcurrent=$immodpg->{_Vtop_lower_layer_current}\n");
		$immodpg->{_isVtop_lower_layer_changed_in_gui} = $yes;
		$immodpg->{_Vtop_lower_layer_prior} =
		  $immodpg->{_Vtop_lower_layer_current};

		#		print("immodpg, _updateVtop_lower_layer, changed\n");
		_set_control( 'Vtop_lower_layer',
			$immodpg->{_Vtop_lower_layer_current} );
		$immodpg->{_Vtop_lower_layer_current} =
		  _get_control('Vtop_lower_layer');

		_setVp_dz( 'Vtop_lower_layer', $immodpg->{_Vtop_lower_layer_current} );

		return ();

	}
	elsif ( $immodpg->{_Vtop_lower_layer_current} ==
		$immodpg->{_Vtop_lower_layer_prior} )
	{

# CASE Vtop_lower_layer is unchanged
#		print("immodpg, _updateVtop_lower_layer, unchanged\n");
#		print("immodpg, _updateVtop_lower_layer, Vcurrent=$immodpg->{_Vtop_lower_layer_current}\n");
		$immodpg->{_isVtop_lower_layer_changed_in_gui} = $no;

		return ();

	}
	else {
		print("immodpg, _updateVtop_lower_layer, unexpected\n");
		return ();
	}
}

=head2 sub _updateVbotNtop_factor

keep tabs on VbotNtop_factor  values
and changes in the values in the  
GUI

=cut

sub _updateVbotNtop_factor {

	my ($self) = @_;

	if ( looks_like_number( $immodpg->{_VbotNtop_factor_current} )
		&& $immodpg->{_VbotNtop_factor_current} !=
		$immodpg->{_VbotNtop_factor_prior} )
	{

# CASE VbotNtop_factor changed
#			$immodpg->{_VbotNtop_factor_current}          = $immodpg->{_VbotNtop_factor_current};
		_set_control( 'VbotNtop_factor', $immodpg->{_VbotNtop_factor_current} );
		$immodpg->{_VbotNtop_factor_current} = _get_control('VbotNtop_factor');
		$immodpg->{_isVbotNtop_factor_changed_in_gui} = $yes;

#			print("immodpg, _updateVbotNtop_factor, updated to $immodpg->{_VbotNtop_factor_current}\n");
#			print("immodpg,_updateVbotNtop_factor,VbotNtop_factor_current=$immodpg->{_VbotNtop_factor_current}\n");
#			print("immodpg,_updateVbotNtop_factor,VbotNtop_factor_prior=$immodpg->{_VbotNtop_factor_prior}\n");
		return ();

	}
	elsif ( $immodpg->{_VbotNtop_factor_current} ==
		$immodpg->{_VbotNtop_factor_prior} )
	{

		# CASE VbotNtop_factor is unchanged
		# print("immodpg, _updateVbotNtop_factor, unchanged\n");
		$immodpg->{_isVbotNtop_factor_changed_in_gui} = $no;

# print("immodpg,_updateVbotNtop_factor,VbotNtop_factor_current=$immodpg->{_VbotNtop_factor_current}\n");
# print("immodpg,_updateVbotNtop_factor,VbotNtop_factor_prior=$immodpg->{_VbotNtop_factor_prior}\n");
		return ();

	}
	else {
		print("immodpg, _updateVbotNtop_factor, unexpected\n");
		return ();
	}
}

=head2 sub _updateVbotNtop_multiply

keep tabs on Vbot AND Vtop values together
and changes in the values in the  
GUI
Also updates an shared copy
of the model properties

=cut

sub _updateVbotNtop_multiply {

	my ($self) = @_;

	if (   looks_like_number( $immodpg->{_Vbot_current} )
		&& looks_like_number( $immodpg->{_Vtop_current} )
		&& looks_like_number( $immodpg->{_Vbot_multiplied} )
		&& looks_like_number( $immodpg->{_Vtop_multiplied} ) )
	{

		$immodpg->{_Vbot_prior}   = $immodpg->{_Vbot_current};
		$immodpg->{_Vbot_current} = $immodpg->{_Vbot_multiplied};

		$immodpg->{_Vtop_prior}   = $immodpg->{_Vtop_current};
		$immodpg->{_Vtop_current} = $immodpg->{_Vtop_multiplied};

		_set_control( 'Vbot', $immodpg->{_Vbot_current} );
		$immodpg->{_Vbot_current} = _get_control('Vbot');

		_set_control( 'Vtop', $immodpg->{_Vtop_current} );
		$immodpg->{_Vtop_current} = _get_control('Vtop');

		# conveniently short variable names
		my $Vtop_current = $immodpg->{_Vtop_current};
		my $Vbot_current = $immodpg->{_Vbot_current};

		$immodpg->{_VtopEntry}->delete( 0, 'end' );
		$immodpg->{_VtopEntry}->insert( 0, $Vtop_current );
		$immodpg->{_VbotEntry}->delete( 0, 'end' );
		$immodpg->{_VbotEntry}->insert( 0, $Vbot_current );

# print("immodpg, _updateVbotNtop_multiply, updated to $immodpg->{_VbotNtop_multiply_current}\n");
# print("immodpg,_updateVbotNtop_multiply,VbotNtop_multiply_current=$immodpg->{_VbotNtop_multiply_current}\n");
# print("immodpg,_updateVbotNtop_multiply,VbotNtop_multiply_prior=$immodpg->{_VbotNtop_multiply_prior}\n");
#			_checkVbot(); #todo
		_updateVbot();

		#			_checkVtop(); #todo
		_updateVtop();

	}
	else {
		print("immodpg, _updateVbotNtop_factor, unexpected\n");
		return ();
	}
}

=head2 sub _update_clip

keep tabs on clip values
and changes in the values in the  
GUI

=cut

sub _update_clip {

	my ($self) = @_;

	if ( looks_like_number( $immodpg->{_clip4plot_current} )
		&& $immodpg->{_clip4plot_current} != $immodpg->{_clip4plot_prior} )
	{

		# CASE clip changed
		$immodpg->{_clip4plot_current}      = $immodpg->{_clip4plot_current};
		$immodpg->{_is_clip_changed_in_gui} = $yes;

# print("immodpg, _update_clip, updated to $immodpg->{_clip4plot_current}\n");
# print("immodpg,_update_clip,clip4plot_current=$immodpg->{_clip4plot_current}\n");
# print("immodpg,_update_clip,clip4plot_prior=$immodpg->{_clip4plot_prior}\n");
		return ();

	}
	elsif ( $immodpg->{_clip4plot_current} == $immodpg->{_clip4plot_prior} ) {

		# CASE clip4plot  is unchanged
		# print("immodpg, _update_clip, unchanged\n");
		$immodpg->{_is_clip_changed_in_gui} = $no;

# print("immodpg,_update_clip,clip4plot_current=$immodpg->{_clip4plot_current}\n");
# print("immodpg,_update_clip,clip4plot_prior=$immodpg->{_clip4plot_prior}\n");
		return ();

	}
	else {
		print("immodpg, _update_clip, unexpected\n");
		return ();
	}
}

=head2 sub _update_thickness_m

keep tabs on thickness_m values
and changes in the values in the  
GUI
Also updates an shared copy
of the model properties

=cut

sub _update_thickness_m {

	my ($self) = @_;

	if ( looks_like_number( $immodpg->{_thickness_m_current} )
		&& $immodpg->{_thickness_m_current} != $immodpg->{_thickness_m_prior} )
	{

		# CASE _thickness_m changed
		$immodpg->{_is_thickness_m_changed_in_gui} = $yes;

# print("immodpg, _update_thickness_m, updated to $immodpg->{_thickness_m_current}\n");
#	print("immodpg,_update_thickness_m,_thickness_m_current=$immodpg->{_thickness_m_current}\n");
# print("immodpg,_update_thickness_m,_thickness_m_prior=$immodpg->{_thickness_m_prior}\n");

		_set_control( 'thickness_m', $immodpg->{_thickness_m_current} );
		$immodpg->{_thickness_m_current} = _get_control('thickness_m');
		_setVp_dz( 'thickness_m', $immodpg->{_thickness_m_current} );

		return ();

	}
	elsif ( $immodpg->{_thickness_m_current} == $immodpg->{_thickness_m_prior} )
	{

		# CASE _thickness_m is unchanged
		# print("immodpg, _update_thickness_m, unchanged\n");
		$immodpg->{_is_thickness_m_changed_in_gui} = $no;

# print("immodpg,_update_thickness_m,_thickness_m_current=$immodpg->{_thickness_m_current}\n");
# print("immodpg,_update_thickness_m,_thickness_m_prior=$immodpg->{_thickness_m_prior}\n");
		return ();

	}
	else {
		print("immodpg, _update_thickness_m, unexpected\n");
		return ();
	}
}

=head2 sub _update_thickness_increment_m_in_gui

keep tabs on thickness_increment_m values
and changes in the values in the  
GUI

=cut

sub _update_thickness_increment_m_in_gui {

	my ($self) = @_;

	if ( looks_like_number( $immodpg->{_thickness_increment_m_current} )
		&& $immodpg->{_thickness_increment_m_current} !=
		$immodpg->{_thickness_increment_m_prior} )
	{

		# CASE thickness changed
		$immodpg->{_thickness_increment_m_prior} =
		  $immodpg->{_thickness_increment_m_current};
		$immodpg->{_is_layer_changed_in_gui} = $yes;

# print("immodpg, _update_thickness_increment_m_in_gui, updated to $immodpg->{_thickness_increment_m_current}\n");
# print("immodpg,_update_thickness_increment_m_in_gui,thickness_increment_m_current=$immodpg->{_thickness_increment_m_current}\n");
# print("immodpg,_update_thickness_increment_m_in_gui,thickness_increment_m_prior=$immodpg->{_thickness_increment_m_prior}\n");
		return ();

	}
	elsif ( $immodpg->{_thickness_increment_m_current} ==
		$immodpg->{_thickness_increment_m_prior} )
	{

		# CASE thickness_increment_m is unchanged
		# print("immodpg, _update_thickness_increment_m_in_gui, unchanged\n");
		$immodpg->{_is_layer_changed_in_gui} = $no;

# print("immodpg,_update_thickness_increment_m_in_gui,thickness_increment_m_current=$immodpg->{_thickness_increment_m_current}\n");
# print("immodpg,_update_thickness_increment_m_in_gui,thickness_increment_m_prior=$immodpg->{_thickness_increment_m_prior}\n");
		return ();

	}
	else {
		print("immodpg, _update_thickness_increment_m_in_gui, unexpected\n");
		return ();
	}
}

=head2 sub _update_layer_in_gui

keep tabs on layer values
and changes in the values in the  
GUI

update prior in advance of _check_layer

=cut

sub _update_layer_in_gui {

	my ($self) = @_;

	if (
		looks_like_number( $immodpg->{_layer_current} )
		and length(
			$immodpg->{_layer_prior} and length( $immodpg->{_layerEntry} )
		)
		and ( $immodpg->{_layer_current} != $immodpg->{_layer_prior} )
	  )
	{

		# CASE layer changed
		$immodpg->{_is_layer_changed_in_gui} = $yes;
		my $layer_current   = $immodpg->{_layer_current};
		my $new_layer_prior = $immodpg->{_layer_current};

		$immodpg->{_layerEntry}->delete( 0, 'end' );
		$immodpg->{_layerEntry}->insert( 0, $layer_current );

		$immodpg->{_layer_prior} = $new_layer_prior;

#		print("immodpg, _update_layer_in_gui, prior=$immodpg->{_layer_prior}current= $immodpg->{_layer_current}\n");

		return ();

lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN


		my $layer_current    = $immodpg->{_control_layer_external};
		my $number_of_layers = _get_number_of_layers();

#		print("2. immodpg, get_control_layer, number_of_layers= $number_of_layers\n");

		if ( $layer_current > $number_of_layers ) {

	  # case 1A layer number exceeds possible value
	  #			print("case1A: immodpg, get_control_layer, layer number too large\n");
	  #			print("immodpg, get_control_layer, layer_number=$layer_current}\n");
			$layer_current = $number_of_layers - 1;

	  # print("immodpg, get_control_layer, new layer_number=$layer_current}\n");
			$result = $layer_current;

		}
		elsif ( $layer_current < 1 ) {

			$layer_current = 1;
			$result        = $layer_current;

#			print("CASE 1B immodpg, get_control_layer, layer_number=$layer_current}\n");

		}
		elsif ( $layer_current == 1 ) {

			$layer_current = 1;
			$result        = $layer_current;

	   #			print("CASE 1 C immodpg, get_control_layer, layer=$layer_current\n");

		}
		elsif ( ( $layer_current < $number_of_layers ) ) {

			$result = $layer_current;

	   #			print("CASE 1 D immodpg, get_control_layer, layer=$layer_current\n");

			# NADA

		}
		elsif ( ( $layer_current == $number_of_layers ) ) {

			$result = $layer_current - 1;

	   #			print("iCASE 1 E mmodpg, get_control_layer, layer=$layer_current\n");
	   # NADA

		}
		else {
			print("immodpg, get_control_layer, unexpected layer number\n");
			$result = $empty_string;
		}

	}
	elsif ( length( $immodpg->{_control_layer_external} ) == 0 ) {

		$result = 1;

#		print("CASE 2immodpg, get_control_layer, empty string layer updated to $result\n");

	}
	else {
		print("immodpg, get_control_layer, unexpected value\n");
	}

	return ($result);
}

=head2 sub get_max_index
 
max index = number of input variables -1
 
=cut

sub get_max_index {
	my ($self) = @_;
	my $max_index = 14;

	return ($max_index);
}

=head2 sub initialize_messages
Create widgets that show 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 initialize_messages {

	my ($self) = @_;

	my $arial_14_b = ( $immodpg->{_mw} )->fontCreate(
		'arial_14_b',
		-family => 'arial',
		-weight => 'bold',
		-size   => -14
	);

=head2 message box
withdraw temporarily while filling
with widgets

=cut 

	$immodpg->{_message_box_w} =
	  $immodpg->{_mw}->Toplevel( -background => $var_L_SU->{_my_yellow}, );
	$immodpg->{_message_box_w}->withdraw;

	$immodpg->{_message_box_w}->geometry( $var_L_SU->{_message_box_geometry} );

	$immodpg->{_message_upper_frame} = $immodpg->{_message_box_w}->Frame(
		-borderwidth => $var_L_SU->{_no_borderwidth},
		-background  => $var_L_SU->{_my_yellow},

lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN


	}
	else {

		# print("immodpg,_get_number_of_layers, missing values\n");
		$number_of_layers = 0;
	}

	my $result = $number_of_layers;
	return ($result);
}

=head2 sub get_replacement4missing


=cut

sub get_replacement4missing {

	my ($self) = @_;

	if (    length( $immodpg->{_replacement4missing} )
		and length( $immodpg->{_inbound_missing} ) )
	{

		my $inbound     = $immodpg->{_inbound_missing};
		my $replacement = $immodpg->{_replacement4missing};

		if ( not( -e $inbound ) ) {

			#				print("immodpg,get_replacement4missing ,file is missing\n");
			use File::Copy;
			my $from = $replacement;
			my $to   = $inbound;
			copy( $from, $to );

		}
		elsif ( -e $inbound ) {

			#				print("immodpg,get_replacement4missing,OK-NADA \n");

		}
		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

lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN


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");
	}
}

lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN

	}
	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);

#				print("immodpg, set_thickness_increment_m,option:$change_thickness_increment_m_opt\n");
#				print(
#					"immodpg, set_thickness_increment_m,immodpg->{_thickness_increment_m_current}=$immodpg->{_thickness_increment_m_current}\n"
#				);

		}
		else {
			_set_change($no);

# print("immodpg, set_thickness_increment_m, same thickness_increment_m NADA\n");
		}

	}
	else {

	}
}

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