1package Prima::Drawable::TextBlock; 2use strict; 3use warnings; 4 5package 6 tb; 7use vars qw($lastop %opnames); 8 9# basic opcodes 10use constant OP_TEXT => (0 | (4 << 16)); # text offset, text length, text width 11use constant OP_COLOR => (1 | (2 << 16)); # 0xRRGGBB or COLOR_INDEX | palette_index 12use constant OP_FONT => (2 | (3 << 16)); # op_font_mode, font info 13use constant OP_TRANSPOSE => (3 | (4 << 16)); # move current point to delta X, delta Y 14use constant OP_CODE => (4 | (3 << 16)); # code pointer and parameters 15 16# formatting opcodes 17use constant OP_WRAP => (5 | (2 << 16)); # WRAP_XXX 18use constant OP_MARK => (6 | (4 << 16)); # id, x, y 19$lastop = 6; 20 21%opnames = ( 22 text => OP_TEXT, 23 color => OP_COLOR, 24 font => OP_FONT, 25 transpose => OP_TRANSPOSE, 26 code => OP_CODE, 27 wrap => OP_WRAP, 28 mark => OP_MARK, 29); 30 31 32# OP_TEXT 33use constant T_OFS => 1; 34use constant T_LEN => 2; 35use constant T_WID => 3; 36 37# OP_FONT 38use constant F_MODE => 1; 39use constant F_DATA => 2; 40 41# OP_COLOR 42use constant COLOR_INDEX => 0x01000000; # index in colormap() array 43use constant BACKCOLOR_FLAG => 0x02000000; # OP_COLOR flag for backColor 44use constant BACKCOLOR_OFF => 0x04000000; # turn off textOpaque 45use constant BACKCOLOR_DEFAULT => BACKCOLOR_FLAG | BACKCOLOR_OFF; 46use constant COLOR_MASK => 0xF8FFFFFF; 47 48# OP_TRANSPOSE - indices 49use constant X_X => 1; 50use constant X_Y => 2; 51use constant X_FLAGS => 3; 52 53# OP_TRANSPOSE - X_FLAGS constants 54use constant X_TRANSPOSE => 0; 55use constant X_EXTEND => 1; 56use constant X_DIMENSION_PIXEL => 0; 57use constant X_DIMENSION_FONT_HEIGHT => 2; # multiply by font height 58use constant X_DIMENSION_POINT => 4; # multiply by resolution / 72 59 60# OP_WRAP 61use constant WRAP_MODE_OFF => 0; # mode selectors 62use constant WRAP_MODE_ON => 1; # 63use constant WRAP_IMMEDIATE => 2; # not a mode selector 64 65# OP_MARK 66use constant MARK_ID => 1; 67use constant MARK_X => 2; 68use constant MARK_Y => 3; 69 70# block header indices 71use constant BLK_FLAGS => 0; 72use constant BLK_WIDTH => 1; 73use constant BLK_HEIGHT => 2; 74use constant BLK_X => 3; 75use constant BLK_Y => 4; 76use constant BLK_APERTURE_X => 5; 77use constant BLK_APERTURE_Y => 6; 78use constant BLK_TEXT_OFFSET => 7; 79use constant BLK_DATA_START => 8; 80use constant BLK_FONT_ID => BLK_DATA_START; 81use constant BLK_FONT_SIZE => 9; 82use constant BLK_FONT_STYLE => 10; 83use constant BLK_COLOR => 11; 84use constant BLK_DATA_END => 12; 85use constant BLK_BACKCOLOR => BLK_DATA_END; 86use constant BLK_START => BLK_DATA_END + 1; 87 88# OP_FONT again 89use constant F_ID => BLK_FONT_ID; 90use constant F_SIZE => BLK_FONT_SIZE; 91use constant F_STYLE => BLK_FONT_STYLE; 92use constant F_HEIGHT=> 1000000; 93 94# BLK_FLAGS constants 95use constant T_SIZE => 0x1; 96use constant T_WRAPABLE => 0x2; 97 98# realize_state mode 99 100use constant REALIZE_FONTS => 0x1; 101use constant REALIZE_COLORS => 0x2; 102use constant REALIZE_ALL => 0x3; 103 104# trace constants 105use constant TRACE_FONTS => 0x01; 106use constant TRACE_COLORS => 0x02; 107use constant TRACE_PENS => TRACE_COLORS | TRACE_FONTS; 108use constant TRACE_POSITION => 0x04; 109use constant TRACE_TEXT => 0x08; 110use constant TRACE_GEOMETRY => TRACE_FONTS | TRACE_POSITION; 111use constant TRACE_UPDATE_MARK => 0x10; 112use constant TRACE_PAINT_STATE => 0x20; 113use constant TRACE_REALIZE => 0x40; 114use constant TRACE_REALIZE_FONTS => TRACE_FONTS | TRACE_REALIZE; 115use constant TRACE_REALIZE_COLORS => TRACE_COLORS | TRACE_REALIZE; 116use constant TRACE_REALIZE_PENS => TRACE_PENS | TRACE_REALIZE; 117 118sub block_create 119{ 120 my $ret = [ ( 0 ) x BLK_START ]; 121 $$ret[ BLK_FLAGS ] |= T_SIZE; 122 push @$ret, @_; 123 return $ret; 124} 125 126sub block_count 127{ 128 my $block = $_[0]; 129 my $ret = 0; 130 my ( $i, $lim) = ( BLK_START, scalar @$block); 131 $i += $$block[$i] >> 16, $ret++ while $i < $lim; 132 return $ret; 133} 134 135# creates a new opcode for custom use 136sub opcode 137{ 138 my $len = $_[0] || 0; 139 my $name = $_[1]; 140 $len = 0 if $len < 0; 141 my $op = ++$lastop; 142 $opnames{$name} = $op if defined $name; 143 return $op | (( $len + 1 ) << 16); 144} 145 146sub text { return OP_TEXT, $_[0], $_[1], $_[2] || 0 } 147sub color { return OP_COLOR, $_[0] } 148sub backColor { return OP_COLOR, $_[0] | BACKCOLOR_FLAG} 149sub colorIndex { return OP_COLOR, $_[0] | COLOR_INDEX } 150sub backColorIndex { return OP_COLOR, $_[0] | COLOR_INDEX | BACKCOLOR_FLAG} 151sub font { return OP_FONT, $_[0], $_[1] } 152sub fontId { return OP_FONT, F_ID, $_[0] } 153sub fontSize { return OP_FONT, F_SIZE, $_[0] } 154sub fontHeight { return OP_FONT, F_SIZE, $_[0] + F_HEIGHT } 155sub fontStyle { return OP_FONT, F_STYLE, $_[0] } 156sub moveto { return OP_TRANSPOSE, $_[0], $_[1], $_[2] || 0 } 157sub extend { return OP_TRANSPOSE, $_[0], $_[1], ($_[2] || 0) | X_EXTEND } 158sub code { return OP_CODE, $_[0], $_[1] } 159sub wrap { return OP_WRAP, $_[0] } 160sub mark { return OP_MARK, $_[0], 0, 0 } 161 162sub realize_fonts 163{ 164 my ( $font_palette, $state) = @_; 165 my $font = {%{$font_palette-> [ $$state[ BLK_FONT_ID]]}}; 166 if ( $$state[ BLK_FONT_SIZE] > F_HEIGHT) { 167 $font->{height} = $$state[ BLK_FONT_SIZE] - F_HEIGHT; 168 } else { 169 $font->{size} = $$state[ BLK_FONT_SIZE]; 170 delete @{$font}{qw(height width)}; 171 } 172 $font->{style} = $$state[ BLK_FONT_STYLE]; 173 return $font; 174} 175 176sub realize_colors 177{ 178 my ( $color_palette, $state ) = @_; 179 return ( 180 color => (( $$state[ BLK_COLOR] & COLOR_INDEX) ? 181 ( $color_palette-> [$$state[ BLK_COLOR] & COLOR_MASK]) : 182 ( $$state[ BLK_COLOR] & COLOR_MASK)), 183 backColor => (( $$state[ BLK_BACKCOLOR] & COLOR_INDEX) ? 184 ( $color_palette-> [$$state[ BLK_BACKCOLOR] & COLOR_MASK]) : 185 ( $$state[ BLK_BACKCOLOR] & COLOR_MASK)), 186 textOpaque => (( $$state[ BLK_BACKCOLOR] & BACKCOLOR_OFF) ? 0 : 1), 187 ); 188} 189 190sub _debug_block 191{ 192 my ($b) = @_; 193 print STDERR "FLAGS : ", (( $$b[BLK_FLAGS] & T_SIZE ) ? "T_SIZE" : ""), (( $$b[BLK_FLAGS] & T_WRAPABLE ) ? "T_WRAPABLE" : ""), "\n"; 194 print STDERR "POSITION : ", $$b[BLK_X] // 'undef', 'x', $$b[BLK_Y] // 'undef', "\n"; 195 print STDERR "SIZE : ", $$b[BLK_WIDTH] // 'undef', 'x', $$b[BLK_HEIGHT] // 'undef', "\n"; 196 print STDERR "APERTURE : ", $$b[BLK_APERTURE_X] // 'undef', 'x', $$b[BLK_APERTURE_Y] // 'undef', "\n"; 197 print STDERR "TEXT_OFS : ", $$b[BLK_TEXT_OFFSET] // 'undef', "\n"; 198 print STDERR "FONT : ID=", $$b[BLK_FONT_ID] // 'undef', ' ', 199 'SIZE=', $$b[BLK_FONT_SIZE] // 'undef', ' ', 200 'STYLE=', $$b[BLK_FONT_STYLE] // 'undef', "\n"; 201 my $color = $$b[BLK_COLOR]; 202 unless ( defined $color ) { 203 $color = "undef"; 204 } elsif ( $color & COLOR_INDEX) { 205 $color = "index(" . ( $color & ~COLOR_INDEX) . ")"; 206 } else { 207 $color = sprintf("%06x", $color); 208 } 209 print STDERR "COLORS : $color "; 210 $color = $$b[BLK_BACKCOLOR]; 211 unless ( defined $color ) { 212 $color = "undef"; 213 } elsif ( $color & COLOR_INDEX) { 214 $color = "index(" . ( $color & ~COLOR_INDEX) . ")"; 215 } else { 216 $color = sprintf("%06x", $color); 217 } 218 print STDERR "$color\n"; 219 220 my ($i, $lim) = (BLK_START, scalar @$b); 221 for ( ; $i < $lim; $i += $$b[$i] >> 16) { 222 my $cmd = $$b[$i]; 223 if ( !defined($cmd)) { 224 $cmd //= 'undef'; 225 print STDERR "corrupted block: $cmd at $i/$lim\n"; 226 last; 227 } 228 if ($cmd == OP_TEXT) { 229 my $ofs = $$b[ $i + T_OFS]; 230 my $len = $$b[ $i + T_LEN]; 231 my $wid = $$b[ $i + T_WID] // 'NULL'; 232 print STDERR ": OP_TEXT( $ofs $len : $wid )\n"; 233 } elsif ( $cmd == OP_FONT ) { 234 my $mode = $$b[ $i + F_MODE ]; 235 my $data = $$b[ $i + F_DATA ]; 236 if ( $mode == F_ID ) { 237 $mode = 'F_ID'; 238 } elsif ( $mode == F_SIZE ) { 239 $mode = 'F_SIZE'; 240 } elsif ( $mode == F_STYLE) { 241 $mode = 'F_STYLE'; 242 my @s; 243 push @s, "italic" if $data & fs::Italic; 244 push @s, "bold" if $data & fs::Bold; 245 push @s, "thin" if $data & fs::Thin; 246 push @s, "underlined" if $data & fs::Underlined; 247 push @s, "struckout" if $data & fs::StruckOut; 248 push @s, "outline" if $data & fs::Outline; 249 @s = "normal" unless @s; 250 $data = join(',', @s); 251 } 252 print STDERR ": OP_FONT.$mode $data\n"; 253 } elsif ( $cmd == OP_COLOR ) { 254 my $color = $$b[ $i + 1 ]; 255 my $bk = ''; 256 if ( $color & BACKCOLOR_FLAG ) { 257 $bk = 'backcolor,'; 258 $color &= ~BACKCOLOR_FLAG; 259 } 260 if ( $color & COLOR_INDEX) { 261 $color = "index(" . ( $color & ~COLOR_INDEX) . ")"; 262 } else { 263 $color = sprintf("%06x", $color); 264 } 265 print STDERR ": OP_COLOR $bk$color\n"; 266 } elsif ( $cmd == OP_TRANSPOSE) { 267 my $x = $$b[ $i + X_X ]; 268 my $y = $$b[ $i + X_Y ]; 269 my $f = $$b[ $i + X_FLAGS ] ? 'EXTEND' : 'TRANSPOSE'; 270 print STDERR ": OP_TRANSPOSE $x $y $f\n"; 271 } elsif ( $cmd == OP_CODE ) { 272 my $code = $$b[ $i + 1 ]; 273 print STDERR ": OP_CODE $code\n"; 274 } elsif ( $cmd == OP_WRAP ) { 275 my $wrap = $$b[ $i + 1 ]; 276 $wrap = ( $wrap == WRAP_MODE_OFF ) ? 'OFF' : ( 277 ($wrap == WRAP_MODE_ON) ? 'ON' : 'IMMEDIATE' 278 ); 279 print STDERR ": OP_WRAP $wrap\n"; 280 } elsif ( $cmd == OP_MARK ) { 281 my $id = $$b[ $i + MARK_ID ]; 282 my $x = $$b[ $i + MARK_X ]; 283 my $y = $$b[ $i + MARK_Y ]; 284 print STDERR ": OP_MARK $id $x $y\n"; 285 } else { 286 my $oplen = $cmd >> 16; 287 my @o = ($oplen > 1) ? @$b[ $i + 1 .. $i + $oplen - 1] : (); 288 print STDERR ": OP($cmd) @o\n"; 289 last unless $$b[$i] >> 16; 290 } 291 } 292} 293 294sub walk 295{ 296 my ( $block, %commands ) = @_; 297 298 my $trace = $commands{trace} // 0; 299 my $position = $commands{position} // [0,0]; 300 my $resolution = $commands{resolution} // [72,72]; 301 my $canvas = $commands{canvas}; 302 my $state = $commands{state} // []; 303 my $other = $commands{other}; 304 my $ptr = $commands{pointer} // \(my $_i); 305 my $def_fs = $commands{baseFontSize} // 10; 306 my $def_fl = $commands{baseFontStyle} // 0; 307 my $semaphore = $commands{semaphore} // \(my $_j); 308 my $text = $commands{textPtr} // \(my $_k); 309 my $fontmap = $commands{fontmap}; 310 my $colormap = $commands{colormap}; 311 my $realize = $commands{realize} // sub { 312 $canvas->font(realize_fonts($fontmap, $_[0])) if $_[1] & REALIZE_FONTS; 313 $canvas->set(realize_colors($colormap, $_[0])) if $_[1] & REALIZE_COLORS; 314 }; 315 316 my @commands; 317 $commands[ $opnames{$_} & 0xffff ] = $commands{$_} for grep { exists $opnames{$_} } keys %commands; 318 my $ret; 319 320 my ( $text_offset, $f_taint, $font, $c_taint, $paint_state, %save_properties ); 321 322 # save paint state 323 if ( $trace & TRACE_PAINT_STATE ) { 324 $paint_state = $canvas-> get_paint_state; 325 if ($paint_state) { 326 $save_properties{set_font} = $canvas->get_font if $trace & TRACE_FONTS; 327 if ($trace & TRACE_COLORS) { 328 $save_properties{$_} = $canvas->$_() for qw(color backColor textOpaque); 329 } 330 } else { 331 $canvas-> begin_paint_info; 332 } 333 } 334 335 $text_offset = $$block[ BLK_TEXT_OFFSET] 336 if $trace & TRACE_TEXT; 337 @$state = @$block[ 0 .. BLK_DATA_END ] 338 if !@$state && $trace & TRACE_PENS; 339 $$position[0] += $$block[ BLK_APERTURE_X], $$position[1] += $$block[ BLK_APERTURE_Y] 340 if $trace & TRACE_POSITION; 341 342 # go 343 my $lim = scalar(@$block); 344 for ( $$ptr = BLK_START; $$ptr < $lim; $$ptr += $$block[ $$ptr ] >> 16 ) { 345 my $i = $$ptr; 346 my $cmd = $$block[$i]; 347 my $sub = $commands[ $cmd & 0xffff]; 348 my @opcode; 349 if ( !$sub && $other ) { 350 $sub = $other; 351 @opcode = ($cmd); 352 } 353 if ($cmd == OP_TEXT) { 354 next unless $$block[$i + T_LEN] > 0; 355 356 if (( $trace & TRACE_FONTS) && ($trace & TRACE_REALIZE) && !$f_taint) { 357 $realize->($state, REALIZE_FONTS); 358 $f_taint = 1; 359 } 360 if (( $trace & TRACE_COLORS) && ($trace & TRACE_REALIZE) && !$c_taint) { 361 $realize->($state, REALIZE_COLORS); 362 $c_taint = 1; 363 } 364 $ret = $sub->( 365 @opcode, 366 @$block[$i + 1 .. $i + ($$block[ $$ptr ] >> 16) - 1], 367 (( $trace & TRACE_TEXT ) ? 368 substr( $$text, $text_offset + $$block[$i + T_OFS], $$block[$i + T_LEN] ) : ()) 369 ) if $sub; 370 $$position[0] += $$block[ $i + T_WID] if $trace & TRACE_POSITION; 371 last if $$semaphore; 372 next; 373 } elsif (($cmd == OP_FONT) && ($trace & TRACE_FONTS)) { 374 if ( $$block[$i + F_MODE] == F_SIZE && $$block[$i + F_DATA] < F_HEIGHT ) { 375 $$state[ $$block[$i + F_MODE]] = $def_fs + $$block[$i + F_DATA]; 376 } elsif ( $$block[$i + F_MODE] == F_STYLE ) { 377 $$state[ $$block[$i + F_MODE]] = $$block[$i + F_DATA] | $def_fl; 378 } else { 379 $$state[ $$block[$i + F_MODE]] = $$block[$i + F_DATA]; 380 } 381 $font = $f_taint = undef; 382 } elsif (($cmd == OP_COLOR) && ($trace & TRACE_COLORS)) { 383 if ( ($$block[ $i + 1] & BACKCOLOR_FLAG) ) { 384 $$state[ BLK_BACKCOLOR ] = $$block[$i + 1] & ~BACKCOLOR_FLAG; 385 } else { 386 $$state[ BLK_COLOR ] = $$block[$i + 1]; 387 } 388 $c_taint = undef; 389 } elsif ( $cmd == OP_TRANSPOSE) { 390 my $x = $$block[ $i + X_X]; 391 my $y = $$block[ $i + X_Y]; 392 my $f = $$block[ $i + X_FLAGS]; 393 if (($trace & TRACE_FONTS) && ($trace & TRACE_REALIZE)) { 394 if ( $f & X_DIMENSION_FONT_HEIGHT) { 395 unless ( $f_taint) { 396 $realize->($state, REALIZE_FONTS); 397 $f_taint = 1; 398 } 399 $font //= $canvas-> get_font; 400 $x *= $font-> {height}; 401 $y *= $font-> {height}; 402 $f &= ~X_DIMENSION_FONT_HEIGHT; 403 } 404 } 405 if ( $f & X_DIMENSION_POINT) { 406 $x *= $resolution->[0] / 72; 407 $y *= $resolution->[1] / 72; 408 $f &= ~X_DIMENSION_POINT; 409 } 410 $ret = $sub->( $x, $y, $f ) if $sub; 411 if (!($f & X_EXTEND) && ($trace & TRACE_POSITION)) { 412 $$position[0] += $x; 413 $$position[1] += $y; 414 } 415 last if $$semaphore; 416 next; 417 } elsif (( $cmd == OP_CODE) && ($trace & TRACE_PENS) && ($trace & TRACE_REALIZE)) { 418 unless ( $f_taint) { 419 $realize->($state, REALIZE_FONTS); 420 $f_taint = 1; 421 } 422 unless ( $c_taint) { 423 $realize->($state, REALIZE_COLORS); 424 $c_taint = 1; 425 } 426 } elsif (( $cmd == OP_MARK) & ( $trace & TRACE_UPDATE_MARK)) { 427 $$block[ $i + MARK_X] = $$position[0]; 428 $$block[ $i + MARK_Y] = $$position[1]; 429 } elsif (( 0 == ($cmd >> 16)) || (($cmd & 0xffff) > $lastop)) { 430 # broken cmd, don't inf loop here 431 warn "corrupted block, $cmd at $$ptr\n"; 432 _debug_block($block); 433 last; 434 } 435 $ret = $sub->( @opcode, @$block[$i + 1 .. $i + ($$block[ $$ptr ] >> 16) - 1]) if $sub; 436 last if $$semaphore; 437 } 438 439 # restore paint state 440 if ( $trace & TRACE_PAINT_STATE ) { 441 if ( $paint_state ) { 442 $canvas->$_( $save_properties{$_} ) for keys %save_properties; 443 } else { 444 $canvas->end_paint_info; 445 } 446 } 447 448 return $ret; 449} 450 451sub block_wrap 452{ 453 my ( $b, %opt) = @_; 454 my ($t, $canvas, $state, $width) = @opt{qw(textPtr canvas state width)}; 455 my %subopt = map { $_ => $opt{$_}} qw(fontmap baseFontSize baseFontStyle resolution); 456 my $flags = $opt{textDirection} ? to::RTL : 0; 457 458 $width = 0 if $width < 0; 459 460 my $cmd; 461 my ( $o) = ( $$b[ BLK_TEXT_OFFSET]); 462 my ( $x, $y) = (0, 0); 463 my $can_wrap = 1; 464 my $stsave = $state; 465 $state = [ @$state ]; 466 my ( $haswrapinfo, $wantnewblock, @wrapret); 467 my ( @ret, $z, $ptr); 468 my $lastTextOffset = $$b[ BLK_TEXT_OFFSET]; 469 my $has_text; 470 my $word_break = $opt{wordBreak}; 471 my $wrap_opts = $word_break ? tw::WordBreak : 0; 472 473 my $newblock = sub 474 { 475 push @ret, $z = block_create(); 476 @$z[ BLK_DATA_START .. BLK_DATA_END ] = 477 @$state[ BLK_DATA_START .. BLK_DATA_END]; 478 $$z[ BLK_X] = $$b[ BLK_X]; 479 $$z[ BLK_FLAGS] &= ~ T_SIZE; 480 $$z[ BLK_TEXT_OFFSET] = $$b [ BLK_TEXT_OFFSET]; 481 $x = 0; 482 undef $has_text; 483 undef $wantnewblock; 484 $haswrapinfo = 0; 485 }; 486 487 my $retrace = sub 488 { 489 splice( @{$ret[-1]}, $wrapret[0]); 490 @$state = @{$wrapret[1]}; 491 $newblock-> (); 492 $ptr = $wrapret[2]; 493 }; 494 495 $newblock-> (); 496 $$z[BLK_TEXT_OFFSET] = $$b[BLK_TEXT_OFFSET]; 497 498 my %state_hash; 499 500 # first state - wrap the block 501 walk( $b, %subopt, 502 textPtr => $t, 503 pointer => \$ptr, 504 canvas => $canvas, 505 state => $state, 506 trace => TRACE_REALIZE_PENS, 507 realize => sub { $canvas->font(realize_fonts($subopt{fontmap}, $_[0])) if $_[1] & REALIZE_FONTS }, 508 text => sub { 509 my ( $ofs, $tlen ) = @_; 510 my $state_key = join('.', @$state[BLK_FONT_ID .. BLK_FONT_STYLE]); 511 $state_hash{$state_key} = $canvas->get_font 512 unless $state_hash{$state_key}; 513 $lastTextOffset = $ofs + $tlen unless $can_wrap; 514 515 REWRAP: 516 my $tw = $canvas-> get_text_shape_width(substr( $$t, $o + $ofs, $tlen), 1, $flags); 517 my $apx = $state_hash{$state_key}-> {width}; 518 if ( $x + $tw + $apx <= $width) { 519 push @$z, OP_TEXT, $ofs, $tlen, $tw; 520 $x += $tw; 521 $has_text = 1; 522 } elsif ( $can_wrap) { 523 return if $tlen <= 0; 524 my $str = substr( $$t, $o + $ofs, $tlen); 525 my $leadingSpaces = ''; 526 if ( $str =~ /^(\s+)/) { 527 $leadingSpaces = $1; 528 $str =~ s/^\s+//; 529 } 530 my $shaped = $canvas-> text_shape($str, rtl => $flags); 531 my $l = $canvas-> text_wrap( $str, $width - $apx - $x, 532 tw::ReturnFirstLineLength | tw::BreakSingle | $wrap_opts, 533 8, 0, -1, $shaped || undef); 534 if ( $l > 0) { 535 if ( $has_text) { 536 push @$z, OP_TEXT, 537 $ofs, $l + length $leadingSpaces, 538 $tw = $canvas-> get_text_shape_width( 539 $leadingSpaces . substr( $str, 0, $l), 1, 540 $flags 541 ); 542 } else { 543 push @$z, OP_TEXT, 544 $ofs + length $leadingSpaces, $l, 545 $tw = $canvas-> get_text_shape_width( 546 substr( $str, 0, $l), 1, 547 $flags 548 ); 549 $has_text = 1; 550 } 551 $str = substr( $str, $l); 552 $l += length $leadingSpaces; 553 $newblock-> (); 554 $ofs += $l; 555 $tlen -= $l; 556 if ( $str =~ /^(\s+)/) { 557 $ofs += length $1; 558 $tlen -= length $1; 559 $x += $canvas-> get_text_shape_width( $1, 1, $flags); 560 $str =~ s/^\s+//; 561 } 562 goto REWRAP if length $str; 563 } else { # does not fit into $width 564 my $ox = $x; 565 $newblock-> (); 566 $ofs += length $leadingSpaces; 567 $tlen -= length $leadingSpaces; 568 if ( length $str) { 569 # well, it cannot be fit into width, 570 # but may be some words can be stripped? 571 goto REWRAP if $ox > 0; 572 if ( $word_break && ($str =~ m/^(\S+)(\s*)/)) { 573 $tw = $canvas-> get_text_shape_width( $1, 1, $flags); 574 push @$z, OP_TEXT, $ofs, length $1, $tw; 575 $has_text = 1; 576 $x += $tw; 577 $ofs += length($1) + length($2); 578 $tlen -= length($1) + length($2); 579 goto REWRAP; 580 } 581 } 582 push @$z, OP_TEXT, $ofs, length($str), 583 $x += $canvas-> get_text_shape_width( $str, 1, $flags); 584 $has_text = 1; 585 } 586 } elsif ( $haswrapinfo) { # unwrappable, and cannot be fit - retrace 587 $retrace-> (); 588 } else { # unwrappable, cannot be fit, no wrap info! - whole new block 589 push @$z, OP_TEXT, $ofs, $tlen, $tw; 590 if ( $can_wrap ) { 591 $newblock-> (); 592 } else { 593 $wantnewblock = 1; 594 } 595 } 596 }, 597 wrap => sub { 598 my $mode = shift; 599 if ( $can_wrap && $mode == WRAP_MODE_OFF) { 600 @wrapret = ( scalar @$z, [ @$state ], $ptr); 601 $haswrapinfo = 1; 602 } elsif ( !$can_wrap && $mode == WRAP_MODE_ON && $wantnewblock) { 603 $newblock-> (); 604 } 605 606 if ( $mode == WRAP_IMMEDIATE ) { 607 $newblock->() unless $opt{ignoreImmediateWrap}; 608 } else { 609 $can_wrap = ($mode == WRAP_MODE_ON); 610 } 611 }, 612 transpose => sub { 613 my ( $dx, $dy, $flags) = @_; 614 if ( $x + $dx >= $width) { 615 if ( $can_wrap) { 616 $newblock-> (); 617 } elsif ( $haswrapinfo) { 618 return $retrace-> (); 619 } 620 } else { 621 $x += $dx; 622 } 623 push @$z, OP_TRANSPOSE, $dx, $dy, $flags; 624 }, 625 other => sub { push @$z, @_ }, 626 ); 627 628 # remove eventual empty blocks 629 @ret = grep { @$_ != BLK_START } @ret; 630 631 # second stage - position the blocks 632 $state = $stsave; 633 my $start; 634 if ( !defined $$b[ BLK_Y]) { 635 # auto position the block if the creator didn't care 636 $start = $$state[ BLK_Y] + $$state[ BLK_HEIGHT]; 637 } else { 638 $start = $$b[ BLK_Y]; 639 } 640 641 $lastTextOffset = $$b[ BLK_TEXT_OFFSET]; 642 my $lastBlockOffset = $lastTextOffset; 643 644 for my $b ( @ret) { 645 $$b[ BLK_Y] = $start; 646 647 my @xy = (0,0); 648 my $ptr; 649 walk( $b, %subopt, 650 textPtr => $t, 651 canvas => $canvas, 652 trace => TRACE_FONTS | TRACE_POSITION | TRACE_UPDATE_MARK, 653 state => $state, 654 position => \@xy, 655 pointer => \$ptr, 656 text => sub { 657 my ( $ofs, $len, $wid ) = @_; 658 my $f_taint = $state_hash{ join('.', 659 @$state[BLK_FONT_ID .. BLK_FONT_STYLE] 660 ) }; 661 my $x = $xy[0] + $wid; 662 my $y = $xy[1]; 663 $$b[ BLK_WIDTH] = $x 664 if $$b[ BLK_WIDTH ] < $x; 665 $$b[ BLK_APERTURE_Y] = $f_taint-> {descent} - $y 666 if $$b[ BLK_APERTURE_Y] < $f_taint-> {descent} - $y; 667 $$b[ BLK_APERTURE_X] = $f_taint-> {width} - $x 668 if $$b[ BLK_APERTURE_X] < $f_taint-> {width} - $x; 669 my $newY = $y + $f_taint-> {ascent} + $f_taint-> {externalLeading}; 670 $$b[ BLK_HEIGHT] = $newY if $$b[ BLK_HEIGHT] < $newY; 671 $lastTextOffset = $$b[ BLK_TEXT_OFFSET] + $ofs + $len; 672 673 $$b[ $ptr + T_OFS] -= $lastBlockOffset - $$b[ BLK_TEXT_OFFSET]; 674 }, 675 transpose => sub { 676 my ( $dx, $dy, $f ) = @_; 677 my ( $newX, $newY) = ( $xy[0] + $dx, $xy[1] + $dy); 678 $$b[ BLK_WIDTH] = $newX 679 if $$b[ BLK_WIDTH ] < $newX; 680 $$b[ BLK_HEIGHT] = $newY 681 if $$b[ BLK_HEIGHT] < $newY; 682 $$b[ BLK_APERTURE_X] = -$newX 683 if $newX < 0 && $$b[ BLK_APERTURE_X] > -$newX; 684 $$b[ BLK_APERTURE_Y] = -$newY 685 if $newY < 0 && $$b[ BLK_APERTURE_Y] > -$newY; 686 }, 687 ); 688 $$b[ BLK_TEXT_OFFSET] = $lastBlockOffset; 689 $$b[ BLK_HEIGHT] += $$b[ BLK_APERTURE_Y]; 690 $$b[ BLK_WIDTH] += $$b[ BLK_APERTURE_X]; 691 $start += $$b[ BLK_HEIGHT]; 692 $lastBlockOffset = $lastTextOffset; 693 } 694 695 if ( $ret[-1]) { 696 $b = $ret[-1]; 697 $$state[$_] = $$b[$_] for BLK_X, BLK_Y, BLK_HEIGHT, BLK_WIDTH; 698 } 699 700 return @ret; 701} 702 703package Prima::Drawable::TextBlock; 704 705sub new 706{ 707 my ($class, %opt) = @_; 708 my $self = bless { 709 restoreCanvas => 1, 710 baseFontSize => 10, 711 baseFontStyle => 0, 712 direction => 0, 713 fontmap => [], 714 colormap => [], 715 text => '', 716 textDirection => 0, 717 block => undef, 718 resolution => [72,72], 719 fontSignature => '', 720 %opt, 721 }, $class; 722 return $self; 723} 724 725eval "sub $_ { \$#_ ? \$_[0]->{$_} = \$_[1] : \$_[0]->{$_}}" for qw( 726 fontmap colormap block text resolution direction 727 baseFontSize baseFontStyle restoreCanvas textDirection 728); 729 730sub acquire {} 731 732sub calculate_dimensions 733{ 734 my ( $self, $canvas ) = @_; 735 736 my @xy = (0,0); 737 my @min = (0,0); 738 my @max = (0,0); 739 my $extra_width = 0; 740 my $ptr = 0; 741 my $b = $self->{block}; 742 tb::walk( $b, $self-> walk_options, 743 position => \@xy, 744 pointer => \$ptr, 745 canvas => $canvas, 746 trace => tb::TRACE_REALIZE_FONTS|tb::TRACE_POSITION|tb::TRACE_PAINT_STATE|tb::TRACE_TEXT, 747 text => sub { 748 my ( undef, undef, undef, $text ) = @_; 749 $b-> [ $ptr + tb::T_WID ] = $canvas->get_text_shape_width( 750 $text, 751 $self->{textDirection} ? to::RTL : 0 752 ); 753 754 my $f = $canvas->get_font; 755 $max[1] = $f->{ascent} if $max[1] < $f->{ascent}; 756 $min[1] = $f->{descent} if $min[0] < $f->{descent}; 757 758 # roughly compensate for uncalculated .A and .C 759 $extra_width = $f->{width} if $extra_width < $f->{width}; 760 }, 761 transpose => sub { 762 my ($x, $y) = @_; 763 $min[0] = $x if $min[0] > $x; 764 $min[1] = $y if $min[1] > $y; 765 }, 766 ); 767 $xy[0] += $extra_width; 768 $max[0] = $xy[0] if $max[0] < $xy[0]; 769 $max[1] = $xy[1] if $max[1] < $xy[1]; 770 $b->[ tb::BLK_WIDTH] = $max[0]+$min[0] if $b->[ tb::BLK_WIDTH ] < $max[0]+$min[0]; 771 $b->[ tb::BLK_HEIGHT] = $max[1]+$min[1] if $b->[ tb::BLK_HEIGHT ] < $max[1]+$min[1]; 772 $b->[ tb::BLK_APERTURE_X] = $min[0]; 773 $b->[ tb::BLK_APERTURE_Y] = $min[1]; 774} 775 776sub walk_options 777{ 778 my $self = shift; 779 return 780 textPtr => \ $self->{text}, 781 ( map { ($_ , $self->{$_}) } qw(fontmap colormap resolution baseFontSize baseFontSize) ), 782 ; 783} 784 785my $RAD = 57.29577951; 786 787sub text_out 788{ 789 my ($self, $canvas, $x, $y) = @_; 790 791 my $restore_base_line; 792 unless ( $canvas-> textOutBaseline ) { 793 $canvas-> textOutBaseline(1); 794 $restore_base_line = 1; 795 } 796 797 $self->acquire($canvas, 798 font => 1, 799 colors => 1, 800 dimensions => 1, 801 ); 802 803 my ($sin, $cos); 804 ($sin, $cos) = (sin( $self-> {direction} / $RAD ), cos( $self-> {direction} / $RAD )) 805 if $self->{direction}; 806 807 my @xy = ($x,$y); 808 my @ofs = ($x,$y); 809 my @state; 810 my $semaphore; 811 812 tb::walk( $self->{block}, $self-> walk_options, 813 semaphore => \ $semaphore, 814 trace => tb::TRACE_GEOMETRY | tb::TRACE_REALIZE_PENS | tb::TRACE_TEXT | 815 ( $self-> {restoreCanvas} ? tb::TRACE_PAINT_STATE : 0 ), 816 canvas => $canvas, 817 position => \@xy, 818 state => \@state, 819 text => sub { 820 my ( $ofs, $len, $wid, $tex) = @_; 821 my @coord = $self-> {direction} ? ( 822 int($ofs[0] + ($xy[0]-$ofs[0]) * $cos - ($xy[1]-$ofs[1]) * $sin + .5), 823 int($ofs[1] + ($xy[0]-$ofs[0]) * $sin + ($xy[1]-$ofs[1]) * $cos + .5) 824 ) : @xy; 825 $semaphore++ unless $canvas-> text_shape_out($tex, @coord, $self->{textDirection}); 826 }, 827 code => sub { 828 my ( $code, $data ) = @_; 829 my @coord = $self-> {direction} ? ( 830 int($ofs[0] + ($xy[0]-$ofs[0]) * $cos - ($xy[1]-$ofs[1]) * $sin + .5), 831 int($ofs[1] + ($xy[0]-$ofs[0]) * $sin + ($xy[1]-$ofs[1]) * $cos + .5) 832 ) : @xy; 833 $code-> ( $self, $canvas, $self->{block}, \@state, @coord, $data); 834 }, 835 ); 836 837 $canvas-> textOutBaseline(0) if $restore_base_line; 838 839 return not $semaphore; 840} 841 842sub get_text_width_with_overhangs 843{ 844 my ($self, $canvas) = @_; 845 my $first_a_width; 846 my $last_c_width; 847 my @xy = (0,0); 848 tb::walk( $self->{block}, $self-> walk_options, 849 position => \@xy, 850 trace => tb::TRACE_GEOMETRY | tb::TRACE_REALIZE | tb::TRACE_TEXT | 851 ( $self-> {restoreCanvas} ? tb::TRACE_PAINT_STATE : 0 ), 852 canvas => $canvas, 853 text => sub { 854 my $t = pop; 855 if ( !defined $first_a_width) { 856 my $char = substr( $t, 0, 1 ); 857 ( $first_a_width ) = @{ $canvas->get_font_abc(ord($char), ord($char), utf8::is_utf8($t)) }; 858 } 859 my $char = substr( $t, -1, 1 ); 860 ( undef, undef, $last_c_width ) = @{ $canvas->get_font_abc(ord($char), ord($char), utf8::is_utf8($t)) }; 861 }, 862 ); 863 return (0,0,0) unless defined $first_a_width; 864 $first_a_width = ( $first_a_width < 0 ) ? -$first_a_width : 0; 865 $last_c_width = ( $last_c_width < 0 ) ? -$last_c_width : 0; 866 return ($xy[0], $first_a_width, $last_c_width); 867} 868 869sub get_text_width 870{ 871 my ( $self, $canvas, $add_overhangs) = @_; 872 873 $self->acquire($canvas, font => 1, dimensions => 1); 874 875 if ( $add_overhangs ) { 876 my ( $width, $a, $c) = $self-> get_text_width_with_overhangs($canvas); 877 return $width + $a + $c; 878 } 879 880 my @xy = (0,0); 881 tb::walk( $self->{block}, $self-> walk_options, 882 trace => tb::TRACE_POSITION, 883 position => \@xy, 884 ); 885 return $xy[0]; 886} 887 888sub get_text_box 889{ 890 my ( $self, $canvas, $text) = @_; 891 892 $self->acquire($canvas, font => 1, dimensions => 1); 893 894 my ($w, $a, $c) = $self-> get_text_width_with_overhangs($canvas); 895 896 my $b = $self->{block}; 897 my ( $fa, $fd ) = ( $b->[tb::BLK_HEIGHT] - $b->[tb::BLK_APERTURE_Y] - 1, $b->[tb::BLK_APERTURE_Y]); 898 899 my @ret = ( 900 -$a, $fa, 901 -$a, -$fd, 902 $w + $c, $fa, 903 $w + $c, -$fd, 904 $w, 0 905 ); 906 unless ( $canvas-> textOutBaseline) { 907 $ret[$_] += $fd for (1,3,5,7,9); 908 } 909 if ( my $dir = $self-> {direction}) { 910 my $s = sin( $dir / $RAD ); 911 my $c = cos( $dir / $RAD ); 912 my $i; 913 for ( $i = 0; $i < 10; $i+=2) { 914 my ( $x, $y) = @ret[$i,$i+1]; 915 $ret[$i] = $x * $c - $y * $s; 916 $ret[$i+1] = $x * $s + $y * $c; 917 } 918 } 919 920 return \@ret; 921} 922 923sub text_wrap 924{ 925 my ( $self, $canvas, $width, $opt, $indent) = @_; 926 $opt //= tw::Default; 927 $width = 2_000_000 if $width < 0; 928 929 # Ignored options: ExpandTabs, CalcTabs . 930 931 # first, we don't return chunks, period. That's too messy. 932 return $canvas-> text_wrap( $self-> {text}, $width, $opt, $indent) 933 if $opt & tw::ReturnChunks; 934 935 $self->acquire($canvas, font => 1); 936 937 my (@ret, $add_tilde); 938 939 # we don't calculate the underscore position and return none. 940 if ( $opt & (tw::CollapseTilde|tw::CalcMnemonic)) { 941 $add_tilde = { 942 tildeStart => undef, 943 tildeEnd => undef, 944 tildeLine => undef, 945 }; 946 } 947 948 my @blocks = tb::block_wrap( $self->{block}, 949 $self-> walk_options, 950 state => $self->{block}, 951 width => $width, 952 canvas => $canvas, 953 optimize => 0, 954 wordBreak => $opt & tw::WordBreak, 955 ignoreImmediateWrap => !($opt & tw::NewLineBreak), 956 ); 957 958 # breaksingle is not supported by block_wrap, emulating 959 if ( $opt & tw::BreakSingle ) { 960 for my $b ( @blocks ) { 961 next if $b->[tb::BLK_WIDTH] <= $width; 962 @blocks = (); 963 last; 964 } 965 } 966 967 # linelength has a separate function 968 if ( $opt & tw::ReturnFirstLineLength ) { 969 return 0 unless @blocks; 970 971 my ($semaphore, $retval) = (0,0); 972 tb::walk( $blocks[0]->{block}, 973 trace => tb::TRACE_TEXT, 974 semaphore => \ $semaphore, 975 text => sub { 976 ( undef, $retval ) = @_; 977 $semaphore++; 978 }, 979 ); 980 return $retval; 981 } 982 983 @ret = map { __PACKAGE__->new( %$self, block => $_ ) } @blocks; 984 push @ret, $add_tilde if $add_tilde; 985 986 return \@ret; 987} 988 989sub text_shape { undef } 990 991sub height 992{ 993 my ( $self, $canvas ) = @_; 994 $self-> acquire( $canvas, dimensions => 1 ); 995 return $self->{block}->[tb::BLK_HEIGHT]; 996} 997 9981; 999 1000=pod 1001 1002=head1 NAME 1003 1004Prima::Drawable::TextBlock - rich text representation 1005 1006=head1 API 1007 1008=head2 Block header 1009 1010A block's fixed header consists of C<tb::BLK_START - 1> integer scalars, 1011each of those is accessible via the corresponding C<tb::BLK_XXX> constant. 1012The constants are separated into two logical groups: 1013 1014 BLK_FLAGS 1015 BLK_WIDTH 1016 BLK_HEIGHT 1017 BLK_X 1018 BLK_Y 1019 BLK_APERTURE_X 1020 BLK_APERTURE_Y 1021 BLK_TEXT_OFFSET 1022 1023and 1024 1025 BLK_FONT_ID 1026 BLK_FONT_SIZE 1027 BLK_FONT_STYLE 1028 BLK_COLOR 1029 BLK_BACKCOLOR 1030 1031The second group is enclosed in C<tb::BLK_DATA_START> - C<tb::BLK_DATA_END> 1032range, like the whole header is contained in 0 - C<tb::BLK_START - 1> range. 1033This is done for the backward compatibility, if the future development changes 1034the length of the header. 1035 1036The first group fields define the text block dimension, aperture position 1037and text offset ( remember, the text is stored as one big chunk ). The second 1038defines the initial color and font settings. Prima::TextView needs all fields 1039of every block to be initialized before displaying. L<block_wrap> method 1040can be used for automated assigning of these fields. 1041 1042=head2 Block parameters 1043 1044The scalars, beginning from C<tb::BLK_START>, represent the commands to the 1045renderer. These commands have their own parameters, that follow the command. 1046The length of a command is high 16-bit word of the command. The basic command 1047set includes C<OP_TEXT>, C<OP_COLOR>, C<OP_FONT>, C<OP_TRANSPOSE>, and 1048C<OP_CODE>. The additional codes are C<OP_WRAP> and C<OP_MARK>, not used in 1049drawing but are special commands to L<block_wrap>. 1050 1051=over 1052 1053=item OP_TEXT - TEXT_OFFSET, TEXT_LENGTH, TEXT_WIDTH 1054 1055C<OP_TEXT> commands to draw a string, from offset C<tb::BLK_TEXT_OFFSET + TEXT_OFFSET>, 1056with a length TEXT_LENGTH. The third parameter TEXT_WIDTH contains the width of the text 1057in pixels. Such the two-part offset scheme is made for simplification of an imaginary code, 1058that would alter ( insert to, or delete part of ) the big text chunk; the updating procedure 1059would not need to traverse all commands, but just the block headers. 1060 1061Relative to: C<tb::BLK_TEXT_OFFSET> 1062 1063=item OP_COLOR - COLOR 1064 1065C<OP_COLOR> sets foreground or background color. To set the background, 1066COLOR must be or-ed with C<tb::BACKCOLOR_FLAG> value. In addition to the 1067two toolkit supported color values ( RRGGBB and system color index ), 1068COLOR can also be or-ed with C<tb::COLOR_INDEX> flags, in such case it is 1069an index in C<::colormap> property array. 1070 1071Relative to: C<tb::BLK_COLOR>, C<tb::BLK_BACKCOLOR>. 1072 1073=item OP_FONT - KEY, VALUE 1074 1075As the font is a complex property, that itself includes font name, size, 1076direction, etc keys, C<OP_FONT> KEY represents one of the three 1077parameters - C<tb::F_ID>, C<tb::F_SIZE>, C<tb::F_STYLE>. All three 1078have different VALUE meaning. 1079 1080Relative to: C<tb::BLK_FONT_ID>, C<tb::BLK_FONT_SIZE>, C<tb::BLK_FONT_STYLE>. 1081 1082=over 1083 1084=item F_STYLE 1085 1086Contains a combination of C<fs::XXX> constants, such as C<fs::Bold>, C<fs::Italic> etc. 1087 1088Default value: 0 1089 1090=item F_SIZE 1091 1092Contains the relative font size. The size is relative to the current widget's font 1093size. As such, 0 is a default value, and -2 is the widget's default font decreased by 10942 points. Prima::TextView provides no range checking ( but the toolkit does ), so 1095while it is o.k. to set the negative C<F_SIZE> values larger than the default font size, 1096one must be vary when relying on the combined font size value . 1097 1098If C<F_SIZE> value is added to a C<F_HEIGHT> constant, then it is treated as a font height 1099in pixels rather than font size in points. The macros for these opcodes are named respectively 1100C<tb::fontSize> and C<tb::fontHeight>, while the opcode is the same. 1101 1102=item F_ID 1103 1104All other font properties are collected under an 'ID'. ID is a index in 1105the C<::fontPalette> property array, which contains font hashes with the other 1106font keys initialized - name, encoding, and pitch. These three are minimal required 1107set, and the other font keys can be also selected. 1108 1109=back 1110 1111=item OP_TRANSPOSE X, Y, FLAGS 1112 1113Contains a mark for an empty space. The space is extended to the relative coordinates (X,Y), 1114so the block extension algorithms take this opcode in the account. If FLAGS does not contain 1115C<tb::X_EXTEND>, then in addition to the block expansion, current coordinate is also 1116moved to (X,Y). In this regard, C<(OP_TRANSPOSE,0,0,0)> and C<(OP_TRANSPOSE,0,0,X_EXTEND)> are 1117identical and are empty operators. 1118 1119There are formatting-only flags,in effect with L<block_wrap> function. 1120C<X_DIMENSION_FONT_HEIGHT> indicates that (X,Y) values must be multiplied to 1121the current font height. Another flag C<X_DIMENSION_POINT> does the same but 1122multiplies by current value of L<resolution> property divided by 72 ( 1123basically, treats X and Y not as pixel but point values). 1124 1125C<OP_TRANSPOSE> can be used for customized graphics, in conjunction with C<OP_CODE> 1126to assign a space, so the rendering 1127algorithms do not need to be re-written every time the new graphic is invented. As 1128an example, see how L<Prima::PodView> deals with the images. 1129 1130=item OP_CODE - SUB, PARAMETER 1131 1132Contains a custom code pointer SUB with a parameter PARAMETER, passed when 1133a block is about to be drawn. SUB is called with the following format: 1134 1135 ( $widget, $canvas, $text_block, $font_and_color_state, $x, $y, $parameter); 1136 1137$font_and_color_state ( or $state, through the code ) contains the state of 1138font and color commands in effect, and is changed as the rendering algorithm advances through a block. 1139The format of the state is the same as of text block, so one may notice that for readability 1140F_ID, F_SIZE, F_STYLE constants are paired to BLK_FONT_ID, BLK_FONT_SIZE and BLK_FONT_STYLE. 1141 1142The SUB code is executed only when the block is about to draw. 1143 1144=item OP_WRAP mode 1145 1146C<OP_WRAP> is only in effect in L<block_wrap> method. C<mode> is a flag, 1147selecting the wrapping command. 1148 1149 WRAP_MODE_ON - default, block commands can be wrapped 1150 WRAP_MODE_OFF - cancels WRAP_MODE_ON, commands cannot be wrapped 1151 WRAP_IMMEDIATE - proceed with immediate wrapping, unless ignoreImmediateWrap options is set 1152 1153L<block_wrap> does not support stacking for the wrap commands, so the 1154C<(OP_WRAP,WRAP_MODE_ON,OP_WRAP,WRAP_MODE_ON,OP_WRAP,WRAP_MODE_OFF)> has same 1155effect as C<(OP_WRAP,WRAP_MODE_OFF)>. If C<mode> is WRAP_MODE_ON, wrapping is 1156disabled - all following commands treated an non-wrapable until 1157C<(OP_WRAP,WRAP_MODE_OFF)> is met. 1158 1159=item OP_MARK PARAMETER, X, Y 1160 1161C<OP_MARK> is only in effect in L<block_wrap> method and is a user command. 1162L<block_wrap> only sets (!) X and Y to the current coordinates when the command is met. 1163Thus, C<OP_MARK> can be used for arbitrary reasons, easy marking the geometrical positions 1164that undergo the block wrapping. 1165 1166=back 1167 1168As can be noticed, these opcodes are far not enough for the full-weight rich text 1169viewer. However, the new opcodes can be created using C<tb::opcode>, that accepts 1170the opcode length and returns the new opcode value. 1171 1172=head2 Rendering methods 1173 1174=over 1175 1176=item block_wrap %OPTIONS 1177 1178C<block_wrap> wraps a block into a given width. It returns one or more text 1179blocks with fully assigned headers. The returned blocks are located one below 1180another, providing an illusion that the text itself is wrapped. It does not 1181only traverses the opcodes and sees if the command fit or not in the given 1182width; it also splits the text strings if these do not fit. 1183 1184By default the wrapping can occur either on a command boundary or by the spaces 1185or tab characters in the text strings. The unsolicited wrapping can be 1186prevented by using C<OP_WRAP> command brackets. The commands inside these 1187brackets are not wrapped; C<OP_WRAP> commands are removed from the output 1188blocks. 1189 1190In general, C<block_wrap> copies all commands and their parameters as is, ( as 1191it is supposed to do ), but some commands are treated specially: 1192 1193- C<OP_TEXT>'s third parameter, C<TEXT_WIDTH>, is disregarded, and is recalculated for every 1194C<OP_TEXT> met. 1195 1196- If C<OP_TRANSPOSE>'s third parameter, C<X_FLAGS> contains C<X_DIMENSION_FONT_HEIGHT> flag, 1197the command coordinates X and Y are multiplied to the current font height and the flag is 1198cleared in the output block. 1199 1200- C<OP_MARK>'s second and third parameters assigned to the current (X,Y) coordinates. 1201 1202- C<OP_WRAP> removed from the output. 1203 1204=item walk BLOCK, %OPTIONS 1205 1206Cycles through block opcodes, calls supplied callbacks on each. 1207 1208=back 1209 1210=head1 AUTHOR 1211 1212Dmitry Karasik, E<lt>dmitry@karasik.eu.orgE<gt>. 1213 1214=head1 SEE ALSO 1215 1216L<Prima::TextView>, L<Prima::Drawable::Markup>, F<examples/mouse_tale.pl>. 1217 1218