line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Tickit::Widget::SparkLine; |
2
|
|
|
|
|
|
|
# ABSTRACT: Simple 'sparkline' widget implementation |
3
|
1
|
|
|
1
|
|
18255
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
29
|
|
4
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
31
|
|
5
|
1
|
|
|
1
|
|
501
|
use parent qw(Tickit::Widget); |
|
1
|
|
|
|
|
294
|
|
|
1
|
|
|
|
|
6
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our $VERSION = '0.106'; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 NAME |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
Tickit::Widget::SparkLine - minimal graph implementation for L |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=head1 VERSION |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
version 0.106 |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=head1 SYNOPSIS |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
my $vbox = Tickit::Widget::VBox->new; |
20
|
|
|
|
|
|
|
my $widget = Tickit::Widget::SparkLine->new( |
21
|
|
|
|
|
|
|
data => [ 0, 3, 2, 5, 1, 6, 0, 7 ] |
22
|
|
|
|
|
|
|
); |
23
|
|
|
|
|
|
|
$vbox->add($widget, expand => 1); |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=head1 DESCRIPTION |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
Generates a mini ("sparkline") graph. |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
=begin HTML |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
=end HTML |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
=head1 STYLE |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
Set the base style background/foreground to determine the graph colours. |
38
|
|
|
|
|
|
|
Note that reverse video and bold don't work very well on some terminals, |
39
|
|
|
|
|
|
|
since the background+foreground colours won't match. |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
=cut |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
use POSIX qw(floor); |
44
|
|
|
|
|
|
|
use Scalar::Util qw(reftype); |
45
|
|
|
|
|
|
|
use List::Util qw(max sum min); |
46
|
|
|
|
|
|
|
use Tickit::Utils qw(textwidth); |
47
|
|
|
|
|
|
|
use Tickit::Style; |
48
|
|
|
|
|
|
|
use constant WIDGET_PEN_FROM_STYLE => 1; |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
BEGIN { |
51
|
|
|
|
|
|
|
style_definition base => |
52
|
|
|
|
|
|
|
fg => 'white'; |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=head1 METHODS |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
=cut |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
sub lines { 1 } |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
sub cols { |
62
|
|
|
|
|
|
|
my $self = shift; |
63
|
|
|
|
|
|
|
scalar @{$self->{data}} |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
=head2 new |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
Instantiate the widget. Takes the following named parameters: |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=over 4 |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=item * data - graph data |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=back |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=cut |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub new { |
79
|
|
|
|
|
|
|
my $class = shift; |
80
|
|
|
|
|
|
|
my %args = @_; |
81
|
|
|
|
|
|
|
my $data = delete $args{data}; |
82
|
|
|
|
|
|
|
my $self = $class->SUPER::new(%args); |
83
|
|
|
|
|
|
|
$self->{data} = $data || []; |
84
|
|
|
|
|
|
|
$self->resized if $data; |
85
|
|
|
|
|
|
|
return $self; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
=head2 data |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
Accessor for stored data. |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
With no parameters, returns the stored data as a list. |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
Pass either an array or an arrayref to set the data values and request display refresh. |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=cut |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub data { |
99
|
|
|
|
|
|
|
my $self = shift; |
100
|
|
|
|
|
|
|
if(@_) { |
101
|
|
|
|
|
|
|
$self->{data} = [ (ref($_[0]) && reftype($_[0]) eq 'ARRAY') ? @{$_[0]} : @_ ]; |
102
|
|
|
|
|
|
|
delete $self->{max_value}; |
103
|
|
|
|
|
|
|
$self->resized; |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
return @{ $self->{data} }; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=head2 data_chars |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
Returns the set of characters corresponding to the current data values. Each value |
111
|
|
|
|
|
|
|
is assigned a single character, so the string length is equal to the number of data |
112
|
|
|
|
|
|
|
items and represents the minimal string capable of representing all current data |
113
|
|
|
|
|
|
|
items. |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
=cut |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
sub data_chars { |
118
|
|
|
|
|
|
|
my $self = shift; |
119
|
|
|
|
|
|
|
return join '', map { $self->char_for_value($_) } $self->data; |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
=head2 push |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
Helper method to add one or more items to the end of the list. |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
$widget->push(3,4,2); |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
=cut |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
sub push : method { |
131
|
|
|
|
|
|
|
my $self = shift; |
132
|
|
|
|
|
|
|
push @{$self->{data}}, @_; |
133
|
|
|
|
|
|
|
delete $self->{max_value}; |
134
|
|
|
|
|
|
|
$self->resized; |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=head2 pop |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
Helper method to remove one item from the end of the list, returns the item. |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
my $item = $widget->pop; |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=cut |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
sub pop : method { |
146
|
|
|
|
|
|
|
my $self = shift; |
147
|
|
|
|
|
|
|
my $item = pop @{$self->{data}}; |
148
|
|
|
|
|
|
|
delete $self->{max_value}; |
149
|
|
|
|
|
|
|
$self->resized; |
150
|
|
|
|
|
|
|
return $item; |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=head2 shift |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
Helper method to remove one item from the start of the list, returns the item. |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
my $item = $widget->shift; |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
=cut |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
sub shift : method { |
162
|
|
|
|
|
|
|
my $self = shift; |
163
|
|
|
|
|
|
|
my $item = shift @{$self->{data}}; |
164
|
|
|
|
|
|
|
delete $self->{max_value}; |
165
|
|
|
|
|
|
|
$self->resized; |
166
|
|
|
|
|
|
|
return $item; |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
=head2 unshift |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
Helper method to add items to the start of the list. Takes a list. |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
$widget->unshift(0, 1, 3); |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
=cut |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
sub unshift : method { |
178
|
|
|
|
|
|
|
my $self = shift; |
179
|
|
|
|
|
|
|
unshift @{$self->{data}}, @_; |
180
|
|
|
|
|
|
|
delete $self->{max_value}; |
181
|
|
|
|
|
|
|
$self->resized; |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
=head2 splice |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
Equivalent to the standard Perl L function. |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
# Insert 3,4,5 at position 2 |
189
|
|
|
|
|
|
|
$widget->splice(2, 0, 3, 4, 5); |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
=cut |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
sub splice : method { |
194
|
|
|
|
|
|
|
my $self = shift; |
195
|
|
|
|
|
|
|
my ($offset, $length, @values) = @_; |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
# Specify parameters directly since splice applies a @$$@-ish prototype here |
198
|
|
|
|
|
|
|
my @items = splice @{$self->{data}}, $offset, $length, @values; |
199
|
|
|
|
|
|
|
delete $self->{max_value}; |
200
|
|
|
|
|
|
|
$self->resized; |
201
|
|
|
|
|
|
|
return @items; |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
=head2 graph_steps |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
Returns an arrayref of characters in order of magnitude. |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
For example: |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
[ ' ', qw(_ x X) ] |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
would yield a granularity of 4 steps. |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
Override this in subclasses to provide different visualisations - there's no limit to the number of |
215
|
|
|
|
|
|
|
characters you provide in this arrayref. |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
=cut |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
sub graph_steps { [ |
220
|
|
|
|
|
|
|
ord " ", |
221
|
|
|
|
|
|
|
0x2581, |
222
|
|
|
|
|
|
|
0x2582, |
223
|
|
|
|
|
|
|
0x2583, |
224
|
|
|
|
|
|
|
0x2584, |
225
|
|
|
|
|
|
|
0x2585, |
226
|
|
|
|
|
|
|
0x2586, |
227
|
|
|
|
|
|
|
0x2587, |
228
|
|
|
|
|
|
|
0x2588 |
229
|
|
|
|
|
|
|
] } |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
=head2 resample |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
Given a width $w, resamples the data (remaining list of |
234
|
|
|
|
|
|
|
parameters) to fit, using the current L. |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
Used internally. |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
=cut |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
sub resample { |
241
|
|
|
|
|
|
|
my $self = shift; |
242
|
|
|
|
|
|
|
my ($total_width, @data) = @_; |
243
|
|
|
|
|
|
|
my $xdelta = $total_width / @data; |
244
|
|
|
|
|
|
|
my $x = 0; |
245
|
|
|
|
|
|
|
my @v; |
246
|
|
|
|
|
|
|
my @out; |
247
|
|
|
|
|
|
|
my $mode = { |
248
|
|
|
|
|
|
|
average => sub { sum(@_) / @_ }, |
249
|
|
|
|
|
|
|
mean => sub { sum(@_) / @_ }, |
250
|
|
|
|
|
|
|
median => sub { |
251
|
|
|
|
|
|
|
my @sorted = sort { $a <=> $b } @_; |
252
|
|
|
|
|
|
|
(@sorted % 2) ? $sorted[@_ / 2] : (sum(@sorted[@_ / 2, 1 + @_ / 2]) / 2) }, |
253
|
|
|
|
|
|
|
peak => sub { max @_ }, |
254
|
|
|
|
|
|
|
min => sub { min @_ }, |
255
|
|
|
|
|
|
|
max => sub { max @_ }, |
256
|
|
|
|
|
|
|
}->{$self->resample_mode} or die 'bad resample mode: ' . $self->resample_mode; |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
for (@data) { |
259
|
|
|
|
|
|
|
my $last_x = $x; |
260
|
|
|
|
|
|
|
$x += $xdelta; |
261
|
|
|
|
|
|
|
push @v, $_; |
262
|
|
|
|
|
|
|
if(floor($x) - floor($last_x)) { |
263
|
|
|
|
|
|
|
push @out, $mode->(@v); |
264
|
|
|
|
|
|
|
@v = (); |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
@out; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
=head2 render_to_rb |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
Rendering implementation. Uses L as the base character set. |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
=cut |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
sub render_to_rb { |
277
|
|
|
|
|
|
|
my ($self, $rb) = @_; |
278
|
|
|
|
|
|
|
my $win = $self->window or return; |
279
|
|
|
|
|
|
|
$rb->clear; |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
my @data = @{$self->{data}}; |
282
|
|
|
|
|
|
|
my $total_width = $win->cols; |
283
|
|
|
|
|
|
|
my $w = $total_width / (@data || 1); |
284
|
|
|
|
|
|
|
my $floored_w = floor $w; |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
# Apply minimum per-cell width of 1 char, and resample data to fit |
287
|
|
|
|
|
|
|
unless($floored_w) { |
288
|
|
|
|
|
|
|
$w = 1; |
289
|
|
|
|
|
|
|
$floored_w = 1; |
290
|
|
|
|
|
|
|
@data = $self->resample($total_width => @data); |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
my $win_height = $win->lines; |
294
|
|
|
|
|
|
|
my $x = 0; |
295
|
|
|
|
|
|
|
my $range = $#{$self->graph_steps}; |
296
|
|
|
|
|
|
|
my $fg_pen = $self->get_style_pen; |
297
|
|
|
|
|
|
|
my $bg_pen = Tickit::Pen->new( |
298
|
|
|
|
|
|
|
bg => $fg_pen->getattr('fg'), |
299
|
|
|
|
|
|
|
map {; $_ => $fg_pen->getattr($_) } qw(rv b) |
300
|
|
|
|
|
|
|
); |
301
|
|
|
|
|
|
|
foreach my $item (@data) { |
302
|
|
|
|
|
|
|
my $v = $item * $win_height / $self->max_value; |
303
|
|
|
|
|
|
|
my $top = $win_height - floor( $v); |
304
|
|
|
|
|
|
|
my $left = floor(0.5 + $x); |
305
|
|
|
|
|
|
|
my $bar_width = (floor(0.5 + $x + $w) - $left); |
306
|
|
|
|
|
|
|
for my $y ($top .. $win_height) { |
307
|
|
|
|
|
|
|
$rb->erase_at($y, $left, $bar_width, $bg_pen); |
308
|
|
|
|
|
|
|
} |
309
|
|
|
|
|
|
|
my $ch = $self->graph_steps->[floor(0.5 + $range * ($v - floor($v)))]; |
310
|
|
|
|
|
|
|
$rb->char_at($top - 1, $left + $_, $ch, $fg_pen) for 0..$bar_width-1; |
311
|
|
|
|
|
|
|
$x += $w; |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
=head2 char_for_value |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
Returns the character code corresponding to the given data value. |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
=cut |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
sub char_for_value { |
322
|
|
|
|
|
|
|
my $self = shift; |
323
|
|
|
|
|
|
|
my $item = shift; |
324
|
|
|
|
|
|
|
my $range = $#{$self->graph_steps}; |
325
|
|
|
|
|
|
|
return $self->graph_steps->[$item * $range / $self->max_value]; |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
=head2 max_value |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
Returns the maximum value seen so far, used for autoscaling. |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
=cut |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
sub max_value { |
335
|
|
|
|
|
|
|
my $self = shift; |
336
|
|
|
|
|
|
|
return $self->{max_value} if exists $self->{max_value}; |
337
|
|
|
|
|
|
|
return $self->{max_value} = max($self->data); |
338
|
|
|
|
|
|
|
} |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
=head2 resample_mode |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
Change method for resampling when we have more data than will fit on the graph. |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
Current values include: |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
=over 4 |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
=item * average - takes the average of combined values for this bucket |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
=item * min - lowest value for this bucket |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
=item * median - highest value for this bucket |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
=item * max - largest value for this bucket |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
=item * peak - alias for 'max' |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
=back |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
The default is 'average'. |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
Returns $self if setting a value, or the current value. |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
=cut |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
sub resample_mode { |
367
|
|
|
|
|
|
|
my $self = shift; |
368
|
|
|
|
|
|
|
if(@_) { |
369
|
|
|
|
|
|
|
$self->{resample_mode} = shift; |
370
|
|
|
|
|
|
|
return $self; |
371
|
|
|
|
|
|
|
} |
372
|
|
|
|
|
|
|
return $self->{resample_mode} // 'average'; |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
1; |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
__END__ |