view release on metacpan or  search on metacpan

lib/App/ErrorCalculator.pm  view on Meta::CPAN

# titlebar), we ask it to call the delete_event () functio
# as defined above. No data is passed to the callback function.
$window->signal_connect(delete_event => \&_delete_event);

# Here we connect the "destroy" event to a signal handler.
# This event occurs when we call Gtk2::Widget::destroy on the window,
# or if we return FALSE in the "delete_event" callback. Perl supports
# anonymous subs, so we can use one of them for one line callbacks.
$window->signal_connect(destroy => sub { Gtk2->main_quit; });

my $table = Gtk2::Table->new(5, 4, FALSE);
$window->add($table);

# Labels
my $l = Gtk2::Label->new('Function:');
$table->attach_defaults(
	$l, 0, 1, # left/right
	1, 2, # top/bottom
);
$l->show;
$l = Gtk2::Label->new('Input:');
$table->attach_defaults(
	$l, 0, 1, # left/right
	2, 3, # top/bottom
);
$l->show;
$l = Gtk2::Label->new('Output:');
$table->attach_defaults(
	$l,	0, 1, # left/right
	3, 4, # top/bottom
);
$l->show;

# feedback labels
my $funclabel = Gtk2::Label->new('Valid Function  ');
$table->attach_defaults(
	$funclabel, 3, 4, # left/right
	1, 2, # top/bottom
);
$funclabel->show;
my $inlabel = Gtk2::Label->new('Invalid Data File');
$table->attach_defaults(
	$inlabel, 3, 4, # left/right
	2, 3, # top/bottom
);
$inlabel->show;
my $outlabel = Gtk2::Label->new('Invalid Output File');
$table->attach_defaults(
	$outlabel, 3, 4, # left/right
	3, 4, # top/bottom
);
$outlabel->show;

# Entries
my $funcentry = Gtk2::Entry->new;
$table->attach_defaults(
	$funcentry,	1, 2, # left/right
	1, 2, # top/bottom
);
$funcentry->signal_connect(
	activate => \&_validate_func,
);
$funcentry->signal_connect(
	changed  => \&_validate_func,
);
$funcentry->set_text('f = a * x^2');
$funcentry->show;

my $inentry = Gtk2::Entry->new;
$table->attach_defaults(
	$inentry,	1, 2, # left/right
	2, 3, # top/bottom
);
$inentry->signal_connect(
	activate => \&_read_file,
);
$inentry->show;

my $outentry = Gtk2::Entry->new;
$table->attach_defaults(
	$outentry,	1, 2, # left/right
	3, 4, # top/bottom
);
$outentry->show;

# buttons
my $valbutton = Gtk2::Button->new('Validate');
$table->attach_defaults(
	$valbutton,	2, 3, # left/right
	1, 2, # top/bottom
);
$valbutton->signal_connect(	clicked => \&_validate_func );
$valbutton->show;

my $inbutton = Gtk2::Button->new('Select File');
$table->attach_defaults(
	$inbutton,	2, 3, # left/right
	2, 3, # top/bottom
);
$inbutton->signal_connect(
	clicked => sub {
		_run_fileselection(
			'Select input file', $inentry,
			sub {
				_read_file();
			},
		);
	},
);
$inbutton->show;

my $outbutton = Gtk2::Button->new('Select File');
$table->attach_defaults(
	$outbutton,	2, 3, # left/right
	3, 4, # top/bottom
);
$outbutton->signal_connect(
	clicked => sub {
		my $t = $outentry->get_text;
		_run_fileselection(
			'Select output file', $outentry,
			sub {
				my $text = shift;
				if ( -e $text ) {
					my $r = ask Gtk2::Ex::Dialogs::Question( "File exists. Overwrite?" );
					$outentry->set_text($t), return if not $r;
					$outlabel->set_text('Valid Output File  ');
				}
				else {
					$outlabel->set_text('Valid Output File  ');
				}
			}
		);
   	},
);
$outbutton->show;

my $runbutton = Gtk2::Button->new('Run Calculation');
$table->attach_defaults(
	$runbutton,	0, 4, # left/right
	4, 5, # top/bottom
);
$runbutton->signal_connect(	clicked => \&_run_calculation );
$runbutton->show;

$table->set_col_spacings(10);
$table->set_row_spacings(10);

$table->show;

sub run {
	$window->show;
	Gtk2->main;
}

sub _run_fileselection {
	my $title = shift;
	my $entry = shift;
	my $callback = shift;
	my $fsel = Gtk2::FileSelection->new($title);
	$fsel->set_filename($entry->get_text);
	$fsel->ok_button->signal_connect(
		"clicked",
		sub {
			$entry->set_text($fsel->get_filename);
			$callback->($fsel->get_filename) if defined $callback;
			$fsel->destroy
		},
		$fsel
	);
	$fsel->cancel_button->signal_connect(
		"clicked",
		sub { $fsel->destroy },
		$fsel
	);
	$fsel->show;

}

sub _parse_function {
	my $f = shift;
	my ($name, $body) = split /\s*=\s*/, $f, 2;
	return() if (not defined $name or $name =~ /^\s*$/ or not defined $body);
	my $nobj;
	eval { $nobj = Math::Symbolic::Variable->new($name) };
	return() if not defined $nobj or not defined $nobj->name or $@;
	my $func;
	eval { $func = $Math::Symbolic::Parser->parse($body) };
	return() if not defined $func or $@;
	my $var = $nobj->name;
	# function must not be recursive
	return() if grep {$var eq $_} $func->signature;
	$func = $func->apply_derivatives()->simplify();
	return($nobj, $func);
}

my ($name, $body);
sub _validate_func {
	my $f = $funcentry->get_text;
	($name, $body) = _parse_function($f);
	if (not defined $name) {
		$funclabel->set_text('Invalid Function');
	}
	else {
		$funclabel->set_text('Valid Function  ');
	}
	
}

my $data;
sub _read_file {
	my $file = $inentry->get_text();
	if (not -e $file) {
		$inlabel->set_text('Invalid Data File');
		$data = undef;
	}
	my $ref = Spreadsheet::Read::ReadData($file);
	if (not defined $ref) {
		$inlabel->set_text('Invalid Data File');
		$data = undef;
	}
	else {
		$inlabel->set_text('Valid Data File  ');
		$data = $ref;
	}
}

sub _run_calculation {
	my $func = $body;

	if (not $funclabel->get_text() eq 'Valid Function  ') {
		new_and_run
		Gtk2::Ex::Dialogs::ErrorMsg( text => "You should give me a valid formula first." );	
		return();
	}
	
	if (not $inlabel->get_text() eq 'Valid Data File  ') {
		new_and_run
		Gtk2::Ex::Dialogs::ErrorMsg( text => "You need to select a valid input data file first." );	
		return();
	}
	
	if (not $outlabel->get_text() eq 'Valid Output File  ') {
		new_and_run
		Gtk2::Ex::Dialogs::ErrorMsg( text => "You need to select a valid output data file first." );	
		return();
	}
	
	my $sym = $name->name;
	my $csv = $data->[1];
	my $cell = $csv->{cell};
	my @vars = $func->signature;
	my %vars = map {($_ => undef)} @vars;

	my %errors;
	
	foreach my $col (1..$csv->{maxcol}) {
		my $name = $cell->[$col][1];