line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Chart::Clicker::Renderer::Bar; |
2
|
|
|
|
|
|
|
$Chart::Clicker::Renderer::Bar::VERSION = '2.90'; |
3
|
2
|
|
|
2
|
|
99676
|
use Moose; |
|
2
|
|
|
|
|
611955
|
|
|
2
|
|
|
|
|
20
|
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
extends 'Chart::Clicker::Renderer'; |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
# ABSTRACT: Bar renderer |
8
|
|
|
|
|
|
|
|
9
|
2
|
|
|
2
|
|
19239
|
use Graphics::Primitive::Brush; |
|
2
|
|
|
|
|
431725
|
|
|
2
|
|
|
|
|
137
|
|
10
|
|
|
|
|
|
|
|
11
|
2
|
|
|
2
|
|
1102
|
use Graphics::Primitive::Operation::Fill; |
|
2
|
|
|
|
|
60955
|
|
|
2
|
|
|
|
|
115
|
|
12
|
2
|
|
|
2
|
|
1145
|
use Graphics::Primitive::Operation::Stroke; |
|
2
|
|
|
|
|
40602
|
|
|
2
|
|
|
|
|
123
|
|
13
|
2
|
|
|
2
|
|
1148
|
use Graphics::Primitive::Paint::Solid; |
|
2
|
|
|
|
|
52344
|
|
|
2
|
|
|
|
|
2862
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
has 'bar_padding' => ( |
17
|
|
|
|
|
|
|
is => 'rw', |
18
|
|
|
|
|
|
|
isa => 'Int', |
19
|
|
|
|
|
|
|
default => 0 |
20
|
|
|
|
|
|
|
); |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
has 'bar_width' => ( |
24
|
|
|
|
|
|
|
is => 'rw', |
25
|
|
|
|
|
|
|
isa => 'Num', |
26
|
|
|
|
|
|
|
predicate => 'has_bar_width' |
27
|
|
|
|
|
|
|
); |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
has 'brush' => ( |
31
|
|
|
|
|
|
|
is => 'rw', |
32
|
|
|
|
|
|
|
isa => 'Graphics::Primitive::Brush', |
33
|
|
|
|
|
|
|
default => sub { Graphics::Primitive::Brush->new } |
34
|
|
|
|
|
|
|
); |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
has 'opacity' => ( |
38
|
|
|
|
|
|
|
is => 'rw', |
39
|
|
|
|
|
|
|
isa => 'Num', |
40
|
|
|
|
|
|
|
default => 1 |
41
|
|
|
|
|
|
|
); |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
override('prepare', sub { |
44
|
|
|
|
|
|
|
my $self = shift; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
super; |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
my $datasets = $self->clicker->get_datasets_for_context($self->context); |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
$self->{KEYCOUNT} = 0; |
51
|
|
|
|
|
|
|
foreach my $ds (@{ $datasets }) { |
52
|
|
|
|
|
|
|
$self->{SCOUNT} += $ds->count; |
53
|
|
|
|
|
|
|
if($ds->max_key_count > $self->{KEYCOUNT}) { |
54
|
|
|
|
|
|
|
$self->{KEYCOUNT} = $ds->max_key_count; |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
return 1; |
59
|
|
|
|
|
|
|
}); |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
override('finalize', sub { |
62
|
|
|
|
|
|
|
my ($self) = @_; |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
my $clicker = $self->clicker; |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
my $height = $self->height; |
67
|
|
|
|
|
|
|
my $width = $self->width; |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
my $dses = $clicker->get_datasets_for_context($self->context); |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
my $brwidth = $self->brush->width; |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
my $padding = $self->bar_padding + $brwidth * 2; |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
my $offset = 1; |
76
|
|
|
|
|
|
|
foreach my $ds (@{ $dses }) { |
77
|
|
|
|
|
|
|
foreach my $series (@{ $ds->series }) { |
78
|
|
|
|
|
|
|
# TODO if undef... |
79
|
|
|
|
|
|
|
my $ctx = $clicker->get_context($ds->context); |
80
|
|
|
|
|
|
|
my $domain = $ctx->domain_axis; |
81
|
|
|
|
|
|
|
my $range = $ctx->range_axis; |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
my $owidth = $width - ($width * $domain->fudge_amount); |
84
|
|
|
|
|
|
|
my $bwidth; |
85
|
|
|
|
|
|
|
if($self->has_bar_width) { |
86
|
|
|
|
|
|
|
$bwidth = $self->bar_width; |
87
|
|
|
|
|
|
|
} else { |
88
|
|
|
|
|
|
|
$bwidth = int(($owidth / $self->{KEYCOUNT})) - $padding; |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
my $hbwidth = int($bwidth / 2); |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
# Fudge amounts mess up the calculation of bar widths, so |
93
|
|
|
|
|
|
|
# we compensate for them here. |
94
|
|
|
|
|
|
|
my $cbwidth = $bwidth / $self->{SCOUNT}; |
95
|
|
|
|
|
|
|
my $chbwidth = int($cbwidth / 2); |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
my $color = $clicker->color_allocator->next; |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
my $base = $range->baseline; |
100
|
|
|
|
|
|
|
my $basey; |
101
|
|
|
|
|
|
|
if(defined($base)) { |
102
|
|
|
|
|
|
|
$basey = $height - $range->mark($height, $base); |
103
|
|
|
|
|
|
|
} else { |
104
|
|
|
|
|
|
|
$basey = $height; |
105
|
|
|
|
|
|
|
$base = $range->range->lower; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
my @vals = @{ $series->values }; |
109
|
|
|
|
|
|
|
my @keys = @{ $series->keys }; |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
my $sksent = $series->key_count; |
112
|
|
|
|
|
|
|
for(0..($sksent - 1)) { |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
# Skip drawing anything if the value is equal to the baseline |
115
|
|
|
|
|
|
|
next if $vals[$_] == $range->baseline; |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
my $x = $domain->mark($width, $keys[$_]); |
118
|
|
|
|
|
|
|
my $y = $range->mark($height, $vals[$_]); |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
if($vals[$_] >= $base) { |
121
|
|
|
|
|
|
|
if($self->{SCOUNT} == 1) { |
122
|
|
|
|
|
|
|
$self->move_to($x + $chbwidth, $basey); |
123
|
|
|
|
|
|
|
$self->rectangle( |
124
|
|
|
|
|
|
|
-int($cbwidth), -int($y - ($height - $basey)) |
125
|
|
|
|
|
|
|
); |
126
|
|
|
|
|
|
|
} else { |
127
|
|
|
|
|
|
|
$self->move_to( |
128
|
|
|
|
|
|
|
$x - $hbwidth + ($offset * $cbwidth), $basey |
129
|
|
|
|
|
|
|
); |
130
|
|
|
|
|
|
|
$self->rectangle( |
131
|
|
|
|
|
|
|
-int($cbwidth) + $brwidth, -int($y - ($height - $basey)) |
132
|
|
|
|
|
|
|
); |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
} else { |
135
|
|
|
|
|
|
|
if($self->{SCOUNT} == 1) { |
136
|
|
|
|
|
|
|
$self->move_to($x + $chbwidth, $basey); |
137
|
|
|
|
|
|
|
$self->rectangle( |
138
|
|
|
|
|
|
|
-int($cbwidth), -int($y - ($height - $basey)) |
139
|
|
|
|
|
|
|
); |
140
|
|
|
|
|
|
|
} else { |
141
|
|
|
|
|
|
|
$self->move_to( |
142
|
|
|
|
|
|
|
$x - $hbwidth + ($offset * $cbwidth), $basey |
143
|
|
|
|
|
|
|
); |
144
|
|
|
|
|
|
|
$self->rectangle( |
145
|
|
|
|
|
|
|
-int($cbwidth) + $brwidth, int($height - $basey - $y) |
146
|
|
|
|
|
|
|
); |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
my $fillop = Graphics::Primitive::Operation::Fill->new( |
152
|
|
|
|
|
|
|
paint => Graphics::Primitive::Paint::Solid->new |
153
|
|
|
|
|
|
|
); |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
if($self->opacity < 1) { |
156
|
|
|
|
|
|
|
my $fillcolor = $color->clone; |
157
|
|
|
|
|
|
|
$fillcolor->alpha($self->opacity); |
158
|
|
|
|
|
|
|
$fillop->paint->color($fillcolor); |
159
|
|
|
|
|
|
|
# Since we're going to stroke this, we want to preserve it. |
160
|
|
|
|
|
|
|
$fillop->preserve(1) if $brwidth; |
161
|
|
|
|
|
|
|
} else { |
162
|
|
|
|
|
|
|
$fillop->paint->color($color); |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
$self->do($fillop); |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
if(($self->opacity < 1) && ($brwidth > 0)) { |
168
|
|
|
|
|
|
|
my $strokeop = Graphics::Primitive::Operation::Stroke->new; |
169
|
|
|
|
|
|
|
$strokeop->brush($self->brush->clone); |
170
|
|
|
|
|
|
|
unless(defined($self->brush->color)) { |
171
|
|
|
|
|
|
|
$strokeop->brush->color($color); |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
$self->do($strokeop); |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
$offset++; |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
return 1; |
181
|
|
|
|
|
|
|
}); |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
__PACKAGE__->meta->make_immutable; |
184
|
|
|
|
|
|
|
|
185
|
2
|
|
|
2
|
|
30
|
no Moose; |
|
2
|
|
|
|
|
7
|
|
|
2
|
|
|
|
|
26
|
|
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
1; |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
__END__ |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
=pod |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
=head1 NAME |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
Chart::Clicker::Renderer::Bar - Bar renderer |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
=head1 VERSION |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
version 2.90 |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
=head1 SYNOPSIS |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
my $br = Chart::Clicker::Renderer::Bar->new; |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=head1 DESCRIPTION |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
Chart::Clicker::Renderer::Bar renders a dataset as bars. |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
=head1 NEGATIVE BARS |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
If you'd like to render both "negative and positive" bars, look at |
212
|
|
|
|
|
|
|
L<Chart::Clicker::Axis>'s C<baseline> attribute. Setting it will result in |
213
|
|
|
|
|
|
|
something like this: |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
=for HTML <p><img src="http://gphat.github.com/chart-clicker/static/images/examples/bar-baseline.png" width="500" height="250" alt="Base (Baseline) Chart" /></p> |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
=for HTML <p><img src="http://gphat.github.com/chart-clicker/static/images/examples/bar.png" width="500" height="250" alt="Bar Chart" /></p> |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
=head2 bar_padding |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
How much padding to put around a bar. A padding of 4 will result in 2 pixels |
222
|
|
|
|
|
|
|
on each side. |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
=head2 bar_width |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
Allows you to override the calculation that determines the optimal width for |
229
|
|
|
|
|
|
|
bars. Be careful using this as it can making things look terrible. Note that |
230
|
|
|
|
|
|
|
this number is divided evenly between all the values in a series when charting |
231
|
|
|
|
|
|
|
multiple series. |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
=head2 brush |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
Set/Get the L<brush|Graphics::Primitive::Brush> to use around each bar. |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
=head2 opacity |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
Set/Get the alpha value to make each bar more or less opaque. |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
=head1 AUTHOR |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
Cory G Watson <gphat@cpan.org> |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
This software is copyright (c) 2016 by Cory G Watson. |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
250
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
=cut |