App-InvestSim
view release on metacpan or search on metacpan
lib/App/InvestSim/GUI.pm view on Meta::CPAN
}
# Force-refresh the content of all entry field.
my @all_refresh_actions; # a list of sub-reference to execute
sub refresh_all_fields {
Tkx::focus('.');
map { $_->() } @all_refresh_actions;
calculate_all();
}
# Callback called when one of our validated fields gets the focus.
# widget is the widget itself (the object, not the Tk path), $var is a scalar
# reference to the variable holding the un-decorated value. $right_justified is
# true if the field should be right justified when not edited.
# This replaces the beautified content of the entry, with the raw content for
# editing.
sub focus_in_field {
my ($widget, $var, $right_justified) = @_;
$widget->m_delete(0, 'end');
$widget->m_insert(0, $$var);
$widget->m_configure(-justify => 'left') if $right_justified;
$widget->m_configure(-validate => 'key');
}
# Callback called when one of our validated fields lose the focus. Arguments are
# the same as for focus_in_field, with the addition of $refresh which is a method
# called to format the raw value into a better looking string.
# This replaces the raw content of the entry with the beautified text.
sub focus_out_field {
my ($widget, $var, $right_justified, $refresh) = @_;
$widget->m_configure(-validate => 'none');
# Todo: check here that the widget is in a valid state before proceeding.
$$var = $widget->m_get() =~ s/,/./r;
$refresh->();
$widget->m_configure(-justify => 'right') if $right_justified;
calculate_all();
}
# Receives a ttk_entry widget, a var reference and a field type (euro, percent,
# or year) and setup the entry so that it edits that variable with a beautified
# display corresponding to the type. $textvar can be undef or a scalar
# reference that gets the beautified content of the field.
sub setup_entry {
my ($widget, $var, $format, $validate, $textvar) = @_;
my $right_justified = (Tkx::SplitList($widget->m_configure('-justify')))[-1] eq 'right';
my $refresh = sub {
$widget->m_delete(0, 'end');
$widget->m_insert(0, $format->($$var));
$$textvar = $format->($$var) if $textvar;
};
push @all_refresh_actions, $refresh;
$widget->g_bind("<FocusIn>", sub { focus_in_field($widget, $var, $right_justified) });
$widget->g_bind("<FocusOut>", sub { focus_out_field($widget, $var, $right_justified, $refresh) });
# The validation function will receive the new string and the event 'key' or
# 'forced' (could be 'focusin' or 'focusout' but we don't validate on these
# event).
$widget->m_configure(-validate => 'none', -validatecommand => [ sub { $has_changes = 1; $validate->(@_) }, Tkx::Ev('%P', '%V')]);
}
my $currently_selected;
sub set_core_table_selected_state {
my ($widget) = @_;
$currently_selected->m_state('!selected') if $currently_selected;
$currently_selected = $widget;
$widget->m_state('selected');
}
lib/App/InvestSim/GUI.pm view on Meta::CPAN
# Some variables that are linked to widgets, that are set from elsewhere.
my ($total_rent_text, $rent_cap_text, $pinel_worth_text, $notary_fees_text, $total_invested_text);
# How to format the various modes of the drop-down menu.
my @modes_format;
# Add in the given frame in column 0 and 1 a label and an entry text box in the
# given row that is incremented ($row is a ref to a scalar).
sub add_input_entry {
my ($frame, $row, $key, $text, $format, $tooltip) = @_;
my (undef, $validate) = @{$values_config{$key}};
my $var_ref = \$values{$key};
$frame->new_ttk__label(-text => "${text} :")
->g_grid(-column => 0, -row => $$row, -sticky => "e", -padx => "0 2");
my $e = $frame->new_ttk__entry(-width => ENTRY_WIDTH);
$e->g_grid(-column => 1, -row => $$row++, -sticky => "we", -pady => 2);
setup_entry($e, $var_ref, $format, $validate);
if ($tooltip) {
local $Text::Wrap::columns = 50;
$e->g_tooltip__tooltip(Text::Wrap::fill('', '', $tooltip));
}
}
# Build the main window of the app.
sub build {
my ($res_dir) = @_;
Tkx::package_require("tooltip");
lib/App/InvestSim/GUI.pm view on Meta::CPAN
{
my $frame = $root->new_ttk__frame(-padding => 3);
$frame->g_grid(-column => 1, -row => 0, -sticky => "nwes");
$frame->g_grid_columnconfigure(0, -weight => 1);
$frame->new_ttk__label(-text => "Durée d'emprunt (années)")
->g_grid(-column => 0, -row => 0, -sticky => "e");
$frame->new_ttk__label(-text => "Taux d'emprunt")
->g_grid(-column => 0, -row => 1, -sticky => "e");
my $loan_durations = $values{loan_durations};
my $validate_duration = $values_config{loan_durations}[1];
my $loan_rates = $values{loan_rates};
my $validate_rate = $values_config{loan_rates}[1];
for my $i (0..NUM_LOAN_DURATION-1) {
my $d = $frame->new_ttk__entry(-width => ENTRY_WIDTH);
$d->g_grid(-column => $i + 1, -row => 0, -sticky => "we");
setup_entry($d, \$loan_durations->[$i], \&format_year, $validate_duration, \$loan_duration_texts[$i]);
my $r = $frame->new_ttk__entry(-width => ENTRY_WIDTH);
$r->g_grid(-column => $i + 1, -row => 1, -sticky => "we");
setup_entry($r, \$loan_rates->[$i], \&format_percent, $validate_rate);
}
}
# Build the combo-box with the list of possible values, in its own frame.
my @modes;
$modes[MONTHLY_PAYMENT] = "Mensualité de l'emprunt (assurance comprise)";
$modes_format[MONTHLY_PAYMENT] = \&format_euro;
$modes[LOAN_COST] = "Cout total de l'emprunt (assurance comprise)";
$modes_format[LOAN_COST] = \&format_euro;
$modes[YEARLY_RENT_AFTER_LOAN] = "Revenus locatif net déduit des remboursement, par an";
lib/App/InvestSim/GUI.pm view on Meta::CPAN
# top bar.
$frame->g_grid_columnconfigure(0, -weight => 1);
$frame->new_ttk__label(-text => 'Emprunt \ Durée')
->g_grid(-column => 0, -row => 0);
for my $i (0..NUM_LOAN_DURATION-1) {
$frame->new_ttk__entry(-width => ENTRY_WIDTH, -textvariable => \$loan_duration_texts[$i], -state => 'readonly', -takefocus => 0)
->g_grid(-column => $i + 1, -row => 0, -sticky => "we");
}
my $loan_amounts = $values{loan_amounts};
my $validate_amount = $values_config{loan_amounts}[1];
for my $j (0..NUM_LOAN_AMOUNT-1) {
my $w = $frame->new_ttk__entry(-width => ENTRY_WIDTH, -justify => 'right');
$w->g_grid(-column => 0, -row => $j + 1, -sticky => "we");
setup_entry($w, \$loan_amounts->[$j], \&format_euro, $validate_amount);
}
for my $i (0..NUM_LOAN_DURATION-1) {
for my $j (0..NUM_LOAN_AMOUNT-1) {
my $e = $frame->new_ttk__entry(-width => ENTRY_WIDTH, -textvariable => \$core_display_values[$i][$j],
-state => 'readonly', -justify => 'right', -takefocus => 0,
-style => 'DataTable.TEntry');
$e->g_grid(-column => $i + 1, -row => $j + 1, -sticky => "we");
$e->g_bind('<FocusIn>', sub { set_core_table_selected_state($e);
update_displayed_table($i, $j) });
}
lib/App/InvestSim/Values.pm view on Meta::CPAN
use List::Util qw(pairmap);
use Data::Dumper;
use Safe;
our @EXPORT = ();
our @EXPORT_OK = qw(%values %values_config $has_changes init_values save_values save_values_as open_values autoload autosave);
our %EXPORT_TAGS = (all => \@EXPORT_OK);
# Validation functions for different value type. Each of these functions receive
# two arguments:
# - the string to validate.
# - the validation event: 'key' when the validation is for a key entered by the
# user, 'focusout' when the value is complete and it can be validated
# entirely. That second event is also used to validate values read from a
# backup file.
# On failure, these methods must all return 0 (and not just '' which is the
# default false value), as that is expected by Tcl.
# An integer that is allowed to be 0 or more.
sub validate_non_negative_integer {
my ($val, undef) = @_;
if ($val =~ m/^\d*$/) {
return 1;
} else {
return 0; # Tcl requires a 0 and not just ''.
}
}
# An integer that must be positive.
sub validate_positive_integer {
my ($val, $event) = @_;
if ($val =~ m/^\d*$/ and ($val or $event eq 'key')) {
return 1;
} else {
return 0; # Tcl requires a 0 and not just ''.
}
}
# A non-negative float.
sub validate_float {
my ($val, $event) = @_;
if ($val =~ m/^\d*((\.|,)\d*)?$/) {
return 1;
} else {
return 0;
}
}
# The file name used for the auto-save feature.
my $autosave_file = catfile(File::HomeDir->my_data(), '.investment_simulator');
lib/App/InvestSim/Values.pm view on Meta::CPAN
my $current_file;
# This hash list all the variables that can be used to configure the simulation.
# Each variable name points to the following values (in an array-ref):
# - its default value (which also give its type if its a reference);
# - a validation function for values entered by the user or read from files;
# - for an array variable, its expected size.
our %values_config = (
# Values set through the left-bar of the program:
invested => [300000, \&validate_positive_integer],
tax_rate => [41.0, \&validate_float],
base_rent => [800, \&validate_positive_integer],
rent_charges => [24, \&validate_float],
rent_increase => [0.5, \&validate_float],
duration => [20, \&validate_positive_integer],
loan_insurance => [0.3, \&validate_float],
other_rate => [0.0, \&validate_float],
social_tax => [17.2, \&validate_float],
surface => [40, \&validate_float],
loan_delay => [0, \&validate_non_negative_integer],
rent_delay => [0, \&validate_non_negative_integer],
notary_fees => [2.5, \&validate_float],
application_fees => [1000, \&validate_non_negative_integer],
mortgage_fees => [1.2, \&validate_float],
# Values set through the top-bar and the core data table:
loan_durations => [[qw(10 12 14 16 18 20)], \&validate_positive_integer, NUM_LOAN_DURATION],
loan_rates => [[qw(0.9 0.9 1.0 1.2 1.3 1.4)], \&validate_float, NUM_LOAN_DURATION],
loan_amounts => [[qw(0 50000 100000 150000 200000 250000 300000)], \&validate_positive_integer, NUM_LOAN_AMOUNT],
# Values set through the menu:
pinel_duration => [0, \&validate_non_negative_integer],
pinel_zone => [0, \&validate_non_negative_integer],
automatic_duration => [0, \&validate_non_negative_integer],
);
Hash::Util::lock_hash(%values_config);
# This hash has the actual values used to configure the simulation. Its keys are
# restricted to those of %values_config.
our %values;
Hash::Util::lock_keys(%values, keys %values_config);
# Whether any of the values has changed. This must be updated manually by the
# caller when they touch a value.
lib/App/InvestSim/Values.pm view on Meta::CPAN
my ($default, undef, $size) = @$conf;
if (ref $default eq '') {
$values{$key} = $default;
} elsif (ref $default eq 'ARRAY') {
if ($size != @$default) {
message_and_die(
"Erreur interne: taille par défaut invalide pour $key",
sprintf("attendu: %d\nréel: %d", $size, scalar(@$default)));
}
# We're using this loop (instead of just @$values{$key} = @$default ) to
# not invalidate the references to the values of the array.
for my $i (0..$#$default) {
$values{$key}[$i] = $default->[$i];
}
} else {
message_and_die(
"Erreur interne: type de reference inatendu dans init_value pour $key: ".(ref $default));
}
}
$has_changes = 0;
}
lib/App/InvestSim/Values.pm view on Meta::CPAN
# With this approach of merging the file read with the default config, we
# are getting the default value for a configuration variable that would not be
# in the file read (or if its value is invalid).
while (my ($key, $conf) = each %values_config) {
my ($default, $validation) = @$conf;
my $value = $saved_data->{$key};
if (ref $default eq '') {
$values{$key} = defined $value && $validation->($value, 'focusout') ? $value : $default;
} elsif (ref $default eq 'ARRAY') {
# We're using this loop (instead of just @$values{$key} = @$default ) to
# not invalidate the references to the values of the array.
for my $i (0..$#$default) {
$values{$key}[$i] = defined $value->[$i] && $validation->($value->[$i], 'focusout') ? $value->[$i] : $default->[$i];
}
} else {
message_and_die(
"Erreur interne: type de reference inatendu dans read_from_file pour $key: ".(ref $default));
}
}
$has_changes = 0;
return 1;
( run in 0.769 second using v1.01-cache-2.11-cpan-beeb90c9504 )