#!/usr/bin/perl

######################################################################
#  A test program for checking out algorithms for inserting and
#  resolving bidi directions in a text widget.
#
#  This test example contains two classes:
#
#  1. line
#       contains the four fields text, strong_dir,
#       resolved_dir_forward, and resolved_dir_backward
#
#  2. line_buf
#       A list of lines with the two public methods insert() and
#       delete().
#
#  Dov Grobgeld
#  2003-04-21
#  This program is in the public domain.
######################################################################

use strict;

######################################################################
#  The line class.
######################################################################
package line;

sub new {
    shift; # Package name
    my $this = {};
    my $text = shift;
    my $dir = resolve_dir($text);
    
    $this->{text} = $text;
    $this->{strong_dir} = $dir;
    $this->{resolved_dir_forward} = $dir;
    $this->{resolved_dir_backward} = $dir;

    return bless $this;
}

sub get_strong_dir {
    my $this = shift;
    return $this->{strong_dir};
}

sub set_strong_dir {
    my $this = shift;
    $this->{strong_dir} = shift;
}

sub get_resolved_dir_backward {
    my $this = shift;
    return $this->{resolved_dir_backward};
}

sub set_resolved_dir_backward {
    my $this = shift;
    $this->{resolved_dir_backward} = shift;
}

sub get_resolved_dir_forward {
    my $this = shift;
    return $this->{resolved_dir_forward};
}

sub set_resolved_dir_forward {
    my $this = shift;
    $this->{resolved_dir_forward} = shift;
}

sub get_dir {
    my $this = shift;

    if ($this->{strong_dir} ne "N") {
	return $this->{strong_dir};
    }
    elsif ($this->{resolved_dir_forward} ne "N") {
	return $this->{resolved_dir_forward};
    }
    else {
	return $this->{resolved_dir_backward};
    }
}

sub get_text {
    my $this = shift;
    return $this->{text};
}

# Assume that starts with one of [LRN] for LTR, RTL and Neutral
sub resolve_dir {
    my $text = shift;

    return substr($text, 0,1);
}

######################################################################
#  The line_buf class.
######################################################################
package line_buf;

sub new {
    my $this = {};
    shift;
    my $base_dir = shift;
    
    $this->{lines} = [];
    $this->{base_dir} = $base_dir;
    return bless $this;
}

# Insert inserts a line in the line buffer and resolves its
# direction.
sub insert {
    my($this, $pos, $text) = @_;
    my $lines = $this->{lines};   # shortcut

    my $line = new line($text);

    $pos = @$lines if $pos < 0;

    # Insert the new line at the position
    splice(@$lines, $pos, 0, $line);

    resolve_bidi_dir($this, $pos);
}

sub delete {
    my($this, $pos) = @_;
    my $lines = $this->{lines};   # shortcut

    # Delete a line
    splice(@$lines, $pos, 1);
    resolve_bidi_dir($this, $pos);
}

######################################################################
#  Here is the heart of the algorithm. This routine resolves the
#  resolved_dir_forward and the resolved_dir_backward on each insert
#  or delete operation of the buffer.
######################################################################
sub resolve_bidi_dir {
    my($this, $pos) = @_;
    my $lines = $this->{lines};   # shortcut

    my $line = $lines->[$pos];

    # Resolve directions

    # If dir of line is neutral, then inherit the direction of the
    # previous line. If there is no previous line and we are on
    # the first line, then set the resolved_dir_forward attribute
    # equal to neutral for the first line and for all the subsequent
    # neutral lines.
    if ($line->get_strong_dir eq "N") {
	# Neutral just inherit from the surrounding text
	if ($pos > 0) {
	    my $prev_line = $lines->[$pos-1];
	    $line->set_resolved_dir_forward($prev_line->get_resolved_dir_forward);
	}
	else {
	    # propagate the neutral attribute until we hit a strong line.
	    # This is necessary in order to enable the backward resolve.
	    $line->set_resolved_dir_forward("N");
	    for (my $p=$pos+1; $p < @$lines; $p++) {
		my $l = $lines->[$p];
		last if $l->get_strong_dir ne "N"
		    || $l->get_resolved_dir_forward eq "N";
		$l->set_resolved_dir_forward("N");
	    }
	}

	# The same for the backward propagated direction. 
	if ($pos < @$lines-1) {
	    my $next_line = $lines->[$pos+1];
	    $line->set_resolved_dir_backward($next_line->get_dir);
	}
	else {
	    $line->set_resolved_dir_backward("N");
	    for (my $p=$pos-1; $p >= 0; $p--) {
		my $l = $lines->[$p];
		last if $l->get_strong_dir ne "N"
		    || $l->get_resolved_dir_backward eq "N";
		$l->set_resolved_dir_backward("N");
	    }
	}
    }
    # The line that was now inserted may influence lines both
    # forward and backwards. If the previous resolved direction is
    # not equal to the current resolved dir, then we must change
    # the direction.
    else {
	# Forward is simple. If the previously resolved dir is equal
	# to the new resolved dir, then this loop breaks.
	my $dir = $line->get_dir;
	for(my $p = $pos+1; $p < @$lines; $p++) {
	    my $l = $lines->[$p];
	    last if $l->get_strong_dir ne "N"
		|| $l->get_resolved_dir_forward eq $dir;

	    $l->set_resolved_dir_forward($dir);
	}

	# Backwards is really the same. Note that we don't determine
	# at this point whether the resolved dir forward or the resolved
	# dir backwards will be used. That will be determined when doing
	# a query for the resolved direction of the line.
	for (my $p = $pos-1; $p >= 0; $p--) {
	    my $l = $lines->[$p];
	    last if $l->get_strong_dir ne "N"
		|| $l->get_resolved_dir_backward eq $dir;

	    $l->set_resolved_dir_backward($dir);
	}
    }
    
}

sub dump {
    my $this = shift;
    my $lines = $this->{lines};
    
    print "Line#  text      SFB=> R  (S=strong, F=forward, B=backward, R=resolved)\n";
    print "======================================================================\n";
    
    foreach my $i (0..(@$lines-1)) {
	my $l = $lines->[$i];
	my $key = $l->get_strong_dir . $l->get_resolved_dir_forward . $l->get_resolved_dir_backward . "=> " . $l->get_dir;
	
	printf "%3d  \"" . $l->get_text . "\"    $key\n", $i;
    }
}

######################################################################
#  The test program insert and deletes several times and makes
#  sure that the buffer remains consistent at all times. The
#  text insert must start with L,R,N to indicate the BiDi dir. The
#  number is a serial number so that it is possible to keep track
#  of lines.
######################################################################
package MAIN;

my $lb = new line_buf("L");
$lb->insert(0, "N -  0");
$lb->insert(-1, "R -  1");
$lb->insert(-1, "L -  2");
$lb->insert(-1, "N -  3");
$lb->insert( 0, "N -  4");
$lb->dump();
print "\n";

$lb->insert( 1, "L -  5");
$lb->insert( 2, "N -  6");
$lb->insert( 4, "N -  7");
$lb->insert( 0, "N -  8");
$lb->insert( 0, "N -  9");
$lb->insert( 0, "R - 10");
$lb->dump();
print "\n";

$lb->delete(0);
print "After deletion.\n";
$lb->dump();
print "\n";

$lb->insert(1, "R - 11");
$lb->delete(8);
$lb->dump();
print "\n";
