Alt-Tickit-Widgets-ObjectPad
view release on metacpan or search on metacpan
lib/Tickit/OneLineWidget.pm view on Meta::CPAN
=head1 SUBCLASS METHODS
Because this is an abstract class, the constructor must be called on a
subclass which implements the following methods.
=head2 render_line
$widget->render_line
Called to redraw the widget's content to its window. When invoked, the window
cursor will already be in column C<0> of the required line of the window, as
determined by the C<valign> value.
=cut
=head1 AUTHOR
Paul Evans <leonerd@leonerd.org.uk>
=cut
lib/Tickit/Widget.pm view on Meta::CPAN
}
return 0;
}
1;
The C<render_to_rb> method sets the focus at the window's top left corner to
ensure that the window always has focus, so the widget will receive keypress
events. (A real widget implementation would likely pick a more sensible place
to put the cursor).
The C<on_key> method then gets invoked for keypresses. It returns a true value
to indicate the keys it handles, returning false for the others, to allow
parent widgets or the main C<Tickit> object to handle them instead.
Similarly, by providing an C<on_mouse> method, the widget subclass will
receive mouse events within the window of the widget. This example saves a
list of the last 10 mouse clicks and renders them with an C<X>.
package ClickerWidget;
lib/Tickit/Widget.pm view on Meta::CPAN
push @points, [ $args->line, $args->col ];
shift @points while @points > 10;
$self->redraw;
}
1;
This time there is no need to set the window focus, because mouse events do
not need to follow the window that's in focus; they always affect the window
at the location of the mouse cursor.
The C<on_mouse> method then gets invoked whenever a mouse event happens within
the window occupied by the widget. In this particular case, the method filters
only for pressing button 1. It then stores the position of the mouse click in
the C<@points> array, for the C<render> method to use.
=cut
=head1 AUTHOR
lib/Tickit/Widget/Button.pm view on Meta::CPAN
my $has_border = ( $self->get_style_values( "linetype" ) ) ne "none";
my ( $lines_before, undef, $lines_after ) = $self->_valign_allocation( 1, $lines - (2 * $has_border) );
my ( $cols_before, undef, $cols_after ) = $self->_align_allocation( $width + 2, $cols - 2 );
$self->{label_line} = $lines_before + $has_border;
$self->{label_col} = $cols_before + 2;
$self->{label_end} = $cols_before + $width + 2;
$win->cursor_at( $self->{label_line}, $self->{label_col} );
}
method render_to_rb
{
my ( $rb, $rect ) = @_;
my $win = $self->window or return;
my $lines = $win->lines;
my $cols = $win->cols;
lib/Tickit/Widget/CheckButton.pm view on Meta::CPAN
=cut
method is_active { !!$_active }
method reshape
{
my $win = $self->window or return;
my $check = $self->get_style_values( "check" );
$win->cursor_at( 0, ( textwidth( $check )-1 ) / 2 );
}
method render_to_rb
{
my ( $rb, $rect ) = @_;
$rb->clear;
return if $rect->top > 0;
lib/Tickit/Widget/Entry.pm view on Meta::CPAN
=item * Delete
Delete one character forwards
=item * Ctrl-Delete
Delete one word forwards
=item * End or Ctrl-E
Move the cursor to the end of the input line
=item * Enter
Accept a line of input by running the C<on_enter> action
=item * Home or Ctrl-A
Move the cursor to the beginning of the input line
=item * Insert
Toggle between overwrite and insert mode
=item * Left
Move the cursor one character left
=item * Ctrl-Left or Alt-B
Move the cursor one word left
=item * Right
Move the cursor one character right
=item * Ctrl-Right or Alt-F
Move the cursor one word right
=back
=cut
=head1 CONSTRUCTOR
=cut
=head2 $entry = Tickit::Widget::Entry->new( %args )
lib/Tickit/Widget/Entry.pm view on Meta::CPAN
Takes the following named arguments:
=over 8
=item text => STR
Optional. Initial text to display in the box
=item position => INT
Optional. Initial position of the cursor within the text.
=item on_enter => CODE
Optional. Callback function to invoke when the C<< <Enter> >> key is pressed.
=back
=cut
has $_text;
lib/Tickit/Widget/Entry.pm view on Meta::CPAN
$self->posttext_render( $rb );
$rb->restore;
}
}
foreach my $line ( $rect->linerange( 1, undef ) ) {
$rb->erase_at( $line, 0, $cols );
}
$self->reposition_cursor;
}
method _recalculate_scroll
{
my ( $pos_ch ) = @_;
my $pos_co = $self->char2col( $pos_ch );
my $off_co = $_scrolloffs_co;
my $pos_x = $pos_co - $off_co;
my $width = $self->window->cols;
my $halfwidth = int( $width / 2 );
# Don't even try unless we have at least 2 columns
return unless $halfwidth;
# Try to keep the cursor within 5 columns of the window edge
while( $pos_x < 5 and $off_co >= 5 ) {
$off_co -= $halfwidth;
$off_co = 0 if $off_co < 0;
$pos_x = $pos_co - $off_co;
}
while( $pos_x > ( $width - 5 ) ) {
$off_co += $halfwidth;
$pos_x = $pos_co - $off_co;
}
return $off_co if $off_co != $_scrolloffs_co;
return undef;
}
method reposition_cursor
{
my ( $pos_ch ) = @_;
my $win = $self->window or return;
$_pos_ch = $pos_ch if defined $pos_ch;
my $new_scrolloffs = $self->_recalculate_scroll( $_pos_ch );
if( defined $new_scrolloffs ) {
$_scrolloffs_co = $new_scrolloffs;
$self->redraw;
}
my $pos_x = $self->char2col( $_pos_ch ) - $_scrolloffs_co;
$win->cursor_at( 0, $pos_x );
}
method _text_spliced
{
my ( $pos_ch, $deleted, $inserted, $at_end ) = @_;
my $win = $self->window;
my $width = $win->cols;
my $insertedlen_co = textwidth $inserted;
lib/Tickit/Widget/Entry.pm view on Meta::CPAN
=head2 $offset = $entry->position
Returns the current entry position, in terms of characters within the text.
=cut
method position { $_pos_ch }
=head2 $entry->set_position( $position )
Set the text entry position, moving the cursor
=cut
method set_position
{
my ( $pos_ch ) = @_;
$pos_ch = 0 if $pos_ch < 0;
$pos_ch = length $_text if $pos_ch > length $_text;
$self->reposition_cursor( $pos_ch );
}
=head1 METHODS
=cut
=head2 $entry->bind_keys( $keystr => $value, ... )
Associate methods or CODE references with keypresses. On receipt of a the key
the method or CODE reference will be invoked, being passed the stringified key
lib/Tickit/Widget/Entry.pm view on Meta::CPAN
# Cursor within splice; move to end
$new_pos_ch = $pos_ch + $textlen_ch;
}
# else { ignore }
# No point incrementally updating as we'll have to scroll anyway
unless( defined $new_pos_ch and defined $self->_recalculate_scroll( $new_pos_ch ) ) {
$self->_text_spliced( $pos_ch, $deleted, $text, $at_end );
}
$self->reposition_cursor( $new_pos_ch ) if defined $new_pos_ch and $new_pos_ch != $_pos_ch;
return $deleted;
}
=head2 $pos = $entry->find_bow_forward( $initial, $else )
Search forward in the string, returning the character position of the next
beginning of word from the initial position. If none is found, returns
C<$else>.
lib/Tickit/Widget/Entry.pm view on Meta::CPAN
Search backward in the string, returning the character position of the
previous end of word from the initial position. If none is found, returns
C<undef>.
=cut
method find_eow_backward
{
my ( $pos ) = @_;
my $pretext = substr( $self->text, 0, $pos + 1 ); # +1 to allow if cursor is on the space
return $pretext =~ m/.*\S(?=\s)/ ? $+[0] : undef;
}
## Key binding methods
method key_backward_char
{
if( $_pos_ch > 0 ) {
$self->set_position( $_pos_ch - 1 );
lib/Tickit/Widget/RadioButton.pm view on Meta::CPAN
{
return $self->group->active == $self;
}
method reshape
{
my $win = $self->window or return;
my $tick = $self->get_style_values( "tick" );
$win->cursor_at( 0, ( textwidth( $tick )-1 ) / 2 );
}
method render_to_rb
{
my ( $rb, $rect ) = @_;
$rb->clear;
return if $rect->top > 0;
t/05widget-focus.t view on Meta::CPAN
sub lines { 1 }
sub cols { 1 }
sub window_gained
{
my $self = shift;
my ( $win ) = @_;
$self->SUPER::window_gained( @_ );
$win->cursor_at( 0, 2 );
}
t/06widget-input.t view on Meta::CPAN
my $do_something_counter = 0;
my $widget = TestWidget->new;
is_oneref( $widget, '$widget has refcount 1 initially' );
$widget->set_window( $win );
$widget->take_focus;
flush_tickit;
ok( $term->cursorvis, 'Cursor visible on window' );
presskey( text => "A" );
is_deeply( \@key_events, [ [ text => "A" ] ], 'on_key A' );
pressmouse( press => 1, 4, 3 );
is_deeply( \@mouse_events, [ [ press => 1, 4, 3 ] ], 'on_mouse abs@3,4' );
presskey( key => "Enter" );
t/06widget-input.t view on Meta::CPAN
sub cols { 1 }
sub render_to_rb {}
sub window_gained
{
my $self = shift;
my ( $win ) = @_;
$self->SUPER::window_gained( $win );
$win->cursor_at( 0, 0 );
}
use constant KEYPRESSES_FROM_STYLE => 1;
BEGIN {
style_definition base =>
'<Enter>' => 'do_thing';
}
sub key_do_thing { $do_something_counter++ }
t/11entry-model.t view on Meta::CPAN
is_termlog( [ GOTO(0,0),
SETBG(undef),
ERASECH(80),
( map { GOTO($_,0), SETBG(undef), ERASECH(80) } 1 .. 24 ),
GOTO(0,0) ],
'Termlog initially' );
is_display( [],
'Display initially' );
is_cursorpos( 0, 0, 'Position initally' );
$entry->text_insert( "Hello", 0 );
flush_tickit;
is( $entry->text, "Hello", '$entry->text after ->text_insert' );
is( $entry->position, 5, '$entry->position after ->text_insert' );
is_termlog( [ GOTO(0,0),
SETPEN,
PRINT("Hello"),
GOTO(0,5) ],
'Termlog after ->text_insert' );
is_display( [ "Hello" ],
'Display after ->text_insert' );
is_cursorpos( 0, 5, 'Position after ->text_insert' );
$entry->text_insert( " ", 0 );
is( $entry->text, " Hello", '$entry->text after ->text_insert at 0' );
is( $entry->position, 6, '$entry->position after ->text_insert at 0' );
flush_tickit;
is_termlog( [ SETBG(undef),
( $Tickit::Test::MockTerm::VERSION >= 0.45 ?
( SCROLLRECT(0,0,1,80, 0,-1) ) :
( GOTO(0,0), INSERTCH(1) ) ),
GOTO(0,0),
SETPEN,
PRINT(" "),
GOTO(0,6) ],
'Termlog after ->text_insert at 0' );
is_display( [ " Hello" ],
'Display after ->text_insert at 0' );
is_cursorpos( 0, 6, 'Position after ->text_insert at 0' );
is( $entry->text_delete( 5, 1 ), "o", '$entry->text_delete' );
is( $entry->text, " Hell", '$entry->text after ->text_delete' );
is( $entry->position, 5, '$entry->position after ->text_delete' );
flush_tickit;
is_termlog( [ SETBG(undef),
( $Tickit::Test::MockTerm::VERSION >= 0.45 ?
( SCROLLRECT(0,5,1,75, 0,1) ) :
( GOTO(0,5), DELETECH(1) ) ),
GOTO(0,79),
SETBG(undef),
ERASECH(1),
GOTO(0,5) ],
'Termlog after ->text_delete' );
is_display( [ " Hell" ],
'Display after ->text_delete' );
is_cursorpos( 0, 5, 'Position after ->text_delete' );
is( $entry->text_splice( 0, 2, "Y" ), " H", '$entry->text_splice shrink' );
is( $entry->text, "Yell", '$entry->text after ->text_splice shrink' );
is( $entry->position, 4, '$entry->position after ->text_splice shrink' );
flush_tickit;
is_termlog( [ SETBG(undef),
( $Tickit::Test::MockTerm::VERSION >= 0.45 ?
( SCROLLRECT(0,0,1,80, 0,1) ) :
t/11entry-model.t view on Meta::CPAN
PRINT("Y"),
GOTO(0,79),
SETBG(undef),
ERASECH(1),
GOTO(0,4) ],
'Termlog after ->text_splice shrink' );
is_display( [ "Yell" ],
'Display after ->text_splice shrink' );
is_cursorpos( 0, 4, 'Position after ->text_splice shrink' );
is( $entry->text_splice( 3, 1, "p" ), "l", '$entry->text_splice preserve' );
is( $entry->text, "Yelp", '$entry->text after ->text_splice preserve' );
is( $entry->position, 4, '$entry->position after ->text_splice preserve' );
flush_tickit;
is_termlog( [ GOTO(0,3),
SETPEN,
PRINT("p"),
GOTO(0,4) ],
'Termlog after ->text_splice preserve' );
is_display( [ "Yelp" ],
'Display after ->text_splice preserve' );
is_cursorpos( 0, 4, 'Position after ->text_splice preserve' );
is( $entry->text_splice( 3, 1, "low" ), "p", '$entry->text_splice grow' );
is( $entry->text, "Yellow", '$entry->text after ->text_splice grow' );
is( $entry->position, 6, '$entry->position after ->text_splice grow' );
flush_tickit;
is_termlog( [ SETBG(undef),
( $Tickit::Test::MockTerm::VERSION >= 0.45 ?
( SCROLLRECT(0,3,1,77, 0,-2) ) :
( GOTO(0,3), INSERTCH(2) ) ),
GOTO(0,3),
SETPEN,
PRINT("low"),
GOTO(0,6) ],
'Termlog after ->text_splice grow' );
is_display( [ "Yellow" ],
'Display after ->text_splice grow' );
is_cursorpos( 0, 6, 'Position after ->text_splice grow' );
$entry->set_position( 3 );
is( $entry->position, 3, '$entry->position after ->set_position' );
flush_tickit;
is_termlog( [ GOTO(0,3) ],
'Termlog after ->set_position' );
is_display( [ "Yellow" ],
'Display after ->set_position' );
is_cursorpos( 0, 3, 'Position after ->set_position' );
$entry->set_text( "Different text" );
is( $entry->text, "Different text", '$entry->text after ->set_text' );
flush_tickit;
is_termlog( [ GOTO(0,0),
SETPEN,
PRINT("Different text"),
SETBG(undef),
ERASECH(66),
( map { GOTO($_,0), SETBG(undef), ERASECH(80) } 1 .. 24 ),
GOTO(0,3) ],
'Termlog after ->set_text' );
is_display( [ "Different text" ],
'Display after ->set_text' );
is_cursorpos( 0, 3, 'Position after ->set_text' );
$entry->set_window( undef );
$term->clear;
drain_termlog;
# A window that doesn't extend to righthand edge of screen, so ICH/DCH won't
# work
{
my $subwin = $win->make_sub( 2, 2, $win->lines - 4, $win->cols - 4 );
t/11entry-model.t view on Meta::CPAN
PRINT("Some initial text"),
SETBG(undef),
ERASECH(63),
( map { GOTO($_,0), SETBG(undef), ERASECH(80) } 1 .. 24 ),
GOTO(0,5) ],
'Termlog written to for initialised' );
is_display( [ "Some initial text" ],
'Display for initialised' );
is_cursorpos( 0, 5, 'Position for initalised' );
is( $entry->find_bow_forward( 9 ), 13, 'find_bow_forward( 9 )' );
is( $entry->find_eow_forward( 9 ), 12, 'find_eow_forward( 9 )' );
is( $entry->find_bow_backward( 9 ), 5, 'find_bow_backward( 9 )' );
is( $entry->find_eow_backward( 9 ), 4, 'find_eow_backward( 9 )' );
is( $entry->find_bow_forward( 15 ), undef, 'find_bow_forward( 15 )' );
is( $entry->find_eow_forward( 15 ), 17, 'find_eow_forward( 15 )' );
is( $entry->find_bow_backward( 2 ), 0, 'find_bow_backward( 2 )' );
t/12entry-input.t view on Meta::CPAN
PRINT("Initial"),
SETBG(undef),
ERASECH(73),
( map { GOTO($_,0), SETBG(undef), ERASECH(80) } 1 .. 24 ),
GOTO(0,0) ],
'Termlog initially' );
is_display( [ "Initial" ],
'Display initially' );
is_cursorpos( 0, 0, 'Position initially' );
presskey( key => "Right" );
is( $entry->position, 1, '$entry->position after Right' );
flush_tickit;
is_termlog( [ GOTO(0,1) ],
'Termlog after Right' );
is_cursorpos( 0, 1, 'Position after Right' );
presskey( key => "End" );
is( $entry->position, 7, '$entry->position after End' );
flush_tickit;
is_termlog( [ GOTO(0,7) ],
'Termlog after End' );
is_cursorpos( 0, 7, 'Position after End' );
presskey( key => "Left" );
is( $entry->position, 6, '$entry->position after Left' );
flush_tickit;
is_termlog( [ GOTO(0,6) ],
'Termlog after Left' );
is_cursorpos( 0, 6, 'Position after Left' );
presskey( key => "Home" );
is( $entry->position, 0, '$entry->position after Home' );
flush_tickit;
is_termlog( [ GOTO(0,0) ],
'Termlog after Home' );
is_cursorpos( 0, 0, 'Position after Home' );
presskey( text => "X" );
is( $entry->text, "XInitial", '$entry->text after X' );
is( $entry->position, 1, '$entry->position after X' );
flush_tickit;
is_termlog( [ SETBG(undef),
( $Tickit::Test::MockTerm::VERSION >= 0.45 ?
t/12entry-input.t view on Meta::CPAN
( GOTO(0,0), INSERTCH(1) ) ),
GOTO(0,0),
SETPEN,
PRINT("X"),
GOTO(0,1) ],
'Termlog after X' );
is_display( [ "XInitial" ],
'Display after X' );
is_cursorpos( 0, 1, 'Position after X' );
presskey( key => "Backspace" );
is( $entry->text, "Initial", '$entry->text after Backspace' );
is( $entry->position, 0, '$entry->position after Backspace' );
flush_tickit;
is_termlog( [ SETBG(undef),
( $Tickit::Test::MockTerm::VERSION >= 0.45 ?
t/12entry-input.t view on Meta::CPAN
( GOTO(0,0), DELETECH(1) ) ),
GOTO(0,79),
SETBG(undef),
ERASECH(1),
GOTO(0,0) ],
'Termlog after Backspace' );
is_display( [ "Initial" ],
'Display after Backspace' );
is_cursorpos( 0, 0, 'Position after Backspace' );
presskey( key => "Delete" );
is( $entry->text, "nitial", '$entry->text after Delete' );
is( $entry->position, 0, '$entry->position after Delete' );
flush_tickit;
is_termlog( [ SETBG(undef),
( $Tickit::Test::MockTerm::VERSION >= 0.45 ?
t/12entry-input.t view on Meta::CPAN
( GOTO(0,0), DELETECH(1) ) ),
GOTO(0,79),
SETBG(undef),
ERASECH(1),
GOTO(0,0) ],
'Termlog after Delete' );
is_display( [ "nitial" ],
'Display after Delete' );
is_cursorpos( 0, 0, 'Position after Delete' );
my $line;
$entry->set_on_enter(
sub {
identical( $_[0], $entry, 'on_enter $_[0] is $entry' );
$line = $_[1];
}
);
presskey( key => "Enter" );
t/13entry-scroll.t view on Meta::CPAN
PRINT("A"x70),
SETBG(undef),
ERASECH(10),
( map { GOTO($_,0), SETBG(undef), ERASECH(80) } 1 .. 24 ),
GOTO(0,70) ],
'Termlog initially' );
is_display( [ "A"x70 ],
'Display initially' );
is_cursorpos( 0, 70, 'Position initially' );
$entry->text_insert( "B"x20, $entry->position );
flush_tickit;
is_termlog( [ GOTO(0,0),
SETPEN(fg => 6),
PRINT("<.."),
SETPEN,
PRINT(("A"x27).("B"x20)),
SETBG(undef),
ERASECH(30),
( map { GOTO($_,0), SETBG(undef), ERASECH(80) } 1 .. 24 ),
GOTO(0,50) ],
'Termlog after append to scroll' );
is_display( [ "<..".("A"x27).("B"x20) ],
'Display after append to scroll' );
is_cursorpos( 0, 50, 'Position after append to scroll' );
$entry->set_position( 0 );
flush_tickit;
is_termlog( [ GOTO(0,0),
SETPEN,
PRINT(("A"x70).("B"x7)),
SETPEN(fg => 6),
PRINT("..>"),
( map { GOTO($_,0), SETBG(undef), ERASECH(80) } 1 .. 24 ),
GOTO(0,0) ],
'Termlog after ->set_position 0' );
is_display( [ ("A"x70).("B"x7)."..>" ],
'Display after ->set_position 0' );
is_cursorpos( 0, 0, 'Position after ->set_position 0' );
$entry->set_position( 90 );
flush_tickit;
is_termlog( [ GOTO(0,0),
SETPEN(fg => 6),
PRINT("<.."),
SETPEN,
PRINT(("A"x27).("B"x20)),
SETBG(undef),
ERASECH(30),
( map { GOTO($_,0), SETBG(undef), ERASECH(80) } 1 .. 24 ),
GOTO(0,50) ],
'Termlog after ->set_position 90' );
is_display( [ "<..".("A"x27).("B"x20) ],
'Display after ->set_position 90' );
is_cursorpos( 0, 50, 'Position after ->set_position 90' );
$entry->set_position( 0 );
flush_tickit;
drain_termlog;
$entry->text_delete( 0, 1 );
flush_tickit;
t/13entry-scroll.t view on Meta::CPAN
SETPEN,
PRINT("B"),
SETPEN(fg=>6),
PRINT("..>"),
GOTO(0,0) ],
'Termlog after ->text_delete 0, 1' );
is_display( [ ("A"x69).("B"x8)."..>" ],
'Display after ->text_delete 0, 1' );
is_cursorpos( 0, 0, 'Position after ->text_delete 0, 1' );
done_testing;
( run in 0.352 second using v1.01-cache-2.11-cpan-4d50c553e7e )