view release on metacpan or  search on metacpan

lib/App/Chart/Gtk2/IndicatorModel.pm  view on Meta::CPAN

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;

lib/App/Chart/Gtk2/IndicatorModel.pm  view on Meta::CPAN

    $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__