File Coverage

blib/lib/Tickit/Widget/Breadcrumb.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


line stmt bran cond sub pod time code
1             package Tickit::Widget::Breadcrumb;
2             # ABSTRACT: breadcrumb-like interface
3 1     1   30379 use strict;
  1         3  
  1         35  
4 1     1   5 use warnings;
  1         1  
  1         21  
5              
6 1     1   527 use parent qw(Tickit::Widget);
  1         242  
  1         6  
7              
8             our $VERSION = '0.003';
9              
10             =head1 NAME
11              
12             Tickit::Widget::Breadcrumb - render a breadcrumb trail
13              
14             =head1 VERSION
15              
16             version 0.003
17              
18             =head1 SYNOPSIS
19              
20             use Tickit;
21             use Tickit::Widget::Breadcrumb;
22             my $bc = Tickit::Widget::Breadcrumb->new;
23             $bc->adapter->push([
24             qw(home perl site-lib)
25             ]);
26             Tickit->new(root_widget => $bc)->run;
27              
28             =head1 DESCRIPTION
29              
30             Provides a widget for showing "breadcrumbs".
31              
32             Accepts focus.
33              
34             Use left/right to navigate, enter to select.
35              
36             Render looks something like:
37              
38             first < second | current | next > last
39              
40             =head2 ITEM TRANSFORMATIONS
41              
42             See L.
43              
44             =cut
45              
46             use curry::weak;
47              
48             use Adapter::Async::OrderedList::Array;
49              
50             use Tickit::Debug;
51             use Tickit::Style;
52             use Tickit::Utils qw(textwidth);
53             use List::Util qw(sum0);
54              
55             use constant CAN_FOCUS => 1;
56             use constant WIDGET_PEN_FROM_STYLE => 1;
57             use constant KEYPRESSES_FROM_STYLE => 1;
58              
59             BEGIN {
60             style_definition base =>
61             powerline => 0,
62             block => 0,
63             right_fg => 'grey',
64             left_fg => 'white',
65             highlight_fg => 'hi-white',
66             highlight_bg => 'green';
67              
68             style_definition ':focus' =>
69             '' => 'prev',
70             '' => 'next',
71             '' => 'select';
72             }
73              
74             =head1 METHODS
75              
76             =cut
77              
78             =head2 new
79              
80             Instantiate. The following named parameters may be of use:
81              
82             =over 4
83              
84             =item * item_transformations - a coderef or arrayref of transformations to
85             apply to items received from the adapter.
86              
87             =item * skip_first - number of items to skip at the start when rendering, default 0
88              
89             =back
90              
91             An example of transformations:
92              
93             my $bc = Tickit::Widget::Breadcrumb->new(
94             item_transformations => sub {
95             my $item = shift;
96             strftime '%Y-%m-%d %H:%M:%S', localtime $item
97             }
98             );
99             $bc->push([ time ]);
100              
101             =cut
102              
103             sub new {
104             my $class = shift;
105             my %args = @_;
106             my $transform = delete $args{item_transformations};
107             my $skip = delete $args{skip_first};
108             $transform ||= [];
109             $transform = [$transform] if ref $transform eq 'CODE';
110             my $self = $class->SUPER::new(%args);
111             $self->{item_transformations} = $transform;
112             $self->{skip_first} = $skip // 0;
113             $self
114             }
115              
116             =head2 lines
117              
118             Returns the number of lines this widget would like.
119              
120             =cut
121              
122             sub lines { 1 }
123              
124             =head2 cols
125              
126             Returns the number of columns this widget would like.
127              
128             =cut
129              
130             sub cols { 1 }
131              
132             =head2 render_to_rb
133              
134             Perform rendering.
135              
136             =cut
137              
138             sub render_to_rb {
139             my ($self, $rb, $rect) = @_;
140             unless($self->{crumbs}) {
141             $rb->eraserect(
142             $rect,
143             );
144             $rb->text_at(0,0, 'Please wait...');
145             return;
146             }
147              
148             $rb->eraserect(
149             $rect,
150             $self->get_style_pen(
151             $self->highlight == $#{$self->{crumbs}}
152             ? 'highlight'
153             : 'right'
154             )
155             );
156              
157             foreach my $idx (0..$#{$self->{crumbs}}) {
158             $self->render_item($rb, $rect, $idx);
159             last if $idx == $#{$self->{crumbs}};
160             $self->render_separator($rb, $rect, $idx);
161             }
162             }
163              
164             {
165             my $order = [qw(left highlight right)];
166             sub render_item {
167             my ($self, $rb, $rect, $idx) = @_;
168             my $pen = $self->get_style_pen(
169             $order->[1 + ($idx <=> $self->highlight)]
170             );
171             # warn "Item at $idx is ". $self->{crumbs}[$idx] . "\n";
172             $rb->text_at(0, $self->item_col($idx), $self->{crumbs}[$idx], $pen);
173             }
174             }
175              
176             =head2 render_separator
177              
178             Renders the separator between two items.
179              
180             Pass the index of the item on the left.
181              
182             There are 3 cases:
183              
184             =over 4
185              
186             =item * inactive to inactive
187              
188             =item * inactive to active
189              
190             =item * active to inactive
191              
192             =back
193              
194             =cut
195              
196             sub render_separator {
197             my ($self, $rb, $rect, $idx) = @_;
198              
199             my $x = $self->item_col($idx) + textwidth $self->{crumbs}[$idx];
200             if($self->highlight == $idx) {
201             # active => inactive
202             $rb->text_at(0, $x, " ", $self->get_style_pen('highlight'));
203             my $pen = Tickit::Pen->new(
204             fg => $self->get_style_pen('highlight')->getattr('bg'),
205             bg => $self->get_style_pen('right')->getattr('bg'),
206             );
207             $rb->text_at(
208             0,
209             $x + 1,
210             $self->get_style_values('powerline')
211             ? "\N{U+E0B0}"
212             : $self->get_style_values('block')
213             ? "\N{U+258C}"
214             : "|",
215             $pen
216             );
217             $rb->text_at(0, $x + 2, " ", $self->get_style_pen('right'));
218             } elsif($self->highlight == $idx + 1) {
219             # inactive => active
220             $rb->text_at(0, $x, " ", $self->get_style_pen());
221             my $pen = Tickit::Pen->new(
222             bg => $self->get_style_pen('left')->getattr('bg'),
223             fg => $self->get_style_pen('highlight')->getattr('bg'),
224             );
225             $rb->text_at(
226             0,
227             $x + 1,
228             $self->get_style_values('powerline')
229             ? "\N{U+E0B2}"
230             : $self->get_style_values('block')
231             ? "\N{U+2590}"
232             : "|",
233             $pen
234             );
235             $rb->text_at(0, $x + 2, " ", $self->get_style_pen('highlight'));
236             } elsif($self->highlight < $idx) {
237             # inactive => inactive, to right of highlight
238             $rb->text_at(0, $x, $self->get_style_values('powerline') ? " \N{U+E0B1} " : ' > ', $self->get_style_pen('right'));
239             } else {
240             # inactive => inactive, left
241             $rb->text_at(0, $x, $self->get_style_values('powerline') ? " \N{U+E0B3} " : ' > ', $self->get_style_pen('left'));
242             }
243             }
244              
245             sub separator_col {
246             my ($self, $idx) = @_;
247             return -2 + sum0 map $self->item_width($_), 0..$idx;
248             }
249              
250             sub item_col {
251             my ($self, $idx) = @_;
252             return unless my $win = $self->window;
253             sum0 map $self->item_width($_), 0..$idx - 1;
254             }
255              
256             sub highlight { shift->{highlight} }
257             sub crumbs { @{ shift->{crumbs} } }
258              
259             sub update_crumbs {
260             my ($self) = @_;
261             $self->adapter->all->on_done(sub {
262             my $data = shift;
263             my @copy = @$data;
264             splice @copy, 0, $self->skip_first if $self->skip_first;
265             $self->{crumbs} = [ map $self->transform_item($_), @copy ];
266             $self->window->expose if $self->window;
267             });
268             }
269              
270             sub skip_first { shift->{skip_first} }
271              
272             =head2 transform_item
273              
274             Applies any transformations to the given item.
275              
276             Currently these are immediate transformations, i.e. no support for Ls.
277             This may change in a newer versions, but you should be safe as long as you return
278             a string or L rather than a L here.
279              
280             See L for details.
281              
282             =cut
283              
284             sub transform_item {
285             my ($self, $item) = @_;
286             $item = $_->($item) for @{$self->{item_transformations}};
287             $item
288             }
289              
290              
291             =head2 adapter
292              
293             Returns the adapter responsible for dealing with the underlying data.
294              
295             If called with no parameters, will return the current adapter (creating one if necessary).
296              
297             If called with a parameter, will set the adapter to that value,
298             assigning a new default adapter if given undef. Will then return
299             $self to allow for method chaining.
300              
301             =cut
302              
303             sub adapter {
304             my $self = shift;
305             return $self->{adapter} if $self->{adapter} && !@_;
306              
307             my ($adapter) = @_;
308              
309             if(my $old = delete $self->{adapter}) {
310             $old->bus->unsubscribe_from_event(
311             splice @{$self->{adapter_subscriptions}}
312             );
313             }
314             $adapter ||= Adapter::Async::OrderedList::Array->new;
315             $self->{adapter} = $adapter;
316              
317             $adapter->bus->subscribe_to_event(
318             @{ $self->{adapter_subscriptions} = [
319             splice => $self->curry::weak::on_splice_event,
320             clear => $self->curry::weak::on_clear_event,
321             ] }
322             );
323             $self->update_crumbs;
324             $self->window->expose if $self->window;
325             @_ ? $self : $self->{adapter};
326             }
327              
328             sub window_gained {
329             my ($self, $win) = @_;
330             $self->{highlight} //= 0;
331             $self->update_cursor;
332             $self->SUPER::window_gained($win);
333             }
334              
335             sub on_splice_event {
336             my ($self) = @_;
337             $self->update_crumbs
338             }
339              
340             sub on_clear_event {
341             }
342              
343             sub update_cursor {
344             my ($self) = @_;
345             return unless my $win = $self->window;
346             $win->cursor_at(0, $self->item_col($self->highlight));
347             $win->cursor_visible(0);
348             }
349              
350             sub item_width {
351             my ($self, $idx) = @_;
352             3 + textwidth $self->{crumbs}[$idx];
353             }
354              
355             sub key_prev {
356             my ($self) = @_;
357             return unless $self->{highlight};
358             --$self->{highlight};
359             return unless $self->window;
360             $self->update_cursor;
361             $self->window->expose;
362             }
363              
364             sub key_next {
365             my ($self) = @_;
366             return unless $self->{crumbs};
367             return if $self->{highlight} == $#{$self->{crumbs}};
368             ++$self->{highlight};
369             return unless $self->window;
370             $self->update_cursor;
371             $self->window->expose;
372             }
373              
374             1;
375              
376             __END__