App-financeta
view release on metacpan or search on metacpan
lib/App/financeta/gui.pm view on Meta::CPAN
my @ncols = (0 .. $total_cols - 1); # get a list of column numbers
my @nhdrs = (@$headers);
return unless $result->{columns};
my @cols2rem = @{$result->{columns}};
foreach my $c (@cols2rem) {
$ncols[$c] = undef;
$nhdrs[$c] = undef;
}
@nhdrs = grep { defined $_ } @nhdrs;
@ncols = grep { defined $_ } @ncols;
$log->debug("New Headers: ", dumper(\@nhdrs));
$log->debug("Remaining columns: ", dumper(\@ncols));
my $ndata = $data->dice('X', \@ncols);
my $nindics = [];
if ($indicators) {
my $index = $result->{indicator_index};
for (0 .. scalar(@$indicators) - 1) {
next if $_ == $index;
push @$nindics, $indicators->[$_];
}
}
if ($self->set_tab_data_by_name($win, $result->{tab}, $ndata, $symbol, $nindics, \@nhdrs)) {
$log->debug("Successfully set data");
$self->display_data($win, $ndata, $symbol);
my ($adata, $asymbol, $aindicators, $ahdr, $abysl) = $self->get_tab_data($win);
my $type = $self->current->{plot_type} || 'OHLC';
$self->plot_data($win, $adata, $asymbol, $type, $aindicators, $abysl);
# disable remove indicator if there are no indicators left
unless (scalar @$aindicators) {
#$self->main->menu->remove_indicator->enabled(0);
}
}
}
}
sub remove_indicator_wizard {
my ($self, $win) = @_;
my $w = Prima::Dialog->new(
name => 'rem_ind_wizard',
centered => 1,
origin => [200, 200],
size => [640, 280],
text => 'Remove Indicator Wizard',
icon => $self->icon,
visible => 1,
taskListed => 0,
onExecute => sub {
my $dlg = shift;
$dlg->cbox_tabs->List->focusedItem(-1);
$dlg->cbox_inds->List->focusedItem(-1);
$dlg->btn_cancel->enabled(1);
$dlg->btn_ok->enabled(0);
},
);
$w->owner($win) if defined $win;
my %tabs = $self->get_tab_names($win);
$log->debug("Current tabs: ", dumper(\%tabs));
my $result = {};
$w->insert(Label => name => 'label_tabs',
text => 'Select Security',
font => { style => fs::Bold, height => 16 },
alignment => ta::Left,
autoHeight => 1,
autoWidth => 1,
origin => [20, 240],
hint => 'This is a list of already open tabs',
hintVisible => 1,
);
$w->insert(ComboBox =>
name => 'cbox_tabs',
style => cs::DropDownList,
height => 30,
width => 360,
hScroll => 0,
multiSelect => 0,
multiColumn => 0,
dragable => 0,
focusedItem => -1,
font => { height => 14 },
items => ['', keys %tabs],
origin => [180, 240],
onChange => sub {
my $cbox = shift;
my $owner = $cbox->owner;
my $lbox = $cbox->List;
my $index = $lbox->focusedItem;
my $txt = $lbox->get_item_text($index);
if (defined $txt and length $txt) {
my $indicators = $self->get_tab_indicators($owner->owner, $txt);
my @inds = ();
if ($indicators) {
foreach (@$indicators) {
push @inds, $_->{indicator}->{func};
}
}
$log->debug("Current indicators for tab $txt: ", dumper(\@inds));
if (scalar @inds) {
$owner->cbox_inds->items(\@inds);
$owner->btn_ok->enabled(1);
} else {
$owner->cbox_inds->items([]);
$owner->btn_ok->enabled(0);
}
$result->{tab} = $txt;
} else {
$owner->cbox_inds->items([]);
$owner->cbox_inds->focusedItem(-1);
$owner->cbox_inds->text('');
$owner->btn_ok->enabled(0);
delete $result->{tab};
}
},
);
$w->cbox_tabs->text('');
$w->insert(Label => name => 'label_inds',
text => 'Select Indicator',
font => { style => fs::Bold, height => 16 },
alignment => ta::Left,
autoHeight => 1,
autoWidth => 1,
origin => [20, 200],
hint => 'These indicators are already present in the selected tab',
hintVisible => 1,
);
$w->insert(ComboBox =>
name => 'cbox_inds',
style => cs::DropDownList,
height => 30,
width => 360,
hScroll => 0,
font => { height => 14 },
multiSelect => 0,
multiColumn => 0,
dragable => 0,
focusedItem => -1,
text => '',
items => [],
origin => [180, 200],
onChange => sub {
my $cbox = shift;
my $owner = $cbox->owner;
my $lbox = $cbox->List;
my $index = $lbox->focusedItem;
my $txt = $lbox->get_item_text($index);
if (defined $txt) {
$owner->btn_ok->enabled(1);
$result->{indicator} = $txt;
$result->{indicator_index} = $index;
} else {
$owner->btn_ok->enabled(0);
$cbox->items([]);
$cbox->focusedItem(-1);
$cbox->text('');
delete $result->{indicator};
delete $result->{indicator_index};
}
},
);
$w->insert(
Button => name => 'btn_cancel',
text => 'Cancel',
autoHeight => 1,
autoWidth => 1,
origin => [ 20, 20 ],
modalResult => mb::Cancel,
default => 0,
enabled => 1,
font => { height => 16, style => fs::Bold },
onClick => sub {
$result = {};
},
);
$w->insert(
Button => name => 'btn_ok',
text => 'OK',
autoHeight => 1,
autoWidth => 1,
origin => [ 150, 20 ],
modalResult => mb::Ok,
default => 1,
enabled => 0,
font => { height => 16, style => fs::Bold },
onClick => sub {
my $btn = shift;
my $owner = $btn->owner;
my $indicators = $self->get_tab_indicators($owner->owner, $result->{tab});
my @inds = ();
if ($indicators) {
my $iref = $indicators->[$result->{indicator_index}]->{indicator};
if ($iref->{func} eq $result->{indicator}) {
$result->{columns} = $indicators->[$result->{indicator_index}]->{columns};
} else {
$log->warn("Cannot find the columns to remove");
}
} else {
$log->warn("Invalid indicators for tab: ", $result->{tab});
}
$log->debug("Result: ", dumper($result));
},
);
my $res = $w->execute();
$w->end_modal;
return ($res == mb::Ok) ? $result : undef;
}
sub run_and_display_indicator {
my ($self, $win, $data, $symbol, $indicators) = @_;
return unless $win;
if (defined $data and defined $symbol and defined $indicators and
ref $indicators eq 'ARRAY') {
my $icount = scalar @$indicators;
foreach my $iref (@$indicators) {
$log->debug("Trying to run indicator for :", dumper($iref));
my $output;
if (exists $iref->{params} and exists $iref->{params}->{CompareWith}) {
# ok this is a security.
# we need to download the data for this and store it
my $bar = App::financeta::gui::progress_bar->new(owner => $win, title => 'Downloading...');
my $current = $self->current;
$iref->{params}->{CompareWith} =~ s/\s//g;
$current->{symbol} = $iref->{params}->{CompareWith};
my $tz = $self->timezone;
unless ($current->{start_date}) {
my $sd = $data->at(0, 0); # time in 0th column
my $dt = DateTime->from_epoch(epoch => $sd, time_zone => $tz);
$current->{start_date} = $dt;
}
unless ($current->{end_date}) {
my $ed = $data->at($data->dim(0) - 1, 0); # time in 0th column
my $dt = DateTime->from_epoch(epoch => $ed, time_zone => $tz);
$current->{end_date} = $dt;
}
my ($data2, $symbol2, $csv2) = $self->download_data($bar, $current);
$bar->close if $bar;
return unless (defined $data2 and defined $symbol2);
$log->debug("Successfully downloaded data for $symbol2");
$iref->{params}->{CompareWith} = $symbol2;
$output = $self->indicator->execute_ohlcv($data, $iref, $data2);
} else {
$output = $self->indicator->execute_ohlcv($data, $iref);
}
unless (defined $output) {
message_box('Indicator Error',
"Unable to run the indicator on data.",
mb::Ok | mb::Error);
return;
}
my ($next_data) = $self->display_data($win, $data, $symbol, $iref, $output);
$icount--;
$data = $next_data if $icount > 0;
}
return 1;
}
return 0;
}
sub add_indicator($$$) {
my ($self, $win, $data, $symbol) = @_;
if ($self->add_indicator_wizard($win)) {
my $iref = $self->current->{indicator};
if ($self->run_and_display_indicator($win, $data, $symbol, [$iref])) {
my ($ndata, $nsymbol, $indicators, $ndhr, $nbs) = $self->get_tab_data($win);
my $type = $self->current->{plot_type} || 'OHLC';
$self->plot_data($win, $ndata, $nsymbol, $type, $indicators, $nbs);
return 1;
}
}
return 0;
}
sub indicator_parameter_wizard {
my ($self, $gbox, $fn_name, $grp, $params) = @_;
if ($gbox) {
# remove the current parameter screen
my @widgets = $gbox->get_widgets;
if (@widgets) {
map { $_->close() } @widgets;
}
} else {
return;
}
# if all are defined create the parameter screen
if (defined $fn_name and defined $grp and defined $params) {
$gbox->text("$fn_name Parameters");
my @origin = $gbox->origin;
my @size = $gbox->size;
$log->debug("Gbox: Origin: @origin Size: @size");
my $num = scalar @$params;
my $sz_x = $size[0] / 2; # label and value
my $sz_y = $size[1] / ($num + 1);
my $count = 0;
$self->current->{indicator}->{params} = {};
# if no params just write that
unless (scalar @$params) {
$gbox->insert('Label',
text => "There are no parameters to configure.",
name => "label_$grp\_noparams",
alignment => ta::Left,
autoHeight => 1,
autoWidth => 1,
origin => [$origin[0] + 10,
$origin[1] + $count * $sz_y - 40],
font => {height => 16},
);
}
foreach my $p (reverse @$params) {
next unless ref $p eq 'ARRAY';
my $hkey = $p->[0];
my $label = $p->[1];
my $type = $p->[2];
my $typeclass = blessed($type) if $type;
my $value = $p->[3];
if (defined $type and $type eq 'ARRAY' and ref $value eq 'ARRAY') {
# use ComboBox
$self->current->{indicator}->{params}->{$hkey} = $value->[0];
$self->current->{indicator}->{params}->{$hkey . '_index'} = 0;
$gbox->insert(Label => text => $label,
name => "label_$grp\_$count",
alignment => ta::Left,
autoHeight => 1,
autoWidth => 1,
origin => [$origin[0] + 10,
$origin[1] + $count * $sz_y - 40],
font => {height => 13},
);
$gbox->insert(ComboBox => style => cs::DropDownList,
name => "cbox_$grp\_$count",
height => 30,
width => $sz_x - 50,
autoHeight => 1,
font => { height => 16 },
hScroll => 0,
multiSelect => 0,
multiColumn => 0,
dragable => 0,
focusedItem => -1,
items => $value,
autoTab => 1,
origin => [$origin[0] + 10 + $sz_x,
$origin[1] + $count * $sz_y - 40],
onChange => sub {
my $cbox = shift;
my $lbox = $cbox->List;
my $index = $lbox->focusedItem;
$self->current->{indicator}->{params}->{$hkey} = $lbox->get_item_text($index);
$self->current->{indicator}->{params}->{$hkey . '_index'} = $index;
},
);
} elsif (defined $typeclass and $typeclass eq 'PDL::Type') {
# use InputLine for all numbers
$self->current->{indicator}->{params}->{$hkey} = $value;
$gbox->insert(Label => text => $label,
name => "label_$grp\_$count",
alignment => ta::Left,
autoHeight => 1,
autoWidth => 1,
origin => [$origin[0] + 10,
$origin[1] + $count * $sz_y - 40],
font => {height => 13},
);
$gbox->insert(InputLine => name => "input_$grp\_$count",
alignment => ta::Left,
autoHeight => 1,
width => $sz_x - 50,
autoTab => 1,
maxLen => 20,
origin => [$origin[0] + 10 + $sz_x,
$origin[1] + $count * $sz_y - 40],
text => $value,
font => {height => 16},
onChange => sub {
my $il = shift;
my $val = undef;
my $txt = $il->text;
return unless length $txt;
if ($type->symbol eq 'PDL_B') {
# byte buffer
$val = $txt;
} elsif ($type->symbol eq 'PDL_F' or $type->symbol eq 'PDL_D') {
# is a real number
if ($txt =~ /^(\d+\.?\d*)|(\.\d+)$/) {
$val = sprintf "%0.04f", $txt;
} else {
message_box('Parameter Error',
"$label has to be a real number",
mb::Ok | mb::Error);
return;
}
} else {
# is an integer form
if ($txt =~ /^([+-]?\d+)$/) {
$val = sprintf "%d", $txt;
} else {
message_box('Parameter Error',
"$label has to be an integer",
mb::Ok | mb::Error);
return;
}
}
$self->current->{indicator}->{params}->{$hkey} = $val;
},
);
} elsif (defined $type and $type eq 'PDL') {
# use InputLine for all numbers
$self->current->{indicator}->{params}->{$hkey} = $value;
$self->current->{indicator}->{params}->{$hkey . '_pdl'} = 1;
$gbox->insert(Label => text => $label,
name => "label_$grp\_$count",
alignment => ta::Left,
autoHeight => 1,
autoWidth => 1,
origin => [$origin[0] + 10,
$origin[1] + $count * $sz_y - 40],
font => {height => 13},
hint => 'This should be a comma-separated list of integers',
);
$gbox->insert(InputLine => name => "input_$grp\_$count",
alignment => ta::Left,
autoHeight => 1,
width => $sz_x - 50,
autoTab => 1,
maxLen => 256,
origin => [$origin[0] + 10 + $sz_x,
$origin[1] + $count * $sz_y - 40],
text => $value,
font => {height => 16},
onChange => sub {
my $il = shift;
my $val = undef;
my $txt = $il->text;
return unless length $txt;
if ($txt !~ /\d[\d,\s]*/) {
message_box('Parameter Error',
"$label has to be a comma-separated list of integers",
mb::Ok | mb::Error);
return;
}
$self->current->{indicator}->{params}->{$hkey} = $txt;
$self->current->{indicator}->{params}->{$hkey . '_pdl'} = 1;
},
);
} else {
# use checkbox
$self->current->{indicator}->{params}->{$hkey} = ($value) ? 1 : 0;
$gbox->insert(CheckBox => name => "chk_$grp\_$count",
alignment => ta::Left,
autoTab => 1,
origin => [$origin[0] + 10,
$origin[1] + $count * $sz_y - 40],
text => $label,
font => {height => 13},
onCheck => sub {
my $chk = shift;
$self->current->{indicator}->{params}->{$hkey} =
$chk->checked ? 1 : 0;
},
);
}
$count++;
}
} else {
$gbox->text("Indicator Parameters");
delete $self->current->{indicator}->{params};
}
}
sub add_indicator_wizard {
my ($self, $win) = @_;
my $w = Prima::Dialog->new(
name => 'add_ind_wizard',
centered => 1,
origin => [200, 200],
size => [640, 480],
text => 'Technical Analysis Indicator Wizard',
icon => $self->icon,
visible => 1,
taskListed => 0,
onExecute => sub {
my $dlg = shift;
$dlg->cbox_groups->List->focusedItem(-1);
$dlg->cbox_funcs->List->focusedItem(-1);
$dlg->btn_cancel->enabled(1);
$dlg->btn_ok->enabled(0);
},
);
$w->owner($win) if defined $win;
$self->current->{indicator} = {}; # reset
my @groups = $self->indicator->get_groups;
$w->insert(Label => name => 'label_groups',
text => 'Select Group',
font => { style => fs::Bold, height => 16 },
alignment => ta::Left,
autoHeight => 1,
autoWidth => 1,
origin => [20, 440],
hint => 'This is a list of indicator groups',
hintVisible => 1,
);
$w->insert(ComboBox =>
name => 'cbox_groups',
style => cs::DropDownList,
height => 30,
width => 360,
hScroll => 0,
multiSelect => 0,
multiColumn => 0,
dragable => 0,
focusedItem => -1,
font => { height => 14 },
items => [ '', @groups],
origin => [180, 440],
onChange => sub {
my $cbox = shift;
my $owner = $cbox->owner;
my $lbox = $cbox->List;
my $index = $lbox->focusedItem;
my $txt = $lbox->get_item_text($index);
if (defined $txt and length $txt) {
my @funcs = $self->indicator->get_funcs($txt);
if (scalar @funcs) {
$owner->cbox_funcs->items(\@funcs);
} else {
$owner->cbox_funcs->items([]);
}
$owner->btn_ok->enabled(1);
$self->current->{indicator}->{group} = $txt;
} else {
$owner->cbox_funcs->items([]);
$owner->cbox_funcs->focusedItem(-1);
$self->indicator_parameter_wizard($owner->gbox_params);
$owner->cbox_funcs->text('');
$owner->btn_ok->enabled(0);
delete $self->current->{indicator}->{group};
}
},
);
$w->cbox_groups->text('');
$w->insert(Label => name => 'label_funcs',
text => 'Select Function',
font => { style => fs::Bold, height => 16 },
alignment => ta::Left,
autoHeight => 1,
autoWidth => 1,
origin => [20, 400],
hint => 'Each indicator group has multiple indicators it supports',
hintVisible => 1,
);
$w->insert(ComboBox =>
name => 'cbox_funcs',
style => cs::DropDownList,
height => 30,
width => 360,
hScroll => 0,
font => { height => 14 },
multiSelect => 0,
multiColumn => 0,
dragable => 0,
focusedItem => -1,
text => '',
items => [],
origin => [180, 400],
onChange => sub {
my $cbox = shift;
my $owner = $cbox->owner;
my $lbox = $cbox->List;
my $index = $lbox->focusedItem;
my $txt = $lbox->get_item_text($index);
my $grp = $self->current->{indicator}->{group};
if (defined $grp) {
# $params is an array-ref
my $params = $self->indicator->get_params($txt, $grp);
$self->current->{indicator}->{func} = $txt;
$log->debug("Params: ", dumper($params));
$owner->btn_ok->enabled(1);
$self->indicator_parameter_wizard($owner->gbox_params,
$txt, $grp, $params);
} else {
$owner->btn_ok->enabled(0);
$cbox->items([]);
$cbox->focusedItem(-1);
delete $self->current->{indicator}->{func};
$self->indicator_parameter_wizard($owner->gbox_params);
$cbox->text('');
}
},
);
$w->insert(
Button => name => 'btn_cancel',
text => 'Cancel',
autoHeight => 1,
autoWidth => 1,
origin => [ 20, 20 ],
modalResult => mb::Cancel,
default => 0,
enabled => 1,
font => { height => 16, style => fs::Bold },
onClick => sub {
delete $self->current->{indicator};
},
);
$w->insert(
Button => name => 'btn_ok',
text => 'OK',
autoHeight => 1,
autoWidth => 1,
origin => [ 360, 20 ],
modalResult => mb::Ok,
default => 1,
enabled => 0,
font => { height => 16, style => fs::Bold },
onClick => sub {
$log->debug("Final parameters selected: ", dumper($self->current->{indicator}));
},
);
$w->insert(
Button => name => 'btn_help',
text => 'Indicator Help',
autoHeight => 1,
autoWidth => 1,
origin => [ 150, 20 ],
default => 0,
enabled => 1,
font => { height => 16, style => fs::Bold },
onClick => sub {
my $url = 'https://vikasnkumar.github.io/financeta/indicators.html';
my $ok = Browser::Open::open_browser($url, 1);
if (not defined $ok) {
message("Error finding a browser to open $url");
} elsif ($ok != 0) {
message("Error opening $url");
}
},
);
$w->insert(GroupBox => name => 'gbox_params',
text => 'Indicator Parameters',
size => [600, 300],
origin => [20, 60],
font => { height => 16, style => fs::Bold },
);
my $res = $w->execute();
$w->end_modal;
return $res == mb::Ok;
}
sub download_data {
my ($self, $pbar, $current) = @_;
$pbar->update(5) if $pbar;
$current = $self->current unless $current;
my $src_index = $current->{source_index} // 0;
my $src = @{$self->list_sources}[$src_index];
my $start = $current->{start_date};
my $end = $current->{end_date};
my $symbol = $current->{symbol};
#TODO: check symbol validity
my $csv = sprintf "%s_%d_%d.csv", $symbol, $start->ymd(''), $end->ymd('');
$csv = File::Spec->catfile($self->tmpdir, $csv);
if (defined $current->{csv}) {
$csv = $current->{csv};
$log->debug("Using $csv as it was chosen");
}
$pbar->update(10) if $pbar;
my $data;
unlink $csv if $current->{force_download};
unless (-e $csv) {
$pbar->update(25) if $pbar;
$data = App::financeta::data::ohlcv($src, $symbol, $start, $end, $csv);
$pbar->update(35) if $pbar;
unless (defined $data) {
message_box('Error',
"Failed to download $symbol data. Check if '$symbol' is correct",
mb::Ok | mb::Error);
unlink $csv if -e $csv;
return;
}
wcols($data, $csv, { COLSEP => ',' });
$log->info("File $csv has downloaded data for analysis for symbol $symbol");
$pbar->update(75) if $pbar;
} else {
## now read this back into a PDL using rcol
$pbar->update(35) if $pbar;
$log->info("$csv already present. loading it...");
$data = rcols($csv, [], { COLSEP => ',', DEFTYPE => PDL::double});
$pbar->update(75) if $pbar;
}
return ($data, $symbol, $csv);
}
sub display_data {
my ($self, $win, $data, $symbol, $iref, $output) = @_;
return unless defined $win and defined $data;
my @tabsize = $win->size();
$symbol = $self->current->{symbol} unless defined $symbol;
my @tabs = grep { $_->name =~ /data_tabs/ } $win->get_widgets();
unless (@tabs) {
$win->insert('Prima::TabbedNotebook',
name => 'data_tabs',
size => \@tabsize,
origin => [ 0, 0 ],
( run in 2.092 seconds using v1.01-cache-2.11-cpan-ceb78f64989 )