The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#  You may distribute under the terms of either the GNU General Public License
#  or the Artistic License (the same terms as Perl itself)
#
#  (C) Paul Evans, 2011-2012 -- leonerd@leonerd.org.uk

package Tickit::Console;

use strict;
use warnings;
use base qw( Tickit::Widget::VBox );

our $VERSION = '0.04';

use Tickit::Widget::Entry;
use Tickit::Widget::Scroller 0.04;
use Tickit::Widget::Tabbed 0.003;

use Scalar::Util qw( weaken );

=head1 NAME

C<Tickit::Console> - build full-screen console-style applications

=cut

=head1 CONSTRUCTOR

=cut

=head2 $console = Tickit::Console->new( %args )

Returns a new instance of a C<Tickit::Console>. Takes the following named
arguments:

=over 8

=item on_line => CODE

Callback to invoke when a line of text is entered in the entry widget.

 $on_line->( $console, $text )

=back

=cut

sub new
{
   my $class = shift;
   my %args = @_;

   my $on_line = delete $args{on_line};

   my $self = $class->SUPER::new( %args );

   $self->add(
      $self->{tabbed} = Tickit::Widget::Tabbed->new(
         tab_position => "bottom",
         tab_class    => "Tickit::Console::Tab",
      ),
      expand => 1,
   );

   $self->add(
      $self->{entry} = Tickit::Widget::Entry->new
   );

   weaken( my $weakself = $self );
   $self->{entry}->set_on_enter( sub {
      return unless $weakself;
      my ( $entry ) = @_;
      my $line = $entry->text;
      $entry->set_text( "" );

      my $tab = $weakself->active_tab;
      if( $tab->{on_line} ) {
         $tab->{on_line}->( $weakself, $line );
      }
      else {
         $on_line->( $weakself, $line );
      }
   } );

   return $self;
}

=head1 METHODS

=cut

=head2 $tab = $console->add_tab( %args )

Adds a new tab to the console, and returns an object representing it.

Takes the following named arguments:

=over 8

=item name => STRING

Name for the tab.

=item on_line => CODE

Optional. Provides a different callback to invoke when a line of text is
entered while this tab is active. Invoked the same way as above.

=back

See L</TAB OBJECTS> below for more information about the returned object.

=cut

sub add_tab
{
   my $self = shift;
   my %args = @_;

   my $tab = $self->{tabbed}->add_tab(
      Tickit::Widget::Scroller->new( gravity => "bottom" ),
      label => $args{name}
   );

   $tab->{on_line} = delete $args{on_line};

   return $tab;
}

=head2 $index = $console->active_tab_index

=head2 $tab = $console->active_tab

=head2 $console->activate_tab( $tab_or_index )

=head2 $console->next_tab

=head2 $console->prev_tab

These methods are all passed through to the underlying
L<Tickit::Widget::Tabbed> object.

=cut

foreach my $method (qw( active_tab_index active_tab activate_tab next_tab prev_tab )) {
   no strict 'refs';
   *$method = sub {
      my $self = shift;
      $self->{tabbed}->$method( @_ );
   };
}

=head1 TAB OBJECTS

=cut

package Tickit::Console::Tab;
use base qw( Tickit::Widget::Tabbed::Tab );

use Tickit::Widget::Scroller::Item::Text;
use Tickit::Widget::Scroller::Item::RichText;

=head2 $name = $tab->name

=head2 $tab->set_name( $name )

Returns or sets the tab name text

=cut

sub name
{
   my $self = shift;
   return $self->label;
}

sub set_name
{
   my $self = shift;
   my ( $name ) = @_;
   $self->set_label( $name );
}

=head2 $tab->add_line( $string, %opts )

Appends a line of text to the tab. C<$string> may either be a plain perl
string, or an instance of L<String::Tagged> containing formatting tags, as
specified by L<Tickit::Widget::Scroller>. Options will be passed to the
L<Tickit::Widget::Scroller::Item::Line> used to contain the string.

=cut

sub add_line
{
   my $self = shift;
   my ( $string, %opts ) = @_;

   my $item;
   if( eval { $string->isa( "String::Tagged" ) } ) {
      $item = Tickit::Widget::Scroller::Item::RichText->new( $string, %opts );
   }
   else {
      $item = Tickit::Widget::Scroller::Item::Text->new( $string, %opts );
   }

   $self->widget->push( $item );
}

=head1 AUTHOR

Paul Evans <leonerd@leonerd.org.uk>

=cut

0x55AA;