File Coverage

blib/lib/Tickit/Widget/Scroller.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             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2011-2016 -- leonerd@leonerd.org.uk
5              
6             package Tickit::Widget::Scroller;
7              
8 1     1   568 use strict;
  1         1  
  1         25  
9 1     1   3 use warnings;
  1         1  
  1         24  
10 1     1   7 use base qw( Tickit::Widget );
  1         1  
  1         483  
11             use Tickit::Style;
12             Tickit::Widget->VERSION( '0.35' );
13             Tickit::Window->VERSION( '0.42' );
14              
15             use Tickit::Window;
16             use Tickit::Utils qw( textwidth );
17             use Tickit::RenderBuffer;
18              
19             our $VERSION = '0.21';
20              
21             use Carp;
22              
23             =head1 NAME
24              
25             C - a widget displaying a scrollable collection of
26             items
27              
28             =head1 SYNOPSIS
29              
30             use Tickit;
31             use Tickit::Widget::Scroller;
32             use Tickit::Widget::Scroller::Item::Text;
33            
34             my $tickit = Tickit->new;
35            
36             my $scroller = Tickit::Widget::Scroller->new;
37              
38             $scroller->push(
39             Tickit::Widget::Scroller::Item::Text->new( "Hello world" ),
40             Tickit::Widget::Scroller::Item::Text->new( "Here are some lines" ),
41             map { Tickit::Widget::Scroller::Item::Text->new( "" ) } 1 .. 50,
42             );
43            
44             $tickit->set_root_widget( $scroller );
45            
46             $tickit->run
47              
48             =head1 DESCRIPTION
49              
50             This class provides a widget which displays a scrollable list of items. The
51             view of the items is scrollable, able to display only a part of the list.
52              
53             A Scroller widget stores a list of instances implementing the
54             C interface.
55              
56             =head1 STYLE
57              
58             The default style pen is used as the widget pen.
59              
60             The following style pen prefixes are used:
61              
62             =over 4
63              
64             =item indicator => PEN
65              
66             The pen used for the scroll position indicators at the top or bottom of the
67             display
68              
69             =back
70              
71             =cut
72              
73             style_definition base =>
74             indicator_rv => 1;
75              
76             use constant WIDGET_PEN_FROM_STYLE => 1;
77              
78             =head1 KEYBINDINGS
79              
80             The following keys are bound
81              
82             =over 2
83              
84             =item * Down
85              
86             Scroll one line down
87              
88             =item * Up
89              
90             Scroll one line up
91              
92             =item * PageDown
93              
94             Scroll half a window down
95              
96             =item * PageUp
97              
98             Scroll half a window up
99              
100             =item * Ctrl-Home
101              
102             Scroll to the top
103              
104             =item * Ctrl-End
105              
106             Scroll to the bottom
107              
108             =back
109              
110             =cut
111              
112             =head1 CONSTRUCTOR
113              
114             =cut
115              
116             =head2 new
117              
118             $scroller = Tickit::Widget::Scroller->new( %args )
119              
120             Constructs a new C object. The new object will start
121             with an empty list of items.
122              
123             Takes the following named arguments:
124              
125             =over 8
126              
127             =item gravity => STRING
128              
129             Optional. If given the value C, resize events and the C method
130             will attempt to preserve the item at the bottom of the screen. Otherwise, will
131             preserve the top.
132              
133             =item gen_top_indicator => CODE
134              
135             =item gen_bottom_indicator => CODE
136              
137             Optional. Generator functions for the top and bottom indicators. See also
138             C and C.
139              
140             =back
141              
142             =cut
143              
144             sub new
145             {
146             my $class = shift;
147             my %args = @_;
148              
149             my $gravity = delete $args{gravity} || "top";
150              
151             my $self = $class->SUPER::new( %args );
152              
153             # We're going to cache window height because we need pre-resize height
154             # during resize event
155             $self->{window_lines} = undef;
156              
157             $self->{items} = [];
158              
159             $self->{start_item} = 0;
160             $self->{start_partial} = 0;
161              
162             $self->{gravity_bottom} = $gravity eq "bottom";
163              
164             $self->set_on_scrolled( $args{on_scrolled} ) if $args{on_scrolled};
165              
166             $self->set_gen_top_indicator( $args{gen_top_indicator} );
167             $self->set_gen_bottom_indicator( $args{gen_bottom_indicator} );
168              
169             return $self;
170             }
171              
172             =head1 METHODS
173              
174             =cut
175              
176             sub cols { 1 }
177             sub lines { 1 }
178              
179             sub _item
180             {
181             my $self = shift;
182             my ( $idx ) = @_;
183             return $self->{items}[$idx];
184             }
185              
186             sub _itemheight
187             {
188             my $self = shift;
189             my ( $idx ) = @_;
190             return $self->{itemheights}[$idx] if defined $self->{itemheights}[$idx];
191             return $self->{itemheights}[$idx] = $self->_item( $idx )->height_for_width( $self->window->cols );
192             }
193              
194             sub reshape
195             {
196             my $self = shift;
197              
198             my ( $itemidx, $itemline ) = $self->line2item( $self->{gravity_bottom} ? -1 : 0 );
199             $itemline -= $self->_itemheight( $itemidx ) if $self->{gravity_bottom} and defined $itemidx;
200              
201             $self->SUPER::reshape;
202              
203             $self->{window_lines} = $self->window->lines;
204              
205             if( !defined $self->{window_cols} or $self->{window_cols} != $self->window->cols ) {
206             $self->{window_cols} = $self->window->cols;
207              
208             undef $self->{itemheights};
209             $self->resized;
210             }
211              
212             if( defined $itemidx ) {
213             $self->scroll_to( $self->{gravity_bottom} ? -1 : 0, $itemidx, $itemline );
214             }
215             elsif( $self->{gravity_bottom} ) {
216             $self->scroll_to_bottom;
217             }
218             else {
219             $self->scroll_to_top;
220             }
221              
222             $self->update_indicators;
223             }
224              
225             sub window_lost
226             {
227             my $self = shift;
228             $self->SUPER::window_lost( @_ );
229              
230             my ( $line, $offscreen ) = $self->item2line( -1, -1 );
231              
232             $self->{pending_scroll_to_bottom} = 1 if defined $line;
233              
234             undef $self->{window_lines};
235             }
236              
237             sub window_gained
238             {
239             my $self = shift;
240             my ( $win ) = @_;
241              
242             $self->{window_lines} = $win->lines;
243              
244             $self->SUPER::window_gained( $win );
245              
246             if( delete $self->{pending_scroll_to_bottom} ) {
247             $self->scroll_to_bottom;
248             }
249             }
250              
251             =head2 on_scrolled
252              
253             =head2 set_on_scrolled
254              
255             $on_scrolled = $scroller->on_scrolled
256              
257             $scroller->set_on_scrolled( $on_scrolled )
258              
259             Return or set the CODE reference to be called when the scroll position is
260             adjusted.
261              
262             $on_scrolled->( $scroller, $delta )
263              
264             This is invoked by the C method, including the C,
265             C and C. In normal cases it will be given the
266             delta offset that C itself was invoked with, though this may be
267             clipped if this would scroll past the beginning or end of the display.
268              
269             =cut
270              
271             sub on_scrolled
272             {
273             my $self = shift;
274             return $self->{on_scrolled};
275             }
276              
277             sub set_on_scrolled
278             {
279             my $self = shift;
280             ( $self->{on_scrolled} ) = @_;
281             }
282              
283             =head2 push
284              
285             $scroller->push( @items )
286              
287             Append the given items to the end of the list.
288              
289             If the Scroller is already at the tail (that is, the last line of the last
290             item is on display) and the gravity mode is C, the newly added items
291             will be displayed, possibly by scrolling downward if required. While the
292             scroller isn't adjusted by using any of the C methods, it will remain
293             following the tail of the items, scrolling itself downwards as more are added.
294              
295             =cut
296              
297             sub push
298             {
299             my $self = shift;
300              
301             my $items = $self->{items};
302              
303             my $oldsize = @$items;
304              
305             push @$items, @_;
306              
307             if( my $win = $self->window and $self->window->is_visible ) {
308             my $added = 0;
309             $added += $self->_itemheight( $_ ) for $oldsize .. $#$items;
310              
311             my $lines = $self->{window_lines};
312              
313             my $oldlast = $oldsize ? $self->item2line( $oldsize-1, -1 ) : -1;
314              
315             # Previous tail is on screen if $oldlast is defined and less than $lines
316             # If not, don't bother drawing or scrolling
317             return unless defined $oldlast and $oldlast < $lines;
318              
319             my $new_start = $oldlast + 1;
320             my $new_stop = $new_start + $added;
321              
322             if( $self->{gravity_bottom} ) {
323             # If there were enough spare lines, render them, otherwise scroll
324             if( $new_stop <= $lines ) {
325             $self->render_lines( $new_start, $new_stop );
326             }
327             else {
328             $self->render_lines( $new_start, $lines ) if $new_start < $lines;
329             $self->scroll( $new_stop - $lines );
330             }
331             }
332             else {
333             # If any new lines of content are now on display, render them
334             $new_stop = $lines if $new_stop > $lines;
335             if( $new_stop > $new_start ) {
336             $self->render_lines( $new_start, $new_stop );
337             }
338             }
339             }
340              
341             $self->update_indicators;
342             }
343              
344             =head2 unshift
345              
346             $scroller->unshift( @items )
347              
348             Prepend the given items to the beginning of the list.
349              
350             If the Scroller is already at the head (that is, the first line of the first
351             item is on display) and the gravity mode is C, the newly added items will
352             be displayed, possibly by scrolling upward if required. While the scroller
353             isn't adjusted by using any of the C methods, it will remain following
354             the head of the items, scrolling itself upwards as more are added.
355              
356             =cut
357              
358             sub unshift :method
359             {
360             my $self = shift;
361              
362             my $items = $self->{items};
363              
364             my $oldsize = @$items;
365              
366             my $oldfirst = $oldsize ? $self->item2line( 0, 0 ) : 0;
367             my $oldlast = $oldsize ? $self->item2line( -1, -1 ) : -1;
368              
369             unshift @$items, @_;
370             unshift @{ $self->{itemheights} }, ( undef ) x @_;
371             $self->{start_item} += @_;
372              
373             if( my $win = $self->window and $self->window->is_visible ) {
374             my $added = 0;
375             $added += $self->_itemheight( $_ ) for 0 .. $#_;
376              
377             # Previous head is on screen if $oldfirst is defined and non-negative
378             # If not, don't bother drawing or scrolling
379             return unless defined $oldfirst and $oldfirst >= 0;
380              
381             my $lines = $self->{window_lines};
382              
383             if( $self->{gravity_bottom} ) {
384             # If the display wasn't yet full, scroll it down to display any new
385             # lines that are visible
386             my $first_blank = $oldlast + 1;
387             my $scroll_delta = $lines - $first_blank;
388             $scroll_delta = $added if $scroll_delta > $added;
389             if( $oldsize ) {
390             $self->scroll( -$scroll_delta );
391             }
392             else {
393             $self->{start_item} = 0;
394             # TODO: if $added > $lines, need special handling
395             $self->render_lines( 0, $added );
396             }
397             }
398             else {
399             # Scroll down by the amount added
400             if( $oldsize ) {
401             $self->scroll( -$added );
402             }
403             else {
404             my $new_stop = $added;
405             $new_stop = $lines if $new_stop > $lines;
406             $self->{start_item} = 0;
407             $self->render_lines( 0, $new_stop );
408             }
409             }
410             }
411              
412             $self->update_indicators;
413             }
414              
415             =head2 shift
416              
417             @items = $scroller->shift( $count )
418              
419             Remove the given number of items from the start of the list and returns them.
420              
421             If any of the items are on display, the Scroller will be scrolled upwards an
422             amount sufficient to close the gap, ensuring the first remaining item is now
423             at the top of the display.
424              
425             The returned items may be re-used by adding them back into the scroller again
426             either by C or C, or may be discarded.
427              
428             =cut
429              
430             sub shift :method
431             {
432             my $self = shift;
433             my ( $count ) = @_;
434              
435             defined $count or $count = 1;
436              
437             my $items = $self->{items};
438              
439             croak '$count out of bounds' if $count <= 0;
440             croak '$count out of bounds' if $count > @$items;
441              
442             my ( $lastline, $offscreen ) = $self->item2line( $count - 1, -1 );
443              
444             if( defined $lastline ) {
445             $self->scroll( $lastline + 1, allow_gap => 1 );
446             # ->scroll implies $win->restore
447             }
448              
449             my @ret = splice @$items, 0, $count;
450             splice @{ $self->{itemheights} }, 0, $count;
451             $self->{start_item} -= $count;
452              
453             if( !defined $lastline and defined $offscreen and $offscreen eq "below" ) {
454             $self->scroll_to_top;
455             # ->scroll implies $win->restore
456             }
457              
458             $self->update_indicators;
459              
460             return @ret;
461             }
462              
463             =head2 pop
464              
465             @items = $scroller->pop( $count )
466              
467             Remove the given number of items from the end of the list and returns them.
468              
469             If any of the items are on display, the Scroller will be scrolled downwards an
470             amount sufficient to close the gap, ensuring the last remaining item is now at
471             the bottom of the display.
472              
473             The returned items may be re-used by adding them back into the scroller again
474             either by C or C, or may be discarded.
475              
476             =cut
477              
478             sub pop :method
479             {
480             my $self = shift;
481             my ( $count ) = @_;
482              
483             defined $count or $count = 1;
484              
485             my $items = $self->{items};
486              
487             croak '$count out of bounds' if $count <= 0;
488             croak '$count out of bounds' if $count > @$items;
489              
490             my ( $firstline, $offscreen ) = $self->item2line( -$count, 0 );
491              
492             if( defined $firstline ) {
493             $self->scroll( $firstline - $self->window->lines );
494             }
495              
496             my @ret = splice @$items, -$count, $count;
497             splice @{ $self->{itemheights} }, -$count, $count;
498              
499             if( !defined $firstline and defined $offscreen and $offscreen eq "above" ) {
500             $self->scroll_to_bottom;
501             }
502              
503             $self->update_indicators;
504              
505             return @ret;
506             }
507              
508             =head2 scroll
509              
510             $scroller->scroll( $delta )
511              
512             Move the display up or down by the given C<$delta> amount; with positive
513             moving down. This will be a physical count of displayed lines; if some items
514             occupy multiple lines, then fewer items may be scrolled than lines.
515              
516             =cut
517              
518             sub scroll
519             {
520             my $self = shift;
521             my ( $delta, %opts ) = @_;
522              
523             return unless $delta;
524              
525             my $window = $self->window;
526             my $items = $self->{items};
527             @$items or return;
528              
529             my $itemidx = $self->{start_item};
530             my $partial = $self->{start_partial};
531             my $scroll_amount = 0;
532              
533             REDO:
534             if( $partial > 0 ) {
535             $delta += $partial;
536             $scroll_amount -= $partial;
537             $partial = 0;
538             }
539              
540             while( $delta ) {
541             my $itemheight = $self->_itemheight( $itemidx );
542              
543             if( $delta >= $itemheight ) {
544             $partial = $itemheight - 1, last if $itemidx == $#$items;
545              
546             $delta -= $itemheight;
547             $scroll_amount += $itemheight;
548              
549             $itemidx++;
550             }
551             elsif( $delta < 0 ) {
552             $partial = 0, last if $itemidx == 0;
553             $itemidx--;
554              
555             $itemheight = $self->_itemheight( $itemidx );
556              
557             $delta += $itemheight;
558             $scroll_amount -= $itemheight;
559             }
560             else {
561             $partial = $delta;
562             $scroll_amount += $delta;
563              
564             $delta = 0;
565             }
566             }
567              
568             return if $itemidx == $self->{start_item} and
569             $partial == $self->{start_partial};
570              
571             my $lines = $self->{window_lines};
572              
573             if( $scroll_amount > 0 and !$opts{allow_gap} ) {
574             # We scrolled down. See if we've gone too far
575             my $line = -$partial;
576             my $idx = $itemidx;
577              
578             while( $line < $lines && $idx < @$items ) {
579             $line += $self->_itemheight( $idx );
580             $idx++;
581             }
582              
583             if( $line < $lines ) {
584             my $spare = $lines - $line;
585              
586             $delta = -$spare;
587             goto REDO;
588             }
589             }
590              
591             $self->{start_item} = $itemidx;
592             $self->{start_partial} = $partial;
593              
594             if( abs( $scroll_amount ) < $lines ) {
595             $window->scroll( $scroll_amount, 0 );
596             }
597             else {
598             $self->redraw;
599             }
600              
601             if( my $on_scrolled = $self->{on_scrolled} ) {
602             $self->$on_scrolled( $scroll_amount );
603             }
604              
605             $self->update_indicators;
606             }
607              
608             =head2 scroll_to
609              
610             $scroller->scroll_to( $line, $itemidx, $itemline )
611              
612             Moves the display up or down so that display line C<$line> contains line
613             C<$itemline> of item C<$itemidx>. Any of these counts may be negative to count
614             backwards from the display lines, items, or lines within the item.
615              
616             =cut
617              
618             sub scroll_to
619             {
620             my $self = shift;
621             my ( $line, $itemidx, $itemline ) = @_;
622              
623             my $window = $self->window or return;
624             my $lines = $self->{window_lines};
625              
626             my $items = $self->{items};
627             @$items or return;
628              
629             if( $line < 0 ) {
630             $line += $lines;
631              
632             croak '$line out of bounds' if $line < 0;
633             }
634             else {
635             croak '$line out of bounds' if $line >= $lines;
636             }
637              
638             if( $itemidx < 0 ) {
639             $itemidx += @$items;
640              
641             croak '$itemidx out of bounds' if $itemidx < 0;
642             }
643             else {
644             croak '$itemidx out of bounds' if $itemidx >= @$items;
645             }
646              
647             my $itemheight = $self->_itemheight( $itemidx );
648              
649             if( $itemline < 0 ) {
650             $itemline += $itemheight;
651              
652             croak '$itemline out of bounds' if $itemline < 0;
653             }
654             else {
655             croak '$itemline out of bounds' if $itemline >= $itemheight;
656             }
657              
658             $line -= $itemline; # now ignore itemline
659              
660             while( $line > 0 ) {
661             if( $itemidx == 0 ) {
662             $line = 0;
663             last;
664             }
665              
666             $itemheight = $self->_itemheight( --$itemidx );
667              
668             $line -= $itemheight;
669             }
670             $itemline = -$line; # $line = 0;
671              
672             # Now we want $itemidx line $itemline to be on physical line 0
673              
674             # Work out how far away that is
675             my $delta = 0;
676             my $i = $self->{start_item};
677              
678             $delta -= $self->{start_partial};
679             while( $itemidx > $i ) {
680             $delta += $self->_itemheight( $i );
681             $i++;
682             }
683             while( $itemidx < $i ) {
684             $i--;
685             $delta -= $self->_itemheight( $i );
686             }
687             $delta += $itemline;
688              
689             return if !$delta;
690              
691             $self->scroll( $delta );
692             }
693              
694             =head2 scroll_to_top
695              
696             $scroller->scroll_to_top( $itemidx, $itemline )
697              
698             Shortcut for C to set the top line of display; where C<$line> is 0.
699             If C<$itemline> is undefined, it will be passed as 0. If C<$itemidx> is also
700             undefined, it will be passed as 0. Calling this method with no arguments,
701             therefore scrolls to the very top of the display.
702              
703             =cut
704              
705             sub scroll_to_top
706             {
707             my $self = shift;
708             my ( $itemidx, $itemline ) = @_;
709              
710             defined $itemidx or $itemidx = 0;
711             defined $itemline or $itemline = 0;
712              
713             $self->scroll_to( 0, $itemidx, $itemline );
714             }
715              
716             =head2 scroll_to_bottom
717              
718             $scroller->scroll_to_bottom( $itemidx, $itemline )
719              
720             Shortcut for C to set the bottom line of display; where C<$line> is
721             -1. If C<$itemline> is undefined, it will be passed as -1. If C<$itemidx> is
722             also undefined, it will be passed as -1. Calling this method with no
723             arguments, therefore scrolls to the very bottom of the display.
724              
725             =cut
726              
727             sub scroll_to_bottom
728             {
729             my $self = shift;
730             my ( $itemidx, $itemline ) = @_;
731              
732             defined $itemidx or $itemidx = -1;
733             defined $itemline or $itemline = -1;
734              
735             $self->scroll_to( -1, $itemidx, $itemline );
736             }
737              
738             =head2 line2item
739              
740             $itemidx = $scroller->line2item( $line )
741              
742             ( $itemidx, $itemline ) = $scroller->line2item( $line )
743              
744             Returns the item index currently on display at the given line of the window.
745             In list context, also returns the line number within item. If no window has
746             been set, or there is no item on display at that line, C or an empty
747             list are returned. C<$line> may be negative to count backward from the last
748             line on display; the last line taking C<-1>.
749              
750             =cut
751              
752             sub line2item
753             {
754             my $self = shift;
755             my ( $line ) = @_;
756              
757             my $window = $self->window or return;
758             my $lines = $self->{window_lines};
759              
760             my $items = $self->{items};
761              
762             if( $line < 0 ) {
763             $line += $lines;
764              
765             croak '$line out of bounds' if $line < 0;
766             }
767             else {
768             croak '$line out of bounds' if $line >= $lines;
769             }
770              
771             my $itemidx = $self->{start_item};
772             $line += $self->{start_partial};
773              
774             while( $itemidx < @$items ) {
775             my $itemheight = $self->_itemheight( $itemidx );
776             if( $line < $itemheight ) {
777             return $itemidx, $line if wantarray;
778             return $itemidx;
779             }
780              
781             $line -= $itemheight;
782             $itemidx++;
783             }
784              
785             return;
786             }
787              
788             =head2 item2line
789              
790             $line = $scroller->item2line( $itemidx, $itemline )
791              
792             ( $line, $offscreen ) = $scroller->item2line( $itemidx, $itemline, $count_offscreen )
793              
794             Returns the display line in the window of the given line of the item at the
795             given index. C<$itemidx> may be given negative, to count backwards from the
796             last item. C<$itemline> may be negative to count backward from the last line
797             of the item.
798              
799             In list context, also returns a value describing the offscreen nature of the
800             item. For items fully on display, this value is C. If the given line of
801             the given item is not on display because it is scrolled off either the top or
802             bottom of the window, this value will be either C<"above"> or C<"below">
803             respectively. If C<$count_offscreen> is true, then the returned C<$line> value
804             will always be defined, even if the item line is offscreen. This will be
805             negative for items C<"above">, and a value equal or greater than the number of
806             lines in the scroller's window for items C<"below">.
807              
808             =cut
809              
810             sub item2line
811             {
812             my $self = shift;
813             my ( $want_itemidx, $want_itemline, $count_offscreen ) = @_;
814              
815             my $window = $self->window or return;
816             my $lines = $self->{window_lines};
817              
818             my $items = $self->{items};
819             @$items or return;
820              
821             if( $want_itemidx < 0 ) {
822             $want_itemidx += @$items;
823              
824             croak '$itemidx out of bounds' if $want_itemidx < 0;
825             }
826             else {
827             croak '$itemidx out of bounds' if $want_itemidx >= @$items;
828             }
829              
830             my $itemheight = $self->_itemheight( $want_itemidx );
831              
832             defined $want_itemline or $want_itemline = 0;
833             if( $want_itemline < 0 ) {
834             $want_itemline += $itemheight;
835              
836             croak '$itemline out of bounds' if $want_itemline < 0;
837             }
838             else {
839             croak '$itemline out of bounds' if $want_itemline >= $itemheight;
840             }
841              
842             my $itemidx = $self->{start_item};
843              
844             my $line = -$self->{start_partial};
845              
846             if( $want_itemidx < $itemidx or
847             $want_itemidx == $itemidx and $want_itemline < $self->{start_partial} ) {
848             if( wantarray and $count_offscreen ) {
849             while( $itemidx >= 0 ) {
850             if( $want_itemidx == $itemidx ) {
851             $line += $want_itemline;
852             last;
853             }
854              
855             $itemidx--;
856             $line -= $self->_itemheight( $itemidx );
857             }
858             return ( $line, "above" );
859             }
860             return ( undef, "above" ) if wantarray;
861             return;
862             }
863              
864             while( $itemidx < @$items and ( $line < $lines or $count_offscreen ) ) {
865             if( $want_itemidx == $itemidx ) {
866             $line += $want_itemline;
867              
868             last if $line >= $lines;
869             return $line;
870             }
871              
872             $line += $self->_itemheight( $itemidx );
873             $itemidx++;
874             }
875              
876             return ( undef, "below" ) if wantarray and !$count_offscreen;
877             return ( $line, "below" ) if wantarray and $count_offscreen;
878             return;
879             }
880              
881             =head2 lines_above
882              
883             $count = $scroller->lines_above
884              
885             Returns the number of lines of content above the scrolled display.
886              
887             =cut
888              
889             sub lines_above
890             {
891             my $self = shift;
892             my ( $line, $offscreen ) = $self->item2line( 0, 0, 1 );
893             return 0 unless $offscreen;
894             return -$line;
895             }
896              
897             =head2 lines_below
898              
899             $count = $scroller->lines_below
900              
901             Returns the number of lines of content below the scrolled display.
902              
903             =cut
904              
905             sub lines_below
906             {
907             my $self = shift;
908             my ( $line, $offscreen ) = $self->item2line( -1, -1, 1 );
909             return 0 unless $offscreen;
910             return $line - $self->window->lines + 1;
911             }
912              
913             sub render_lines
914             {
915             my $self = shift;
916             my ( $startline, $endline ) = @_;
917              
918             my $win = $self->window or return;
919             $win->expose( Tickit::Rect->new(
920             top => $startline,
921             bottom => $endline,
922             left => 0,
923             right => $win->cols,
924             ) );
925             }
926              
927             sub render_to_rb
928             {
929             my $self = shift;
930             my ( $rb, $rect ) = @_;
931              
932             my $win = $self->window;
933             my $cols = $win->cols;
934              
935             my $items = $self->{items};
936              
937             my $line = 0;
938             my $itemidx = $self->{start_item};
939              
940             if( my $partial = $self->{start_partial} ) {
941             $line -= $partial;
942             }
943              
944             my $startline = $rect->top;
945             my $endline = $rect->bottom;
946              
947             while( $line < $endline and $itemidx < @$items ) {
948             my $item = $self->_item( $itemidx );
949             my $itemheight = $self->_itemheight( $itemidx );
950              
951             my $top = $line;
952             my $firstline = ( $startline > $line ) ? $startline - $top : 0;
953              
954             $itemidx++;
955             $line += $itemheight;
956              
957             next if $firstline >= $itemheight;
958              
959             $rb->save;
960             {
961             my $lastline = ( $endline < $line ) ? $endline - $top : $itemheight;
962              
963             $rb->translate( $top, 0 );
964             $rb->clip( Tickit::Rect->new(
965             top => $firstline,
966             bottom => $lastline,
967             left => 0,
968             cols => $cols,
969             ) );
970              
971             $item->render( $rb,
972             top => 0,
973             firstline => $firstline,
974             lastline => $lastline - 1,
975             width => $cols,
976             height => $itemheight,
977             );
978              
979             }
980             $rb->restore;
981             }
982              
983             while( $line < $endline ) {
984             $rb->goto( $line, 0 );
985             $rb->erase( $cols );
986             $line++;
987             }
988             }
989              
990             my %bindings = (
991             Down => sub { $_[0]->scroll( +1 ) },
992             Up => sub { $_[0]->scroll( -1 ) },
993              
994             PageDown => sub { $_[0]->scroll( +int( $_[0]->window->lines / 2 ) ) },
995             PageUp => sub { $_[0]->scroll( -int( $_[0]->window->lines / 2 ) ) },
996              
997             'C-Home' => sub { $_[0]->scroll_to_top },
998             'C-End' => sub { $_[0]->scroll_to_bottom },
999             );
1000              
1001             sub on_key
1002             {
1003             my $self = shift;
1004             my ( $ev ) = @_;
1005              
1006             if( $ev->type eq "key" and my $code = $bindings{$ev->str} ) {
1007             $code->( $self );
1008             return 1;
1009             }
1010              
1011             return 0;
1012             }
1013              
1014             sub on_mouse
1015             {
1016             my $self = shift;
1017             my ( $ev ) = @_;
1018              
1019             return unless $ev->type eq "wheel";
1020              
1021             $self->scroll( 5 ) if $ev->button eq "down";
1022             $self->scroll( -5 ) if $ev->button eq "up";
1023             }
1024              
1025             =head2 set_gen_top_indicator
1026              
1027             =head2 set_gen_bottom_indicator
1028              
1029             $scroller->set_gen_top_indicator( $method )
1030              
1031             $scroller->set_gen_bottom_indicator( $method )
1032              
1033             Accessors for the generators for the top and bottom indicator text. If set,
1034             each should be a CODE reference or method name on the scroller which will be
1035             invoked after any operation that changes the contents of the window, such as
1036             scrolling or adding or removing items. It should return a text string which,
1037             if defined and non-empty, will be displayed in an indicator window. This will
1038             be a small one-line window displayed at the top right or bottom right corner
1039             of the Scroller's window.
1040              
1041             $text = $scroller->$method()
1042              
1043             The ability to pass method names allows subclasses to easily implement custom
1044             logic as methods without having to capture a closure.
1045              
1046             =cut
1047              
1048             sub set_gen_top_indicator
1049             {
1050             my $self = shift;
1051             ( $self->{gen_top_indicator} ) = @_;
1052              
1053             $self->update_indicators;
1054             }
1055              
1056             sub set_gen_bottom_indicator
1057             {
1058             my $self = shift;
1059             ( $self->{gen_bottom_indicator} ) = @_;
1060              
1061             $self->update_indicators;
1062             }
1063              
1064             =head2 update_indicators
1065              
1066             $scroller->update_indicators
1067              
1068             Calls any defined generators for indicator text, and updates the indicator
1069             windows with the returned text. This may be useful if the functions would
1070             return different text now.
1071              
1072             =cut
1073              
1074             sub update_indicators
1075             {
1076             my $self = shift;
1077              
1078             my $win = $self->window or return;
1079              
1080             for my $edge (qw( top bottom )) {
1081             my $text_field = "${edge}_indicator_text";
1082              
1083             my $text = $self->{"gen_${edge}_indicator"} ? $self->${ \$self->{"gen_${edge}_indicator"} }
1084             : undef;
1085             $text //= "";
1086             next if $text eq ( $self->{$text_field} // "" );
1087              
1088             $self->{$text_field} = $text;
1089              
1090             if( !length $text ) {
1091             $self->{"${edge}_indicator_win"}->hide if $self->{"${edge}_indicator_win"};
1092             undef $self->{"${edge}_indicator_win"};
1093             next;
1094             }
1095              
1096             my $textwidth = textwidth $text;
1097             my $line = $edge eq "top" ? 0
1098             : $win->lines - 1;
1099              
1100             my $floatwin;
1101             if( $floatwin = $self->{"${edge}_indicator_win"} ) {
1102             $floatwin->change_geometry( $line, $win->cols - $textwidth, 1, $textwidth );
1103             }
1104             elsif( $self->window ) {
1105             $floatwin = $win->make_float( $line, $win->cols - $textwidth, 1, $textwidth );
1106             $floatwin->set_on_expose( with_rb => sub {
1107             my ( undef, $rb, $rect ) = @_;
1108             $rb->text_at( 0, 0,
1109             $self->{$text_field},
1110             $self->get_style_pen( "indicator" )
1111             );
1112             } );
1113             $self->{"${edge}_indicator_win"} = $floatwin;
1114             }
1115              
1116             $floatwin->expose;
1117             }
1118             }
1119              
1120             =head1 TODO
1121              
1122             =over 4
1123              
1124             =item *
1125              
1126             Abstract away the "item storage model" out of the actual widget. Implement
1127             more storage models, such as database-driven ones.. more dynamic.
1128              
1129             =item *
1130              
1131             Keybindings
1132              
1133             =back
1134              
1135             =cut
1136              
1137             =head1 AUTHOR
1138              
1139             Paul Evans
1140              
1141             =cut
1142              
1143             0x55AA;