Curses-Readline

 view release on metacpan or  search on metacpan

lib/Curses/Readline.pm  view on Meta::CPAN


our @EXPORT_OK = 'curses_readline';

our $VERSION = '0.9';

sub curses_readline {
    my ($prefix) = @_;
    $prefix //= ':';

    my $buffer        = '';
    my $cursor_pos    = 0;
    my $buffer_offset = 0;

    my ( $lines, $columns );
    getmaxyx( $lines, $columns );
    move( $lines + 1, $columns );
    addstring( $lines - 1, 0, ":" );

    my $half_width = int( $columns / 2 );

    while (1) {

        ## cursor_pos and buffer_offset are zero-based, columns
        ## start at one!
        if ( $cursor_pos + 1 >= $columns ) {
            $buffer_offset += $half_width - 1;
            $cursor_pos = length($buffer) - $buffer_offset;
        }
        elsif ( $cursor_pos < 0 ) {
            if ( $buffer_offset != 0 ) {
                $buffer_offset -= $half_width - 1;
                $cursor_pos = $half_width - 2;
            }
            else {
                $cursor_pos = 0;
            }
        }

        addstring( $lines - 1, 0,
            "$prefix" . substr( $buffer, $buffer_offset, $columns - 1 ) );
        clrtoeol;
        move( $lines - 1, $cursor_pos + 1 );
        refresh;

        my $c = getch;
        if ( $c eq "\cG" ) {
            $buffer = undef;
            last;
        }
        elsif ( $c eq "\n" ) {
            last;
        }
        elsif ( $c eq KEY_LEFT ) {
            $cursor_pos--;
        }
        elsif ( $c eq KEY_RIGHT ) {
            next if $cursor_pos == length($buffer) - $buffer_offset;
            $cursor_pos++;
        }
        elsif ( $c eq KEY_HOME || $c eq "\cA" ) {
            $cursor_pos    = 0;
            $buffer_offset = 0;
        }
        elsif ( $c eq "\cK" ) {
            substr( $buffer, $buffer_offset + $cursor_pos ) = '';
        }
        elsif ( $c eq KEY_END || $c eq "\cE" ) {
            my $l = length($buffer);
            if ( $l >= $columns ) {
                $buffer_offset = $l - $columns + 2;
                $cursor_pos    = $columns - 2;
            }
            else {
                $cursor_pos = $l;
            }
        }
        elsif ( $c eq KEY_BACKSPACE ) {
            next if $buffer_offset == 0 && $cursor_pos == 0;
            $cursor_pos--;
            substr( $buffer, $buffer_offset + $cursor_pos, 1 ) = '';
        }
        elsif ( $c eq "\cD" ) {
            substr( $buffer, $buffer_offset + $cursor_pos, 1 ) = '';
        }
        else {
            substr( $buffer, $buffer_offset + $cursor_pos, 0 ) = $c;
            $cursor_pos++;
        }
    }
    move( $lines - 1, 0 );
    clrtoeol;
    return $buffer;
}

1;

__END__



( run in 0.241 second using v1.01-cache-2.11-cpan-4d50c553e7e )