File Coverage

blib/lib/App/Chart/Gtk2/View.pm

Criterion	Covered	Total	%
statement	12	14	85.7
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	17	19	89.4

# Copyright 2007, 2008, 2009, 2010, 2011, 2012 Kevin Ryde

# This file is part of Chart.
#
# Chart is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 3, or (at your option) any later version.
#
# Chart is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along
# with Chart.  If not, see <http://www.gnu.org/licenses/>.

package App::Chart::Gtk2::View;
use 5.010;
use strict;
use warnings;
use Carp;
use Glib;
use Glib::Ex::ConnectProperties;
use Gtk2 1.220;
use Gtk2::Ex::AdjustmentBits 43; # v.43 for set_maybe()
use List::Util qw(min max);
use Locale::TextDomain ('App-Chart');

use App::Chart::Glib::Ex::MoreUtils;
use App::Chart;
use App::Chart::Gtk2::GUI;

# uncomment this to run the ### lines
#use Smart::Comments;

use constant DEFAULT_TIMEBASE_CLASS => 'App::Chart::Timebase::Days';

use Glib::Object::Subclass
  'Gtk2::Table',
  properties => [Glib::ParamSpec->string
                 ('symbol',
                   __('Symbol'),
                  'The stock or commodity symbol to display, or empty string for none.',
                  '', # default
                  Glib::G_PARAM_READWRITE),

                 Glib::ParamSpec->string
                 ('timebase-class',
                  'timebase-class',
                  'Blurb.',
                  DEFAULT_TIMEBASE_CLASS,
                  Glib::G_PARAM_READWRITE),

                 Glib::ParamSpec->object
                 ('statusbar',
                  'statusbar',
                  'Blurb.',
                  'Gtk2::Statusbar',
                  Glib::G_PARAM_READWRITE),

                 Glib::ParamSpec->scalar
                 ('viewstyle',
                  'viewstyle',
                  'Blurb.',
                  Glib::G_PARAM_READWRITE),
                ];

# FIXME: adjust_splits breaks AnnDrag
use constant DEFAULT_VIEWSTYLE =>
  { adjust_splits     => 0,
    adjust_dividends  => 0,
    adjust_imputation => 1,
    adjust_rollovers  => 0,
    graphs => [ { size => 4,
                  linestyle => 'Candles',
                  indicators => [{ key => 'SMA', },
                                ],
                },
                { size => 1,
                  indicators => [{ key => 'Volume', }
                                ],
                },
              ],
  };

sub viewstyle_read {
  require App::Chart::DBI;
  my $str = App::Chart::DBI->read_single
    ('SELECT value FROM preference WHERE key=\'viewstyle\'');
  if (! defined $str) { return DEFAULT_VIEWSTYLE; }
  my $viewstyle = eval $str;
  if (! defined $viewstyle) {
    print "chart: oops, bad viewstyle in database, using default: $@";
    return DEFAULT_VIEWSTYLE;
  }
 return $viewstyle;
}
# viewstyle_write(DEFAULT_VIEWSTYLE);
# print viewstyle_read(DEFAULT_VIEWSTYLE);
# exit 0;
sub viewstyle_write {
  my ($viewstyle) = @_;
  require App::Chart::DBI;
  require Data::Dumper;
  my $str = Data::Dumper->new([$viewstyle],['viewstyle'])->Indent(1)->Terse(1)->Sortkeys(1)->Dump;
  require App::Chart::DBI;
  my $dbh = App::Chart::DBI->instance;
  $dbh->do ('INSERT OR REPLACE INTO preference (key, value)
                          VALUES (\'viewstyle\',?)', {}, $str);
  App::Chart::chart_dirbroadcast()->send ('viewstyle-changed');
}

#------------------------------------------------------------------------------

sub INIT_INSTANCE {
  my ($self) = @_;
  $self->{'symbol'} = '';  # per property default above
  $self->{'series_list'} = [];
  $self->{'timebase_class'} = DEFAULT_TIMEBASE_CLASS;
  $self->{'graphs'} = [];
  $self->set(n_rows => 9,
             n_columns => 3);

  App::Chart::chart_dirbroadcast()->connect_for_object
      ('data-changed', \&_do_data_changed, $self);

  # FIXME: this induces a rescale at a good time, but otherwise not wanted
  App::Chart::chart_dirbroadcast()->connect_for_object
      ('latest-changed', \&_do_data_changed, $self);

  App::Chart::Gtk2::GUI::chart_style_widget ('AppChartViewLabel');
  my $ebox = $self->{'initial'} = Gtk2::EventBox->new;
  $ebox->set_name ('AppChartViewLabel');
  my $label = Gtk2::Label->new
    (__('Use File/Open to open or add a symbol'));
  $label->set_name ('AppChartViewLabel');
  $ebox->add ($label);
  $ebox->show_all;

  $self->attach ($ebox, 0,3, 0,9,
                 ['fill','shrink','expand'],
                 ['fill','shrink','expand'], 0,0);
}

sub GET_PROPERTY {
  my ($self, $pspec) = @_;
  my $pname = $pspec->get_name;
  if ($pname eq 'viewstyle') {
    if (! $self->{'init_graphs'}) {
      return viewstyle_read();
    }
  }
  return $self->{$pname};
}

sub SET_PROPERTY {
  my ($self, $pspec, $newval) = @_;
  my $pname = $pspec->get_name;
  my $oldval = $self->{$pname};
  ### View SET_PROPERTY: $pname
  ### $newval

  if ($pname eq 'symbol') {
    $self->set_symbol ($newval);
    return;
  }

  $self->{$pname} = $newval;  # per default GET_PROPERTY

  if ($pname eq 'timebase_class') {
    if ($oldval ne $newval) {
      $self->set_symbol ($self->get('symbol'));
    }

  } elsif ($pname eq 'statusbar') {
    # lose old id
    delete $self->{'crosshair_status_id'};

  } elsif ($pname eq 'viewstyle') {
    if ($self->{'init_graphs'}) {
      _update_attach ($self);
    }
    if ($self->{'symbol'}) {
      _set_symbol ($self, $self->{'symbol'});
    }
  }
}

#------------------------------------------------------------------------------
# Crosshair

sub crosshair {
  my ($self) = @_;
  return ($self->{'crosshair_object'}
          ||= do {
            _init_graphs ($self);
            require Gtk2::Ex::CrossHair;
            my $ch = Gtk2::Ex::CrossHair->new (widgets => $self->{'graphs'},
                                               foreground => 'orange');
            $ch->signal_connect (moved => \&_do_crosshair_moved,
                                App::Chart::Glib::Ex::MoreUtils::ref_weak($self));
            ### View created crosshair: "$ch"
            $ch;
          });
}

sub _do_crosshair_moved {
  my ($crosshair, $graph, $x, $y, $ref_weak_self) = @_;
  my $self = $$ref_weak_self or return;
  ### View _do_crosshair_moved()

  my $statusbar = $self->{'statusbar'} || return;
  my $id = $statusbar->get_context_id (__PACKAGE__ . '.crosshair');
  $statusbar->pop ($id);

  if (! defined $x) { return; }
  my $series = $graph->get('series-list')->[0] || return;

  my $t = $graph->x_to_date ($x);
  my $dstr = $series->timebase->strftime ($App::Chart::option{'d_fmt'}, $t);

  my $value = $graph->y_to_value ($y);
  my $nf = App::Chart::number_formatter();
  my $pstr = $nf->format_number ($value, $series->decimals, 0);

  my $status = $dstr . '  ' . $pstr;
  ### $id
  ### $status
  $statusbar->push ($id, $status);
}


sub _do_lasso_ended {
}

sub _do_graph_button_press {
  my ($graph, $event) = @_;
  my $self = $graph->get_ancestor (__PACKAGE__);

  if ($event->button == 3) {
    $self->crosshair->start ($event);
  }
  return Gtk2::EVENT_PROPAGATE;
}

#------------------------------------------------------------------------------

sub set_symbol {
  my ($self, $symbol) = @_;
  $self->{'symbol'} = $symbol;
  if ($self->realized) {
    _set_symbol ($self, $symbol);
  } else {

    # a nasty hack to get initial pages for scaling after windows realized
    $self->{'realize_set_symbol_id'} ||=
      $self->signal_connect (realize => sub {
                               my ($self) = @_;
                               # once only
                               my $id = delete $self->{'realize_set_symbol_id'};
                               $self->signal_handler_disconnect ($id);
                               _set_symbol ($self, $self->{'symbol'});
                             });
  }
  $self->notify ('symbol');
}

sub _init_graphs {
  my ($self) = @_;
  if ($self->{'init_graphs'}) { return; }
  ### View _init_graphs()
  $self->{'init_graphs'} = 1;
  $self->{'viewstyle'} = viewstyle_read();

  require App::Chart::Gtk2::Graph;
  require App::Chart::Gtk2::HAxis;

  App::Chart::Gtk2::GUI::chart_style_class ('Gtk2::Ex::NumAxis');

  require App::Chart::Gtk2::Heading;
  $self->{'heading'} = App::Chart::Gtk2::Heading->new;

  # initial horiz scale 4 pixels per date
  require App::Chart::Gtk2::HScale;
  my $hadj = $self->{'hadjustment'}
    = App::Chart::Gtk2::HScale->new (pixel_per_value => 4);
  $self->{'haxis'}   = App::Chart::Gtk2::HAxis->new (adjustment => $hadj);
  $self->{'hscroll'} = Gtk2::HScrollbar->new ($hadj);

  _update_attach ($self);
  $self->show_all;

  #   # this is a nasty hack to force the Gtk2::Table to set its childrens'
  #   # sizes now, instead of later under the queue_resize or whatever
  #   $self->size_allocate ($self->allocation);

  if (my $ebox = delete $self->{'initial'}) {
    $self->remove ($ebox);
  }
}

#   0              1  2  3
# 0 +--------------+--+--+
#   | heading            |
# 1 +--------------+--+--+
#   |              |v |v |
#   | upper        |a |s |
#   |              |x |c |
#   |              |i |r |
#   |              |s |o |
#   |              |  |l |
#   |              |  |l |
# 5 +--------------+--+--+
#   | gap                |
# 6 +--------------+--+--+
#   |              |v |v |
#   | lower        |a |s |
#   |              |x |b |
# 7 +--------------+--+--+
#   | haxis        |     |
# 8 +--------------+     |
#   | hscroll      |     |
# 9 +--------------+--+--+
#
sub _update_attach {
  my ($self) = @_;
  require Gtk2::Ex::TableBits;

  my $y = 0;
  Gtk2::Ex::TableBits::update_attach
      ($self, $self->{'heading'}, 0,3, $y,$y+1,
       ['fill','shrink','expand'], [], 0,0);
  $y++;

  my $graphs = $self->{'graphs'};
  my @graphstyles = @{$self->{'viewstyle'}->{'graphs'}};
  while ($#$graphs > max (0, $#graphstyles)) {
    my $graph = pop @$graphs;
    $self->remove ($graph);
    $self->remove ($graph->{'noshrink'});
    $self->remove ($graph->{'vscroll'});
  }
  $graphs->[0] ||= do {
    my $upper = _make_graph($self);
    delete $upper->{'heading_in_graph'};
    $self->{'hadjustment'}->set (widget => $upper);
    Glib::Ex::ConnectProperties->new ([$upper,'series-list'],
                                      [$self->{'heading'},'series-list']);
    $upper;
  };

  for (my $i = 0; $i < @graphstyles; $i++) {
    my $graph = ($graphs->[$i] ||= _make_graph($self));
    ### now graphs: "@$graphs"

    if ($i > 0) {
      my $gap = ($graph->{'gap'} ||= Glib::Object::new ('Gtk2::DrawingArea',
                                                        height_request => 2));
      Gtk2::Ex::TableBits::update_attach
          ($self, $gap, 0,3, $y,$y+1,
           [], [], 0,0);
      $y++;
    }

    my $graphstyle = $graphstyles[$i];
    my $size = $graphstyle->{'size'};

    Gtk2::Ex::TableBits::update_attach
        ($self, $graph, 0,1, $y,$y+$size,
         ['fill','shrink','expand'],
         ['fill','shrink','expand'], 0,0);
    Gtk2::Ex::TableBits::update_attach
        ($self, $graph->{'noshrink'},
         1,2, $y,$y+$size,
         ['fill','shrink'],
         ['fill','shrink','expand'], 0,0);
    Gtk2::Ex::TableBits::update_attach
        ($self, $graph->{'vscroll'},
         2,3, $y,$y+$size,
         ['fill','shrink'],
         ['fill','shrink','expand'], 0,0);
    $y += $size;
  }

  Gtk2::Ex::TableBits::update_attach
      ($self, $self->{'haxis'}, 0,1, $y,$y+1,
       ['fill','shrink','expand'],
       ['fill','shrink'], 0,0);
  $y++;
  Gtk2::Ex::TableBits::update_attach
      ($self, $self->{'hscroll'}, 0,1, $y,$y+1,
       ['fill','shrink','expand'],
       ['fill','shrink'], 0,0);
  $y++;

  if (my $cross = $self->{'crosshair_object'}) {
    ### _update_attach() cross widgets: "@$graphs"
    $cross->set (widgets => $graphs);
  }

  $self->resize (3, $y);
}

sub _make_graph {
  my ($self) = @_;

  require App::Chart::Gtk2::Graph;
  require App::Chart::Gtk2::AdjScale;
  my $vadj = App::Chart::Gtk2::AdjScale->new (orientation => 'vertical',
                                        inverted => 1);
  my $graph = App::Chart::Gtk2::Graph->new (hadjustment => $self->{'hadjustment'},
                                      vadjustment => $vadj);
  $graph->{'heading_in_graph'} = 1;
  $vadj->set (widget => $graph);
  $graph->signal_connect (button_press_event => \&_do_graph_button_press);

  require Gtk2::Ex::NumAxis;
  my $vaxis = $graph->{'vaxis'}
    = Gtk2::Ex::NumAxis->new (adjustment => $vadj,
                              inverted   => 1);
  $vaxis->signal_connect (number_to_text => \&_vaxis_number_to_text);

  require Gtk2::Ex::NoShrink;
  $graph->{'noshrink'} = Gtk2::Ex::NoShrink->new (child => $vaxis);
  my $vscroll = $graph->{'vscroll'} = Gtk2::VScrollbar->new ($vadj);
  $vscroll->set_inverted (1);

  $vaxis->add_events (['button-press-mask',
                       'button-motion-mask',
                       'button-release-mask']);
  $vaxis->signal_connect (button_press_event => \&_do_vaxis_button_press);
  $graph->show_all;
  return $graph;
}

sub _vaxis_number_to_text {
  my ($axis, $number, $decimals) = @_;
  return App::Chart::number_formatter()->format_number ($number, $decimals, 1);
}


sub _do_vaxis_button_press {
  my ($vaxis, $event) = @_;
  if ($event->button == 1) {
    require Gtk2::Ex::Dragger;
    my $dragger = ($vaxis->{'dragger'} ||=
                   Gtk2::Ex::Dragger->new
                   (widget      => $vaxis,
                    vadjustment => $vaxis->get('adjustment'),
                    vinverted   => 1,
                    cursor      => 'sb-v-double-arrow',
                    confine     => 1));
    $dragger->start ($event);
  }
  return Gtk2::EVENT_PROPAGATE;
}

sub _set_symbol {
  my ($self, $symbol) = @_;
  if (! $symbol) { return; }

  _init_graphs ($self);

  my $hadj = $self->{'hadjustment'};
  my $haxis = $self->{'haxis'};

  if (! $symbol) {
    foreach my $graph (@{$self->{'graphs'}}) {
      $graph->set('series_list', []);
      $graph->get('vadjustment')->empty
    }
    $hadj->empty;
    return;
  }

  require App::Chart::Series::Database;
  my $series = App::Chart::Series::Database->new ($symbol);

  my $viewstyle = $self->{'viewstyle'};
  if ($viewstyle->{'adjust_splits'}
      || $viewstyle->{'adjust_dividends'}
      || $viewstyle->{'adjust_rollovers'}) {
    require App::Chart::Series::Derived::Adjust;
    $series = App::Chart::Series::Derived::Adjust->derive
      ($series,
       adjust_splits     => $viewstyle->{'adjust_splits'},
       adjust_dividends  => $viewstyle->{'adjust_dividends'},
       adjust_imputation => $viewstyle->{'adjust_imputation'},
       adjust_rollovers  => $viewstyle->{'adjust_rollovers'});
  }

  my $timebase_class = $self->{'timebase_class'};
  if (! $series->timebase->isa ($timebase_class)) {
    ### collapse to: $timebase_class
    $series = $series->collapse ($timebase_class);
  }

  my $timebase = $series->timebase;
  $haxis->set(timebase => $timebase);

  my $graphstyles = $viewstyle->{'graphs'} || [];
  my $graphs = $self->{'graphs'};

  require App::Chart::Gtk2::Graph::Plugin::Latest;
  require App::Chart::Gtk2::Graph::Plugin::Today;
  require App::Chart::Gtk2::Graph::Plugin::Text;
  require App::Chart::Gtk2::Graph::Plugin::AnnLines;
  my @hrange = (0, $series->hi);
  my @today_hrange;

  for (my $i = 0; $i < @$graphstyles; $i++) {
    my $graphstyle = $graphstyles->[$i];
    my $graph = $graphs->[$i] || die;
    my $series_list = graphstyle_to_series_list ($graphstyle, $series);

    # date range for series, latest, and perhaps today
    if ($i == 0) {
      push @hrange,
        (@today_hrange = App::Chart::Gtk2::Graph::Plugin::Today->hrange ($graph, $series_list));
      push @hrange,
        (App::Chart::Gtk2::Graph::Plugin::Latest->hrange ($graph, $series_list),
         App::Chart::Gtk2::Graph::Plugin::Text->hrange ($graph, $series_list),
         App::Chart::Gtk2::Graph::Plugin::AnnLines->hrange ($graph, $series_list));
    }

    $graph->set('series_list', []);
    $graph->set('series_list', $series_list);
    my $decimals = max (0, map {$_->decimals} @$series_list);
    $graph->{'vaxis'}->set (min_decimals => $decimals);
    ### graph: "$i decimals $decimals"
  }

  require List::MoreUtils;
  my ($lower, $upper) = List::MoreUtils::minmax (@hrange);
  $upper += 2;  # +1 for inclusive, +1 for bit of margin

  # rightmost edge
  my $value = $upper;
  my $today = $today_hrange[0];
  if (defined $today) {
    if ($upper > $today + 10) {
      $value = $today + 4;
    }
  }
  $value -= $hadj->page_size;
  $lower = min ($lower, $value);

  ### View decide hadj: "$lower to $upper, value=$value"
  Gtk2::Ex::AdjustmentBits::set_maybe ($hadj,
                                       lower => $lower,
                                       upper => $upper,
                                       value => $value);
  ### View hadj: $hadj->lower." to $upper =",$timebase->to_iso($upper)
  my ($lo, $hi) = $hadj->value_range_inc;

  foreach my $graph (@$graphs) {
    $graph->update_v_range;

    #     my $series_list = $graph->{'series_list'};
    #     my $this_series = $series_list->[0] || next;
    #
    #     my ($p_lo, $p_hi) = $this_series->range ($lo, $hi);
    #     if (! defined $p_lo) {
    #       $p_hi = $p_lo = 0;
    #     }
    #     ### View graph vrange: "$p_lo $p_hi"
    #     Gtk2::Ex::AdjustmentBits::set_maybe ($graph->get('vadjustment'),
    #                                          lower => $p_lo,
    #                                          upper => $p_hi);
  }
}

sub graphstyle_to_series_list {
  my ($graphstyle, $series) = @_;
  ### View graphstyle_to_series_list()
  my @series_list;

  # top-level series goes into upper graph only
  if (exists $graphstyle->{'linestyle'}
      && ($graphstyle->{'linestyle'}||'') ne 'None') {
    $series->linestyle($graphstyle->{'linestyle'});
    push @series_list, $series;
  }

  foreach my $indicatorstyle (@{$graphstyle->{'indicators'}}) {
    my $key = $indicatorstyle->{'key'} || next;
    if ($key eq 'None') { next; }
    ### $indicatorstyle

    if (! $series->can($key)) {
      warn "Ignoring unknown indicator '$key'";
      next;
    }

    require App::Chart::IndicatorInfo;
    my $info = App::Chart::IndicatorInfo->new ($key);
    my @params;
    foreach my $paraminfo (@{$info->parameter_info}) {
      my $paramkey = $paraminfo->{'key'};
      push @params, ($indicatorstyle->{$paramkey}
                     // $paraminfo->{'default'});
    }
    ### @params
    my $derived = $series->$key (@params);
    push @series_list, $derived;
  }
  return \@series_list;
}

# 'data-changed'
sub _do_data_changed {
  my ($self, $symbol_hash) = @_;
  my $symbol = $self->{'symbol'} // return;
  if (exists $symbol_hash->{$symbol}) {
    ### "View _do_data_changed() displayed symbol: $symbol
    _set_symbol ($self, $symbol);
  }
}

sub centre {
  my ($self) = @_;
  $self->{'graphs'}->[0]->centre;
  #  $self->{'lower'}->centre;
}

sub zoom {
  my ($self, $xfactor, $yfactor) = @_;
  if ($xfactor != 1) {
    my $hadj = $self->{'hadjustment'};
    my $ppv = $hadj->get_pixel_per_value;
    my $new_ppv = POSIX::ceil ($xfactor * $ppv);
    if ($ppv == $new_ppv) {
      if ($xfactor < 1) {
        $new_ppv = max (1, $new_ppv-1);
      } else {
        $new_ppv = $new_ppv+1;
      }
    }
    if ($ppv != $new_ppv) {
      $hadj->set_pixel_per_value ($new_ppv);
    }
  }
  if ($yfactor != 1) {
    foreach my $graph (@{$self->{'graphs'}}) {
      my $vadj = $graph->get('vadjustment');
      $vadj->set_pixel_per_value ($yfactor * $vadj->get_pixel_per_value);
    }
  }
}

1;
__END__

=for stopwords viewstyle

=head1 NAME

App::Chart::Gtk2::View -- view widget of heading, graphs, axes, scrollbars, etc

=head1 SYNOPSIS

 my $view = App::Chart::Gtk2::View->new;

=head1 DESCRIPTION

A C<App::Chart::Gtk2::View> widget displays graphs of the data from a given stock
symbol, with a "viewstyle" controlling what graphs and indicators are
presented.

=head1 FUNCTIONS

=over 4

=item C<< $view->symbol >>

Return the currently displayed stock symbol (a string), or C<undef> if none.

=item C<< $view->centre >>

Centre the displayed data within the graph windows.  This is the
"View/Centre" menu item in the main GUI.

=back

=head1 PROPERTIES

=over 4

=item C<symbol> (string, default none)

=back

=cut