Net::Partty::Screen - Term::Screen for Net::Partty

  use Net::Partty::Screen;

   my $scr = net::Partty::Screen->new;
   $scr->connect(
       message           => 'message',
       session_name      => 'session_name',
       writable_password => 'writable_password',
       readonly_password => '',
   );
   $scr->clrscr();
   $scr->at(5,3);
   $scr->puts("this is some stuff");
   $scr->at(10,10)->bold()->puts("hi!")->normal();
      # you can concatenate many calls (not getch)
   $c = $scr->getch();      # doesn't need Enter key 
   ...
   if ($scr->key_pressed()) { print "ha you hit a key!"; }

  svn co http://svn.coderepos.org/share/lang/perl/Net-Partty-Screen/trunk Net-Partty-Screen

package Net::Partty::Screen;

use strict;
use warnings;
use base 'Term::Screen';
our $VERSION = '0.01';

use Net::Partty;
use Term::Cap;

sub new {
    my($class, %opts) = @_;

    my $self = bless {
        %opts,
        IN   => '',
        KEYS => {},
        ECHO => 1,
    }, $class;

    unless ($self->{term}) {
        my $term = Term::Cap->Tgetent({
            TERM   => 'vt100',
            OSPEED => 9600,
        });
        $self->term($term);
    }
    $self->resize;
    $self->get_fn_keys;

    $self->{partty} = delete $opts{partty} || Net::Partty->new(%{ $opts{partty_conf} || {} }) unless $self->{sock};

    if ($self->{debug}) {
        eval { require Term::ReadKey; };
        if ($@) {
            require Carp;
            Carp::croak $@;
        }

        $self->at(0, 0);
        Term::ReadKey::ReadMode('raw', \*STDIN);
        $| = 1;
    }

    $self;
}

sub DESTROY {
    Term::ReadKey::ReadMode(0, \*STDIN) if shift->{debug};
}

sub sock { shift->{sock} }
sub partty { shift->{partty} }
sub connect {
    my $self = shift;
    $self->{partty}->connect(@_);
    $self->{sock} = $self->partty->sock;
    $self->sock->sb(chr(31), pack('nn', $self->{COLS}, $self->{ROWS}));
    $self->sock->blocking(0);
    $self->at(0, 0);
}

sub esc {
    my($self, $fmt, @args) = @_;
    $self->puts(sprintf "%s$fmt", chr(0x1b), @args);
}

# sub term {}
# sub rows {}
# sub cols {}

sub at {
    my($self, $rows, $cols) = @_;
    $rows = 0 if $rows < 0;
    $cols = 0 if $cols < 0;
    $rows = $self->{ROWS} - 1 if $rows >= $self->{ROWS};
    $cols = $self->{COLS} - 1 if $cols >= $self->{COLS};
    $self->esc('[%s;%sH', $rows + 1, $cols + 1);
    $self;
}

sub resize {
    my($self, $rows, $cols) = @_;
    $self->{ROWS} = $rows || 25;
    $self->{COLS} = $cols || 80;
    $self;
}

sub normal { shift->esc('[m') }
sub bold { shift->esc('[1m') }
sub reverse { shift->esc('[7m') }
sub clrscr { shift->esc('[2J')->at(0, 0) }
sub clreol { shift->esc('[0K') }
sub creos { shift->esc('[0J') }
sub il { shift->esc('[L') }
sub dl { shift->esc('[M') }

sub ic_exists { 0 }
sub ic { shift }
sub dc_exists { 0 }
sub dc { shift }

sub puts {
    my($self, $data) = @_;
    if ($self->{debug}) {
        print $data;
    } else {
        $self->sock->send($data);
        $self->partty->can_write(100);
    }
    $self;
}

sub getc {
    my $self = shift;
    return CORE::getc(STDIN) if $self->{debug};

    $self->partty->can_read(100);
    return $self->sock->getc;
}

sub getch {
    my $self           = shift;
    my $fn_flag        = 0;
    my $char           = $self->{IN} ? chop($self->{IN}) : $self->getc;
    my $partial_fn_str = $char;
    return unless $char;

    while (exists($self->{KEYS}{$partial_fn_str})) {
        $fn_flag = 1;
        if ($self->{KEYS}{$partial_fn_str}) {
            $char           = $self->{KEYS}{$partial_fn_str};
            $partial_fn_str = '';
            last;
        }
        $partial_fn_str .= $self->{IN} ? chop($self->{IN}) : $self->getc;
    }

    if ($fn_flag) {
        if ($partial_fn_str) {
            if ($partial_fn_str eq "\e\e") {
                $char = "\e";
            } else {
                $self->{IN} = CORE::reverse($partial_fn_str) . $self->{IN};
                $char = chop($self->{IN});
                $self->puts($char) if $self->{ECHO} && $char ne "\e";
            }
        }
    } elsif ($self->{ECHO} && $char ne "\e") {
        $self->puts($char);
    }
    $char;
}

# sub def_key {}

sub key_pressed {
    my($self, $wait) = @_;
    my $fds   = '';
    my $ready = 0;

    my $fno = $self->{debug} ? fileno(STDIN) : fileno($self->sock);
    $wait = 0 unless defined $wait;

    vec($fds, $fno, 1) = 1;
    eval {
        $ready = select($fds, undef, undef, $wait);
    };
    $ready;
}

# sub echo {}
# sub noecho {}

sub flush_input {
    my $self = shift;
    $self->{IN} = '';
    while ($self->key_pressed) { $self->getc }
    $self;
}


# sub stuff_input {}
# sub get_fn_keys {}

1;
__END__