#! perl
# Created: Tue 21 Aug 2012 12:49:09 PM IDT
# Last Changed: Wed 25 Sep 2013 12:50:06 PM IDT
# Author: Moshe Kamensky <kamensky@cpan.org>

=head1 NAME

bidi - Make urxvt present Bidi text correctly

=head1 DESCRIPTION

This extension filters the text displayed by Urxvt, so that Bi-directional 
text (e.g., Hebrew or Arabic mixed with English) is displayed correctly. It 
does so using the L<Text::Bidi> module (which should be installed).

The extension emulates a cursor via rendition. This means that when typing, 
there will be two cursors, the original one whose location corresponds to the 
current location within the logical string (so, mostly useless), and a fake 
one which corresponds to the current insertion point.

To enable the extension, add C<bidi> to the I<Urxvt.perl-ext-common> 
resource. See urxvt(1) and urxvtperl(1) for other options and more details.

The extension recognises one resource, I<Urxvt.bidi.FieldSep>. This should be 
a string on which each line is split before applying the Bidi algorithm. This 
permits creating tables, where each cell is treated separately, e.g., in the 
index of an email client. Note that this is a string, not a regular 
expression. The default is C<\x{2502}>.

=cut

use 5.10.0;
use Text::Bidi qw(log2vis is_bidi);
use Encode qw(decode_utf8);

sub on_start {
    my ($self) = @_;
    $self->{'split'} = decode_utf8($self->x_resource('%.FieldSep')) // 
                       "\x{2502}";
    $self->{'spre'} = qr/\Q$self->{'split'}\E/o;
    $self->{'ls'} = length($self->{'split'});
}

sub on_refresh_begin {
    my ($self) = @_;
    my ($crow, $ccol) = $self->screen_cur;
    for my $i ( 0..$self->nrow-1 ) {
        my $l = $self->ROW_t($i);
        # for speed
        next unless is_bidi($l);
        my $r = $self->ROW_r($i);
        my @l = split $self->{'spre'}, $l;
        my (@res, @levels, @map);
        # current offset within the line
        my $off = 0;
        # we keep the map, so that we can apply it to the rendition
        for my $part ( @l ) {
            my ($p, $v) = log2vis($part);
            push @res, $v;
            push @levels, @{$p->levels}, 0;
            push @map, map { $_ + $off } @{$p->map};
            $off += length($part);
            # compensate for the field separator
            push @map, $off..$off+$self->{'ls'}-1;
            $off += $self->{'ls'};
        }
        # remove the last field separator
        splice @map, -$self->{'ls'};
        my $res = join($self->{'split'}, @res);
        # fake cursor
        if ( $crow == $i ) {
            $r->[$ccol] |= urxvt::RS_RVid unless $map[$ccol]==$ccol;
        }
        my @newr = (@$r)[@map];
        # keep the logical data for restoring after display
        $self->{'text'}[$i] = $self->ROW_t($i, $res);
        $self->{'rend'}[$i] = $self->ROW_r($i, \@newr);
    }
    ()
}

sub on_refresh_end {
    my ($self) = @_;
    return unless defined $self->{'text'};
    foreach (0..$self->nrow-1 ) {
        next unless defined $self->{'text'}[$_];
        $self->ROW_t($_, $self->{'text'}[$_]);
        $self->ROW_r($_, $self->{'rend'}[$_]);
    }
    delete $self->{'text'};
    delete $self->{'rend'};
    ()
}