#!/usr/bin/perl
#
# PED - Editor v0.2
# (C)2003 DaanSystems, Niek Albers
# License: PAL (Perl Artistic License)
# http://www.daansystems.com
# mailto:nieka@daansystems.com

use strict;

my $editor = new Editor;

# catch terminal resize
$SIG{WINCH} = sub {
    $editor->get_terminal_size();
    $editor->{forceupdate} = 1;
    $editor->draw();
};

$editor->load( $ARGV[0] );
$editor->run();

package Editor;

use Term::ReadKey;

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;

    # initialize data members
    my $self = {};
    $self->{topline}     = 0;
    $self->{x}           = 0;
    $self->{y}           = 0;
    $self->{lastxsearch} = -1;
    $self->{lastysearch} = 0;
    $self->{forceupdate} = 1;
    $self->{ins}         = 1;
    bless( $self, $class );
    return $self;
}

sub help {
    my $self = shift;

    my @help = (
        '                                  ',
        ' |ped| V0.2 Text editor in Perl   ',
        ' (C)2003 DaanSystems, Niek Albers ',
        ' http://www.daansystems.com       ',
        ' mailto:nieka@daansystems.com     ',
        '----------------------------------',
        ' Ctrl+s Save                      ',
        ' Ctrl+f Search                    ',
        ' Ctrl+d Save+Exit                 ',
        ' Ctrl+c Exit                      ',
        '                                  ',
    );

    my $x = int( ( $self->{cols} / 2 ) - ( length( $help[0] ) / 2 ) );
    my $y = int( ( $self->{rows} / 2 ) - ( scalar(@help) / 2 ) );
    foreach my $helpline (@help) {
        $self->absmove( $x, $y++ );
        print $self->inverse($helpline);
    }

    $self->get_escape_sequence() if ( ord( ReadKey() ) == 27 );
    $self->{forceupdate} = 1;
}

sub get_terminal_size {
    my $self = shift;
    my ( $rows, $cols ) = split ( /\s+/, `stty size` );

    $self->{cols} = $cols;
    $self->{rows} = $rows - 2;
}

sub load {
    my $self = shift;
    my ($filename) = @_;

    if ( !open( FILE, $filename ) ) {
        $self->{lines} = [''];
        return;
    }
    binmode(FILE);
    my @lines;
    my $dos = 0;
    foreach my $line (<FILE>) {
        $dos = 1 if ( $line =~ m/\r\n$/ );
        $line =~ s/\r?\n$//;
        push ( @lines, $line );
    }

    close(FILE);
    $self->{dos}      = $dos;
    $self->{lines}    = \@lines;
    $self->{filename} = $filename;
    return 1;
}

sub save {
    my $self     = shift;
    my $filename = $self->{filename} || $self->input('Filename');

    if ( !open( FILE, ">$filename" ) ) {
        $self->status("Save failed $!");
        return;
    }
    binmode(FILE);
    my $count = 0;
    foreach my $line ( @{ $self->{lines} } ) {
        print FILE $line . ( $self->{dos} ? "\r\n" : "\n" );
        $count++;
    }
    close(FILE);

    $self->status("Saved $count lines.");
    $self->footer();
    $self->{filename} = $filename;
    return 1;
}

my $key;

sub run {
    my $self = shift;
    $self->get_terminal_size();
    binmode(STDIN);
    ReadMode 5;
    while (1) {
        $self->{lasttopline} = $self->{topline};
        $self->{status} = '';
        $self->{nrlines}     = scalar( @{ $self->{lines} } );
        $self->dokey($key);
        $self->draw();
        $self->move();
        $key = ReadKey();
    }

    ReadMode 0;
    $self->absmove( 0, $self->{rows} + 2 );
    print "\n";
}

sub get_escape_sequence {
    my $self = shift;

    my $esc;
    while ( $key = ReadKey() ) {
        $esc .= $key;
        last if ( $key =~ /[a-z~]/i );
    }

    return $esc;
}

sub dokey {
    my $self = shift;
    my ($key) = @_;
    my $ctrl = ord($key);
    if    ( $ctrl == 3 )  { last }                         # Ctrl+c
    elsif ( $ctrl == 4 )  { last if ( $self->save() ) }    # Ctrl+d
    elsif ( $ctrl == 27 ) {                                # escape code
        my $esc = $self->get_escape_sequence();

        if    ( $esc eq '[A' ) { $self->moveup(1) }        # up
        elsif ( $esc eq '[B' ) {
            $self->movedown(1);
        }                                                  # down
        elsif ( $esc eq '[5~' ) { $self->moveup( $self->{rows} ) }      # pgup
        elsif ( $esc eq '[6~' ) { $self->movedown( $self->{rows} ) }    # pgdn
        elsif ( $esc eq '[C' )  { $self->moveright(1) }                 # right
        elsif ( $esc eq '[D' )  { $self->moveleft(1) }                  # left
        elsif ( $esc eq '[3~' ) { $self->delat() }                      # del
        elsif ( $esc eq '[1~' ) {                                       # home
            $self->moveup( $self->{topline} + $self->{y} );
        }
        elsif ( $esc eq '[4~' ) {                                       # end
            $self->movedown(
                scalar( @{ $self->{lines} } ) -
                  ( $self->{topline} + $self->{y} ) );
        }
        elsif ( $esc eq '[2~' ) {                                       # insert
            $self->{ins} = !$self->{ins};
        }
        elsif ( $esc eq '[[A' || $esc eq '[11~' ) {
            $self->help();
        }
    }
    elsif ( $ctrl == 8 || $ctrl == 127 ) {    # BACKSPACE
        $self->backspaceat();
        $self->moveleft(1);
    }
    elsif ( $ctrl == 13 ) {                   # newline
        $self->newlineat();
        $self->movedown(1);
        $self->{x} = 0;
    }
    elsif ( $ctrl == 11 ) {                   # Ctrl+K
        $self->delteol();
    }
    elsif ( $ctrl == 19 ) {                   # Ctrl+S
        $self->save();
    }
    elsif ( $ctrl == 6 ) {                    # Ctrl+F
        $self->search();
    }
    elsif ( $ctrl == 9 || ( $ctrl >= 32 && $ctrl <= 126 ) ) {
        $self->setat($key);
        $self->moveright(1);
    }

}

sub moveright {
    my $self = shift;
    my ($rows) = @_;
    $self->{x} += $rows;
    if ( $self->{x} > length( $self->line() ) ) {
        $self->movedown(1);
        $self->{x} = 0
          if ( ( $self->{topline} + $self->{y} ) !=
            scalar( @{ $self->{lines} } ) - 1 );

    }

}

sub moveleft {
    my $self = shift;
    my ($rows) = @_;
    $self->{x} -= $rows;

    if ( $self->{x} < 0 ) {
        $self->{x} = length( $self->line(-1) );
        $self->moveup(1);
    }

}

sub moveup {
    my $self = shift;
    my ($lines) = @_;
    $self->{y} -= $lines;

    # check for topline, move up
    if ( $self->{y} < 0 ) {
        $self->{topline} += $self->{y};
        $self->{y} = 0;
    }
}

sub movedown {
    my $self = shift;
    my ($lines) = @_;
    my $y = $self->{y} + $lines;

    # move down
    if ( ( $self->{topline} + $y ) >= scalar( @{ $self->{lines} } ) ) {
        $y = scalar( @{ $self->{lines} } ) - $self->{topline} - 1;
    }

    if ( $y >= $self->{rows} ) {
        $self->{topline} += ( $y - $self->{rows} + 1 );
        $y = $self->{rows} - 1;
    }

    # check for corsormovement beyond line $self->length
    $self->{y} = $y;
}

sub search {
    my $self = shift;

    $self->{search} = $self->input('search') if ( !$self->{search} );
    my $found;
    for (
        my $i = $self->{topline} + $self->{y} ;
        $i < scalar( @{ $self->{lines} } ) ;
        $i++
      )
    {
        $found =
          index( $self->{lines}->[$i], $self->{search}, $self->{searchx} + 1 );
        if ( $found != -1 ) {
            $self->{x}       = $found;
            $self->{searchx} = $found;
            $self->{y}       = 0;
            $self->{topline} = $i;
            $self->move();
            last;

        }
        else { $self->{searchx} = 0 }
    }
    if ( $found == -1 ) {
        $self->movedown(
            scalar( @{ $self->{lines} } ) - ( $self->{topline} + $self->{y} ) );
    }
}

sub delteol {
    my $self = shift;
    $self->line( 0, substr( $self->line(), 0, $self->{x} ) );
    if ( $self->{x} == 0 ) {
        $self->delat();
    }

}

sub newlineat {
    my $self  = shift;
    my $begin = substr( $self->line(), 0, $self->{x} );
    my $end   = substr( $self->line(), $self->{x} );

    $self->line( 0, $begin );
    splice( @{ $self->{lines} }, $self->{topline} + $self->{y} + 1, 0, $end );
}

sub delat {
    my $self = shift;

    my $len = $self->length( $self->line() );
    if ( $self->{x} < $len ) {
        my $begin = substr( $self->line(), 0, $self->{x} );
        my $end = substr( $self->line(), $self->{x} + 1 );
        $self->line( 0, $begin . $end );
    }
    else {
        $self->line( 0, $self->line() . $self->line(1) );
        splice( @{ $self->{lines} }, $self->{topline} + $self->{y} + 1, 1 );

    }

}

sub backspaceat {
    my $self = shift;

    if ( $self->{x} <= 0 && $self->{y} > 0 ) {
        my $y = $self->{y};
        $self->{x} = $self->length( $self->line(-1) ) + 1;
        $self->line( -1, $self->line(-1) . $self->line() );
        $self->moveup(1);
        splice( @{ $self->{lines} }, $self->{topline} + $y, 1 );
    }
    else {
        my $begin = substr( $self->line(), 0, $self->{x} ? $self->{x} - 1 : 0 );
        my $end   = substr( $self->line(), $self->{x} );

        my $line = $begin . $end;
        $self->line( 0, $line );
    }

}

sub line {
    my ($self) = shift;
    my ( $offset, $text ) = @_;
    my $pos = $self->{topline} + $self->{y} + $offset;

    if ( defined($text) ) {
        $self->{lines}->[$pos] = $text;
    }
    else {
        return $self->{lines}->[$pos];
    }
}

sub setat {
    my $self = shift;
    my ($key) = @_;

    my $begin = substr( $self->line(), 0, $self->{x} );
    my $end =
      substr( $self->line(), $self->{ins} ? $self->{x} : $self->{x} + 1 );
    $self->line( 0, $begin . $key . $end );

}

sub error {
    my $self = shift;
    die "failed: @_";
}

sub clear {
    my $self = shift;
    print "\e[2J";
}

sub header {
    my $self = shift;

    $self->absmove( 0, 0 );
    print $self->inverse( ' ' x ( $self->{cols} - 1 ) );
    $self->absmove( 0, 0 );

    print $self->inverse(
        '|ped| ' . ( '+-------' x ( ( $self->{cols} - 7 ) / 8 ) ) );
}

sub footer {
    my $self = shift;
    $self->absmove( 0, $self->{rows} + 2 );
    print $self->inverse( ' ' x ( $self->{cols} - 1 ) );
    $self->absmove( 0, $self->{rows} + 2 );
    print $self->inverse(
        (
            '['
              . ( $self->{filename} || 'Untitled' ) . ']' . ' '
              . $self->{status}
        )
    );

    my $xy = 'HELP=F1 '
      . ( $self->{dos} ? 'DOS' : 'UNIX' ) . ' '
      . ( $self->{ins} ? 'INS' : '' ) . ' [ '
      . ( $self->{x} + 1 ) . '/'
      . ( length( $self->line() ) + 1 ) . ':'
      . ( $self->{topline} + $self->{y} + 1 ) . '/'
      . ( scalar( @{ $self->{lines} } ) ) . ' ]';
    $self->absmove( $self->{cols} - $self->length($xy), $self->{rows} + 2 );
    print $self->inverse($xy);

}

sub draw {
    my $self = shift;

    my $len = $self->length( $self->line() );
    if ( $self->{x} > $len ) { $self->{x} = $len }
    if ( $self->{topline} < 0 ) {
        $self->{topline} = 0;
        $self->{x}       = 0;
    }
    my $bottom = scalar( @{ $self->{lines} } ) - $self->{rows} + 1;
    $bottom = 0 if ( $bottom < 0 );
    if ( $self->{topline} > $bottom ) {
        $self->{topline} = $bottom;
        $self->{x}       = $self->length( $self->line() );
    }

    # update only current line
    if (   $self->{lasttopline} == $self->{topline}
        && $self->{nrlines} == scalar( @{ $self->{lines} } )
        && !$self->{forceupdate} )
    {
        $self->absmove( 0, $self->{y} + 2 );
        print "\e[K";
        $self->drawline( $self->{topline} + $self->{y} );
    }
    else    # update screen
    {
        $self->clear();
        $self->absmove( 0, 2 );

        for (
            my $pos = $self->{topline} ;
            $pos < $self->{topline} + $self->{rows}
            && $pos < scalar( @{ $self->{lines} } ) ;
            $pos++
          )
        {
            $self->drawline($pos);
        }
        $self->{forceupdate} = 0;
    }
    $self->footer();
    $self->header();

}

sub drawline {
    my $self = shift;
    my ($pos) = @_;
    my $line = $self->{lines}->[$pos];

    # expand tabs

    1 while $line =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e;
    my $realx = $self->getrealx( $self->{lines}->[$pos] );
    if ( $realx < $self->{cols} - 7 ) {
        $line = substr( $line, 0, $self->{cols} - 7 );
    }
    else {
        $line =
          substr( $line, $realx - ( $self->{cols} - 7 ), $self->{cols} - 7 );
    }

    my $posstring = sprintf( '%5d', $pos + 1 );
    print $self->inverse($posstring) . ' ' . $line . "\r\n";
}



sub absmove {
    my $self = shift;
    my ( $x, $y ) = @_;
    print "\e[" . $y . ';' . $x . 'f';
}

sub getrealx {
    my $self = shift;
    my ($line) = @_;
    return $self->length( substr( $line, 0, $self->{x} ) );
}

sub move {
    my $self = shift;

    my $realx = $self->getrealx($self->line() );
    print "\e[" . ( $self->{y} + 2 ) . ';' . ( $realx + 7 ) . 'f';
}

sub inverse {
    my $self = shift;
    my ($text) = @_;
    return "\e[7m" . $text . "\e[m";
}

sub input {
    my $self = shift;
    my ($text) = @_;
    $self->absmove( 0, $self->{rows} + 2 );
    print $self->inverse( ' ' x ( $self->{cols} - 1 ) );
    $self->absmove( 0, $self->{rows} + 2 );
    print "\e[7m";
    print "$text: ";

    ReadMode 1;
    my $result = ReadLine();
    ReadMode 5;
    $result =~ s/\r?\n$//;
    
    print "\e[m";
    $self->{forceupdate} = 1;
    return $result;
}

sub status {
    my $self = shift;
    my ($status) = @_;
    $self->{status} = $status;
}

sub length {    # calculate length with tabs expanded
    my $self = shift;
    my ($text) = @_;
    1 while $text =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e;
    return length($text);
}

1;