package Prima::Drawable::TextBlock;
use strict;
use warnings;
use Prima;

package
    tb;
use vars qw($lastop %opnames);

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

# formatting opcodes
use constant OP_WRAP               =>  (5 | (2 << 16)); # WRAP_XXX
use constant OP_MARK               =>  (6 | (4 << 16)); # id, x, y
$lastop = 6;

%opnames = (
	text      => OP_TEXT,
	color     => OP_COLOR,
	font      => OP_FONT,
	transpose => OP_TRANSPOSE,
	code      => OP_CODE,
	wrap      => OP_WRAP,
	mark      => OP_MARK,
);


# 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_OFF         => 0x04000000; # turn off textOpaque
use constant BACKCOLOR_DEFAULT     => BACKCOLOR_FLAG | BACKCOLOR_OFF;
use constant COLOR_MASK            => 0xF8FFFFFF;

# 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_TRANSPOSE             => 0;
use constant X_EXTEND                => 1;
use constant X_DIMENSION_PIXEL       => 0;
use constant X_DIMENSION_FONT_HEIGHT => 2; # multiply by font height
use constant X_DIMENSION_POINT       => 4; # multiply by resolution / 72

# OP_WRAP
use constant WRAP_MODE_OFF           => 0; # mode selectors
use constant WRAP_MODE_ON            => 1; #
use constant WRAP_IMMEDIATE          => 2; # not a mode selector

# OP_MARK
use constant MARK_ID                 => 1;
use constant MARK_X                  => 2;
use constant MARK_Y                  => 3;

# 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;

# trace constants
use constant TRACE_FONTS          => 0x01;
use constant TRACE_COLORS         => 0x02;
use constant TRACE_PENS           => TRACE_COLORS | TRACE_FONTS;
use constant TRACE_POSITION       => 0x04;
use constant TRACE_TEXT           => 0x08;
use constant TRACE_GEOMETRY       => TRACE_FONTS | TRACE_POSITION;
use constant TRACE_UPDATE_MARK    => 0x10;
use constant TRACE_PAINT_STATE    => 0x20;
use constant TRACE_REALIZE        => 0x40;
use constant TRACE_REALIZE_FONTS  => TRACE_FONTS | TRACE_REALIZE;
use constant TRACE_REALIZE_COLORS => TRACE_COLORS | TRACE_REALIZE;
use constant TRACE_REALIZE_PENS   => TRACE_PENS | TRACE_REALIZE;

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 += $$block[$i] >> 16, $ret++ while $i < $lim;
	return $ret;
}

# creates a new opcode for custom use
sub opcode
{
	my $len = $_[0] || 0;
	my $name = $_[1];
	$len = 0 if $len < 0;
	my $op;
	if ( defined $name && exists $opnames{$name}) {
		$op = $opnames{$name};
	} else {
		$op = ++$lastop;
		$opnames{$name} = $op if defined $name;
	}
	return $op | (( $len + 1 ) << 16);
}

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 font           { return OP_FONT, $_[0], $_[1] }
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 }

sub realize_fonts
{
	my ( $font_palette, $state) = @_;
	my $font = {%{$font_palette-> [ $$state[ BLK_FONT_ID]]}};
	if ( $$state[ BLK_FONT_SIZE] > F_HEIGHT) {
		$font->{height} = $$state[ BLK_FONT_SIZE] - F_HEIGHT;
	} else {
		$font->{size} = $$state[ BLK_FONT_SIZE];
		delete @{$font}{qw(height width)};
	}
	$font->{style} = $$state[ BLK_FONT_STYLE];
	return $font;
}

sub realize_colors
{
	my ( $color_palette, $state ) = @_;
	return (
		color     =>  (( $$state[ BLK_COLOR] & COLOR_INDEX) ?
				( $color_palette-> [$$state[ BLK_COLOR] & COLOR_MASK]) :
				( $$state[ BLK_COLOR] & COLOR_MASK)),
		backColor =>  (( $$state[ BLK_BACKCOLOR] & COLOR_INDEX) ?
				( $color_palette-> [$$state[ BLK_BACKCOLOR] & COLOR_MASK]) :
				( $$state[ BLK_BACKCOLOR] & COLOR_MASK)),
		textOpaque => (( $$state[ BLK_BACKCOLOR] & BACKCOLOR_OFF) ? 0 : 1),
	);
}

sub _debug_block
{
	my ($b, $text) = @_;
	print STDERR "FLAGS      : ", (( $$b[BLK_FLAGS] & T_SIZE ) ? "T_SIZE" : ""), (( $$b[BLK_FLAGS] & T_WRAPABLE ) ? "T_WRAPABLE" : ""), "\n";
	print STDERR "POSITION   : ", $$b[BLK_X] // 'undef', 'x', $$b[BLK_Y] // 'undef', "\n";
	print STDERR "SIZE       : ", $$b[BLK_WIDTH] // 'undef', 'x', $$b[BLK_HEIGHT] // 'undef', "\n";
	print STDERR "APERTURE   : ", $$b[BLK_APERTURE_X] // 'undef', 'x', $$b[BLK_APERTURE_Y] // 'undef', "\n";
	print STDERR "TEXT_OFS   : ", $$b[BLK_TEXT_OFFSET] // 'undef', "\n";
	print STDERR "FONT       : ID=", $$b[BLK_FONT_ID] // 'undef', ' ',
	                           'SIZE=', $$b[BLK_FONT_SIZE] // 'undef', ' ',
	                           'STYLE=', $$b[BLK_FONT_STYLE] // 'undef', "\n";
	my $color = $$b[BLK_COLOR];
	unless ( defined $color ) {
		$color = "undef";
	} elsif ( $color & COLOR_INDEX) {
		$color = "index(" . ( $color & ~COLOR_INDEX) . ")";
	} else {
		$color = sprintf("%06x", $color & 0xffffff);
	}
	print STDERR "COLORS     : $color ";
	$color = $$b[BLK_BACKCOLOR];
	unless ( defined $color ) {
		$color = "undef";
	} elsif ( $color & COLOR_INDEX) {
		$color = "index(" . ( $color & ~COLOR_INDEX) . ")";
	} else {
		$color = sprintf("%06x%s", $color & 0xffffff, ($color & BACKCOLOR_OFF) ? ',transparent' : '');
	}
	print STDERR "$color\n";
	my %opval = reverse %opnames;

	my ($i, $lim) = (BLK_START, scalar @$b);
	for ( ; $i < $lim; $i += $$b[$i] >> 16) {
		my $cmd = $$b[$i];
		if ( !defined($cmd)) {
			$cmd //= 'undef';
			print STDERR "corrupted block: $cmd at $i/$lim\n";
			last;
		}
		if ($cmd == OP_TEXT) {
			my $ofs = $$b[ $i + T_OFS];
			my $len = $$b[ $i + T_LEN];
			my $wid = $$b[ $i + T_WID] // 'NULL';
			print STDERR ": OP_TEXT( $ofs $len : $wid )";
			print STDERR ": (",
				substr( $$text, $$b[BLK_TEXT_OFFSET] + $$b[$i + T_OFS], $$b[$i + T_LEN] ),
				")" if $text;
			print STDERR "\n";
		} elsif ( $cmd == OP_FONT ) {
			my $mode = $$b[ $i + F_MODE ];
			my $data = $$b[ $i + F_DATA ];
			if ( $mode == F_ID ) {
				$mode = 'F_ID';
			} elsif ( $mode == F_SIZE ) {
				$mode = 'F_SIZE';
			} elsif ( $mode == F_STYLE) {
				$mode = 'F_STYLE';
				my @s;
				push @s, "italic" if $data & fs::Italic;
				push @s, "bold" if $data & fs::Bold;
				push @s, "thin" if $data & fs::Thin;
				push @s, "underlined" if $data & fs::Underlined;
				push @s, "struckout" if $data & fs::StruckOut;
				push @s, "outline" if $data & fs::Outline;
				@s = "normal" unless @s;
				$data = join(',', @s);
			}
			print STDERR ": OP_FONT.$mode $data\n";
		} elsif ( $cmd == OP_COLOR ) {
			my $color = $$b[ $i + 1 ];
			my $bk = '';
			if ( $color & BACKCOLOR_FLAG ) {
				$bk = 'backcolor,';
				$color &= ~BACKCOLOR_FLAG;
			}
			if ( $color & BACKCOLOR_OFF ) {
				$bk = 'transparent,';
				$color &= ~BACKCOLOR_OFF;
			}
			if ( $color & COLOR_INDEX) {
				$color = "index(" . ( $color & ~COLOR_INDEX) . ")";
			} else {
				$color = sprintf("%06x", $color);
			}
			print STDERR ": OP_COLOR $bk$color\n";
		} elsif ( $cmd == OP_TRANSPOSE) {
			my $x = $$b[ $i + X_X ];
			my $y = $$b[ $i + X_Y ];
			my $f = $$b[ $i + X_FLAGS ] ? 'EXTEND' : 'TRANSPOSE';
			print STDERR ": OP_TRANSPOSE $x $y $f\n";
		} elsif ( $cmd == OP_CODE ) {
			my $code = $$b[ $i + 1 ];
			print STDERR ": OP_CODE $code\n";
		} elsif ( $cmd == OP_WRAP ) {
			my $wrap = $$b[ $i + 1 ];
			$wrap = ( $wrap == WRAP_MODE_OFF ) ? 'OFF' : (
				($wrap == WRAP_MODE_ON) ? 'ON' : 'IMMEDIATE'
			);
			print STDERR ": OP_WRAP $wrap\n";
		} elsif ( $cmd == OP_MARK ) {
			my $id = $$b[ $i + MARK_ID ];
			my $x  = $$b[ $i + MARK_X ];
			my $y  = $$b[ $i + MARK_Y ];
			print STDERR ": OP_MARK $id $x $y\n";
		} else {
			my $oplen = $cmd >> 16;
			$cmd &= 0xffff;
			$cmd = $opval{$cmd} if defined $opval{$cmd};
			my @o = ($oplen > 1) ? @$b[ $i + 1 .. $i + $oplen - 1] : ();
			print STDERR ": OP($cmd) @o\n";
			last unless $$b[$i] >> 16;
		}
	}
}

sub walk
{
	my ( $block, %commands ) = @_;

	my $trace      = $commands{trace}      // 0;
	my $position   = $commands{position}   // [0,0];
	my $resolution = $commands{resolution} // [72,72];
	my $canvas     = $commands{canvas};
	my $state      = $commands{state}      // [];
	my $other      = $commands{other};
	my $ptr        = $commands{pointer}     // \(my $_i);
	my $def_fs     = $commands{baseFontSize} // 10;
	my $def_fl     = $commands{baseFontStyle} // 0;
	my $semaphore  = $commands{semaphore}   // \(my $_j);
	my $text       = $commands{textPtr}     // \(my $_k);
	my $fontmap    = $commands{fontmap};
	my $colormap   = $commands{colormap};
	my $realize    = $commands{realize}     // sub {
		$canvas->font(realize_fonts($fontmap, $_[0]))  if $_[1] & REALIZE_FONTS;
		$canvas->set(realize_colors($colormap, $_[0])) if $_[1] & REALIZE_COLORS;
	};

	my @commands;
	$commands[ $opnames{$_} & 0xffff ] = $commands{$_} for grep { exists $opnames{$_} } keys %commands;
	my $ret;

	my ( $text_offset, $f_taint, $font, $c_taint, $paint_state, %save_properties, $f_touched, $c_touched );

	# save paint state
	if ( $trace & TRACE_PAINT_STATE ) {
		$paint_state = $canvas-> get_paint_state;
		if ($paint_state) {
			$save_properties{set_font} = $canvas->get_font if $trace & TRACE_FONTS;
			if ($trace & TRACE_COLORS) {
				$save_properties{$_} = $canvas->$_() for qw(color backColor textOpaque);
			}
		} else {
			$canvas-> begin_paint_info;
		}
	}

	$text_offset = $$block[ BLK_TEXT_OFFSET]
		if $trace & TRACE_TEXT;
	@$state = @$block[ 0 .. BLK_DATA_END ]
		if !@$state && $trace & TRACE_PENS;
	$$position[0] += $$block[ BLK_APERTURE_X], $$position[1] += $$block[ BLK_APERTURE_Y]
		if $trace & TRACE_POSITION;

	# go
	my $lim = scalar(@$block);
	for ( $$ptr = BLK_START; $$ptr < $lim; $$ptr += $$block[ $$ptr ] >> 16 ) {
		my $i   = $$ptr;
		my $cmd = $$block[$i];
		my $sub = $commands[ $cmd & 0xffff];
		my @opcode;
		if ( !$sub && $other ) {
			$sub = $other;
			@opcode = ($cmd);
		}
		if ($cmd == OP_TEXT) {
			next unless $$block[$i + T_LEN] > 0;

			if (( $trace & TRACE_FONTS) && ($trace & TRACE_REALIZE) && !$f_taint) {
				$realize->($state, REALIZE_FONTS);
				$f_taint   = 1;
				$f_touched = 1;
			}
			if (( $trace & TRACE_COLORS) && ($trace & TRACE_REALIZE) && !$c_taint) {
				$realize->($state, REALIZE_COLORS);
				$c_taint   = 1;
				$c_touched = 1;
			}
			$ret = $sub->(
				@opcode,
				@$block[$i + 1 .. $i + ($$block[ $$ptr ] >> 16) - 1],
				(( $trace & TRACE_TEXT ) ?
					substr( $$text, $text_offset + $$block[$i + T_OFS], $$block[$i + T_LEN] ) : ())
			) if $sub;
			$$position[0] += $$block[ $i + T_WID] if $trace & TRACE_POSITION;
			last if $$semaphore;
			next;
		} elsif (($cmd == OP_FONT) && ($trace & TRACE_FONTS)) {
			my ($op, $data) = @{$block}[$i + F_MODE, $i + F_DATA];
			if ( $op == F_SIZE && $data < F_HEIGHT ) {
				$$state[F_SIZE] = $def_fs + $data;
			} elsif ( $op == F_STYLE ) {
				$$state[F_STYLE] = $data | $def_fl;
			} else {
				$$state[$op] = $data;
			}
			$font = $f_taint = undef;
		} elsif (($cmd == OP_COLOR) && ($trace & TRACE_COLORS)) {
			if ( ($$block[ $i + 1] & BACKCOLOR_FLAG) ) {
				$$state[ BLK_BACKCOLOR ] = $$block[$i + 1] & ~BACKCOLOR_FLAG;
			} else {
				$$state[ BLK_COLOR ] = $$block[$i + 1];
			}
			$c_taint = undef;
		} elsif ( $cmd == OP_TRANSPOSE) {
			my $x = $$block[ $i + X_X];
			my $y = $$block[ $i + X_Y];
			my $f = $$block[ $i + X_FLAGS];
			if (($trace & TRACE_FONTS) && ($trace & TRACE_REALIZE)) {
				if ( $f & X_DIMENSION_FONT_HEIGHT) {
					unless ( $f_taint) {
						$realize->($state, REALIZE_FONTS);
						$f_taint   = 1;
						$f_touched = 1;
					}
					$font //= $canvas-> get_font;
					$x *= $font-> {height};
					$y *= $font-> {height};
					$f &= ~X_DIMENSION_FONT_HEIGHT;
				}
			}
			if ( $f & X_DIMENSION_POINT) {
				$x = int($x * $resolution->[0] / 72 + .5);
				$y = int($y * $resolution->[1] / 72 + .5);
				$f &= ~X_DIMENSION_POINT;
			}
			$ret = $sub->( @opcode, $x, $y, $f ) if $sub;
			if (!($f & X_EXTEND) && ($trace & TRACE_POSITION)) {
				$$position[0] += $x;
				$$position[1] += $y;
			}
			last if $$semaphore;
			next;
		} elsif (( $cmd == OP_CODE) && ($trace & TRACE_PENS) && ($trace & TRACE_REALIZE)) {
			unless ( $f_taint) {
				$realize->($state, REALIZE_FONTS) if $trace & TRACE_FONTS;
				$f_taint   = 1;
				$f_touched = 1;
			}
			unless ( $c_taint) {
				$realize->($state, REALIZE_COLORS) if $trace & TRACE_COLORS;
				$c_taint   = 1;
				$c_touched = 1;
			}
		} elsif (( $cmd == OP_MARK) & ( $trace & TRACE_UPDATE_MARK)) {
			$$block[ $i + MARK_X] = $$position[0];
			$$block[ $i + MARK_Y] = $$position[1];
		} elsif (( 0 == ($cmd >> 16)) || (($cmd & 0xffff) > $lastop)) {
			# broken cmd, don't inf loop here
			warn "corrupted block, $cmd at $$ptr\n";
			_debug_block($block);
			last;
		}
		$ret = $sub->( @opcode, @$block[$i + 1 .. $i + ($$block[ $$ptr ] >> 16) - 1]) if $sub;
		last if $$semaphore;
	}

	# restore paint state
	if ( $trace & TRACE_PAINT_STATE ) {
		if ( $paint_state ) {
			delete @save_properties{qw(color backColor)} unless $c_touched;
			delete @save_properties{qw(font)}            unless $f_touched;
			$canvas->$_( $save_properties{$_} ) for keys %save_properties;
		} else {
			$canvas->end_paint_info;
		}
	}

	return $ret;
}

sub block_wrap
{
	my ( $b, %opt) = @_;
	my ($t, $canvas, $state, $width) = @opt{qw(textPtr canvas state width)};
	my %subopt = map { $_ => $opt{$_}} qw(fontmap baseFontSize baseFontStyle resolution);
	my $flags = $opt{textDirection} ? to::RTL : 0;

	$width = 0 if $width < 0;

	my $cmd;
	my ( $o) = ( $$b[ BLK_TEXT_OFFSET]);
	my ( $x, $y) = (0, 0);
	my $can_wrap = 1;
	my $stsave = $state;
	$state = [ @$state ];
	my ( $haswrapinfo, $wantnewblock, @wrapret);
	my ( @ret, $z, $ptr);
	my $lastTextOffset = $$b[ BLK_TEXT_OFFSET];
	my $has_text;
	my $strip_leading_spaces = $opt{stripLeadingSpaces} // 1;
	my $ignore_wrap_commands = $opt{ignoreWraps} // 0;
	my $word_break           = $opt{wordBreak};
	my $wrap_opts            = $word_break ? tw::WordBreak : 0;

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

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

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

	my %state_hash;

	# first state - wrap the block
	walk( $b, %subopt,
		textPtr => $t,
		pointer => \$ptr,
		canvas  => $canvas,
		state   => $state,
		trace   => TRACE_REALIZE_PENS,
		realize => sub { $canvas->font(realize_fonts($subopt{fontmap}, $_[0])) if $_[1] & REALIZE_FONTS },
		text    => sub {
			my ( $ofs, $tlen ) = @_;
			my $state_key = join('.', @$state[BLK_FONT_ID .. BLK_FONT_STYLE]);
			$state_hash{$state_key} = $canvas->get_font
				unless $state_hash{$state_key};
			$lastTextOffset = $ofs + $tlen unless $can_wrap;

		REWRAP:
			my $tw  = $canvas-> get_text_shape_width(substr( $$t, $o + $ofs, $tlen), to::AddOverhangs, $flags);
			my $apx = $state_hash{$state_key}-> {width};
			if ( $x + $tw + $apx <= $width) {
				push @$z, OP_TEXT, $ofs, $tlen, $tw;
				$x += $tw;
				$has_text = 1;
			} elsif ( $x + $apx >= $width ) {
				return if $x == 0;
				$newblock-> ();
				goto REWRAP;
			} elsif ( $can_wrap) {
				return if $tlen <= 0;
				my $str = substr( $$t, $o + $ofs, $tlen);
				my $leadingSpaces = '';
				if ( $strip_leading_spaces && $str =~ /^(\s+)/) {
					$leadingSpaces = $1;
					$str =~ s/^\s+//;
				}
				my $shaped = $canvas-> text_shape($str, rtl => $flags);
				my $l = $canvas-> text_wrap( $str, $width - $apx - $x,
					tw::ReturnFirstLineLength | tw::BreakSingle | $wrap_opts,
					8, 0, -1, $shaped || undef);
				if ( $l > 0) {
					if ( $has_text) {
						push @$z, OP_TEXT,
							$ofs, $l + length $leadingSpaces,
							$tw = $canvas-> get_text_shape_width(
								$leadingSpaces . substr( $str, 0, $l), to::AddOverhangs,
								$flags
							);
					} else {
						push @$z, OP_TEXT,
							$ofs + length $leadingSpaces, $l,
							$tw = $canvas-> get_text_shape_width(
								substr( $str, 0, $l), to::AddOverhangs,
								$flags
							);
						$has_text = 1;
					}
					$str = substr( $str, $l);
					$l += length $leadingSpaces;
					$newblock-> ();
					$ofs += $l;
					$tlen -= $l;
					if ( $str =~ /^(\s+)/) {
						$ofs  += length $1;
						$tlen -= length $1;
						$x    += $canvas-> get_text_shape_width( $1, to::AddOverhangs, $flags);
						$str =~ s/^\s+//;
					}
					goto REWRAP if length $str;
				} else { # does not fit into $width
					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 ( $word_break && ($str =~ m/^(\S+)(\s*)/)) {
							$tw = $canvas-> get_text_shape_width( $1, to::AddOverhangs, $flags);
							push @$z, OP_TEXT, $ofs, length $1, $tw;
							$has_text = 1;
							$x += $tw;
							$ofs  += length($1) + length($2);
							$tlen -= length($1) + length($2);
							goto REWRAP;
						}
					}
					my $rr = $x;
					push @$z, OP_TEXT, $ofs, length($str),
						$x += $canvas-> get_text_shape_width( $str, to::AddOverhangs, $flags);
					$has_text = 1;
				}
			} elsif ( $haswrapinfo) { # unwrappable, and cannot be fit - retrace
				$retrace-> ();
			} else { # unwrappable, cannot be fit, no wrap info! - whole new block
				push @$z, OP_TEXT, $ofs, $tlen, $tw;
				if ( $can_wrap ) {
					$newblock-> ();
				} else {
					$wantnewblock = 1;
				}
			}
		},
		wrap => sub {
			return if $ignore_wrap_commands;

			my $mode = shift;
			if ( $can_wrap && $mode == WRAP_MODE_OFF) {
				@wrapret = ( scalar @$z, [ @$state ], $ptr);
				$haswrapinfo = 1;
			} elsif ( !$can_wrap && $mode == WRAP_MODE_ON && $wantnewblock) {
				$newblock-> ();
			}

			if ( $mode == WRAP_IMMEDIATE ) {
				$newblock->() unless $opt{ignoreImmediateWrap};
			} else {
				$can_wrap = ($mode == WRAP_MODE_ON);
			}
		},
		transpose => sub {
			my ( $dx, $dy, $flags) = @_;
			if ( $x + $dx >= $width) {
				if ( $can_wrap) {
					$newblock-> ();
				} elsif ( $haswrapinfo) {
					return $retrace-> ();
				}
			} else {
				$x += $dx;
			}
			push @$z, OP_TRANSPOSE, $dx, $dy, $flags;
		},
		other => sub { push @$z, @_ },
	);

	# remove eventual empty blocks
	@ret = grep { @$_ != BLK_START } @ret;

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

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

	for my $b ( @ret) {
		$$b[ BLK_Y] = $start;

		my @xy = (0,0);
		my $ptr;
		walk( $b, %subopt,
			textPtr  => $t,
		        canvas   => $canvas,
			trace    => TRACE_FONTS | TRACE_POSITION | TRACE_UPDATE_MARK,
			state    => $state,
			position => \@xy,
			pointer  => \$ptr,
			text     => sub {
				my ( $ofs, $len, $wid ) = @_;
				my $f_taint = $state_hash{ join('.',
					@$state[BLK_FONT_ID .. BLK_FONT_STYLE]
				) };
				my $x = $xy[0] + $wid;
				my $y = $xy[1];
				$$b[ BLK_WIDTH] = $x
					if $$b[ BLK_WIDTH ] < $x;
				$$b[ BLK_APERTURE_Y] = $f_taint-> {descent} - $y
					if $$b[ BLK_APERTURE_Y] < $f_taint-> {descent} - $y;
				$$b[ BLK_APERTURE_X] = $f_taint-> {width}   - $x
					if $$b[ BLK_APERTURE_X] < $f_taint-> {width}   - $x;
				my $newY = $y + $f_taint-> {ascent} + $f_taint-> {externalLeading};
				$$b[ BLK_HEIGHT] = $newY if $$b[ BLK_HEIGHT] < $newY;
				$lastTextOffset = $$b[ BLK_TEXT_OFFSET] + $ofs + $len;

				$$b[ $ptr + T_OFS] -= $lastBlockOffset - $$b[ BLK_TEXT_OFFSET];
			},
			transpose => sub {
				my ( $dx, $dy, $f ) = @_;
				my ( $newX, $newY) = ( $xy[0] + $dx, $xy[1] + $dy);
				$$b[ BLK_WIDTH]  = $newX
					if $$b[ BLK_WIDTH ] < $newX;
				$$b[ BLK_HEIGHT] = $newY
					if $$b[ BLK_HEIGHT] < $newY;
				$$b[ BLK_APERTURE_X] = -$newX
					if $newX < 0 && $$b[ BLK_APERTURE_X] > -$newX;
				$$b[ BLK_APERTURE_Y] = -$newY
					if $newY < 0 && $$b[ BLK_APERTURE_Y] > -$newY;
			},
		);
		$$b[ BLK_TEXT_OFFSET] = $lastBlockOffset;
		$$b[ BLK_HEIGHT] += $$b[ BLK_APERTURE_Y];
		$$b[ BLK_WIDTH]  += $$b[ BLK_APERTURE_X];
		$start += $$b[ BLK_HEIGHT];
		$lastBlockOffset = $lastTextOffset;
	}

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

	return @ret;
}

sub get_text_width_with_overhangs
{
	my ( $b, %opt) = @_;

	return $$b[BLK_WIDTH] if !wantarray && defined $$b[BLK_WIDTH];

	my $canvas = $opt{canvas};

	my $last_letter_ofs;
	walk( $b, %opt,
		trace     => tb::TRACE_TEXT,
		text      => sub { $last_letter_ofs = $_[0] },
	);

	my @xy = (0,0);
	my $last_c_width;
	my $first_a_width;
	walk( $b, %opt,
		position  => \@xy,
		trace     => tb::TRACE_REALIZE_FONTS | tb::TRACE_TEXT | tb::TRACE_GEOMETRY |
				(( $opt{restoreCanvas} // 1) ? tb::TRACE_PAINT_STATE : 0 ),
		text      => sub {
			my ($ofs, $len, undef, $t) = @_;
			my ($whole, $this_c_width);
			if ( !defined $first_a_width) {
				my $char = substr( $t, 0, 1 );
				( $first_a_width, undef, $this_c_width ) = @{ $canvas->get_font_abc(
					ord($char), ord($char), utf8::is_utf8($t)
				) };
				$whole++ if $len == 1;
			}
			if ( $ofs == $last_letter_ofs ) {
				if ( $whole ) {
					$last_c_width = $this_c_width;
				} else {
					my $char = substr( $t, -1, 1 );
					( undef, undef, $last_c_width ) = @{ $canvas->get_font_abc(ord($char), ord($char), utf8::is_utf8($t)) };
				}
			}
		},
	);
	if ( defined $first_a_width ) {
		$first_a_width = ( $first_a_width < 0 ) ? -$first_a_width : 0;
		$last_c_width  = ( $last_c_width  < 0 ) ? -$last_c_width : 0;
	} else {
		$first_a_width = $last_c_width = 0;
	}

	return wantarray ?
		($xy[0], $first_a_width, $last_c_width) :
		$xy[0] + $first_a_width + $last_c_width;
}

sub justify_interspace
{
	my ($b, %opt) = @_;
	my ($canvas, $width) = @opt{qw(canvas width)};

	my $curr_width = $$b[BLK_WIDTH] // scalar get_text_width_with_overhangs($b, %opt);
	return if $curr_width > $opt{width} || $curr_width == 0;
	my $min_text_to_space_ratio = $opt{max_text_to_space_ratio} // 0.75;
	return if $curr_width / $width < $min_text_to_space_ratio;
	my @new = @$b[0 .. BLK_DATA_END];
	my @breaks;
	my $n_spaces = 0;
	my $tt = '';
	my $space_width;
	my $got_spaces_at_start;
	my $combined_width = 0;
	walk( $b, %opt,
		trace     => TRACE_TEXT | TRACE_REALIZE_FONTS | TRACE_PAINT_STATE,
		other     => sub { push @new, @_ },
		font      => sub {
			push @new, font(@_);
			undef $space_width;
		},
		text      => sub {
			my ($ofs, $len, $wid, $t) = @_;
			unless ($t =~ m/^(\s*)(\S+\s+\S.*?)(\s*)$/) {
				push @new, text(@_);
				$combined_width += $wid;
				return;
			}

			my ($start, $mid, $end) = ($1, $2, $3);
			($start, $mid) = ('', "$start$mid") if $got_spaces_at_start;
			$got_spaces_at_start = 1;

			my @txt;
			while ( 1 ) {
				my $tx;
				if ( $mid =~ m/\G(\s+)/gcs) {
					my $l = length($1);
					$ofs += $l;
					$space_width //= $canvas->get_text_shape_width(' ');
					push @txt, undef, undef, $l * $space_width;
					$n_spaces++;
					$combined_width += $l * $space_width;
					next;
				} elsif ( $mid =~ m/\G$/gcs) {
					last;
				} elsif ($mid =~ m/\G^(\S+)/gcs) {
					$tx = "$start$1";
				} elsif ( $mid =~ m/\G(\S+)$/gcs) {
					$tx = "$1$end";
				} elsif ( $mid =~ m/\G(\S+)/gcs) {
					$tx = $1;
				}
#				$tt .= "$tx ";

				my $l = length($tx);
				my $tw = $canvas->get_text_shape_width($tx);
				$combined_width += $tw;
				push @txt, $ofs, $l, $tw;
				$ofs += $l;
			}
			push @breaks, [ scalar(@new), \@txt ];
		},
	);
	return unless $n_spaces;
	return if $combined_width >= $width;

	my $avg_space_incr  = ($width - $combined_width) / $n_spaces;
	my ($curr, $last_incr) = (0,0);
	my $ff = $canvas->font;
	my $fh = $ff->{height} + $ff->{externalLeading};
	my $dh = $$b[BLK_APERTURE_Y] - $ff->{descent};

	for ( my $i = $#breaks; $i >= 0; $i--) {
		my ( $at, $txt ) = @{ $breaks[$i] };
		my @blk;
		for ( my $j = 0; $j < @$txt; $j += 3) {
			if ( defined $$txt[$j] ) {
				push @blk, text(@$txt[$j .. $j+2] );
			} else {
				$curr += $avg_space_incr;
				my $incr = int( $curr - $last_incr );
				$last_incr += $incr;
				push @blk, moveto(0, $dh) if $dh != 0;
				push @blk, extend($$txt[$j + 2] + $incr, $fh);
				push @blk, moveto($$txt[$j + 2] + $incr, -$dh);
			}
		}
		splice( @new, $at, 0, @blk);
	}

	$new[BLK_WIDTH] = $width;

	return \@new;
}


package Prima::Drawable::TextBlock;

sub new
{
	my ($class, %opt) = @_;
	my $self = bless {
		restoreCanvas => 1,
		baseFontSize  => 10,
		baseFontStyle => 0,
		direction     => 0,
		fontmap       => [],
		colormap      => [],
		textRef       => \'',
		textDirection => 0,
		block         => undef,
		resolution    => [72,72],
		fontSignature => '',
		%opt,
	}, $class;
	return $self;
}

eval "sub $_ { \$#_ ? \$_[0]->{$_} = \$_[1] : \$_[0]->{$_}}" for qw(
	fontmap colormap block textRef resolution direction
	baseFontSize baseFontStyle restoreCanvas textDirection
);

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

sub acquire {}

sub calculate_dimensions
{
	my ( $self, $canvas ) = @_;

	my @xy = (0,0);
	my @min = (0,0);
	my @max = (0,0);
	my $extra_width = 0;
	my $ptr = 0;
	my $b   = $self->{block};
	tb::walk( $b, $self-> walk_options,
		position => \@xy,
		pointer  => \$ptr,
		canvas   => $canvas,
		trace    => tb::TRACE_REALIZE_FONTS|tb::TRACE_POSITION|tb::TRACE_PAINT_STATE|tb::TRACE_TEXT,
		text     => sub {
			my ( undef, undef, undef, $text ) = @_;
			$b-> [ $ptr + tb::T_WID ] = $canvas->get_text_shape_width(
				$text,
				($self->{textDirection} ? to::RTL : 0) | to::AddOverhangs,
			);

			my $f = $canvas->get_font;
			$max[1] = $f->{ascent}  if $max[1] < $f->{ascent};
			$min[1] = $f->{descent} if $min[0] < $f->{descent};

			# roughly compensate for uncalculated .A and .C
			$extra_width = $f->{width} if $extra_width < $f->{width};
		},
		transpose => sub {
			my ($x, $y) = @_;
			$min[0] = $x if $min[0] > $x;
			$min[1] = $y if $min[1] > $y;
		},
	);
	$xy[0] += $extra_width;
	$max[0] = $xy[0] if $max[0] < $xy[0];
	$max[1] = $xy[1] if $max[1] < $xy[1];
	$b->[ tb::BLK_WIDTH]  = $max[0]+$min[0] if $b->[ tb::BLK_WIDTH  ] < $max[0]+$min[0];
	$b->[ tb::BLK_HEIGHT] = $max[1]+$min[1] if $b->[ tb::BLK_HEIGHT ] < $max[1]+$min[1];
	$b->[ tb::BLK_APERTURE_X] = $min[0];
	$b->[ tb::BLK_APERTURE_Y] = $min[1];
}

sub walk_options
{
	my $self = shift;
	return
		textPtr => $self->{textRef},
		( map { ($_ , $self->{$_}) } qw(fontmap colormap resolution baseFontSize baseFontSize) ),
		;
}

my $RAD = 57.29577951;

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

	my $restore_base_line;
	unless ( $canvas-> textOutBaseline ) {
		$canvas-> textOutBaseline(1);
		$restore_base_line = 1;
	}

	$self->acquire($canvas,
		font       => 1,
		colors     => 1,
		dimensions => 1,
	);

	my ($sin, $cos);
	($sin, $cos) = (sin( $self-> {direction} / $RAD ), cos( $self-> {direction} / $RAD ))
		if $self->{direction};

	my @xy  = ($x,$y);
	my @ofs = ($x,$y);
	my @state;
	my $semaphore;

	tb::walk( $self->{block}, $self-> walk_options,
		semaphore => \ $semaphore,
		trace     => tb::TRACE_GEOMETRY | tb::TRACE_REALIZE_PENS | tb::TRACE_TEXT |
				( $self-> {restoreCanvas} ? tb::TRACE_PAINT_STATE : 0 ),
		canvas    => $canvas,
		position  => \@xy,
		state     => \@state,
		text      => sub {
			my ( $ofs, $len, $wid, $tex) = @_;
			my @coord = $self-> {direction} ? (
				int($ofs[0] + ($xy[0]-$ofs[0]) * $cos - ($xy[1]-$ofs[1]) * $sin + .5),
				int($ofs[1] + ($xy[0]-$ofs[0]) * $sin + ($xy[1]-$ofs[1]) * $cos + .5)
			) : @xy;
			$semaphore++ unless $canvas-> text_shape_out($tex, @coord, $self->{textDirection});
		},
		code      => sub {
			my ( $code, $data ) = @_;
			my @coord = $self-> {direction} ? (
				int($ofs[0] + ($xy[0]-$ofs[0]) * $cos - ($xy[1]-$ofs[1]) * $sin + .5),
				int($ofs[1] + ($xy[0]-$ofs[0]) * $sin + ($xy[1]-$ofs[1]) * $cos + .5)
			) : @xy;
			$code-> ( $self, $canvas, $self->{block}, \@state, @coord, $data);
		},
	);

	$canvas-> textOutBaseline(0) if $restore_base_line;

	return not $semaphore;
}

sub get_text_width
{
	my ( $self, $canvas, $add_overhangs) = @_;

	$self->acquire($canvas, font => 1, dimensions => 1);

	return scalar tb::get_text_width_with_overhangs( $self->{block}, $self-> walk_options )
		if $add_overhangs;

	my @xy = (0,0);
	tb::walk( $self->{block}, $self-> walk_options,
		trace     => tb::TRACE_POSITION,
		position  => \@xy,
	);
	return $xy[0];
}

sub get_text_box
{
	my ( $self, $canvas, $text) = @_;

	$self->acquire($canvas, font => 1, dimensions => 1);

	my ($w, $a, $c) = $self-> get_text_width_with_overhangs($canvas);

	my $b = $self->{block};
	my ( $fa, $fd ) = ( $b->[tb::BLK_HEIGHT] - $b->[tb::BLK_APERTURE_Y] - 1, $b->[tb::BLK_APERTURE_Y]);

	my @ret = (
		-$a,      $fa,
		-$a,     -$fd,
		$w + $c,  $fa,
		$w + $c, -$fd,
		$w, 0
	);
	unless ( $canvas-> textOutBaseline) {
		$ret[$_] += $fd for (1,3,5,7,9);
	}
	if ( my $dir = $self-> {direction}) {
		my $s = sin( $dir / $RAD );
		my $c = cos( $dir / $RAD );
		my $i;
		for ( $i = 0; $i < 10; $i+=2) {
			my ( $x, $y) = @ret[$i,$i+1];
			$ret[$i]   = $x * $c - $y * $s;
			$ret[$i+1] = $x * $s + $y * $c;
		}
	}

	return \@ret;
}

sub text_wrap
{
	my ( $self, $canvas, $width, $opt, $indent) = @_;
	$opt //= tw::Default;
	$width = 2_000_000 if $width < 0; 

	# Ignored options: ExpandTabs, CalcTabs .

	# first, we don't return chunks, period. That's too messy.
	return $canvas-> text_wrap( ${$self-> {textRef}}, $width, $opt, $indent)
		if $opt & tw::ReturnChunks;

	$self->acquire($canvas, font => 1);

	my (@ret, $add_tilde);

	# we don't calculate the underscore position and return none.
	if ( $opt & (tw::CollapseTilde|tw::CalcMnemonic)) {
		$add_tilde = {
			tildeStart => undef,
			tildeEnd   => undef,
			tildeLine  => undef,
		};
	}

	my @blocks = tb::block_wrap( $self->{block},
		$self-> walk_options,
		state     => $self->{block},
		width     => $width,
		canvas    => $canvas,
		optimize  => 0,
		wordBreak => $opt & tw::WordBreak,
		ignoreImmediateWrap => !($opt & tw::NewLineBreak),
	);

	# breaksingle is not supported by block_wrap, emulating
	if ( $opt & tw::BreakSingle ) {
		for my $b ( @blocks ) {
			next if $b->[tb::BLK_WIDTH] <= $width;
			@blocks = ();
			last;
		}
	}

	# linelength has a separate function
	if ( $opt & tw::ReturnFirstLineLength ) {
		return 0 unless @blocks;

		my ($semaphore, $retval) = (0,0);
		tb::walk( $blocks[0]->{block},
			trace     => tb::TRACE_TEXT,
			semaphore => \ $semaphore,
			text      => sub {
				( undef, $retval ) = @_;
				$semaphore++;
			},
		);
		return $retval;
	}

	@ret = map { __PACKAGE__->new( %$self, block => $_ ) } @blocks;
	push @ret, $add_tilde if $add_tilde;

	return \@ret;
}

sub text_shape { undef }

sub height
{
	my ( $self, $canvas ) = @_;
	$self-> acquire( $canvas, dimensions => 1 );
	return $self->{block}->[tb::BLK_HEIGHT];
}

package Prima::Drawable::PolyTextBlock;
use base qw(Prima::Drawable::TextBlock);


sub new
{
	my ($class, %opt) = @_;
	my $self = $class->SUPER::new(%opt);
	$self->{blocks} //= [];
	return $self;
}

sub blocks { $_[0]->{blocks} }

sub for_blocks
{
	my ( $self, $canvas, $cb ) = @_;

	my $ps = $canvas ? $canvas->get_paint_state : ps::Enabled;
	$canvas->begin_paint_info if $ps == ps::Disabled;

	for my $b ( @{ $self->{blocks} }) {
		$self->{block} = $b;
		$cb->(@_);
	}

	$canvas->end_paint_info if $ps == ps::Disabled;
}

sub calculate_dimensions
{
	my ( $self, $canvas ) = @_;
	$self-> for_blocks( $canvas, sub {
		$self-> SUPER::calculate_dimensions( $canvas );
	} );
}

sub text_out
{
	my ($self, $canvas, $x, $y) = @_;
	$self-> for_blocks( $canvas, sub {
		my $b = $self->{block};
		$self-> SUPER::text_out( $canvas, $x, $y);
		$y -= $$b[tb::BLK_HEIGHT];
	});
}

sub get_text_width
{
	my ( $self, $canvas, $add_overhangs) = @_;

	my $max = 0;
	$self-> for_blocks( $canvas, sub {
		my $x = $self-> SUPER::get_text_width( $canvas, $add_overhangs );
		$max = $x if $max < $x;
	} );
	return $max;
}

sub get_text_box
{
	# XXX unimplemented - todo
}

sub text_wrap
{
	my ( $self, $canvas, $width, $opt, $indent) = @_;
	my @ret;
	$self-> for_blocks( $canvas, sub {
		my $x = $self-> SUPER::text_wrap( $canvas, $width, $opt, $indent);
		push @ret, @$x;
	} );
	return \@ret;
}

1;

=pod

=head1 NAME

Prima::Drawable::TextBlock - rich text representation

=head1 API

=head2 Block header

A block's fixed header consists of C<tb::BLK_START - 1> integer scalars,
each of which 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 first group defines the offset constants that are used to address the
values in the block header; the constants lie in the 0 - C<tb::BLK_START - 1>
range.  The second group values line in the C<tb::BLK_DATA_START> -
C<tb::BLK_DATA_END> range.  This is done for eventual backward compatibility,
if the future development changes the length of the header.

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

=head2 Block parameters

The scalars after C<tb::BLK_START> encode the commands to the block renderer.
These commands have their own parameters which follow the command.  The length
of the command is encoded in the high 16-bit word of the command. 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 the offset C<tb::BLK_TEXT_OFFSET +
TEXT_OFFSET>, with the length TEXT_LENGTH. The third parameter TEXT_WIDTH
contains the width of the text in pixels. The scheme is made for simplification
of an imaginary code, that would alter ( insert to, or delete part of ) the
text; the updating procedure would not need to traverse all commands in all
blocks, but only 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 the 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 the C<tb::COLOR_INDEX> flag, in such case it is
treated an index in the C<::colormap> property array.

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

=item OP_FONT - KEY, VALUE

As a font is a complex property which includes font name, size, direction, etc
fields, the 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
meanings.

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

=over

=item F_STYLE

Contains a combination of the 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 font
size. As such, 0 is a default value, and -2 is the 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 careful when relying on the combined font size value .

If the C<F_SIZE> value is added to the C<F_HEIGHT> constant, then it is treated
as 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 an index in
the C<::fontPalette> property array, which contains font hashes with the other
font keys initialized - name, encoding, and pitch. These three fields are required
to be defined in the font hash; the other font fields are optional.

=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 into
account. If FLAGS does not contain C<tb::X_EXTEND>, then in addition to the
block expansion, the current coordinate is also moved to (X,Y). 
C<(OP_TRANSPOSE,0,0,0)> and C<(OP_TRANSPOSE,0,0,X_EXTEND)> are identical and
are empty operators.

The C<X_DIMENSION_FONT_HEIGHT> flag indicates that (X,Y) values must be multiplied by
the current font height.  Another flag C<X_DIMENSION_POINT> does the same but
multiplies by the current value of the L<resolution> property divided by 72 (
treats X and Y not as pixel but as 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
rewritten every time a new graphic is invented. For example, see how
L<Prima::PodView> implements images and bullet points.

=item OP_CODE - SUB, PARAMETER

Contains a custom code pointer SUB with a parameter PARAMETER, passed when
the 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 the block.  The format of the state is the same as of the text
block, and the F_ID, F_SIZE, the F_STYLE constants are the same as BLK_FONT_ID,
BLK_FONT_SIZE, and BLK_FONT_STYLE.

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

=item OP_WRAP mode

C<OP_WRAP> is only used in the L<block_wrap> method. C<mode> is a flag,
selecting the wrapping command.

   WRAP_MODE_ON   - default, block commands can be wrapped
   WRAP_MODE_OFF  - cancels WRAP_MODE_ON, commands cannot be wrapped
   WRAP_IMMEDIATE - proceed with immediate wrapping, unless the ignoreImmediateWrap option is set

L<block_wrap> does not support stacking for the wrap commands, so the
C<(OP_WRAP,WRAP_MODE_ON,OP_WRAP,WRAP_MODE_ON,OP_WRAP,WRAP_MODE_OFF)> command
sequence has the same effect as the C<(OP_WRAP,WRAP_MODE_OFF)> sequence. If C<mode> is
WRAP_MODE_ON, wrapping is disabled - all following commands are treated as
non-wrappable until the C<(OP_WRAP,WRAP_MODE_OFF)> command sequence is met.

=item OP_MARK PARAMETER, X, Y

C<OP_MARK> is only in effect in the 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, for example for
saving the geometrical positions during the block wrapping.

=back

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

=head2 Rendering methods

=over

=item block_wrap %OPTIONS

C<block_wrap> wraps a block into a given width in pixels. It returns one or more text
blocks with fully formed headers. The returned blocks are located one below
another, providing an illusion that the text itself is wrapped.  It does not
only traverse the opcodes and sees if the command fits 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 the C<OP_WRAP> command brackets. The commands inside these
brackets are not wrapped; the C<OP_WRAP> commands are removed from the resulting
blocks.

C<block_wrap> copies all commands and their parameters as is, except the following:

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

- If C<OP_TRANSPOSE>'s third parameter, C<X_FLAGS> contains the
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. The C<X_DIMENSION_PIXEL> has a similar effect but the coordinates are
multiplied by the current resolution divided by 72.

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

- C<OP_WRAP> is removed from the output.

=item justify_interspace %OPTIONS

Uses C<$OPTIONS{width}> and C<$OPTIONS{min_text_to_space_ratio}> to try to make
inter-word spacing. Returns new block if successful, undef otherwise.

=item walk BLOCK, %OPTIONS

Cycles through the block opcodes, calls supplied callbacks on each.

=back

=head1 AUTHOR

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

=head1 SEE ALSO

L<Prima::TextView>, L<Prima::Drawable::Markup>, F<examples/mouse_tale.pl>.

