File Coverage

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

Criterion	Covered	Total	%
statement	9	11	81.8
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	13	15	86.6

# Copyright 2007, 2008, 2009, 2010, 2011 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::IndicatorModel;
use 5.008;
use strict;
use warnings;
use Gtk2;
use List::MoreUtils;
use Locale::TextDomain ('App-Chart');

use constant DEBUG => 0;

use Glib::Object::Subclass
  'Gtk2::TreeStore';

use Class::Singleton 1.03; # 1.03 for _new_instance()
use base 'Class::Singleton';
*_new_instance = \&Glib::Object::new;

my %columns;
BEGIN {
  %columns = (COL_KEY      => 0,   # string
              COL_NAME     => 1,   # string
              COL_TYPE     => 2,   # string
              COL_PRIORITY => 3);  # string
}
use constant ({%columns});
use constant NUM_COLS => 4;

our $MODEL;
use constant::defer INIT_INSTANCE => sub {
  my ($self) = @_;

  $self->set_column_types (('Glib::String') x NUM_COLS);
  @{$self}{keys %columns} = values %columns;

  $self->set ($self->append(undef),
              COL_KEY,     'None',
              COL_NAME,    __('None'));

  my $aref = require App::Chart::Gtk2::IndicatorModelGenerated;

  # add anything not in IndicatorModelGenerated.pm
  {
    require Module::Find;
    require Gtk2::Ex::TreeModelBits;
    my %extra;
    # hash slice, everything on disk
    @extra{map {s/^App::Chart::Series::Derived:://;$_}
             Module::Find::findsubmod ('App::Chart::Series::Derived')} = ();
    # hash slice, drop keys already in the model
    delete @extra{map {$_->{'key'}} @$aref};

    # could load each extra to get name,type,priority ...
    foreach my $key (sort keys %extra) {
      push @$aref, { key      => $key,
                     name     => $key,
                     priority => 0 };
    }
  }

  # sort by translated name, case-insensitive
  @$aref = sort {$b->{'priority'} <=> $a->{'priority'}
                   || lc($a->{'name'}) cmp lc($b->{'name'})
                     || $a->{'name'} cmp $b->{'name'}
                   } @$aref;
  my ($top, $low)
    = List::MoreUtils::part {$_->{'priority'} >= 0 ? 0 : 1} @$aref;
  foreach my $elem (@$top) {
    $self->set($self->append(undef),
               COL_KEY,      $elem->{'key'},
               COL_NAME,     $elem->{'name'},
               COL_TYPE,     $elem->{'type'},
               COL_PRIORITY, $elem->{'priority'});
  }
  if (@$low) {
    my $low_iter = $self->append(undef);
    $self->set ($low_iter,
                COL_KEY,     'low-priority',
                COL_NAME,    __('Low Priority'));
    foreach my $elem (@$low) {
      $self->set($self->append($low_iter),
                 COL_KEY,      $elem->{'key'},
                 COL_NAME,     $elem->{'name'},
                 COL_TYPE,     $elem->{'type'},
                 COL_PRIORITY, $elem->{'priority'});
    }
  }
  if (DEBUG) {
    require Scalar::Util;
    Scalar::Util::weaken ($aref);
    if ($aref) {
      die "Oops, IndicatorModelGenerated array not destroyed";
    } else {
      print "IndicatorModelGenerated array destroyed\n";
    }
  }

  #--------------
  # TA

  if (eval { require Finance::TA }) {
    my $talib_iter = $self->append(undef);
    $self->set ($talib_iter, COL_NAME, __('TA-Lib'));
    my $talib_path = $self->get_path ($talib_iter);

    my %exclude = ('0',                   1,
                   'Math Operators',      1,
                   'Math Transform',      1,
                  );

    my @groups = Finance::TA::TA_GroupTable();
    @groups = grep {!$exclude{$_}} @groups;
    foreach my $group (@groups) {

      my @functions = Finance::TA::TA_FuncTable($group);
      shift @functions;

      $talib_iter = $self->get_iter($talib_path);
      my $group_iter = $self->append($talib_iter);
      $self->set ($group_iter, COL_NAME, $group);
      my $group_path = $self->get_path ($group_iter);

      foreach my $func (@functions) {
        if ($func eq 'MA') { next; } # selectable MA

        my $fh;
        Finance::TA::TA_GetFuncHandle($func, \$fh) == $Finance::TA::TA_SUCCESS
            or die;
        my $fi;
        Finance::TA::TA_GetFuncInfo($fh, \$fi) == $Finance::TA::TA_SUCCESS
            or die;

        # flag bits per ta_abstract.h
        # TA_FUNC_FLG_VOLUME     for volume overlay
        # TA_FUNC_FLG_UNST_PER   initial unstable
        my $flags = $fi->{'flags'};
        no warnings 'once';

        # if ($flags & $Finance::TA::TA_FUNC_FLG_CANDLESTICK) { next; }

        my $type = 'indicator';
        if ($group eq 'Price Transform') {
          $type = 'selector';
        } elsif ($flags & $Finance::TA::TA_FUNC_FLG_OVERLAP) {
          # output same as input
          $type = 'average';
        }

        my $hint = $fi->{'hint'};
        my $name = $hint;
        if ($hint !~ /\Q$func/) {
          $name = "$func - $name";
        }

        $group_iter = $self->get_iter($group_path);
        my $func_iter = $self->append($group_iter);
        $self->set ($func_iter,
                    COL_KEY,  "TA_$func",
                    COL_NAME, $name,
                    COL_TYPE, $type);
      }

      $group_iter = $self->get_iter($group_path);
      if ($self->iter_n_children ($group_iter) == 0) {
        $self->remove ($group_iter);
      }
    }
  }

  #--------------
  # GT

  require Module::Find;
  if (my @modules = Module::Find::findsubmod ('GT::Indicators')) {

    my %type = (ADL   => 'indicator',
                ADX   => 'indicator',
                ADXR  => 'indicator',
                AROON => 'indicator',
                AT3   => 'average',
                ATR   => 'indicator',
                BBO   => 'indicator',
                BOL   => 'average',
                BPCorrelation => [ 'indicator', __('GT Misc') ],
                CCI     => 'indicator',
                CHAIKIN => 'indicator',
                CMO     => 'indicator',

                # result is a binary code or something, so might be much to
                # view
                CNDL    => [ 'indicator', __('GT Misc') ],

                ChaikinsVola => 'indicator',
                Chandelier   => 'average',
                DMI      => 'indicator',
                DSS      => 'indicator',
                EMA      => 'average',
                ENV      => 'average',
                EPMA     => 'average',
                EVWMA    => 'average',
                ElderRay => 'indicator',
                FISH     => 'indicator',
                FRAMA    => 'average',
                ForceIndex    => 'indicator',
                FromTimeframe => 'special',  # time collapsing
                GAPO          => 'indicator',
                GMEAN         => [ 'indicator', __('GT Misc') ],
                HilbertPeriod => [ 'indicator', __('GT Misc') ],
                HilbertSine   => [ 'indicator', __('GT Misc') ],
                IFISH         => 'indicator',
                InstantTrendLine => 'average',
                Interquartil => 'indicator',
                KAMA    => 'average',
                Keltner => 'average',
                KirshenbaumBands => 'average',
                # LinearRegression.pm
                MACD => 'indicator',
                MAMA => 'average',
                MASS => 'indicator',
                MEAN => 'selector',
                MFI  => 'indicator',
                MOM  => 'indicator',
                MaxDrawDown      => 'indicator',
                MaxPossibleGain  => 'indicator',
                MaxPossibleLoss  => 'indicator',
                OBV    => 'indicator',

                # but param is a date, so probably can't use
                PERF   => [ 'indicator', __('GT Misc') ],

                PFE    => 'indicator',
                PFEraw => 'indicator',
                PGO    => 'indicator',
                PP     => 'average',
                PercentagePosition => 'indicator',

                # but params are strings, so probably can't use
                Prices   => 'selector',

                QSTICK   => 'indicator',
                RAVI     => 'indicator',
                REMA     => 'average',
                RMI      => 'indicator',
                ROC      => 'indicator',
                RSI      => 'indicator',
                RSquare  => 'indicator',
                Range    => [ 'indicator', __('GT Misc') ],
                SAR      => 'average',
                SMA      => 'average',
                SMI      => 'indicator',
                STO      => 'indicator',
                SWMA     => 'average',
                SafeZone => 'indicator',
                StandardDeviation => [ 'indicator', __('GT Misc') ],
                StandardError     => [ 'indicator', __('GT Misc') ],
                T3        => 'average',
                TDREI     => 'indicator',
                TETHER    => 'average',
                TMA       => 'average',
                TP        => 'selector',
                TR        => [ 'indicator', __('GT Misc') ],
                TRIX      => 'average',
                Test      => 'exclude',  # development stuff
                UI        => 'indicator',
                VHF       => 'indicator',
                VOSC      => [ 'indicator', __('GT Misc') ],
                VROC      => [ 'indicator', __('GT Misc') ],
                WMA       => 'average',
                WTCL      => 'selector',
                WWMA      => 'average',
                WilliamsR => 'indicator',
                ZigZag    => 'average',
               );


    my $gt_iter = $self->append(undef);
    $self->set ($gt_iter, COL_NAME, __('Genius Trader'));
    my $gt_path = $self->get_path ($gt_iter);
      my %other;

    foreach my $mod (sort @modules) {
      $mod =~ s/^GT::Indicators:://;

      my $type = $type{$mod};
      if (ref $type) {
        ($type, my $sub) = @$type;
        push @{$other{$sub}}, [ $mod, $type ];
        next;
      }
      if (defined $type && $type eq 'exclude') {
        next;
      }

      $gt_iter = $self->get_iter($gt_path);
      my $mod_iter = $self->append($gt_iter);

      $self->set ($mod_iter,
                  COL_KEY,  "GT_$mod",
                  COL_NAME, __x('GT {name}', name => $mod),
                  COL_TYPE, $type);
    }

    foreach my $sub (sort keys %other) {
      $gt_iter = $self->get_iter($gt_path);
      my $sub_iter = $self->append($gt_iter);
      $self->set ($sub_iter, COL_NAME, $sub);
      my $sub_path = $self->get_path($sub_iter);

      foreach my $elem (@{$other{$sub}}) {
        my ($mod, $type) = @$elem;

        $sub_iter = $self->get_iter($sub_path);
        my $mod_iter = $self->append($sub_iter);
        $self->set ($mod_iter,
                    COL_KEY,  "GT_$mod",
                    COL_NAME, __x('GT {name}', name => $mod),
                    COL_TYPE, $type);
      }
    }
  }

  return;
};


my %by_type;
sub by_type {
  my ($class, $want_type) = @_;
  if (! $want_type) { return $class->instance; }

  return ($by_type{$want_type} ||= do {
    my $model = Gtk2::TreeModelFilter->new ($class->instance);
    @{$model}{keys %columns} = values %columns;

    $model->set_visible_func
      (Gtk2::Ex::TreeModelFilterBits::visible_func_hide_empty_parents
       (sub {
          my ($model, $iter) = @_;
          my $type = $model->get($iter,COL_TYPE);
          return (! $type || $type eq $want_type);
        }));
    $model
  });
}

# =over 4
#
# =item C<< $wrapped_visible_func = Gtk2::Ex::TreeModelFilterBits::visible_func_hide_empty_parents ($visible_func) >>
#
# Return a function suitable for use as a TreeModelFilter
# C<set_visible_func> which applies C<$visible_func> and in addition makes
# parent rows visible only if there's at least one visible child row under
# it.
#
# C<$visible_func> is called just like a normal C<set_visible_func>, ie.
#
#     bool = &$visible_func ($model, $iter, $userdata);
#
# The C<$wrapped_visible_func> returned is designed to be called the same
# way.
#
# If you omit C<$userdata> from the C<set_visible_func> install then just
# two arguments are passed.  C<$wrapped_visible_func> likewise passes just
# two arguments to C<$visible_func> in that case (though it'd be unusual for
# that to make much difference).
#
# =back
#
# =cut

sub Gtk2::Ex::TreeModelFilterBits::visible_func_hide_empty_parents {
  my ($visible_func) = @_;

  # cf Sub::Recursive for avoiding circularities
  #
  my $weak_wrapped_func;
  my $wrapped_func = sub {
    if (! $visible_func->(@_)) { return 0; }
    my ($model, $iter) = @_;
    if (my $subiter = $model->iter_children ($iter)) {
      shift; shift;
      do {
        if ($weak_wrapped_func->($model, $subiter, @_)) {
          return 1;
        }
      } while ($subiter = $model->iter_next($subiter));
      return 0;
    } else {
      goto $visible_func;
    }
  };
  require Scalar::Util;
  $weak_wrapped_func = $wrapped_func;
  Scalar::Util::weaken ($weak_wrapped_func);
  return $wrapped_func;
}

1;
__END__