libprima-perl 1.28-1.1 / usr / lib / perl5 / Prima / TextView.pm

#
#  Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen
#  All rights reserved.
#
#  Redistribution and use in source and binary forms, with or without
#  modification, are permitted provided that the following conditions
#  are met:
#  1. Redistributions of source code must retain the above copyright
#     notice, this list of conditions and the following disclaimer.
#  2. Redistributions in binary form must reproduce the above copyright
#     notice, this list of conditions and the following disclaimer in the
#     documentation and/or other materials provided with the distribution.
#
#  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
#  ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
#  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
#  ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
#  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
#  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
#  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
#  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
#  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
#  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
#  SUCH DAMAGE.
#
#  Created by:
#     Dmitry Karasik <dk@plab.ku.dk> 
#
#  $Id: TextView.pm,v 1.25 2008/04/09 20:14:27 dk Exp $

use strict;
use Prima;
use Prima::IntUtils;
use Prima::ScrollBar;

package tb;
use vars qw(@oplen);

@oplen = ( 4, 2, 3, 4, 3, 2, 4);   # lengths of tb::OP_XXX constants ( see below ) + 1

# basic opcodes
use constant OP_TEXT               =>  0; # (3) text offset, text length, text width
use constant OP_COLOR              =>  1; # (1) 0xRRGGBB or COLOR_INDEX | palette_index
use constant OP_FONT               =>  2; # (2) op_font_mode, font info
use constant OP_TRANSPOSE          =>  3; # (3) move current point to delta X, delta Y
use constant OP_CODE               =>  4; # (2) code pointer and parameters 

# formatting opcodes
use constant OP_WRAP               =>  5; # (1) on / off
use constant OP_MARK               =>  6; # (3) id, x, y

# OP_TEXT 
use constant T_OFS                => 1;
use constant T_LEN                => 2;
use constant T_WID                => 3;

# OP_FONT
use constant F_MODE                => 1;
use constant F_DATA                => 2;

# OP_COLOR
use constant COLOR_INDEX           => 0x01000000; # index in colormap() array
use constant BACKCOLOR_FLAG        => 0x02000000; # OP_COLOR flag for backColor
use constant BACKCOLOR_DEFAULT     => BACKCOLOR_FLAG|COLOR_INDEX|1;
use constant COLOR_MASK            => 0xFCFFFFFF;

# OP_TRANSPOSE - indices
use constant X_X     => 1;
use constant X_Y     => 2;
use constant X_FLAGS => 3;

# OP_TRANSPOSE - X_FLAGS constants
use constant X_DIMENSION_PIXEL       => 0;
use constant X_TRANSPOSE             => 0;
use constant X_EXTEND                => 1;
# formatting flags
use constant X_DIMENSION_FONT_HEIGHT => 2; # multiply by font height
use constant X_DIMENSION_POINT       => 4; # multiply by resolution / 72

# block header indices
use constant  BLK_FLAGS            => 0;
use constant  BLK_WIDTH            => 1;
use constant  BLK_HEIGHT           => 2;
use constant  BLK_X                => 3;
use constant  BLK_Y                => 4;
use constant  BLK_APERTURE_X       => 5;
use constant  BLK_APERTURE_Y       => 6;
use constant  BLK_TEXT_OFFSET      => 7;
use constant  BLK_DATA_START       => 8;
use constant  BLK_FONT_ID          => BLK_DATA_START; 
use constant  BLK_FONT_SIZE        => 9; 
use constant  BLK_FONT_STYLE       => 10;
use constant  BLK_COLOR            => 11; 
use constant  BLK_DATA_END         => 12;
use constant  BLK_BACKCOLOR        => BLK_DATA_END;
use constant  BLK_START            => BLK_DATA_END + 1;

# OP_FONT again
use constant  F_ID    => BLK_FONT_ID;
use constant  F_SIZE  => BLK_FONT_SIZE;
use constant  F_STYLE => BLK_FONT_STYLE;
use constant  F_HEIGHT=> 1000000; 

# BLK_FLAGS constants
use constant T_SIZE      => 0x1;
use constant T_WRAPABLE  => 0x2;

# realize_state mode

use constant REALIZE_FONTS   => 0x1;
use constant REALIZE_COLORS  => 0x2;
use constant REALIZE_ALL     => 0x3;


use constant YMAX => 1000;

sub block_create
{
	my $ret = [ ( 0 ) x BLK_START ];
	$$ret[ BLK_FLAGS ] |= T_SIZE;
	push @$ret, @_;
	return $ret;
}

sub block_count
{
	my $block = $_[0];
	my $ret = 0;
	my ( $i, $lim) = ( BLK_START, scalar @$block);
	$i += $oplen[$$block[$i]], $ret++ while $i < $lim;
	return $ret;
}

# creates a new opcode for custom use
sub opcode
{
	my $len = $_[0] || 0;
	$len = 0 if $len < 0;
	push @oplen, $len + 1;
	return scalar(@oplen) - 1;
}


sub text           { return OP_TEXT, $_[0], $_[1], $_[2] || 0 }
sub color          { return OP_COLOR, $_[0] } 
sub backColor      { return OP_COLOR, $_[0] | BACKCOLOR_FLAG}
sub colorIndex     { return OP_COLOR, $_[0] | COLOR_INDEX }  
sub backColorIndex { return OP_COLOR, $_[0] | COLOR_INDEX | BACKCOLOR_FLAG}  
sub fontId         { return OP_FONT, F_ID, $_[0] }
sub fontSize       { return OP_FONT, F_SIZE, $_[0] }
sub fontHeight     { return OP_FONT, F_SIZE, $_[0] + F_HEIGHT }
sub fontStyle      { return OP_FONT, F_STYLE, $_[0] }
sub moveto         { return OP_TRANSPOSE, $_[0], $_[1],  $_[2] || 0 } 
sub extend         { return OP_TRANSPOSE, $_[0], $_[1], ($_[2] || 0) | X_EXTEND } 
sub code           { return OP_CODE, $_[0], $_[1] } 
sub wrap           { return OP_WRAP, $_[0] } 
sub mark           { return OP_MARK, $_[0], 0, 0 } 

package Prima::TextView::EventContent;

sub on_mousedown {}
sub on_mousemove {}
sub on_mouseup   {}

package Prima::TextView;
use vars qw(@ISA);
@ISA = qw(Prima::Widget Prima::MouseScroller Prima::GroupScroller);

sub profile_default
{
	my $def = $_[ 0]-> SUPER::profile_default;
	my %prf = (
		autoHScroll       => 1,
		autoVScroll       => 0,
		borderWidth     => 2,
		colorMap        => [ $def-> {color}, $def-> {backColor} ],
		fontPalette     => [ { 
			name     => $def-> {font}-> {name},
			encoding => '',
			pitch    => fp::Default,
		}],
		hScroll         => 1,
		offset          => 0,
		paneWidth       => 0,
		paneHeight      => 0,
		paneSize        => [0,0],
		resolution      => [ $::application-> resolution ],
		topLine         => 0,
		scaleChildren   => 0,
		selectable      => 1,
		textOutBaseline => 1,
		textRef         => '',
		vScroll         => 1,
		widgetClass     => wc::Edit,
		pointer         => cr::Text,
	);
	@$def{keys %prf} = values %prf;
	return $def;
}

sub profile_check_in
{
	my ( $self, $p, $default) = @_;
	$self-> SUPER::profile_check_in( $p, $default);
	if ( exists( $p-> { paneSize})) {
		$p-> { paneWidth}  = $p-> { paneSize}-> [ 0];
		$p-> { paneHeight} = $p-> { paneSize}-> [ 1];
	}
	$p-> { text} = '' if exists( $p-> { textRef});
	$p-> {autoHScroll} = 0 if exists $p-> {hScroll};
	$p-> {autoVScroll} = 0 if exists $p-> {vScroll};
}   

sub init
{
	my $self = shift;
	for ( qw( topLine scrollTransaction hScroll vScroll offset 
		paneWidth paneHeight borderWidth autoVScroll autoHScroll))
		{ $self-> {$_} = 0; }
	my %profile = $self-> SUPER::init(@_);
	$self-> {paneSize} = [0,0];
	$self-> {colorMap} = [];
	$self-> {fontPalette} = [];
	$self-> {blocks} = [];
	$self-> {resolution} = [];
	$self-> {defaultFontSize} = $self-> font-> size;
	$self-> {selection}   = [ -1, -1, -1, -1];
	$self-> {selectionPaintMode} = 0;
	$self-> {ymap} = [];
	$self-> setup_indents;
	$self-> resolution( @{$profile{resolution}});
	for ( qw( autoHScroll autoVScroll colorMap fontPalette 
				hScroll vScroll borderWidth paneWidth paneHeight 
				offset topLine textRef))
		{ $self-> $_( $profile{ $_}); }
	return %profile;
}

sub reset_scrolls
{
	my $self = shift;
	my @sz = $self-> get_active_area( 2, @_);
	if ( $self-> {scrollTransaction} != 1) {
		if ( $self-> {autoVScroll}) {
			my $vs = ($self-> {paneHeight} > $sz[1]) ? 1 : 0;
			if ( $vs != $self-> {vScroll}) {
				$self-> vScroll( $vs);
				@sz = $self-> get_active_area( 2, @_);
			}
		}
		$self-> {vScrollBar}-> set(
			max      => $self-> {paneHeight} - $sz[1],
			pageStep => int($sz[1] * 0.9),
			step     => $self-> font-> height,
			whole    => $self-> {paneHeight},
			partial  => $sz[1],
			value    => $self-> {topLine},
		) if $self-> {vScroll};
	}
	if ( $self-> {scrollTransaction} != 2) {
		if ( $self-> {autoHScroll}) {
			my $hs = ($self-> {paneWidth} > $sz[0]) ? 1 : 0;
			if ( $hs != $self-> {hScroll}) {
				$self-> hScroll( $hs); 
				@sz = $self-> get_active_area( 2, @_);
			}
		}
		$self-> {hScrollBar}-> set(
			max      => $self-> {paneWidth} - $sz[0],
			whole    => $self-> {paneWidth},
			value    => $self-> {offset},
			partial  => $sz[0],
			pageStep => int($sz[0] * 0.75),
		) if $self-> {hScroll};
	}
}

sub on_size
{
	my ( $self, $oldx, $oldy, $x, $y) = @_;
	$self-> reset_scrolls( $x, $y);
}

sub on_fontchanged
{
	my $f = $_[0]-> font;
	$_[0]-> {defaultFontSize}           = $f-> size;
	$_[0]-> {fontPalette}-> [0]-> {name} = $f-> name;
}

sub set
{
	my ( $self, %set) = @_;
	if ( exists $set{paneSize}) {
		$self-> paneSize( @{$set{paneSize}});
		delete $set{paneSize};
	}
	$self-> SUPER::set( %set);
}

sub text
{
	unless ($#_) {
		my $hugeScalarRef = $_[0]-> textRef;
		return $$hugeScalarRef;
	} else {
		my $s = $_[1];
		$_[0]-> textRef( \$s);
	}
}

sub textRef 
{
	return $_[0]-> {text} unless $#_;
	$_[0]-> {text} = $_[1] if $_[1];
}

sub paneWidth
{
	return $_[0]-> {paneWidth} unless $#_;
	my ( $self, $pw) = @_;
	$pw = 0 if $pw < 0;
	return if $pw == $self-> {paneWidth};
	$self-> {paneWidth} = $pw;
	$self-> reset_scrolls;
	$self-> repaint;
}

sub paneHeight
{
	return $_[0]-> {paneHeight} unless $#_;
	my ( $self, $ph) = @_;
	$ph = 0 if $ph < 0;
	return if $ph == $self-> {paneHeight};
	$self-> {paneHeight} = $ph;
	$self-> reset_scrolls;
	$self-> repaint;
}

sub paneSize
{
	return $_[0]-> {paneWidth}, $_[0]-> {paneHeight} if $#_ < 2;
	my ( $self, $pw, $ph) = @_;
	$ph = 0 if $ph < 0;
	$pw = 0 if $pw < 0;
	return if $ph == $self-> {paneHeight} && $pw == $self-> {paneWidth};
	$self-> {paneWidth}  = $pw;
	$self-> {paneHeight} = $ph;
	$self-> reset_scrolls;
	$self-> repaint;
}

sub offset
{
	return $_[0]-> {offset} unless $#_;
	my ( $self, $offset) = @_;
	$offset = int($offset);
	my @sz = $self-> size;
	my @aa = $self-> get_active_area(2, @sz);
	my $pw = $self-> {paneWidth};
	$offset = $pw - $aa[0] if $offset > $pw - $aa[0];
	$offset = 0 if $offset < 0;
	return if $self-> {offset} == $offset;
	my $dt = $offset - $self-> {offset};
	$self-> {offset} = $offset;
	if ( $self-> {hScroll} && $self-> {scrollTransaction} != 2) {
		$self-> {scrollTransaction} = 2;
		$self-> {hScrollBar}-> value( $offset);
		$self-> {scrollTransaction} = 0;
	}
	$self-> scroll( -$dt, 0, clipRect => [ $self-> get_active_area(0, @sz)]);
}

sub resolution
{
	return @{$_[0]->{resolution}} unless $#_;
	my ( $self, $x, $y) = @_;
	die "Invalid resolution\n" if $x <= 0 or $y <= 0;
	@{$self-> {resolution}} = ( $x, $y);
}

sub topLine
{
	return $_[0]-> {topLine} unless $#_;
	my ( $self, $top) = @_;
	$top = int($top);
	my @sz = $self-> size;
	my @aa = $self-> get_active_area(2, @sz);
	my $ph = $self-> {paneHeight};
	$top = $ph - $aa[1] if $top > $ph - $aa[1];
	$top = 0 if $top < 0;
	return if $self-> {topLine} == $top;
	my $dt = $top - $self-> {topLine};
	$self-> {topLine} = $top;
	if ( $self-> {vScroll} && $self-> {scrollTransaction} != 1) {
		$self-> {scrollTransaction} = 1;
		$self-> {vScrollBar}-> value( $top);
		$self-> {scrollTransaction} = 0;
	}
	$self-> scroll( 0, $dt, clipRect => [ $self-> get_active_area(0, @sz)]);
}

sub VScroll_Change
{
	my ( $self, $scr) = @_;
	return if $self-> {scrollTransaction};
	$self-> {scrollTransaction} = 1;
	$self-> topLine( $scr-> value);
	$self-> {scrollTransaction} = 0;
}

sub HScroll_Change
{
	my ( $self, $scr) = @_;
	return if $self-> {scrollTransaction};
	$self-> {scrollTransaction} = 2;
	$self-> offset( $scr-> value);
	$self-> {scrollTransaction} = 0;
}

sub colorMap
{
	return [ @{$_[0]-> {colorMap}}] unless $#_;
	my ( $self, $cm) = @_;
	$self-> {colorMap} = [@$cm];
	$self-> {colorMap}-> [1] = $self-> backColor if scalar @$cm < 2;
	$self-> {colorMap}-> [0] = $self-> color if scalar @$cm < 1;
	$self-> repaint;
}

sub fontPalette
{
	return [ @{$_[0]-> {fontPalette}}] unless $#_;
	my ( $self, $fm) = @_;
	$self-> {fontPalette} = [@$fm];
	$self-> {fontPalette}-> [0] = {
		name     => $self-> font-> name,
		encoding => '',
		pitch    => fp::Default,
	} if scalar @$fm < 1;
	$self-> repaint;
}

sub create_state
{
	my $self = $_[0];
	my $g = tb::block_create();
	$$g[ tb::BLK_FONT_SIZE] = $self-> {defaultFontSize};
	$$g[ tb::BLK_COLOR]     = tb::COLOR_INDEX;
	$$g[ tb::BLK_BACKCOLOR] = tb::BACKCOLOR_DEFAULT;
	return $g;
}

sub realize_state
{
	my ( $self, $canvas, $state, $mode) = @_;

	if ( $mode & tb::REALIZE_FONTS) {
		my %f = %{$self-> {fontPalette}-> [ $$state[ tb::BLK_FONT_ID]]};
		if ( $$state[ tb::BLK_FONT_SIZE] > tb::F_HEIGHT) {
			$f{height} = $$state[ tb::BLK_FONT_SIZE] - tb::F_HEIGHT;
		} else {
			$f{size} = $$state[ tb::BLK_FONT_SIZE];
		}
		$f{style} = $$state[ tb::BLK_FONT_STYLE];
		$canvas-> set_font( \%f);
	}

	return unless $mode & tb::REALIZE_COLORS;
	if ( $self-> {selectionPaintMode}) {
		$self-> selection_state( $canvas);
	} else {
		$canvas-> set(
			color     =>  (( $$state[ tb::BLK_COLOR] & tb::COLOR_INDEX) ? 
				( $self-> {colorMap}-> [$$state[ tb::BLK_COLOR] & tb::COLOR_MASK]) :
				( $$state[ tb::BLK_COLOR] & tb::COLOR_MASK)),
			backColor =>  (( $$state[ tb::BLK_BACKCOLOR] & tb::COLOR_INDEX) ? 
				( $self-> {colorMap}-> [$$state[ tb::BLK_BACKCOLOR] & tb::COLOR_MASK]) : 
				( $$state[ tb::BLK_BACKCOLOR] & tb::COLOR_MASK)),
			textOpaque => (( $$state[ tb::BLK_BACKCOLOR] == tb::BACKCOLOR_DEFAULT) ? 0 : 1),
		);
	}
}


sub recalc_ymap
{
	my ( $self, $from) = @_;
	$self-> {ymap} = [] unless $from; # ok if $from == 0
	my $ymap = $self-> {ymap};
	my ( $i, $lim) = ( defined($from) ? $from : 0, scalar(@{$self-> {blocks}}));
	my $b = $self-> {blocks};
	for ( ; $i < $lim; $i++) {
		$_ = $$b[$i];
		my $y1 = $$_[ tb::BLK_Y];
		my $y2 = $$_[ tb::BLK_HEIGHT] + $y1;
		for ( int( $y1 / tb::YMAX) .. int ( $y2 / tb::YMAX)) {
			push @{$ymap-> [$_]}, $i; 
		}
	}
}

sub block_wrap
{
	my ( $self, $canvas, $b, $state, $width) = @_;
	$width = 0 if $width < 0;
	my ( $i, $lim) = ( tb::BLK_START, scalar @$b);

	my $cmd;
	my ( $o, $t) = ( $$b[ tb::BLK_TEXT_OFFSET], $self-> {text});
	my ( $x, $y) = (0, 0);
	my $f_taint;
	my $wrapmode = 1;
	my $stsave = $state;
	$state = [ @$state ];
	my ( $haswrapinfo, @wrapret);
	my ( @ret, $z);
	my $lastTextOffset = $$b[ tb::BLK_TEXT_OFFSET];
	my $has_text;

	my $newblock = sub 
	{
		push @ret, $z = tb::block_create();
		@$z[ tb::BLK_DATA_START .. tb::BLK_DATA_END ] = 
			@$state[ tb::BLK_DATA_START .. tb::BLK_DATA_END];
		$$z[ tb::BLK_X] = $$b[ tb::BLK_X];
		$$z[ tb::BLK_FLAGS] &= ~ tb::T_SIZE;
		$$z[ tb::BLK_TEXT_OFFSET] = $$b [ tb::BLK_TEXT_OFFSET];
		$x = 0;
		undef $has_text;
	};

	my $retrace = sub 
	{
		$haswrapinfo = 0;
		splice( @{$ret[-1]}, $wrapret[0]); 
		@$state = @{$wrapret[1]};
		$newblock-> ();
		$i = $wrapret[2];
	};

	$newblock-> ();
	$$z[tb::BLK_TEXT_OFFSET] = $$b[tb::BLK_TEXT_OFFSET];

	my %state_hash;

# print "start - $$b[tb::BLK_TEXT_OFFSET] \n";

	# first state - wrap the block
# print "new wrap for $width\n";
	for ( ; $i < $lim; $i += $tb::oplen[ $$b[ $i]]) {
		$cmd = $$b[$i];
		if ( $cmd == tb::OP_TEXT) {
# print "OP_TEXT @$b[$i+1..$i+3], x = $x\n";
			unless ( $f_taint) {
				$self-> realize_state( $canvas, $state, tb::REALIZE_FONTS);
				$f_taint = $canvas-> get_font;
				my $state_key = join('.', 
					@$state[tb::BLK_FONT_ID .. tb::BLK_FONT_STYLE]
				);
				$state_hash{$state_key} = $f_taint 
					unless $state_hash{$state_key};
			}
			my $ofs  = $$b[ $i + 1];
			my $tlen = $$b[ $i + 2];
			$lastTextOffset = $ofs + $tlen unless $wrapmode;
		REWRAP: 
			my $tw = $canvas-> get_text_width( substr( $$t, $o + $ofs, $tlen), 1);
			my $apx = $f_taint-> {width};
# print "$x+$apx: new text $tw :|",substr( $$t, $o + $ofs, $tlen),"|\n";
			if ( $x + $tw + $apx <= $width) {
				push @$z, tb::OP_TEXT, $ofs, $tlen, $tw;
				$x += $tw;
				$has_text = 1;
# print "copied as is, advanced to $x, width $tw, $ofs\n";
			} elsif ( $wrapmode) {
				next if $tlen <= 0;
				my $str = substr( $$t, $o + $ofs, $tlen);
				my $leadingSpaces = '';
				if ( $str =~ /^(\s+)/) {
					$leadingSpaces = $1;
					$str =~ s/^\s+//;
				}
				my $l = $canvas-> text_wrap( $str, $width - $apx - $x,
					tw::ReturnFirstLineLength | tw::WordBreak | tw::BreakSingle);
# print "repo $l bytes wrapped in $width - $apx - $x\n";
				if ( $l > 0) {
					if ( $has_text) {
						push @$z, tb::OP_TEXT, 
							$ofs, $l + length $leadingSpaces, 
							$tw = $canvas-> get_text_width( 
								$leadingSpaces . substr( $str, 0, $l), 1
							);
					} else {
						push @$z, tb::OP_TEXT, 
							$ofs + length $leadingSpaces, $l, 
							$tw = $canvas-> get_text_width( 
								substr( $str, 0, $l), 1
							);
						$has_text = 1;
					}
# print "$x + advance $$z[-1]/$tw|", $leadingSpaces , "+", substr( $str, 0, $l), "|\n";
					$str = substr( $str, $l);
					$l += length $leadingSpaces;
					$newblock-> ();
					$ofs += $l;
					$tlen -= $l;
# print "tx shift $l, str=|$str|, x=$x\n";
					if ( $str =~ /^(\s+)/) {
						$ofs  += length $1;
						$tlen -= length $1;
						$x    += $canvas-> get_text_width( $1, 1);
						$str =~ s/^\s+//;
					}
					goto REWRAP if length $str;
				} else { # does not fit into $width
# print "new block: x = $x |$str|\n";
					my $ox = $x;
					$newblock-> ();
					$ofs  += length $leadingSpaces;
					$tlen -= length $leadingSpaces; 
					if ( length $str) { 
					# well, it cannot be fit into width,
					# but may be some words can be stripped?
						goto REWRAP if $ox > 0;
						if ( $str =~ m/^(\S+)(\s*)/) {
							$tw = $canvas-> get_text_width( $1, 1);
							push @$z, tb::OP_TEXT, $ofs, length $1, $tw;
							$has_text = 1;
							$x += $tw;
							$ofs  += length($1) + length($2);
							$tlen -= length($1) + length($2);
							goto REWRAP;
						}
					}
					push @$z, tb::OP_TEXT, $ofs, length($str), $x += $canvas-> get_text_width( $str, 1);
					$has_text = 1;
				}
			} elsif ( $haswrapinfo) { # unwrappable, and cannot be fit - retrace
				$retrace-> ();
# print "retrace\n";
				next;
			} else { # unwrappable, cannot be fit, no wrap info! - whole new block
# print "new empty block - |", substr( $$t,$o + $ofs, $tlen), "|\n";
				push @$z, tb::OP_TEXT, $ofs, $tlen, $tw;
				$newblock-> ();
			}
		} elsif ( $cmd == tb::OP_WRAP) {
			if ( $wrapmode == 1 && $$b[ $i + 1] == 0) {
				@wrapret = ( scalar @$z, [ @$state ], $i);
				$haswrapinfo = 1;
# print "wrap start record x = $x\n";
			}
			$wrapmode = $$b[ $i + 1];
# print "wrap: $wrapmode\n";
		} elsif ( $cmd == tb::OP_FONT) {
			if ( $$b[$i + 1] == tb::F_SIZE && $$b[$i + 2] < tb::F_HEIGHT ) {
				$$state[ $$b[$i + 1]] = $self-> {defaultFontSize} + $$b[$i + 2];
			} else {
				$$state[ $$b[$i + 1]] = $$b[$i + 2];
			}
			$f_taint = undef;
			push @$z, @$b[ $i .. ( $i + $tb::oplen[ $cmd] - 1)];
		} elsif ( $cmd == tb::OP_COLOR) {
			$$state[ tb::BLK_COLOR + (($$b[ $i + 1] & tb::BACKCOLOR_FLAG) ? 1 : 0)] = 
				$$b[$i + 1];
			push @$z, @$b[ $i .. ( $i + $tb::oplen[ $cmd] - 1)];
		} elsif ( $cmd == tb::OP_TRANSPOSE) {
			my @r = @$b[ $i .. $i + 3];
			if ( $$b[ $i + tb::X_FLAGS] & tb::X_DIMENSION_FONT_HEIGHT) {
				unless ( $f_taint) {
					$self-> realize_state( $canvas, $state, tb::REALIZE_FONTS); 
					$f_taint = $canvas-> get_font;
					my $state_key = join('.', 
						@$state[tb::BLK_FONT_ID .. tb::BLK_FONT_STYLE]
					);
					$state_hash{$state_key} = $f_taint 
						unless $state_hash{$state_key};
				}
				$r[ tb::X_X] *= $f_taint-> {height};
				$r[ tb::X_Y] *= $f_taint-> {height};
				$r[ tb::X_FLAGS] &= ~ tb::X_DIMENSION_FONT_HEIGHT;
			}
			if ( $$b[ $i + tb::X_FLAGS] & tb::X_DIMENSION_POINT) {
				$r[ tb::X_X] *= $self-> {resolution}-> [0] / 72;
				$r[ tb::X_Y] *= $self-> {resolution}-> [1] / 72;
				$r[ tb::X_FLAGS] &= ~tb::X_DIMENSION_POINT;
			}
# print "advance block $x $r[tb::X_X]\n";
			if ( $x + $r[tb::X_X] >= $width) {
				if ( $wrapmode) {
					$newblock-> (); 
				} elsif ( $haswrapinfo) {
					$retrace-> ();
					next;
				} 
			} else {
				$x += $r[ tb::X_X];
			}
			push @$z, @r;
		} else {
			push @$z, @$b[ $i .. ( $i + $tb::oplen[ $cmd] - 1)];
		}
	}

	# remove eventual empty trailing blocks
	pop @ret while scalar ( @ret) && ( tb::BLK_START == scalar @{$ret[-1]});

	# second stage - position the blocks
	$state = $stsave;
	$f_taint = undef;
	my $start;
	if ( !defined $$b[ tb::BLK_Y]) { 
		# auto position the block if the creator didn't care
		$start = $$state[ tb::BLK_Y] + $$state[ tb::BLK_HEIGHT];
	} else {
		$start = $$b[ tb::BLK_Y];
	}

	$lastTextOffset = $$b[ tb::BLK_TEXT_OFFSET];
	my $lastBlockOffset = $lastTextOffset;

	for ( @ret) {
		$b = $_;
		$$b[ tb::BLK_Y] = $start;

		( $x, $y, $i, $lim) = ( 0, 0, tb::BLK_START, scalar @$b);
		for ( ; $i < $lim; $i += $tb::oplen[ $$b[ $i]]) {
			$cmd = $$b[$i];
			if ( $cmd == tb::OP_TEXT) {
				$f_taint = $state_hash{ join('.', 
					@$state[tb::BLK_FONT_ID .. tb::BLK_FONT_STYLE]
				) };
				$x += $$b[ $i + 3];
				$$b[ tb::BLK_WIDTH] = $x 
					if $$b[ tb::BLK_WIDTH ] < $x;
				$$b[ tb::BLK_APERTURE_Y] = $f_taint-> {descent} - $y 
					if $$b[ tb::BLK_APERTURE_Y] < $f_taint-> {descent} - $y;
				$$b[ tb::BLK_APERTURE_X] = $f_taint-> {width}   - $x 
					if $$b[ tb::BLK_APERTURE_X] < $f_taint-> {width}   - $x;
				my $newY = $y + $f_taint-> {ascent} + $f_taint-> {externalLeading};
				$$b[ tb::BLK_HEIGHT] = $newY if $$b[ tb::BLK_HEIGHT] < $newY; 
#            print "OP_TEXT patch $$b[$i+1] => ";
				$lastTextOffset = 
					$$b[ tb::BLK_TEXT_OFFSET] + 
					$$b[ $i + 1] + 
					$$b[ $i + 2];
				$$b[ $i + 1] -= $lastBlockOffset - $$b[ tb::BLK_TEXT_OFFSET];
#            print "$$b[$i+1]\n";
			} elsif ( $cmd == tb::OP_FONT) {
				if ( $$b[$i + 1] == tb::F_SIZE && $$b[$i + 2] < tb::F_HEIGHT ) {
					$$state[ $$b[$i + 1]] = $self-> {defaultFontSize} + $$b[$i + 2];
				} else {
					$$state[ $$b[$i + 1]] = $$b[$i + 2];
				}
			} elsif ( $cmd == tb::OP_TRANSPOSE) {
				my ( $newX, $newY) = ( $x + $$b[ $i + tb::X_X], $y + $$b[ $i + tb::X_Y]);
				$$b[ tb::BLK_WIDTH]  = $newX 
					if $$b[ tb::BLK_WIDTH ] < $newX;
				$$b[ tb::BLK_HEIGHT] = $newY 
					if $$b[ tb::BLK_HEIGHT] < $newY;
				$$b[ tb::BLK_APERTURE_X] = -$newX 
					if $newX < 0 && $$b[ tb::BLK_APERTURE_X] > -$newX;
				$$b[ tb::BLK_APERTURE_Y] = -$newY 
					if $newY < 0 && $$b[ tb::BLK_APERTURE_Y] > -$newY;
				unless ( $$b[ $i + tb::X_FLAGS] & tb::X_EXTEND) {
					( $x, $y) = ( $newX, $newY);
				}
			} elsif ( $cmd == tb::OP_MARK) {
				$$b[ $i + 2] = $x;
				$$b[ $i + 3] = $y;
			}
		}
		$$b[ tb::BLK_TEXT_OFFSET] = $lastBlockOffset;
#      print "block offset: $lastBlockOffset\n";
		$$b[ tb::BLK_HEIGHT] += $$b[ tb::BLK_APERTURE_Y];
		$$b[ tb::BLK_WIDTH]  += $$b[ tb::BLK_APERTURE_X];
		$start += $$b[ tb::BLK_HEIGHT];
		$lastBlockOffset = $lastTextOffset;
	}

	if ( $ret[-1]) {
		$b = $ret[-1];
		$$state[$_] = $$b[$_] for tb::BLK_X, tb::BLK_Y, tb::BLK_HEIGHT, tb::BLK_WIDTH;
	}

	return @ret;
}

sub selection_state
{
	my ( $self, $canvas) = @_;
	$canvas-> color( $self-> hiliteColor);
	$canvas-> backColor( $self-> hiliteBackColor);
	$canvas-> textOpaque(0);
}

sub on_paint
{
	my ( $self, $canvas) = @_;
	my @size = $canvas-> size;
	unless ( $self-> enabled) {
		$self-> color( $self-> disabledColor);
		$self-> backColor( $self-> disabledBackColor);
	}
	my ( $t, $offset, @aa) = (
	$self-> { topLine}, $self-> { offset},
	$self-> get_active_area(1,@size));

	my @clipRect = $canvas-> clipRect;
	$self-> draw_border( $canvas, $self-> backColor, @size);

	my $bx = $self-> {blocks};
	my $lim = scalar @$bx;
	return unless $lim;

	my @cy = ( $aa[3] - $clipRect[3], $aa[3] - $clipRect[1]);
	$cy[0] = 0 if $cy[0] < 0;
	$cy[1] = $aa[3] - $aa[1] if $cy[1] > $aa[3] - $aa[1];
	$cy[$_] += $t for 0,1;

	$self-> clipRect( $self-> get_active_area( 1, @size));
	@clipRect = $self-> clipRect; 
	my $i = 0;
	my $b;

	my ( $sx1, $sy1, $sx2, $sy2) = @{$self-> {selection}};

	for ( int( $cy[0] / tb::YMAX) .. int( $cy[1] / tb::YMAX)) {
		next unless $self-> {ymap}-> [$_];
		for ( @{$self-> {ymap}-> [$_]}) {
			my $j = $_;
			$b = $$bx[$j];
			my ( $x, $y) = ( 
				$aa[0] - $offset + $$b[ tb::BLK_X], 
				$aa[3] + $t - $$b[ tb::BLK_Y] - $$b[ tb::BLK_HEIGHT] 
			);
			next if 
				$x + $$b[ tb::BLK_WIDTH]  < $clipRect[0] || $x > $clipRect[2] ||
				$y + $$b[ tb::BLK_HEIGHT] < $clipRect[1] || $y > $clipRect[3] ||
				$$b[ tb::BLK_WIDTH] == 0 || $$b[ tb::BLK_HEIGHT] == 0;
					

			if ( $j == $sy1 || $j == $sy2) { # complex selection case
				my @cr = @clipRect;
				my $x1 = $x + $self-> text2xoffset(( $j == $sy1) ? $sx1 : $sx2, $j);
				my $eq = ( $j == $sy1 ) && ( $j == $sy2 );
				$self-> {selectionPaintMode} = ( $eq || $j == $sy1 ) ? 0 : 1;
				if ( $cr[0] <= $x1 ) { # left upper part
				$cr[2] = $x1 - 1 if $cr[2] > $x1 - 1;
				$cr[2] = $aa[2] if $cr[2] > $aa[2];
				$cr[2] = $aa[0] if $cr[2] < $aa[0];
				if ( $cr[0] <= $cr[2]) {
					$self-> selection_state( $canvas) 
						if $self-> {selectionPaintMode}; 
					$self-> clipRect( @cr);
					$self-> block_draw( $canvas, $b, $x, $y);
				}
					@cr = @clipRect;
				}
				$self-> {selectionPaintMode} = (( $eq || $j == $sy1 ) ? 1 : 0); 
				if ( $cr[2] >= $x1) { # right part
					$cr[0] = $x1 if $cr[0] < $x1;
					$cr[0] = $aa[0] if $cr[0] < $aa[0];
					$cr[0] = $aa[2] if $cr[0] > $aa[2];
					my $x2 = $x + $self-> text2xoffset( $sx2, $j);
					if ( $eq) { # selection is one block - center part
						if ( $cr[0] <= $x2) {
							my $cr2 = $cr[2];
							$cr[2] = $x2 - 1 if $cr[2] > $x2 - 1;
							$cr[2] = $aa[0] if $cr[2] < $aa[0];
							$cr[2] = $aa[2] if $cr[2] > $aa[2];
							if ( $cr[0] <= $cr[2]) {
								$self-> selection_state( $canvas) 
									if $self-> {selectionPaintMode}; 
								$self-> clipRect( @cr);
								$self-> block_draw( $canvas, $b, $x, $y);
							}
							@cr = @clipRect;
						}
						$cr[0] = $x2 if $cr[0] < $x2;
						$cr[0] = $aa[0] if $cr[0] < $aa[0];
						$cr[0] = $aa[2] if $cr[0] > $aa[2];
					}
					$self-> {selectionPaintMode} = ( $eq || $j == $sy2 ) ? 0 : 1;
					if ( $cr[0] <= $cr[2]) {
						$self-> selection_state( $canvas) if $self-> {selectionPaintMode}; 
						$self-> clipRect( @cr);
						$self-> block_draw( $canvas, $b, $x, $y);
					}
				}
				$self-> {selectionPaintMode} = 0;
				$self-> clipRect( @clipRect);
			} elsif ( $j > $sy1 && $j < $sy2) { # simple selection case
				$self-> {selectionPaintMode} = 1;
				$self-> selection_state( $canvas);
				$self-> block_draw( $canvas, $b, $x, $y);
				$self-> {selectionPaintMode} = 0;
			} else {
				$self-> block_draw( $canvas, $b, $x, $y);
			}
		}
	}

	$self-> {selectionPaintMode} = 0;
}


sub block_draw
{
	my ( $self, $canvas, $b, $x, $y) = @_;
	my ( $i, $lim) = ( tb::BLK_START, scalar @$b);
	my $ret = 1;

	my $cmd;
	my ( $t, $o) = ( $self-> {text}, $$b[ tb::BLK_TEXT_OFFSET]);
	my @state = @$b[ 0 .. tb::BLK_DATA_END ];
	my ( $f_taint, $c_taint); 

	$canvas-> clear( $x, $y, $x + $$b[ tb::BLK_WIDTH] - 1, $y + $$b[ tb::BLK_HEIGHT] - 1)
	if $self-> {selectionPaintMode};

	$x += $$b[ tb::BLK_APERTURE_X];
	$y += $$b[ tb::BLK_APERTURE_Y];

	for ( ; $i < $lim; $i += $tb::oplen[ $$b[ $i]] ) {
		$cmd = $$b[$i];
		if ( $cmd == tb::OP_TEXT) {
			if ( $$b[$i + 2] > 0) {
				unless ( $f_taint) {
					$self-> realize_state( $canvas, \@state, tb::REALIZE_FONTS); 
					$f_taint = $canvas-> get_font;
				}
				unless ( $c_taint) {
					$self-> realize_state( $canvas, \@state, tb::REALIZE_COLORS); 
					$c_taint = 1;
				}
				$ret = $canvas-> text_out( substr( $$t, $o + $$b[$i + 1], $$b[$i + 2]), $x, $y);
			}
			$x += $$b[ $i + 3];
		} elsif ( $cmd == tb::OP_FONT) {
			if ( $$b[$i + 1] == tb::F_SIZE && $$b[$i + 2] < tb::F_HEIGHT ) {
				$state[ $$b[$i + 1]] = $self-> {defaultFontSize} + $$b[$i + 2];
			} else {
				$state[ $$b[$i + 1]] = $$b[$i + 2];
			}
			$f_taint = undef;
		} elsif (( $cmd == tb::OP_TRANSPOSE) && !($$b[ $i + tb::X_FLAGS] & tb::X_EXTEND)) {
			$x += $$b[ $i + tb::X_X];
			$y += $$b[ $i + tb::X_Y];
		} elsif ( $cmd == tb::OP_CODE) {
			unless ( $f_taint) {
				$self-> realize_state( $canvas, \@state, tb::REALIZE_FONTS); 
				$f_taint = $canvas-> get_font;
			}
			unless ( $c_taint) {
				$self-> realize_state( $canvas, \@state, tb::REALIZE_COLORS); 
				$c_taint = 1;
			}
			$$b[ $i + 1]-> ( $self, $canvas, $b, \@state, $x, $y, $$b[ $i + 2]);
		} elsif ( $cmd == tb::OP_COLOR) {
			$state[ tb::BLK_COLOR + (($$b[ $i + 1] & tb::BACKCOLOR_FLAG) ? 1 : 0)] 
				= $$b[$i + 1];
			$c_taint = undef;
		}
	}

	return $ret;
}

sub xy2info
{
	my ( $self, $x, $y) = @_;

	my $bx = $self-> {blocks};
	my ( $pw, $ph) = $self-> paneSize;
	$x = 0 if $x < 0;
	$x = $pw if $x > $pw;
	return (0,0) if $y < 0 || !scalar(@$bx) ;
	$x = $pw, $y = $ph if $y > $ph;
	
	my ( $b, $bid);

	my $xhint = 0;

	# find if there's a block that has $y in its inferior
	my $ymapix = int( $y / tb::YMAX);
	if ( $self-> {ymap}-> [ $ymapix]) {
		my ( $minxdist, $bdist, $bdistid) = ( $self-> {paneWidth} * 2, undef, undef);
		for ( @{$self-> {ymap}-> [ $ymapix]}) {
			my $z = $$bx[$_];
			if ( $y >= $$z[ tb::BLK_Y] && $y < $$z[ tb::BLK_Y] + $$z[ tb::BLK_HEIGHT]) {
				if ( 
					$x >= $$z[ tb::BLK_X] && 
					$x < $$z[ tb::BLK_X] + $$z[ tb::BLK_WIDTH]
				) {
					$b = $z;
					$bid = $_;
					last;
				} elsif ( 
					abs($$z[ tb::BLK_X] - $x) < $minxdist || 
					abs($$z[ tb::BLK_X] + $$z[ tb::BLK_WIDTH] - $x) < $minxdist
				) {
					$minxdist = ( abs( $$z[ tb::BLK_X] - $x) < $minxdist) ? 
						abs( $$z[ tb::BLK_X] - $x) :
						abs( $$z[ tb::BLK_X] + $$z[ tb::BLK_WIDTH] - $x);
					$bdist = $z;
					$bdistid = $_;
				}
			}
		}
		if ( !$b && $bdist) {
			$b   = $bdist;
			$bid = $bdistid;
			$xhint = (( $$b[ tb::BLK_X] > $x) ? -1 : 1);
		}
	}

	# if still no block found, find the closest block down 
	unless ( $b) {
		my $minydist = $self-> {paneHeight} * 2;
		my $ymax = scalar @{$self-> {ymap}};
		while ( $ymapix < $ymax) {
			if ( $self-> {ymap}-> [ $ymapix]) {
				for ( @{$self-> {ymap}-> [ $ymapix]}) {
					my $z = $$bx[$_];
					if ( 
						$minydist > $$z[ tb::BLK_Y] - $y && 
						$$z[ tb::BLK_Y] >= $y
					) {
						$minydist = $$z[ tb::BLK_Y] - $y;
						$b = $z;
						$bid = $_;
					}
				}
			}
			last if $b;
			$ymapix++;
		}
		$ymapix = int( $y / tb::YMAX);
		$xhint = -1;
	}

	# if still no block found, assume EOT
	unless ( $b) {
		$b = $$bx[-1];
		$bid = scalar @{$bx} - 1;
		$xhint = 1;
	}

	if ( $xhint < 0) { # start of line
		return ( 0, $bid);
	} elsif ( $xhint > 0) { # end of line
		if ( $bid < ( scalar @{$bx} - 1)) {
			return ( 
				$$bx[ $bid + 1]-> [ tb::BLK_TEXT_OFFSET] - $$b[ tb::BLK_TEXT_OFFSET], 
				$bid
			);
		} else {
			return ( length( ${$self-> {text}}) - $$b[ tb::BLK_TEXT_OFFSET], $bid);
		}
	}

	# find text offset
	my $bofs = $$b[ tb::BLK_TEXT_OFFSET];
	my ( $ofs, $unofs) = (0,0);
	my $pm = $self-> get_paint_state;
	$self-> begin_paint_info unless $pm;
	my $savefont  = $self-> get_font;
	my @state = @$b[ 0 .. tb::BLK_DATA_END ];
	my $f_taint;

	my ( $i, $lim) = ( tb::BLK_START, scalar @$b);
	my $px = $$b[ tb::BLK_X];
	for ( ; $i < $lim; $i += $tb::oplen[ $$b[ $i]] ) {
		my $cmd = $$b[$i];
		if ( $cmd == tb::OP_TEXT) {
			my $npx = $px + $$b[$i+3];
			if ( $px > $x) {
				$ofs = $$b[ $i + 1]; 
				undef $unofs;
				last;
			} elsif ( $px <= $x && $npx > $x) {
				unless ( $f_taint) {
					$self-> realize_state( $self, \@state, tb::REALIZE_FONTS); 
					$f_taint = $self-> get_font;
				}
				$ofs = $$b[ $i + 1] + $self-> text_wrap( 
					substr( 
						${$self-> {text}}, $bofs + $$b[ $i + 1], $$b[ $i + 2]
					),
					$x - $px, 
					tw::ReturnFirstLineLength | tw::BreakSingle
				);
				undef $unofs;
				last;
			} 
			$unofs = $$b[ $i + 1] + $$b[ $i + 2];
			$px = $npx;
		} elsif (( $cmd == tb::OP_TRANSPOSE) && !($$b[ $i + tb::X_FLAGS] & tb::X_EXTEND)) {
			$px += $$b[ $i + tb::X_X];
		} elsif ( $cmd == tb::OP_FONT) {
			if ( $$b[$i + 1] == tb::F_SIZE && $$b[$i + 2] < tb::F_HEIGHT ) {
				$state[ $$b[$i + 1]] = $self-> {defaultFontSize} + $$b[$i + 2];
			} else {
				$state[ $$b[$i + 1]] = $$b[$i + 2];
			}
			$f_taint = undef;
		}
	}

	$pm ? 
		$self-> set_font( $savefont) : 
		$self-> end_paint_info;

	return defined( $unofs) ? $unofs : $ofs, $bid;
}

sub screen2point
{
	my ( $self, $x, $y, @size) = @_;

	@size = $self-> size unless @size;
	my @aa = $self-> get_active_area( 0, @size);

	$x -= $aa[0];
	$y  = $aa[3] - $y;
	$y += $self-> {topLine};
	$x += $self-> {offset};

	return $x, $y;
}

sub text2xoffset
{
	my ( $self, $x, $bid) = @_;

	my $b = $self-> {blocks}-> [$bid];
	return 0 unless $b;
	return 0 if $x <= 0; # XXX

	my $pm = $self-> get_paint_state;
	$self-> begin_paint_info unless $pm;
	my $savefont = $self-> get_font;
	my @state = @$b[ 0 .. tb::BLK_DATA_END ];
	my $f_taint;

	my ( $i, $lim) = ( tb::BLK_START, scalar @$b);
	my $px   = $$b[tb::BLK_APERTURE_X];
	my $bofs = $$b[tb::BLK_TEXT_OFFSET];
	for ( ; $i < $lim; $i += $tb::oplen[ $$b[ $i]] ) {
		my $cmd = $$b[$i];
		if ( $cmd == tb::OP_TEXT) {
			if ( $x >= $$b[$i+1]) {
				if ( $x < $$b[$i+1] + $$b[$i+2]) {
					unless ( $f_taint) {
						$self-> realize_state( 
							$self, \@state, 
							tb::REALIZE_FONTS
						);
						$f_taint = $self-> get_font;
					}
					$px += $self-> get_text_width( 
						substr( 
							${$self-> {text}}, 
							$bofs + $$b[$i+1], 
							$x - $$b[$i+1] 
						)
					);
					last;
				} elsif ( $x == $$b[$i+1] + $$b[$i+2]) {
					$px += $$b[$i+3];
					last;
				}
			}
			$px += $$b[$i+3];
		} elsif (( $cmd == tb::OP_TRANSPOSE) && !($$b[ $i + tb::X_FLAGS] & tb::X_EXTEND)) {
			$px += $$b[ $i + tb::X_X];
		} elsif ( $cmd == tb::OP_FONT) {
			if ( $$b[$i + 1] == tb::F_SIZE && $$b[$i + 2] < tb::F_HEIGHT ) {
				$state[ $$b[$i + 1]] = $self-> {defaultFontSize} + $$b[$i + 2];
			} else {
				$state[ $$b[$i + 1]] = $$b[$i + 2];
			}
			$f_taint = undef;
		}
	}
	$pm ? $self-> set_font( $savefont) : $self-> end_paint_info;
	return $px;
}

sub info2text_offset
{
	my ( $self, $ofs, $blk) = @_;
	if ( $blk >= 0 && $ofs >= 0) {
		return $self-> {blocks}-> [$blk]-> [tb::BLK_TEXT_OFFSET] + $ofs;
	} else {
		return length ${$self-> {text}};
	}
}

sub text_offset2info
{
	my ( $self, $ofs) = @_;
	my $blk = $self-> text_offset2block( $ofs);
	return undef unless defined $blk;
	return $ofs - $self-> {blocks}-> [$blk]-> [ tb::BLK_TEXT_OFFSET], $blk;
}

sub info2xy
{
	my ( $self, $ofs, $blk) = @_;
	$blk = $self-> {blocks}-> [$blk];
	return undef unless defined $blk;
	return @$blk[ tb::BLK_X, tb::BLK_Y];
}

sub text_offset2block
{
	my ( $self, $ofs) = @_;
	
	my $bx = $self-> {blocks};
	my $end = length ${$self-> {text}};
	my $ret = 0;
	return undef if $ofs < 0 || $ofs >= $end;

	my ( $l, $r) = ( 0, scalar @$bx);
	while ( 1) {
		my $i = int(( $l + $r) / 2);
		last if $i == $ret;
		$ret = $i;
		my ( $b1, $b2) = ( $$bx[$i], $$bx[$i+1]);

		last if $ofs == $$b1[ tb::BLK_TEXT_OFFSET];

		if ( $ofs > $$b1[ tb::BLK_TEXT_OFFSET]) { 
			if ( $b2) {
				last if $ofs < $$b2[ tb::BLK_TEXT_OFFSET];
				$l = $i;
			} else {
				last;
			}
		} else {
		$r = $i;
		}
	}
	return $ret;
}


sub on_mousedown
{
	my ( $self, $btn, $mod, $x, $y) = @_;
	return if $self-> {mouseTransaction};

	my @size = $self-> size;
	my @aa = $self-> get_active_area( 0, @size);
	return if $x < $aa[0] || $x >= $aa[2] || $y < $aa[1] || $y >= $aa[3];

	( $x, $y) = $self-> screen2point( $x, $y, @size);

	for my $obj ( @{$self-> {contents}}) {
		unless ( $obj-> on_mousedown( $self, $btn, $mod, $x, $y)) {
			$self-> clear_event;
			return;
		}
	}

	return if $btn != mb::Left;
	
	my ( $text_offset, $bid) = $self-> xy2info( $x, $y);

	$self-> {mouseTransaction} = 1;
	$self-> {mouseAnchor} = [ $text_offset, $bid ]; 
	$self-> selection( -1, -1, -1, -1);

	$self-> capture(1);
	$self-> clear_event;
}

sub on_mouseclick
{
	my ( $self, $btn, $mod, $x, $y, $dbl) = @_;
	return unless $dbl;
	return if $self-> {mouseTransaction};
	return if $btn != mb::Left;
	
	my @size = $self-> size;
	my @aa = $self-> get_active_area( 0, @size);
	if ( $x < $aa[0] || $x >= $aa[2] || $y < $aa[1] || $y >= $aa[3]) {
		if ( $self-> has_selection) {
			$self-> selection( -1, -1, -1, -1);
			my $cp = $::application-> bring('Primary');
			$cp-> text( '') if $cp;
		}
		return;
	}

	( $x, $y) = $self-> screen2point( $x, $y, @size);
	my ( $text_offset, $bid) = $self-> xy2info( $x, $y);
	my $ln = ( $bid + 1 == scalar @{$self-> {blocks}}) ? 
		length ${$self-> {text}} : $self-> {blocks}-> [$bid+1]-> [tb::BLK_TEXT_OFFSET];
	$self-> selection( 0, $bid, $ln - $self-> {blocks}-> [$bid]-> [tb::BLK_TEXT_OFFSET], $bid);
	$self-> clear_event;
	
	my $cp = $::application-> bring('Primary');
	$cp-> text( $self-> get_selected_text) if $cp;
}

sub on_mouseup
{
	my ( $self, $btn, $mod, $x, $y) = @_;

	unless ( $self-> {mouseTransaction}) {
		( $x, $y) = $self-> screen2point( $x, $y);
		for my $obj ( @{$self-> {contents}}) {
			unless ( $obj-> on_mouseup( $self, $btn, $mod, $x, $y)) {
				$self-> clear_event;
				return;
			}
		}
		return;
	}

	return if $btn != mb::Left;
	
	$self-> capture(0);
	$self-> {mouseTransaction} = undef;
	$self-> clear_event;

	my $cp = $::application-> bring('Primary');
	$cp-> text( $self-> get_selected_text) if $cp;
}

sub on_mousemove
{
	my ( $self, $mod, $x, $y) = @_;

	unless ( $self-> {mouseTransaction}) {
		( $x, $y) = $self-> screen2point( $x, $y);
		for my $obj ( @{$self-> {contents}}) {
			unless ( $obj-> on_mousemove( $self, $mod, $x, $y)) {
				$self-> clear_event;
				return;
			}
		}
		return;
	}


	my @size = $self-> size;
	my @aa = $self-> get_active_area( 0, @size);
	if ( $x < $aa[0] || $x >= $aa[2] || $y < $aa[1] || $y >= $aa[3]) {
		$self-> scroll_timer_start unless $self-> scroll_timer_active;
		return unless $self-> scroll_timer_semaphore;
		$self-> scroll_timer_semaphore(0);
	} else {
		$self-> scroll_timer_stop;
	}

	my ( $nx, $ny) = $self-> screen2point( $x, $y, @size);
	my ( $text_offset, $bid) = $self-> xy2info( $nx, $ny);

	$self-> selection( @{$self-> {mouseAnchor}}, $text_offset, $bid);

	if ( $x < $aa[0] || $x >= $aa[2]) {
		my $px = $self-> {paneWidth} / 8;
		$px = 5 if $px < 5;
		$px *= -1 if $x < $aa[0];
		$self-> offset( $self-> {offset} + $px);
	}
	if ( $y < $aa[1] || $y >= $aa[3]) {
		my $py = $self-> font-> height;
		$py = 5 if $py < 5;
		$py *= -1 if $y >= $aa[3];
		$self-> topLine( $self-> {topLine} + $py);
	}
}


sub on_mousewheel
{
	my ( $self, $mod, $x, $y, $z) = @_;
	$z = int( $z/120) * 3;
	$z *= $self-> font-> height + $self-> font-> externalLeading unless $mod & km::Ctrl;
	my $newTop = $self-> {topLine} - $z;
	$self-> topLine( $newTop > $self-> {paneHeight} ? $self-> {paneHeight} : $newTop);
	$self-> clear_event;
}

sub on_keydown
{
	my ( $self, $code, $key, $mod, $repeat) = @_;

	$mod &= km::Alt|km::Ctrl|km::Shift;
	return if $mod & km::Alt;

	if ( grep { $key == $_ } ( 
		kb::Up, kb::Down, kb::Left, kb::Right, 
		kb::Space, kb::PgDn, kb::PgUp, kb::Home, kb::End
	)) {
		my ( $dx, $dy) = (0,0);
		if ( $key == kb::Up || $key == kb::Down) {
			$dy = $self-> font-> height;
			$dy = 5 if $dy < 5;
			$dy *= $repeat;
			$dy = -$dy if $key == kb::Up;
		} elsif ( $key == kb::Left || $key == kb::Right) {
			$dx = $self-> {paneWidth} / 8;
			$dx = 5 if $dx < 5;
			$dx *= $repeat;
			$dx = -$dx if $key == kb::Left;
		} elsif ( $key == kb::PgUp || $key == kb::PgDn || $key == kb::Space) {
			my @aa = $self-> get_active_area(0);
			$dy = ( $aa[3] - $aa[1]) * 0.9;
			$dy = 5 if $dy < 5;
			$dy *= $repeat;
			$dy = -$dy if $key == kb::PgUp;
		} 

		$dx += $self-> {offset};
		$dy += $self-> {topLine};
		
		if ( $key == kb::Home) {
			$dy = 0;
		} elsif ( $key == kb::End) {
			$dy = $self-> {paneHeight};
		}
		$self-> offset( $dx);
		$self-> topLine( $dy);
		$self-> clear_event; 
	}

	if (((( $key == kb::Insert) && ( $mod & km::Ctrl)) ||
		chr($code & 0xff) eq "\cC") && $self-> has_selection)
	{
		$self-> copy;
		$self-> clear_event;
	}
}

sub has_selection
{
	return ( grep { $_ != -1 } @{$_[0]-> {selection}} ) ? 1 : 0;
}

sub selection
{
	return @{$_[0]-> {selection}} unless $#_;
	my ( $self, $sx1, $sy1, $sx2, $sy2) = @_;

	$sy1 = 0 if $sy1 < 0;
	$sy2 = 0 if $sy2 < 0;
	my $lim = scalar @{$self-> {blocks}} - 1;
	$sy1 = $lim if $sy1 > $lim;
	$sy2 = $lim if $sy2 > $lim;

	my $empty = ! $self-> has_selection;
	my ( $osx1, $osy1, $osx2, $osy2) = @{$self-> {selection}};
	my ( $x1, $y1, $x2, $y2) = (0,0,0,0);
	
	unless ( grep { $_ != -1 } $sx1, $sy1, $sx2, $sy2 ) { # new empty selection
	EMPTY:
		return if $empty;     
		$y1 = $osy1;
		$y2 = $osy2;
		if ( $y1 == $y2) {
			$x1 = $osx1;
			$x2 = $osx2;
		}
	} else {
		( $sy1, $sy2, $sx1, $sx2) = ( $sy2, $sy1, $sx2, $sx1) if $sy2 < $sy1;
		( $sx1, $sx2) = ( $sx2, $sx1) if $sy2 == $sy1 && $sx2 < $sx1;
		( $sx1, $sx2, $sy1, $sy2) = ( -1, -1, -1, -1), goto EMPTY 
			if $sy1 == $sy2 && $sx1 == $sx2;
		if ( $empty) {
			$y1 = $sy1;
			$y2 = $sy2;
			if ( $y1 == $y2) {
				$x1 = $sx1;
				$x2 = $sx2;
			}
		} else {
			if ( $sy1 == $osy1 && $sx1 == $osx1) {
				return if $sy2 == $osy2 && $sx2 == $osx2;
				$y1 = $sy2;
				$y2 = $osy2;
				if ( $sy2 == $osy2) {
					$x1 = $sx2;
					$x2 = $osx2;
				}
			} elsif ( $sy2 == $osy2 && $sx2 == $osx2) {
				$y1 = $sy1;
				$y2 = $osy1;
				if ( $sy1 == $osy1) {
					$x1 = $sx1;
					$x2 = $osx1;
				}
			} else {
				$y1 = ( $sy1 < $osy1) ? $sy1 : $osy1;
				$y2 = ( $sy2 > $osy2) ? $sy2 : $osy2;
				if ( $sy1 == $sy2 && $osy1 == $osy2 && $sy2 == $osy1) {
					$x1 = ( $sx1 < $osx1) ? $sx1 : $osx1;
					$x2 = ( $sx2 > $osx2) ? $sx2 : $osx2;
				}
			}
			( $y1, $y2, $x1, $x2) = ( $y2, $y1, $x2, $x1) if $y2 < $y1;
		}
	}

	my $bx = $self-> {blocks};
	my @clipRect;
	my @size = $self-> size;
	my @aa   = $self-> get_active_area( 0, @size);

	if ( $y2 != $y1) {
		my $b = $$bx[ $y1];
		my @a = ( $$b[ tb::BLK_X], $$b[tb::BLK_Y], $$b[ tb::BLK_X], $$b[ tb::BLK_Y]);
		for ( $y1 .. $y2) {
			my $z = $$bx[ $_];
			my @b = ( $$z[ tb::BLK_X], $$z[tb::BLK_Y], $$z[ tb::BLK_X] + $$z[ tb::BLK_WIDTH], $$z[ tb::BLK_Y] + $$z[ tb::BLK_HEIGHT]);
			for ( 0, 1) { $a[$_] = $b[$_] if $a[$_] > $b[$_] }
			for ( 2, 3) { $a[$_] = $b[$_] if $a[$_] < $b[$_] }
		}
		$clipRect[0] = $aa[0] - $self-> {offset}  + $a[0];
		$clipRect[1] = $aa[3] + $self-> {topLine} - $a[1] - 1;
		$clipRect[2] = $aa[0] - $self-> {offset}  + $a[2];
		$clipRect[3] = $aa[3] + $self-> {topLine} - $a[3] - 1;
	} else {
		my $b = $$bx[ $y1]; 
		( $x2, $x1) = ( $x1, $x2) if $x1 > $x2;
		$clipRect[0] = $aa[0] - $self-> {offset} + 
			$$b[ tb::BLK_X] + $self-> text2xoffset( $x1, $y1); 
		$clipRect[1] = $aa[3] - $$b[ tb::BLK_Y] - 
			$$b[ tb::BLK_HEIGHT] + $self-> {topLine} - 1;
		$clipRect[2] = $aa[0] - $self-> {offset} + 
			$$b[ tb::BLK_X] + $self-> text2xoffset( $x2, $y1);
		$clipRect[3] = $aa[3] - $$b[ tb::BLK_Y] + 
			$self-> {topLine} - 1;
	}

	for ( 0, 1) {
		@clipRect[$_,$_+2] = @clipRect[$_+2,$_] 
			if $clipRect[$_] > $clipRect[$_+2];
		$clipRect[$_] = $aa[$_] if $clipRect[$_] < $aa[$_]; 
		$clipRect[$_+2] = $aa[$_+2] if $clipRect[$_+2] > $aa[$_+2];
	}

	$self-> {selection} = [ $sx1, $sy1, $sx2, $sy2 ];
	my @cpr = $self-> get_invalid_rect;
	if ( $cpr[0] != $cpr[2] || $cpr[1] != $cpr[3]) {
		for ( 0,1) {
			$clipRect[$_] = $cpr[$_] if $clipRect[$_] > $cpr[$_];
			$clipRect[$_+2] = $cpr[$_+2] if $clipRect[$_+2] < $cpr[$_+2];
		}
	}
	$self-> invalidate_rect( @clipRect);
}

sub get_selected_text
{
	my $self = $_[0];
	return unless $self-> has_selection;
	my ( $sx1, $sy1, $sx2, $sy2) = $self-> selection;
	my ( $a1, $a2) = (
		$self-> {blocks}-> [$sy1]-> [tb::BLK_TEXT_OFFSET] + $sx1,
		$self-> {blocks}-> [$sy2]-> [tb::BLK_TEXT_OFFSET] + $sx2,
	);
	return substr( ${$self-> {text}}, $a1, $a2 - $a1);
}

sub copy
{
	my $self = $_[0];
	my $text = $self-> get_selected_text;
	$::application-> Clipboard-> store( 'Text', $text) if defined $text;
}

sub clear_all
{
	my $self = $_[0];
	$self-> selection(-1,-1,-1,-1);
	$self-> {blocks} = [];
	$self-> paneSize( 0, 0);
	$self-> text('');
}


package Prima::TextView::EventRectangles;

sub new
{
	my $class = shift;
	my %profile = @_;
	my $self = {};
	bless( $self, $class);
	$self-> {$_} = $profile{$_} ? $profile{$_} : [] 
		for qw( rectangles references);
	return $self;
}

sub contains 
{ 
	my ( $self, $x, $y) = @_;
	my $rec = 0;
	for ( @{$self-> {rectangles}}) {
		return $rec if $x >= $$_[0] && $y >= $$_[1] && $x < $$_[2] && $y < $$_[3];
		$rec++;
	}
	return -1;
}

sub rectangles
{
	return $_[0]-> {rectangles} unless $#_;
	$_[0]-> {rectangles} = $_[1];
}

sub references
{
	return $_[0]-> {references} unless $#_;
	$_[0]-> {references} = $_[1];
}

1;

__END__

=pod

=head1 NAME 

Prima::TextView - rich text browser widget

=head1 DESCRIPTION

Prima::TextView accepts blocks of formatted text, and provides
basic functionality - scrolling and user selection. The text strings
are stored as one large text chunk, available by the C<::text> and C<::textRef> properties.
A block of a formatted text is an array with fixed-length header and 
the following instructions. 

A special package C<tb::> provides the block constants and simple functions
for text block access. 

=head2 Capabilities

Prima::TextView is mainly the text block functions and helpers. It provides
function for wrapping text block, calculating block dimensions, drawing
and converting coordinates from (X,Y) to a block position. Prima::TextView
is centered around the text functionality, and although any custom graphic of
arbitrary complexity can be embedded in a text block, the internal coordinate
system is used ( TEXT_OFFSET, BLOCK ), where TEXT_OFFSET is a text offset from 
the beginning of a block and BLOCK is an index of a block.

The functionality does not imply any text layout - this is up to the class
descendants, they must provide they own layout policy. The only policy
Prima::TextView requires is that blocks' BLK_TEXT_OFFSET field must be
strictly increasing, and the block text chunks must not overlap. The text gaps
are allowed though. 

A text block basic drawing function includes change of color, backColor and font,
and the painting of text strings. Other types of graphics can be achieved by
supplying custom code.

=head2 Block header

A block's fixed header consists of C<tb::BLK_START - 1> integer scalars,
each of those is accessible via the corresponding C<tb::BLK_XXX> constant.
The constants are separated into two logical groups:

	BLK_FLAGS        
	BLK_WIDTH        
	BLK_HEIGHT      
	BLK_X           
	BLK_Y           
	BLK_APERTURE_X  
	BLK_APERTURE_Y  
	BLK_TEXT_OFFSET 

and

	BLK_FONT_ID          
	BLK_FONT_SIZE        
	BLK_FONT_STYLE       
	BLK_COLOR            
	BLK_BACKCOLOR        

The second group is enclosed in C<tb::BLK_DATA_START> - C<tb::BLK_DATA_END>
range, like the whole header is contained in 0 - C<tb::BLK_START - 1> range.
This is done for the backward compatibility, if the future development changes 
the length of the header. 

The first group fields define the text block dimension, aperture position
and text offset ( remember, the text is stored as one big chunk ). The second
defines the initial color and font settings. Prima::TextView needs all fields
of every block to be initialized before displaying. L<block_wrap> method
can be used for automated assigning of these fields.

=head2 Block parameters

The scalars, beginning from C<tb::BLK_START>, represent the commands to the renderer.
These commands have their own parameters, that follow the command. The length of
a command is located in C<@oplen> array, and must not be changed. The basic command
set includes C<OP_TEXT>, C<OP_COLOR>, C<OP_FONT>, C<OP_TRANSPOSE>, and C<OP_CODE>.
The additional codes are C<OP_WRAP> and C<OP_MARK>, not used in drawing but are
special commands to L<block_wrap>.

=over

=item OP_TEXT - TEXT_OFFSET, TEXT_LENGTH, TEXT_WIDTH

C<OP_TEXT> commands to draw a string, from offset C<tb::BLK_TEXT_OFFSET + TEXT_OFFSET>,
with a length TEXT_LENGTH. The third parameter TEXT_WIDTH contains the width of the text
in pixels. Such the two-part offset scheme is made for simplification or an imaginary code,
that would alter ( insert to, or delete part of ) the big text chunk; the updating procedure
would not need to traverse all commands, but just the block headers.

Relative to: C<tb::BLK_TEXT_OFFSET>.

=item OP_COLOR - COLOR

C<OP_COLOR> sets foreground or background color. To set the background,
COLOR must be or-ed with C<tb::BACKCOLOR_FLAG> value. In addition to the 
two toolkit supported color values ( RRGGBB and system color index ), 
COLOR can also be or-ed with C<tb::COLOR_INDEX> flags, in such case it is
an index in C<::colormap> property array.

Relative to: C<tb::BLK_COLOR>, C<tb::BLK_BACKCOLOR>.

=item OP_FONT - KEY, VALUE

As the font is a complex property, that itself includes font name, size, 
direction, etc keys, C<OP_FONT> KEY represents one of the three
parameters - C<tb::F_ID>, C<tb::F_SIZE>, C<tb::F_STYLE>. All three
have different VALUE meaning. 

Relative to: C<tb::BLK_FONT_ID>, C<tb::BLK_FONT_SIZE>, C<tb::BLK_FONT_STYLE>.  

=over

=item F_STYLE

Contains a combination of C<fs::XXX> constants, such as C<fs::Bold>, C<fs::Italic> etc. 

Default value: 0 

=item F_SIZE

Contains the relative font size. The size is relative to the current widget's font
size. As such, 0 is a default value, and -2 is the widget's default font decreased by
2 points. Prima::TextView provides no range checking ( but the toolkit does ), so
while it is o.k. to set the negative C<F_SIZE> values larger than the default font size,
one must be vary when relying on the combined font size value .

If C<F_SIZE> value is added to a C<F_HEIGHT> constant, then it is treated as a font height
in pixels rather than font size in points. The macros for these opcodes are named respectively
C<tb::fontSize> and C<tb::fontHeight>, while the opcode is the same.

=item F_ID

All other font properties are collected under an 'ID'. ID is a index in
the C<::fontPalette> property array, which contains font hashes with the other
font keys initialized - name, encoding, and pitch. These three are minimal required
set, and the other font keys can be also selected.

=back

=item OP_TRANSPOSE X, Y, FLAGS

Contains a mark for an empty space. The space is extended to the relative coordinates (X,Y), 
so the block extension algorithms take this opcode in the account. If FLAGS does not contain
C<tb::X_EXTEND>, then in addition to the block expansion, current coordinate is also
moved to (X,Y). In this regard, C<(OP_TRANSPOSE,0,0,0)> and C<(OP_TRANSPOSE,0,0,X_EXTEND)> are
identical and are empty operators. 

There are formatting-only flags,in effect with L<block_wrap> function.
C<X_DIMENSION_FONT_HEIGHT> indicates that (X,Y) values must be multiplied to
the current font height.  Another flag C<X_DIMENSION_POINT> does the same but
multiplies by current value of L<resolution> property divided by 72 (
basically, treats X and Y not as pixel but point values).

C<OP_TRANSPOSE> can be used for customized graphics, in conjunction with C<OP_CODE>
to assign a space, so the rendering
algorithms do not need to be re-written every time the new graphic is invented. As
an example, see how L<Prima::PodView> deals with the images.

=item OP_CODE - SUB, PARAMETER

Contains a custom code pointer SUB with a parameter PARAMETER, passed when
a block is about to be drawn. SUB is called with the following format:

	( $widget, $canvas, $text_block, $font_and_color_state, $x, $y, $parameter);

$font_and_color_state ( or $state, through the code ) contains the state of 
font and color commands in effect, and is changed as the rendering algorithm advances through a block.
The format of the state is the same as of text block, so one may notice that for readability
F_ID, F_SIZE, F_STYLE constants are paired to BLK_FONT_ID, BLK_FONT_SIZE and BLK_FONT_STYLE.

The SUB code is executed only when the block is about to draw. 

=item OP_WRAP ON_OFF

C<OP_WRAP> is only in effect in L<block_wrap> method. ON_OFF is a boolean flag,
selecting if the wrapping is turned on or off. L<block_wrap> does not support 
stacking for the wrap commands, so the C<(OP_WRAP,1,OP_WRAP,1,OP_WRAP,0)> has 
same effect as C<(OP_WRAP,0)>. If ON_OFF is 1, wrapping is disabled - all following
commands treated an non-wrapable until C<(OP_WRAP,0)> is met.

=item OP_MARK PARAMETER, X, Y

C<OP_MARK> is only in effect in L<block_wrap> method and is a user command.
L<block_wrap> only sets (!) X and Y to the current coordinates when the command is met. 
Thus, C<OP_MARK> can be used for arbitrary reasons, easy marking the geometrical positions
that undergo the block wrapping.

=back

As can be noticed, these opcodes are far not enough for the full-weight rich text
viewer. However, the new opcodes can be created using C<tb::opcode>, that accepts
the opcode length and returns the new opcode value.

=head2 Rendering methods

=over

=item block_wrap

C<block_wrap> is the function, that is used to wrap a block into a given width.
It returns one or more text blocks with fully assigned headers. The returned blocks
are located one below another, providing an illusion that the text itself is wrapped.
It does not only traverses the opcodes and sees if the command fit or not in the given width;
it also splits the text strings if these do not fit. 

By default the wrapping can occur either on a command boundary or by the spaces or tab characters
in the text strings. The unsolicited wrapping can be prevented by using C<OP_WRAP>
command brackets. The commands inside these brackets are not wrapped; C<OP_WRAP> commands
are removed from the output blocks.

In general, C<block_wrap> copies all commands and their parameters as is, ( as it is supposed
to do ), but some commands are treated especially:

- C<OP_TEXT>'s third parameter, C<TEXT_WIDTH>, is disregarded, and is recalculated for every
C<OP_TEXT> met.

- If C<OP_TRANSPOSE>'s third parameter, C<X_FLAGS> contains C<X_DIMENSION_FONT_HEIGHT> flag,
the command coordinates X and Y are multiplied to the current font height and the flag is
cleared in the output block.

- C<OP_MARK>'s second and third parameters assigned to the current (X,Y) coordinates.

- C<OP_WRAP> removed from the output.

=item block_draw CANVAS, BLOCK, X, Y

The C<block_draw> draws BLOCK onto CANVAS in screen coordinates (X,Y).
It can not only be used for drawing inside begin_paint/end_paint brackets;
CANVAS can be an arbitrary C<Prima::Drawable> descendant.

=back

=head2 Coordinate system methods

Prima::TextView employs two its own coordinate systems:
(X,Y)-document and (TEXT_OFFSET,BLOCK)-block. 

The document coordinate system is isometric and measured in pixels. Its origin is located 
into the imaginary point of the beginning of the document ( not of the first block! ),
in the upper-left point. X increases to the right, Y increases downwards.
The block header values BLK_X and BLK_Y are in document coordinates, and
the widget's pane extents ( regulated by C<::paneSize>, C<::paneWidth> and
C<::paneHeight> properties ) are also in document coordinates.

The block coordinate system in an-isometric - its second axis, BLOCK, is an index
of a text block in the widget's blocks storage, C<$self-E<gt>{blocks}>, and
its first axis, TEXT_OFFSET is a text offset from the beginning of the block.

Below described different coordinate system converters

=over

=item screen2point X, Y

Accepts (X,Y) in the screen coordinates ( O is a lower left widget corner ),
returns (X,Y) in document coordinates ( O is upper left corner of a document ).

=item xy2info X, Y

Accepts (X,Y) is document coordinates, returns (TEXT_OFFSET,BLOCK) coordinates,
where TEXT_OFFSET is text offset from the beginning of a block ( not related
to the big text chunk ) , and BLOCK is an index of a block.

=item info2xy TEXT_OFFSET, BLOCK

Accepts (TEXT_OFFSET,BLOCK) coordinates, and returns (X,Y) in document coordinates
of a block.

=item text2xoffset TEXT_OFFSET, BLOCK

Returns X coordinate where TEXT_OFFSET begins in a BLOCK index.

=item info2text_offset

Accepts (TEXT_OFFSET,BLOCK) coordinates and returns the text offset 
with regard to the big text chunk.

=item text_offset2info TEXT_OFFSET

Accepts big text offset and returns (TEXT_OFFSET,BLOCK) coordinates 

=item text_offset2block TEXT_OFFSET

Accepts big text offset and returns BLOCK coordinate.

=back

=head2 Text selection

The text selection is performed automatically when the user selects the
region with a mouse. The selection is stored in (TEXT_OFFSET,BLOCK)
coordinate pair, and is accessible via the C<::selection> property.
If its value is assigned to (-1,-1,-1,-1) this indicates that there is
no selection. For convenience the C<has_selection> method is introduced.

Also, C<get_selected_text> returns the text within the selection
(or undef with no selection ), and C<copy> copies automatically 
the selected text into the clipboard. The latter action is bound to 
C<Ctrl+Insert> key combination.

=head2 Event rectangles

Partly as an option for future development, partly as a hack a
concept of 'event rectangles' was introduced. Currently, C<{contents}>
private variable points to an array of objects, equipped with 
C<on_mousedown>, C<on_mousemove>, and C<on_mouseup> methods. These
are called within the widget's mouse events, so the overloaded classes
can define the interactive content without overloading the actual
mouse events ( which is although easy but is dependent on Prima::TextView 
own mouse reactions ).

As an example L<Prima::PodView> uses the event rectangles to catch
the mouse events over the document links. Theoretically, every 'content'
is to be bound with a separate logical layer; when the concept was designed,
a html-browser was in mind, so such layers can be thought as 
( in the html world ) links, image maps, layers, external widgets. 

Currently, C<Prima::TextView::EventRectangles> class is provided
for such usage. Its property C<::rectangles> contains an array of
rectangles, and the C<contains> method returns an integer value, whether
the passed coordinates are inside one of its rectangles or not; in the first
case it is the rectangle index.

=cut