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