File Coverage

blib/lib/Chart/Clicker/Renderer/CandleStick.pm
Criterion Covered Total %
statement 21 21 100.0
branch n/a
condition n/a
subroutine 7 7 100.0
pod n/a
total 28 28 100.0


line stmt bran cond sub pod time code
1             package Chart::Clicker::Renderer::CandleStick;
2             $Chart::Clicker::Renderer::CandleStick::VERSION = '2.90';
3 1     1   56283 use Moose;
  1         380575  
  1         6  
4              
5             extends 'Chart::Clicker::Renderer';
6              
7             # ABSTRACT: CandleStick renderer
8              
9 1     1   6356 use Graphics::Primitive::Brush;
  1         255366  
  1         45  
10 1     1   643 use Graphics::Primitive::Operation::Fill;
  1         39673  
  1         45  
11 1     1   676 use Graphics::Primitive::Operation::Stroke;
  1         25127  
  1         46  
12 1     1   665 use Graphics::Primitive::Paint::Solid;
  1         30160  
  1         46  
13              
14 1     1   7 use List::Util qw(max min);
  1         1  
  1         790  
15              
16              
17             has 'bar_padding' => (
18             is => 'rw',
19             isa => 'Int',
20             default => 0
21             );
22              
23              
24             has 'brush' => (
25             is => 'rw',
26             isa => 'Graphics::Primitive::Brush',
27             default => sub { Graphics::Primitive::Brush->new(width => 2) }
28             );
29              
30             override('prepare', sub {
31             my $self = shift;
32              
33             super;
34              
35             my $datasets = $self->clicker->get_datasets_for_context($self->context);
36              
37             $self->{SCOUNT} = 1;
38             $self->{KEYCOUNT} = 0;
39             foreach my $ds (@{ $datasets }) {
40             $self->{SCOUNT} += $ds->count;
41             if($ds->max_key_count > $self->{KEYCOUNT}) {
42             $self->{KEYCOUNT} = $ds->max_key_count;
43             }
44             }
45              
46             return 1;
47             });
48              
49             override('finalize', sub {
50             my ($self) = @_;
51              
52             my $clicker = $self->clicker;
53              
54             my $width = $self->width;
55             my $height = $self->height;
56              
57             my $dses = $clicker->get_datasets_for_context($self->context);
58              
59             my $padding = $self->bar_padding + $self->brush->width;
60              
61             my $bwidth = int(($width / $dses->[0]->max_key_count)) - $self->bar_padding;
62             my $hbwidth = int($bwidth / 2);
63              
64             my $scounter = $self->{SCOUNT};
65             foreach my $ds (@{ $dses }) {
66             foreach my $series (@{ $ds->series }) {
67              
68             my $color = $clicker->color_allocator->next;
69              
70             # TODO if undef...
71             my $ctx = $clicker->get_context($ds->context);
72             my $domain = $ctx->domain_axis;
73             my $range = $ctx->range_axis;
74              
75             my $ocbwidth = $bwidth - ($bwidth * $domain->fudge_amount);
76             my $cbwidth = $ocbwidth / $self->{SCOUNT};
77             my $hcbwidth = $cbwidth / 2;
78             my $offset = $bwidth - ($bwidth / $self->{SCOUNT});
79              
80             my $min = $range->range->lower;
81              
82             my @highs = @{ $series->highs };
83             my @lows = @{ $series->lows };
84             my @opens = @{ $series->opens };
85             my @vals = @{ $series->values };
86              
87             my @keys = @{ $series->keys };
88             for(0..($series->key_count - 1)) {
89             my $x = $domain->mark($width, $keys[$_]);
90              
91             $x -= $cbwidth * $scounter;
92             $x += $offset;
93              
94             my $openy = $height - $range->mark($height, $opens[$_]);
95             my $closey = $height - $range->mark($height, $vals[$_]);
96             my $highy = $height - $range->mark($height, $highs[$_]);
97             my $lowy = $height - $range->mark($height, $lows[$_]);
98              
99             my $_height = $closey - $openy;
100              
101             $self->move_to($x - $hcbwidth, $openy);
102             $self->rectangle(
103             $cbwidth, $_height
104             );
105              
106             my $op;
107             if($_height < 0) {
108             # We fill the bar if it closed higher
109             $op = Graphics::Primitive::Operation::Fill->new(
110             paint => Graphics::Primitive::Paint::Solid->new(
111             color => $color
112             )
113             );
114             } else {
115             # We stroke the bar if it closed lower
116             $op = Graphics::Primitive::Operation::Stroke->new(
117             brush => $self->brush->clone
118             );
119             $op->brush->color($color);
120             $op->brush->width(2);
121             }
122             $self->do($op);
123              
124             $self->move_to($x, min($openy, $closey));
125             $self->line_to($x, $highy);
126              
127             $self->move_to($x, max($openy, $closey));
128             $self->line_to($x, $lowy);
129              
130             my $lineop = Graphics::Primitive::Operation::Stroke->new(
131             brush => $self->brush->clone
132             );
133             $lineop->brush->color($color);
134              
135             $self->do($lineop);
136              
137             }
138              
139             $scounter--;
140             }
141             }
142              
143             return 1;
144             });
145              
146             __PACKAGE__->meta->make_immutable;
147              
148 1     1   7 no Moose;
  1         1  
  1         7  
149              
150             1;
151              
152             __END__
153              
154             =pod
155              
156             =head1 NAME
157              
158             Chart::Clicker::Renderer::CandleStick - CandleStick renderer
159              
160             =head1 VERSION
161              
162             version 2.90
163              
164             =head1 SYNOPSIS
165              
166             my $br = Chart::Clicker::Renderer::CandleStick->new;
167              
168             =head1 DESCRIPTION
169              
170             Chart::Clicker::Renderer::CandleStick renders a dataset as a candlestick style
171             bar chart.
172              
173             =for HTML <p><img src="http://gphat.github.com/chart-clicker/static/images/examples/candlestick.png" width="500" height="250" alt="Candlestick Chart" /></p>
174              
175             =head1 ATTRIBUTES
176              
177             =head2 bar_padding
178              
179             How much padding to put around a bar. A padding of 4 will result in 2 pixels
180             on each side.
181              
182             =head2 brush
183              
184             Set/Get the L<brush|Graphics::Primitive::Brush> to use around each bar and on each line.
185              
186             =head1 AUTHOR
187              
188             Cory G Watson <gphat@cpan.org>
189              
190             =head1 COPYRIGHT AND LICENSE
191              
192             This software is copyright (c) 2016 by Cory G Watson.
193              
194             This is free software; you can redistribute it and/or modify it under
195             the same terms as the Perl 5 programming language system itself.
196              
197             =cut