package Prima::Drawable::TextBlock;
use strict;
use warnings;
use Prima::Bidi;
package
tb;
use vars qw(@oplen %opnames);
@oplen = ( 4, 2, 3, 4, 3, 2, 4, 3); # lengths of 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) WRAP_XXX
use constant OP_MARK => 6; # (3) id, x, y
use constant OP_BIDIMAP => 7; # (2) visual, $map
%opnames = (
text => OP_TEXT,
color => OP_COLOR,
font => OP_FONT,
transpose => OP_TRANSPOSE,
code => OP_CODE,
wrap => OP_WRAP,
mark => OP_MARK,
bidimap => OP_BIDIMAP,
);
# 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;
# OP_BIDIMAP
use constant BIDI_VISUAL => 1;
use constant BIDI_MAP => 2;
# 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;
use constant T_IS_BIDI => 0x4;
# 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 += $oplen[$$block[$i]], $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;
push @oplen, $len + 1;
$opnames{$name} = scalar(@oplen) - 1 if defined $name;
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 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 bidimap { return OP_BIDIMAP, $_[0], $_[1] }
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) = @_;
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);
}
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", $color);
}
print STDERR "$color\n";
my ($i, $lim) = (BLK_START, scalar @$b);
my $oplen;
for ( ; $i < $lim; $i += $oplen[ $$b[ $i]]) {
my $cmd = $$b[$i];
if ( !defined($cmd) || $cmd > $#oplen ) {
$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 )\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 & 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_X ];
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_BIDIMAP ) {
my $visual = $$b[ $i + BIDI_VISUAL ];
my $map = $$b[ $i + BIDI_MAP ];
$visual =~ s/([^\x{32}-\x{128}])/sprintf("\\x{%x}", ord($1))/ge;
print STDERR ": OP_BIDIMAP: $visual / @$map\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 = $oplen[ $cmd ];
my @o = ($oplen > 1) ? @$b[ $i + 1 .. $i + $oplen - 1] : ();
print STDERR ": OP($cmd) @o\n";
}
}
}
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{$_} ] = $commands{$_} for grep { exists $opnames{$_} } keys %commands;
my $ret;
my ( $text_offset, $f_taint, $font, $c_taint, $paint_state, %save_properties );
# 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 += $oplen[ $$block[ $$ptr ]] ) {
my $i = $$ptr;
my $cmd = $$block[$i];
my $sub = $commands[ $$block[$i] ];
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;
}
if (( $trace & TRACE_COLORS) && ($trace & TRACE_REALIZE) && !$c_taint) {
$realize->($state, REALIZE_COLORS);
$c_taint = 1;
}
$ret = $sub->(
@opcode,
@$block[$i + 1 .. $i + $oplen[ $$block[ $$ptr ]] - 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)) {
if ( $$block[$i + F_MODE] == F_SIZE && $$block[$i + F_DATA] < F_HEIGHT ) {
$$state[ $$block[$i + F_MODE]] = $def_fs + $$block[$i + F_DATA];
} elsif ( $$block[$i + F_MODE] == F_STYLE ) {
$$state[ $$block[$i + F_MODE]] = $$block[$i + F_DATA] | $def_fl;
} else {
$$state[ $$block[$i + F_MODE]] = $$block[$i + F_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;
}
$font //= $canvas-> get_font;
$x *= $font-> {height};
$y *= $font-> {height};
$f &= ~X_DIMENSION_FONT_HEIGHT;
}
}
if ( $f & X_DIMENSION_POINT) {
$x *= $resolution->[0] / 72;
$y *= $resolution->[1] / 72;
$f &= ~X_DIMENSION_POINT;
}
$ret = $sub->( $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);
$f_taint = 1;
}
unless ( $c_taint) {
$realize->($state, REALIZE_COLORS);
$c_taint = 1;
}
} elsif (($cmd == OP_BIDIMAP) && ( $trace & TRACE_TEXT )) {
$text = \ $$block[$i + BIDI_VISUAL];
$text_offset = 0;
} elsif (( $cmd == OP_MARK) & ( $trace & TRACE_UPDATE_MARK)) {
$$block[ $i + MARK_X] = $$position[0];
$$block[ $i + MARK_Y] = $$position[1];
} elsif ( $cmd > $#oplen ) {
warn "corrupted block, $cmd at $$ptr\n";
_debug_block($block);
last;
}
$ret = $sub->( @opcode, @$block[$i + 1 .. $i + $oplen[ $$block[ $$ptr ]] - 1]) if $sub;
last if $$semaphore;
}
# restore paint state
if ( $trace & TRACE_PAINT_STATE ) {
if ( $paint_state ) {
$canvas->$_( $save_properties{$_} ) for keys %save_properties;
} else {
$canvas->end_paint_info;
}
}
return $ret;
}
# convert block with bidicharacters to its visual representation
sub bidi_visualize
{
my ( $b, %opt ) = @_;
my %subopt = map { $_ => $opt{$_}} qw(fontmap baseFontSize baseFontStyle resolution);
my ($p, $visual) = Prima::Bidi::paragraph($opt{text});
my $map = $p->map;
my $revmap = Prima::Bidi::revmap($map);
my @new = ( @$b[0..BLK_DATA_END], bidimap( $visual, $map ) );
$new[BLK_FLAGS] |= T_IS_BIDI;
my $oplen;
my ($x, $y, $i, $lim) = (0,0,BLK_START, scalar @$b);
# step 1 - record how each character is drawn with font/color, and also
# where other ops are positioned
my @default_fc = @$b[ 0 .. BLK_DATA_END ]; # fc == fonts and colors
my %id_hash = ( join(".", @default_fc[BLK_DATA_START .. BLK_DATA_END]) => 0 );
my @fonts_and_colors = ( \@default_fc ); # this is the number #0, default char state
my @current_fc = @default_fc;
my $current_state = 0;
my @char_states = (-1) x length($visual); # not all chars are displayed
my $char_offset = 0;
my %other_ops_after;
my $font_and_color = sub {
my $key = join(".", @current_fc[ BLK_DATA_START .. BLK_DATA_END ]);
my $state;
if (defined ($state = $id_hash{$key}) ) {
$current_state = $state;
} else {
push @fonts_and_colors, [ @current_fc ];
$id_hash{$key} = $current_state = $#fonts_and_colors;
}
};
walk( $b, %subopt,
trace => TRACE_PENS,
state => \@current_fc,
text => sub {
my ( $ofs, $len ) = @_;
for ( my $k = 0; $k < $len; $k++) {
$char_states[ $revmap->[ $ofs + $k ]] = $current_state;
}
$char_offset = $revmap->[$ofs + $len - 1];
},
font => $font_and_color,
color => $font_and_color,
other => sub { push @{$other_ops_after{ $char_offset }}, @_ }
);
# step 2 - produce RLEs for text and stuff font/colors/other ops in between
my $last_char_state = 0;
my $current_text_offset = 0;
# find first character displayed
for ( my $i = 0; $i < @char_states; $i++) {
next if $char_states[$i] < 0;
$current_text_offset = $i;
last;
}
my @initialized;
@initialized = ((1) x BLK_START) unless $opt{optimize};
push @char_states, -1;
for ( my $i = 0; $i < @char_states; $i++) {
my $char_state = $char_states[$i];
if ( $char_state != $last_char_state ) {
# push accumulated text
my $ofs = $current_text_offset;
my $len = $i - $ofs;
$current_text_offset = ($char_state < 0) ? $i + 1 : $i;
if ( $len > 0 ) {
push @new, OP_TEXT, $ofs, $len,
($opt{canvas} ? substr( $visual, $ofs, $len) : 0); # putting a string there for later width calc
}
# change to the new font/color
if ( $char_state >= 0 ) {
my $old_state = $fonts_and_colors[ $last_char_state ];
my $new_state = $fonts_and_colors[ $char_state ];
if ( $$old_state[ BLK_COLOR ] != $$new_state[ BLK_COLOR ] ) {
if ( $initialized[ BLK_COLOR ]++ ) {
push @new, OP_COLOR, $$new_state[ BLK_COLOR ];
} else {
$new[ BLK_COLOR ] = $$new_state[ BLK_COLOR ];
}
}
if ( $$old_state[ BLK_BACKCOLOR ] != $$new_state[ BLK_BACKCOLOR ] ) {
if ( $initialized[ BLK_BACKCOLOR ]++ ) {
push @new, OP_COLOR, $$new_state[ BLK_BACKCOLOR ] | BACKCOLOR_FLAG;
} else {
$new[ BLK_BACKCOLOR ] = $$new_state[ BLK_BACKCOLOR ];
}
}
for ( my $font_mode = BLK_FONT_ID; $font_mode <= BLK_FONT_STYLE; $font_mode++) {
next if $$old_state[ $font_mode ] == $$new_state[ $font_mode ];
if ( $initialized[ $font_mode ]++ ) {
push @new, OP_FONT, $font_mode, $$new_state[ $font_mode ];
} else {
$new[ $font_mode ] = $$new_state[ $font_mode ];
}
}
$last_char_state = $char_state;
}
}
# push other ops
if ( my $ops = $other_ops_after{ $i } ) {
push @new, @$ops;
}
}
# recalculate widths
if ( $opt{canvas} ) {
my @xy = (0,0);
my $ptr;
$new[ BLK_WIDTH] = 0;
walk( \@new, %subopt,
canvas => $opt{canvas},
trace => TRACE_REALIZE_FONTS | TRACE_UPDATE_MARK | TRACE_POSITION,
position => \@xy,
pointer => \$ptr,
text => sub { $new[ $ptr + T_WID ] = $opt{canvas}->get_text_width( $_[2], 1 ) },
);
$new[ BLK_WIDTH] = $xy[0] if $new[ BLK_WIDTH ] < $xy[0];
}
return \@new;
}
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);
$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 $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;
my $has_bidi;
# 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_width(substr( $$t, $o + $ofs, $tlen), 1);
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 ( $can_wrap) {
return 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::BreakSingle | $wrap_opts );
if ( $l > 0) {
if ( $has_text) {
push @$z, OP_TEXT,
$ofs, $l + length $leadingSpaces,
$tw = $canvas-> get_text_width(
$leadingSpaces . substr( $str, 0, $l), 1
);
} else {
push @$z, OP_TEXT,
$ofs + length $leadingSpaces, $l,
$tw = $canvas-> get_text_width(
substr( $str, 0, $l), 1
);
$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_width( $1, 1);
$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_width( $1, 1);
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;
}
}
push @$z, OP_TEXT, $ofs, length($str),
$x += $canvas-> get_text_width( $str, 1);
$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 {
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 unless $opt{bidi};
# third stage - map bidi characters to visual representation, and update widths and positions etc
my @text_offsets = (( map { $$_[ BLK_TEXT_OFFSET ] } @ret ), $lastTextOffset);
for ( my $j = 0; $j < @ret; $j++) {
my $substr = substr( $$t, $text_offsets[$j], $text_offsets[$j+1] - $text_offsets[$j]);
next unless Prima::Bidi::is_bidi($substr);
my $new = bidi_visualize($ret[$j], %subopt,
text => $substr,
canvas => $canvas,
optimize => 1,
);
splice(@ret, $j, 1, $new);
}
return @ret;
}
package Prima::Drawable::TextBlock;
sub new
{
my ($class, %opt) = @_;
my $self = bless {
restoreCanvas => 1,
baseFontSize => 10,
baseFontStyle => 0,
direction => 0,
fontmap => [],
colormap => [],
text => '',
block => undef,
resolution => [72,72],
fontSignature => '',
%opt,
}, $class;
return $self;
}
eval "sub $_ { \$#_ ? \$_[0]->{$_} = \$_[1] : \$_[0]->{$_}}" for qw(
fontmap colormap block text resolution direction
baseFontSize baseFontStyle restoreCanvas
);
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_width( $text );
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->{text},
( 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_out($tex, @coord);
},
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, $b, \@state, @coord, $data);
},
);
$canvas-> textOutBaseline(0) if $restore_base_line;
return not $semaphore;
}
sub get_text_width_with_overhangs
{
my ($self, $canvas) = @_;
my $first_a_width;
my $last_c_width;
my @xy = (0,0);
tb::walk( $self->{block}, $self-> walk_options,
position => \@xy,
trace => tb::TRACE_GEOMETRY | tb::TRACE_REALIZE | tb::TRACE_TEXT |
( $self-> {restoreCanvas} ? tb::TRACE_PAINT_STATE : 0 ),
canvas => $canvas,
text => sub {
my $t = pop;
if ( !defined $first_a_width) {
my $char = substr( $t, 0, 1 );
( $first_a_width ) = @{ $canvas->get_font_abc(ord($char), ord($char), utf8::is_utf8($t)) };
}
my $char = substr( $t, -1, 1 );
( undef, undef, $last_c_width ) = @{ $canvas->get_font_abc(ord($char), ord($char), utf8::is_utf8($t)) };
},
);
return (0,0,0) unless 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;
return ($xy[0], $first_a_width, $last_c_width);
}
sub get_text_width
{
my ( $self, $canvas, $add_overhangs) = @_;
$self->acquire($canvas, font => 1, dimensions => 1);
if ( $add_overhangs ) {
my ( $width, $a, $c) = $self-> get_text_width_with_overhangs($canvas);
return $width + $a + $c;
}
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;
# Ignored options: ExpandTabs, CalcTabs .
# first, we don't return chunks, period. That's too messy.
return $canvas-> text_wrap( $self-> {text}, $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,
bidi => 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 height
{
my ( $self, $canvas ) = @_;
$self-> acquire( $canvas, dimensions => 1 );
return $self->{block}->[tb::BLK_HEIGHT];
}
1;
__DATA__
=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 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 of 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> when not preceded by L<OP_BIDIMAP>.
=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 mode
C<OP_WRAP> is only in effect in 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 ignoreImmediateWrap options 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)> has same
effect as C<(OP_WRAP,WRAP_MODE_OFF)>. If C<mode> is WRAP_MODE_ON, wrapping is
disabled - all following commands treated an non-wrapable until
C<(OP_WRAP,WRAP_MODE_OFF)> 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.
=item OP_BIDIMAP VISUAL, BIDIMAP
C<OP_BIDIMAP> is used when the text to be displayed is RTL (right-to-left) and requires
special handling. This opcode is automatically created by C<block_wrap>. It must be
present before any C<OP_TEXT> opcode, because when in effect, the C<OP_TEXT> offset calculation
is different - instead of reading characters from C<< $self->{text} >>, it reads them from
C<VISUAL>, and C<BLK_TEXT_OFFSET> in the block header is not used.
=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.
- C<OP_BIDIMAP> added to the output, if the text to be displayed in the block
contains right-to-left characters.
=item walk BLOCK, %OPTIONS
Cycles through 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>.