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::Async;

use strict;
use warnings;
use base qw( Tickit IO::Async::Notifier );
Tickit->VERSION( '0.17' );
IO::Async::Notifier->VERSION( '0.43' ); # Need support for being a nonprinciple mixin

our $VERSION = '0.16';

use IO::Async::Loop 0.47; # ->run and ->stop methods
use IO::Async::Signal;
use IO::Async::Stream;
use IO::Async::Handle;
use IO::Async::Timer::Countdown;

=head1 NAME

C<Tickit::Async> - use C<Tickit> with C<IO::Async>

=head1 SYNOPSIS

 use IO::Async;
 use Tickit::Async;

 my $tickit = Tickit::Async->new;

 # Create some widgets
 # ...

 $tickit->set_root_widget( $rootwidget );

 my $loop = IO::Async::Loop->new;
 $loop->add( $tickit );

 $tickit->run;

=head1 DESCRIPTION

This class allows a L<Tickit> user interface to run alongside other
L<IO::Async>-driven code, using C<IO::Async> as a source of IO events.

As a shortcut convenience, if the C<run> method is invoked and the object is
not yet a member of an L<IO::Async::Loop>, then a new one will be constructed
and the C<Tickit::Async> object added to it. This will allow a
C<Tickit::Async> object to be used without being aware it is not a simple
C<Tickit> object.

=cut

sub new
{
   my $class = shift;
   my $self = $class->Tickit::new( @_ );

   $self->add_child( IO::Async::Signal->new( 
      name => "WINCH",
      on_receipt => $self->_capture_weakself( "_SIGWINCH" ),
   ) );

   $self->add_child( IO::Async::Handle->new(
      read_handle => $self->term->get_input_handle,
      on_read_ready => $self->_capture_weakself( "_input_readready" ),
   ) );

   $self->add_child( $self->{timer} = IO::Async::Timer::Countdown->new(
      on_expire => $self->_capture_weakself( "_timeout" ),
   ) );

   return $self;
}

sub _make_writer
{
   my $self = shift;
   my ( $out ) = @_;

   my $writer = IO::Async::Stream->new(
      write_handle => $out,
      autoflush => 1,
   );

   $self->add_child( $writer );

   return $writer;
}

sub _input_readready
{
   my $self = shift;
   my $term = $self->term;

   $self->{timer}->stop;

   $term->input_readable;

   $self->_timeout;
}

sub _timeout
{
   my $self = shift;
   my $term = $self->term;

   if( defined( my $timeout = $term->check_timeout ) ) {
      $self->{timer}->configure( delay => $timeout / 1000 ); # msec
      $self->{timer}->start;
   }
}

sub _add_to_loop
{
   my $self = shift;

   $self->SUPER::_add_to_loop( @_ );

   if( $self->{todo_queue} ) {
      $self->get_loop->later( $self->_capture_weakself( sub {
         my $self = shift or return;
         $self->_flush_later
      } ) );
   }
}

sub later
{
   my $self = shift;
   my ( $code ) = @_;

   if( my $loop = $self->get_loop ) {
      $loop->later( $code );
   }
   else {
      push @{ $self->{todo_queue} }, $code;
   }
}

sub stop
{
   my $self = shift;
   $self->get_loop->stop;
}

sub run
{
   my $self = shift;

   my $loop = $self->get_loop || do {
      my $newloop = IO::Async::Loop->new;
      $newloop->add( $self );
      $newloop;
   };

   $self->setup_term;

   $loop->add( my $sigint_notifier = IO::Async::Signal->new(
      name => "INT",
      on_receipt => $self->_capture_weakself( sub {
            my $self = shift;
            if(my $loop = $self->get_loop) {
               $loop->stop
            }
         }),
   ) );

   my $ret = eval { $loop->run };
   my $e = $@;

   {
      local $@;

      $self->teardown_term;
      $loop->remove( $sigint_notifier );
   }

   die $@ if $@;
   return $ret;
}

=head1 AUTHOR

Paul Evans <leonerd@leonerd.org.uk>

=cut

0x55AA;