Prima/TextView.pm - metacpan.org

use strict;
use warnings;

package Prima::TextView::EventContent;

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

package Prima::TextView;

use Prima;
use Prima::IntUtils;
use Prima::ScrollBar;
use Prima::Drawable::TextBlock;
use vars qw(@ISA);
@ISA = qw(Prima::Widget Prima::MouseScroller Prima::GroupScroller);
use Prima::Bidi qw(:methods is_bidi);

use constant YMAX => 1000;

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,
		scrollBarClass  => 'Prima::ScrollBar',
		hScrollBarProfile=> {},
		vScrollBarProfile=> {},
		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) = @_;
	if ( exists $p->{owner} && !exists $p->{font} && !exists $p->{fontPalette} && 
		(( $p->{ownerFont} // $default->{ownerFont} // 1 ) == 1 )) {
		$p-> {fontPalette}-> [0]-> {name} = $p->{owner}->font->name;
	}
	$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}});
	$self->{$_} = $profile{$_} for qw(scrollBarClass hScrollBarProfile vScrollBarProfile);
	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 begin_paint_info
{
	my $self = shift;
	delete $self->{currentFont};
	return $self->SUPER::begin_paint_info;
}

sub end_paint_info
{
	my $self = shift;
	delete $self->{currentFont};
	return $self->SUPER::end_paint_info;
}

sub _hash { my $k = shift; join("\0", map { ($_, $k->{$_}) } sort keys %$k) }

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

	if ( $mode & tb::REALIZE_FONTS) {
		my $f = tb::realize_fonts($self-> {fontPalette}, $state);
		goto SKIP if 
			exists $self->{currentFont} &&
			_hash($self->{currentFont}) eq _hash($f);
		$self->{currentFont} = $f;
		$canvas-> set_font( $f);
	SKIP:
	}

	return unless $mode & tb::REALIZE_COLORS;
	if ( $self-> {selectionPaintMode}) {
		$self-> selection_state( $canvas);
	} else {
		$canvas-> set( tb::realize_colors( $self-> {colorMap}, $state));
	}
}

sub recalc_ymap
{
	my ( $self, $from) = @_;
	# if $from is zero or not defined, clear the ymap; otherwise we append
	# to what was already calculated. This is optimized for *building* a
	# collection of blocks; if you need to change a collection of blocks,
	# you should always set $from to a false value.
	$self-> {ymap} = [] unless $from; # ok if $from == 0
	my $ymap = $self-> {ymap};
	my $blocks = $self-> {blocks};
	my ( $i, $lim) = ( defined($from) ? $from : 0, scalar(@{$blocks}));
	for ( ; $i < $lim; $i++) {
		my $block = $$blocks[$i];
		my $y1 = $block->[ tb::BLK_Y];
		my $y2 = $block->[ tb::BLK_HEIGHT] + $y1;
		for my $y ( int( $y1 / YMAX) .. int ( $y2 / YMAX)) {
			push @{$ymap-> [$y]}, $i;
		}
	}
}

sub block_walk_abort { shift->{blockWalk} = 1 }

sub block_walk
{
	my ( $self, $block, %commands ) = @_;
	local $self-> {blockWalk} = 0;
	my $canvas = $commands{canvas} // $self;
	return tb::walk( $block, 
		textPtr      => $self->{text},
		canvas       => $canvas,
		realize      => sub { $self-> realize_state($canvas, @_) },
		baseFontSize => $self-> {defaultFontSize},
		semaphore    => \ $self-> {blockWalk},
		resolution   => $self->{resolution},
		%commands 
	);
}

sub block_wrap
{
	my ( $self, $canvas, $b, $state, $width) = @_;
	return tb::block_wrap( $b,
		textPtr      => $self->{text},
		canvas       => $canvas,
		state        => $state,
		width        => $width,
		fontmap      => $self->{fontPalette},
		baseFontSize => $self->{defaultFontSize},
		resolution   => $self->{resolution},
		wordBreak    => 1,
		bidi         => 1,
	);
}

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

sub paint_selection
{
	my ( $self, $canvas, $block, $index, $x, $y, $sx1, $sx2) = @_;

	my $len = $self->get_block_text_length($index);
	$sx2 = $len - 1 if $sx2 < 0;

	my @selection_map;
	unless ($$block[ tb::BLK_FLAGS ] & tb::T_IS_BIDI) {
		@selection_map = (0) x $len;
		$selection_map[$_] = 1 for $sx1 .. $sx2;
	}
	my @state;
	my @xy = ($x,$y);
	local $self->{selectionPaintMode} = 0;

	my $draw_text = sub {
		my ( $x, $text ) = @_;
		my $f = $canvas->get_font;
		my $w = $canvas->get_text_width($text);
		$self-> realize_state( $canvas, \@state, tb::REALIZE_COLORS); 
		$canvas->clear(
			$x, $xy[1] - $f->{descent},
			$x + $w - 1, $xy[1] + $f->{ascent} + $f->{externalLeading} - 1
			) if $self->{selectionPaintMode};
		$canvas-> text_out($text, $x, $xy[1]);
		return $w;
	};

	$self-> block_walk( $block,
		trace    => tb::TRACE_GEOMETRY | tb::TRACE_REALIZE_PENS | tb::TRACE_TEXT,
		canvas   => $canvas,
		position => \@xy,
		state    => \@state,
		text     => sub {
			my ($offset, $length, undef, $text) = @_;
			my $accumulated = '';
			my $x = $xy[0];
			for ( my $i = 0; $i < $length; $i++) {
				if ( $selection_map[$offset + $i] != $self->{selectionPaintMode} ) {
					$x += $draw_text->( $x, $accumulated );
					$accumulated = '';
					$self->{selectionPaintMode} = $selection_map[$offset + $i];
				}
				$accumulated .= substr($text, $i, 1);
			}
			$draw_text->( $x, $accumulated ) if length $accumulated;
		},
		code     => sub {
			my ( $code, $data ) = @_;
			$self-> realize_state( $canvas, \@state, tb::REALIZE_ALL); 
			$code-> ( $self, $canvas, $block, \@state, @xy, $data);
		},
		transpose => sub {
			my ( $x, $y, $f) = @_;
			return if !($f & tb::X_EXTEND) || !$self->{selectionPaintMode} || $x == 0 || $y == 0;
			$canvas->clear($xy[0], $xy[1] - $$block[ tb::BLK_APERTURE_Y], $xy[0] + $x - 1, $xy[1] + $y - $$block[ tb::BLK_APERTURE_Y] - 1);
		},
		bidimap  => sub {
			my $map = pop;
			for ( my $i = 0; $i < @$map; $i++) {
				$selection_map[$i] = ($map->[$i] >= $sx1 && $map->[$i] <= $sx2) ? 1 : 0;
			}
		},
	);
}

sub on_paint
{
	my ( $self, $canvas) = @_;
	delete $self->{currentFont};
	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 my $ymap_i ( int( $cy[0] / YMAX) .. int( $cy[1] / YMAX)) {
		next unless $self-> {ymap}-> [$ymap_i];
		for my $j ( @{$self-> {ymap}-> [$ymap_i]}) {
			$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 ) {
				# selection within one line
				$self->paint_selection( $canvas, $b, $j, $x, $y, $sx1, $sx2 - 1);
			} elsif ( $j == $sy1 ) {
				# upper selected part
				$self->paint_selection( $canvas, $b, $j, $x, $y, $sx1, -1);
			} elsif ( $j == $sy2 ) {
				# lower selected part
				$self->paint_selection( $canvas, $b, $j, $x, $y, 0, $sx2 - 1);
			} 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 { # no selection case
				$self-> block_draw( $canvas, $b, $x, $y);
			}
		}
	}

	$self-> {selectionPaintMode} = 0;
}

sub block_draw
{
	my ( $self, $canvas, $b, $x, $y) = @_;

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

	my @xy = ($x, $y);
	my @state;
	$self-> block_walk( $b, 
		trace    => tb::TRACE_GEOMETRY | tb::TRACE_REALIZE_PENS | tb::TRACE_TEXT,
		canvas   => $canvas,
		position => \@xy,
		state    => \@state,
		text     => sub {
			$self-> block_walk_abort( $ret = 0 ) unless $canvas-> text_out($_[-1], @xy);
		},
		code     => sub {
			my ( $code, $data ) = @_;
			$code-> ( $self, $canvas, $b, \@state, @xy, $data);
		},
	);
	
	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 / 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 / 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 $ofs = 0;
	my $bidimap;
	my @pos = ($$b[ tb::BLK_X] - $x,0);

	$self-> block_walk( $b,
		position => \@pos,
		trace    => tb::TRACE_GEOMETRY | tb::TRACE_REALIZE | tb::TRACE_PAINT_STATE | tb::TRACE_TEXT,
		text     => sub {
			my ( $offset, $length, $width, $text) = @_;
			my $npx = $pos[0] + $width;
			if ( $pos[0] > 0) {
				$ofs = $offset;
				$self-> block_walk_abort;
			} elsif ( $pos[0] <= 0 && $npx > 0) {
				$ofs = $offset + $self-> text_wrap( $text, -$pos[0], tw::ReturnFirstLineLength | tw::BreakSingle);
				$self-> block_walk_abort;
			} else {
				$ofs = $offset + $length - 1;
			}
		},
		bidimap => sub { $bidimap = pop },
	);

	$ofs = $bidimap->[$ofs] if $bidimap;

	return $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 @pos = (0,0);

	$self-> block_walk( $b,
		position => \@pos,
		trace    => tb::TRACE_GEOMETRY | tb::TRACE_REALIZE | tb::TRACE_PAINT_STATE | tb::TRACE_TEXT,
		text     => sub {
			my ( $offset, $length, $width, $text) = @_;
			return if $x < $offset;

			if ( $x < $offset + $length ) {
				$pos[0] += $self-> get_text_width( substr( $text, 0, $x - $offset), 1);
				$self-> block_walk_abort;
			} elsif ( $x == $offset + $length ) {
				$pos[0] += $width;
				$self-> block_walk_abort;
			}
		},
	);

	return $pos[0];
}

sub get_block_text
{
	my ( $self, $block ) = @_;
	my $ptr = $self-> {blocks}-> [$block]-> [tb::BLK_TEXT_OFFSET];
	my $len = $self->get_block_text_length( $block );
	return substr( ${$self->{text}}, $ptr, $len);
}

sub get_block_text_length
{
	my ( $self, $block ) = @_;
	my $ptr1 = $self-> {blocks}-> [$block]-> [tb::BLK_TEXT_OFFSET];
	my $ptr2 = ( $block + 1 < @{$self-> {blocks}}) ? 
		$self-> {blocks}-> [$block+1]-> [tb::BLK_TEXT_OFFSET] :
		length ${$self-> {text}};
	return $ptr2 - $ptr1;
}

sub info2text_offset
{
	my ( $self, $offset, $block) = @_;
	return length ${$self-> {text}} unless $block >= 0 && $offset >= 0;

	my $ptr = $self-> {blocks}-> [$block]-> [tb::BLK_TEXT_OFFSET];
	my $len = $self->get_block_text_length( $block );
	if (
		$offset < $len &&
		$self->is_bidi( my $str = substr( ${$self-> {text}}, $ptr, $len ) )
	) {
		$offset = $self->bidi_map($str)->[$offset];
	}
	return $ptr + $offset;
}

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

	if ( $self->is_bidi( my $str = $self-> get_block_text($blk))) {
		$ofs = $self->bidi_map_find( $self-> bidi_map($str), $ofs );
	}
	return $ofs, $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;
	}

	# my $p = $self-> get_selected_text;
	# Prima::Bidi::debug_str($p) if defined $p;

	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 ( $y1, $y2) = (0,0);
	my ( @old, @new);

	unless ( grep { $_ != -1 } $sx1, $sy1, $sx2, $sy2 ) { # new empty selection
	EMPTY:
		return if $empty;     
		$y1 = $osy1;
		$y2 = $osy2;
		if ( $y1 == $y2) {
			@old = ( $osx1, $osx2 - 1 );
			@new = (1,0);
		}
	} 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) {
				@new = ( $sx1, $sx2 - 1 );
				@old = (1,0);
			}
		} else {
			if ( $sy1 == $osy1 && $sx1 == $osx1) {
				return if $sy2 == $osy2 && $sx2 == $osx2;
				$y1 = $sy2;
				$y2 = $osy2;
				if ( $sy2 == $osy2) {
					@old = ( 0, $osx2 - 1 );
					@new = ( 0, $sx2  - 1 );
				}
			} elsif ( $sy2 == $osy2 && $sx2 == $osx2) {
				$y1 = $sy1;
				$y2 = $osy1;
				if ( $sy1 == $osy1) {
					@old = ( $osx1, -1 );
					@new = ( $sx1,  -1 );
				}
			} else {
				$y1 = ( $sy1 < $osy1) ? $sy1 : $osy1;
				$y2 = ( $sy2 > $osy2) ? $sy2 : $osy2;
				if ( $sy1 == $sy2 && $osy1 == $osy2 && $sy2 == $osy1) {
					@old = ( $osx1, $osx2 - 1 );
					@new = ( $sx1,  $sx2  - 1 );
				}
			}
			( $y1, $y2) = ( $y2, $y1) if $y2 < $y1;
		}
	}

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

	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;

	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];
	}

	push @invalid_rects, \@clipRect;

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

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

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 SYNOPSIS

 use strict;
 use warnings;
 use Prima qw(TextView Application);
 
 my $w = Prima::MainWindow-> create(
     name => 'TextView example',
 );
 
 my $t = $w->insert(TextView =>
     text     => 'Hello from TextView!',
     pack     => { expand => 1, fill => 'both' },
 );
 
 # Create a single block that renders all the text using the default font
 my $tb = tb::block_create();
 my $text_width_px = $t->get_text_width($t->text);
 my $font_height_px = $t->font->height;
 $tb->[tb::BLK_WIDTH]  = $text_width_px;
 $tb->[tb::BLK_HEIGHT] = $font_height_px;
 $tb->[tb::BLK_BACKCOLOR] = cl::Back;
 $tb->[tb::BLK_FONT_SIZE] = int($font_height_px) + tb::F_HEIGHT;
 # Add an operation that draws the text:
 push @$tb, tb::text(0, length($t->text), $text_width_px);
 
 # Set the markup block(s) and recalculate the ymap
 $t->{blocks} = [$tb];
 $t->recalc_ymap;
 
 # Additional step needed for horizontal scroll as well as per-character
 # selection:
 $t->paneSize($text_width_px, $font_height_px);
 
 run Prima;

=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.

=over

=item block_draw CANVAS, BLOCK, X, Y

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

=item block_walk BLOCK, %OPTIONS

Cycles through block opcodes, calls supplied callbacks on each.

=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 pixel. X increases to the right, Y increases down.
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 different coordinate system converters are described

=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 a text
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.

=head1 AUTHOR

Dmitry Karasik, E<lt>dmitry@karasik.eu.orgE<gt>.

=head1 SEE ALSO

L<Prima::Drawable::TextBlock>, L<Prima::PodView>, F<examples/mouse_tale.pl>.

=cut
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)