# Copyright 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::Series::TA;
use 5.010;
use strict;
use warnings;
use Carp;
use List::Util qw(min max);
use Locale::TextDomain ('App-Chart');

use base 'App::Chart::Series';

use Finance::TA;

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

sub manual {
  my ($series) = @_;
  if (! $series) { return; }
  my $fi = $series->{'fi'};
  return "http://tadoc.org/indicator/$fi->{'name'}.htm";
}

sub parameter_info {
  my ($series) = @_;
  my $fi = $series->{'fi'};
  return [ map {
    my $i = $_;
    my ($retcode, $info);
    ($retcode = TA_GetOptInputParameterInfo ($fi, $i, \$info)) == $TA_SUCCESS
      or croak "Oops, cannot TA_GetOptInputParameterInfo $i: ",_retcode_str($retcode);

    { name => $info->{'displayName'},
        key  => $info->{'paramName'},
          # type => 'integer',
          # minimum  => 1
      }
  } (0 .. $fi->{'nbOptInput'}-1)
         ];
}

sub new {
  my ($class, $type, $parent, @args) = @_;
  ### TA new() ...
  ### $type
  ### parent: "$parent"

  my ($retcode, $fh, $fi);
  ($retcode = TA_GetFuncHandle ($type, \$fh)) == $TA_SUCCESS
    or croak "Cannot get TA function '$type': ",_retcode_str($retcode);
  ($retcode = TA_GetFuncInfo ($fh, \$fi)) == $TA_SUCCESS
    or croak "Cannot TA_GetFuncInfo for '$type': ",_retcode_str($retcode);
  ### FuncInfo hint: $fi->{'hint'}

  my $self = $class->SUPER::new (parent => $parent,
                                 fi     => $fi,
                                 args   => \@args);

  my $funcname = 'TA_' . $fi->{'name'};
  $self->{'func'} = Finance::TA->can($funcname)
    || croak "Oops, '$funcname' not found";

  {
    my $lookbackname = "${funcname}_Lookback";
    my $lookbackfunc = Finance::TA->can($lookbackname)
      || croak "Oops, function $lookbackname not found";
    my @lookbackargs = map {
      my $i = $_;
      $args[$i] // do {
        my $info;
        ($retcode = TA_GetOptInputParameterInfo ($fh, $i, \$info)) == $TA_SUCCESS
          or croak "Oops, cannot TA_GetOptInputParameterInfo '$type' $i: ",_retcode_str($retcode);
        $info->{'defaultValue'}
      } } (0 .. $fi->{'nbOptInput'}-1);
    $self->{'parameters'} = \@lookbackargs;
    ### @lookbackargs
    my $lookback = $self->{'lookback'} = $lookbackfunc->(@lookbackargs);
    ### $lookback
  }

  {
    my $info;
    ($retcode = TA_GetInputParameterInfo ($fh, 0, \$info)) == $TA_SUCCESS
      or croak "Oops, cannot TA_GetInputParameterInfo '$type' 0: ",_retcode_str($retcode);
    my $inname = $info->{'paramName'};
    ### input paramName: $inname
    my @inarrays = input_paramName_to_arrays($inname);
    ### @inarrays
    $self->{'inarrays'} = [ map {$parent->array($_)} @inarrays ];
  }

  {
    my $nbOutput = $fi->{'nbOutput'};
    ### $nbOutput
    my @outarrays;
    $self->{'outarrays'} = \@outarrays;
    my $arrays = $self->{'arrays'} = {};
    my $first_outname;
    foreach my $i (0 .. $nbOutput-1) {
      my $info;
      ($retcode = TA_GetOutputParameterInfo ($fh, $i, \$info)) == $TA_SUCCESS
        or croak "Oops, cannot TA_GetOutputParameterInfo '$type' $i: ",_retcode_str($retcode);
      my $outname = $info->{'paramName'};
      ### $outname
      $arrays->{$outname} = $outarrays[$i] = [];
      $first_outname //= $outname;
    }
    if (exists $arrays->{'outRealMiddleBand'}) {
      # hack to prefer middle line of TA_BBANDS
      $first_outname = 'outRealMiddleBand';
    }
    $self->{'array_aliases'} = { values => $first_outname };
  }

  return $self;
}

sub name {
  my ($self) = @_;
  my $name = $self->{'fi'}->{'hint'};

  my $parameters = join (__p('separator',',') . ' ',
                         @{$self->{'parameters'}});
  $name = join (' ', $name, $parameters);

  my $parent_name = $self->parent->name;
  if (defined $parent_name) {
    $name = join (' - ', $parent_name, $name);
  }
  return $name;
}

sub fill_part {
  my ($self, $lo, $hi) = @_;
  my $parent = $self->{'parent'};
  my $start = $parent->find_before ($lo, $self->{'lookback'});
  $parent->fill ($start, $hi);

  my $inarrays = $self->{'inarrays'};
  my $values = $parent->values_array;
  my $inpart_end = $hi - $start;
  my @inparts = map { my @x; $#x = $inpart_end; \@x } @$inarrays;
  my $inend = $#$inarrays;
  my @inmap; $#inmap = $inpart_end;
  my $inmap_lo_pos;
  my $upto = 0;
  foreach my $i ($start .. $hi) {
    $values->[$i] // next;
    foreach my $j (0 .. $inend) {
      $inparts[$j]->[$upto] = $inarrays->[$j]->[$i] // $values->[$i];
    }
    $inmap[$upto] = $i;
    if ($i >= $lo) { $inmap_lo_pos //= $upto; }
    $upto++;
  }
  $#inmap = $upto-1;

  # Crib: as of TA-Lib Jun11 start_idx/end_idx aren't range checked against
  # the actual array size, so bad values like -1 give segvs.
  #
  if (! defined $inmap_lo_pos) {
    ### no input values, nothing to fill ...
    return;
  }

  my $func = $self->{'func'};
  ### $func
  ### start_idx inmap_lo_pos: $inmap_lo_pos
  ### end_idx $#inmap: $#inmap
  ### @inmap
  ### @inparts
  ### args: $self->{'args'}

  my ($retcode, $out_lo, @gotarrays)
    = &$func ($inmap_lo_pos,  # start_idx
              $#inmap,        # end_idx
              @inparts,       # in_array
              @{$self->{'args'}});
  ### $retcode
  ### $out_lo
  $retcode == $TA_SUCCESS
    or croak "TA_$self->{'fi'}->{'name'} error ",_retcode_str($retcode);
  ### @gotarrays

  my $outarrays = $self->{'outarrays'};
  my $outend = $#$outarrays;

  splice @inmap, 0,$out_lo;
  $inmap_lo_pos -= $out_lo;
  ### gotarray for: $inmap[0]
  ### cf lo: $lo
  ### adjusted lopos: $inmap_lo_pos

  $inmap_lo_pos = max (0, $inmap_lo_pos);

  my @src = ($inmap_lo_pos .. $#inmap);
  my @dst = @inmap[@src];
  foreach my $j (0 .. $outend) {
    @{$outarrays->[$j]}[@dst] = @{$gotarrays[$j]}[@src];
  }
}

sub _retcode_str {
  my ($retcode) = @_;
  my $rci = Finance::TA::TA_RetCodeInfo->new ($retcode);
  return "[$rci->{'enumStr'}] $rci->{'infoStr'}";
}

my %inchar_to_array = ('O' => 'opens',
                       'H' => 'highs',
                       'L' => 'lows',
                       'C' => 'closes',
                       'V' => 'volumes');

# $inname like 'inReal' or 'inPriceHLCV' or 'inPriceHLC', coming from
# various TA_InputParameterInfo in ta_def_ui.c
#
sub input_paramName_to_arrays {
  my ($inname) = @_;
  if ($inname eq 'inReal') { return 'values'; }
  if ($inname =~ /^inPrice([OHLCV]+)$/) {
    my $parts = $1;
    return (map {$inchar_to_array{$_}
                   || die "Unrecognised input paramName '$inname'"}
            split //, $parts); # split into individual characters
  }
}

1;
__END__

=head1 NAME

App::Chart::Series::TA -- ...

=for test_synopsis my ($ta_name, $parent)

=head1 SYNOPSIS

 use App::Chart::Series::TA;
 my $series = App::Chart::Series::TA->new ($ta_name, $parent);

=head1 CLASS HIERARCHY

    App::Chart::Series
      App::Chart::Series::TA

=head1 DESCRIPTION

A C<App::Chart::Series::TA> series applies a TA-Lib indicator or average to a
given series.  You must have the TA-Lib C<Finance::TA> module available to
use this, see

=over

L<http://ta-lib.org/>

=back

=head1 FUNCTIONS

=over 4

=item C<< App::Chart::Series::TA->new ($ta_name, $parent) >>

C<$ta_name> is string name per C<TA_GetFuncHandle>, for example C<"SMA"> for
the C<TA_SMA()> function.

=back

=head1 SEE ALSO

L<App::Chart::Series>, L<Finance::TA>, L<App::Chart::Series::GT>

=cut