1package Prima::PS::PDF; 2 3use strict; 4use warnings; 5use Encode; 6use Prima; 7use Prima::PS::CFF; 8use Prima::PS::TempFile; 9use base qw(Prima::PS::Drawable); 10 11sub profile_default 12{ 13 my $def = $_[ 0]-> SUPER::profile_default; 14 my %prf = ( 15 compress => 1, 16 ); 17 @$def{keys %prf} = values %prf; 18 return $def; 19} 20 21sub init 22{ 23 my $self = shift; 24 $self-> {compress} = 1; 25 my %profile = $self-> SUPER::init(@_); 26 $self-> $_( $profile{$_}) for qw( compress); 27 return %profile; 28} 29 30sub cmd_rgb 31{ 32 my ( $r, $g, $b) = ( 33 int((($_[1] & 0xff0000) >> 16) * 100 / 256 + 0.5) / 100, 34 int((($_[1] & 0xff00) >> 8) * 100 / 256 + 0.5) / 100, 35 int(($_[1] & 0xff)*100/256 + 0.5) / 100); 36 unless ( $_[0]-> {grayscale}) { 37 return "$r $g $b RG"; 38 } else { 39 my $i = int( 100 * ( 0.31 * $r + 0.5 * $g + 0.18 * $b) + 0.5) / 100; 40 return "$i G"; 41 } 42} 43 44sub emit 45{ 46 my ($self, $data, $raw) = @_; 47 return 0 unless $self-> {can_draw}; 48 my $eol = $raw ? '' : "\n"; 49 $self-> {ps_data} .= $data . $eol; 50 $self-> {content_size} += length($data . $eol); 51 52 if ( length($self-> {ps_data}) > 10240) { 53 $self-> abort_doc unless $self-> spool( $self-> {ps_data}); 54 $self-> {ps_data} = ''; 55 } 56 57 return 1; 58} 59 60sub emit_content 61{ 62 my $self = $_[0]; 63 return 0 unless $self-> {can_draw}; 64 65 my $obj = $self->{objects}->[$self->{page_content}] or return 0; 66 return $obj->write($_[1] . "\n"); 67} 68 69sub change_transform 70{ 71 my ( $self, $gsave ) = @_; 72 return if $self-> {delay}; 73 74 my @tp = $self-> translate; 75 my @cr = $self-> clipRect; 76 my @sc = $self-> scale; 77 my $ro = $self-> rotate; 78 my $rg = $self-> region; 79 80 $cr[2] -= $cr[0]; 81 $cr[3] -= $cr[1]; 82 my $doClip = grep { $_ != 0 } @cr; 83 my $doTR = grep { $_ != 0 } @tp; 84 my $doSC = grep { $_ != 0 } @sc; 85 86 if ( !$doClip && !$doTR && !$doSC && !$ro && !$rg) { 87 $self-> emit_content('q') if $gsave; 88 return; 89 } 90 91 @cr = $self-> pixel2point( @cr); 92 @tp = $self-> pixel2point( @tp); 93 my $mcr3 = -$cr[3]; 94 95 $self-> emit_content('Q') unless $gsave; 96 $self-> emit_content('q'); 97 98 my ($ps, $pm) = @{ $self }{ qw(pageSize pageMargins) }; 99 my @pm = ( 100 @$pm[0,1], 101 $ps->[0] - $pm->[2] - $pm->[0], 102 $ps->[1] - $pm->[3] - $pm->[1] 103 ); 104 105 $self-> emit_content("h @pm re W n"); 106 $self-> emit_content("h @cr re W n") if $doClip; 107 $self-> emit_content("1 0 0 1 @tp cm") if $doTR; 108 $self-> emit_content($rg-> apply_offset . " n") if $rg && !$doClip; 109 $self-> emit_content("$sc[0] 0 0 $sc[1] 0 0 cm") if $doSC; 110 if ($ro != 0) { 111 my $sin1 = sin($ro); 112 my $cos = cos($ro); 113 my $sin2 = -$sin1; 114 $self-> emit_content("$cos $sin1 $sin2 $cos 0 0 cm"); 115 } 116 $self-> {changed}-> {$_} = 1 for qw(fill linePattern lineWidth lineJoin lineEnd miterLimit font); 117} 118 119sub fill 120{ 121 my ( $self, $code) = @_; 122 my ( $r1, $r2) = ( $self-> rop, $self-> rop2); 123 return if 124 $r1 == rop::NoOper && 125 $r2 == rop::NoOper; 126 127 if ( $r2 != rop::NoOper && $self-> {fpType} ne 'F') { 128 my $bk = 129 ( $r2 == rop::Blackness) ? 0 : 130 ( $r2 == rop::Whiteness) ? 0xffffff : $self-> backColor; 131 132 $self-> {changed}-> {fill} = 1; 133 $self-> emit_content( lc $self-> cmd_rgb( $bk)); 134 $self-> emit_content( $code); 135 } 136 if ( $r1 != rop::NoOper && $self-> {fpType} ne 'B') { 137 my $c = 138 ( $r1 == rop::Blackness) ? 0 : 139 ( $r1 == rop::Whiteness) ? 0xffffff : $self-> color; 140 if ($self-> {changed}-> {fill}) { 141 if ( $self-> {fpType} eq 'F') { 142 $self-> emit_content( lc $self-> cmd_rgb( $c)); 143 } else { 144 my ( $r, $g, $b) = ( 145 int((($c & 0xff0000) >> 16) * 100 / 256 + 0.5) / 100, 146 int((($c & 0xff00) >> 8) * 100 / 256 + 0.5) / 100, 147 int(($c & 0xff)*100/256 + 0.5) / 100); 148 my $color; 149 if ( $self-> {grayscale}) { 150 my $i = int( 100 * ( 0.31 * $r + 0.5 * $g + 0.18 * $b) + 0.5) / 100; 151 $color = $i; 152 } else { 153 $color = "$r $g $b"; 154 } 155 $self-> emit_content("/CS cs $color /P$self->{fpType} scn"); 156 } 157 $self-> {changed}-> {fill} = 0; 158 } 159 $self-> emit_content( $code); 160 } 161} 162 163sub stroke 164{ 165 my ( $self, $code) = @_; 166 167 my ( $r1, $r2) = ( $self-> rop, $self-> rop2); 168 my $lp = $self-> linePattern; 169 return if 170 $r1 == rop::NoOper && 171 $r2 == rop::NoOper; 172 173 if ( $self-> {changed}-> {lineWidth}) { 174 my ($lw) = $self-> pixel2point($self-> lineWidth); 175 $self-> emit_content( $lw . ' w'); 176 $self-> {changed}-> {lineWidth} = 0; 177 } 178 179 if ( $self-> {changed}-> {lineEnd}) { 180 my $le = $self-> lineEnd; 181 my $id = ( $le == le::Round) ? 1 : (( $le == le::Square) ? 2 : 0); 182 $self-> emit_content( "$id J"); 183 $self-> {changed}-> {lineEnd} = 0; 184 } 185 186 if ( $self-> {changed}-> {lineJoin}) { 187 my $lj = $self-> lineJoin; 188 my $id = ( $lj == lj::Round) ? 1 : (( $lj == lj::Bevel) ? 2 : 0); 189 $self-> emit_content( "$id j"); 190 $self-> {changed}-> {lineJoin} = 0; 191 } 192 193 if ( $self-> {changed}-> {miterLimit}) { 194 my $ml = $self-> miterLimit; 195 $self-> emit_content( "$ml M"); 196 $self-> {changed}-> {miterLimit} = 0; 197 } 198 199 if ( $r2 != rop::NoOper && $lp ne lp::Solid ) { 200 my $bk = 201 ( $r2 == rop::Blackness) ? 0 : 202 ( $r2 == rop::Whiteness) ? 0xffffff : $self-> backColor; 203 204 $self-> {changed}-> {linePattern} = 1; 205 $self-> {changed}-> {fill} = 1; 206 $self-> emit_content('[] 0 d'); 207 $self-> emit_content( uc $self-> cmd_rgb( $bk)); 208 $self-> emit_content( $code); 209 } 210 211 if ( $r1 != rop::NoOper && length( $lp)) { 212 my $fk = 213 ( $r1 == rop::Blackness) ? 0 : 214 ( $r1 == rop::Whiteness) ? 0xffffff : $self-> color; 215 216 if ( $self-> {changed}-> {linePattern}) { 217 if ( length( $lp) == 1) { 218 $self-> emit_content('[] 0 d'); 219 } else { 220 my @x = split('', $lp); 221 push( @x, 0) if scalar(@x) % 1; 222 @x = map { ord($_) } @x; 223 $self-> emit_content("[@x] 0 d"); 224 } 225 $self-> {changed}-> {linePattern} = 0; 226 } 227 228 if ( $self-> {changed}-> {fill}) { 229 $self-> emit_content( uc $self-> cmd_rgb( $fk)); 230 $self-> {changed}-> {fill} = 0; 231 } 232 233 $self-> emit_content( $code); 234 } 235} 236 237sub new_dummy_obj 238{ 239 my $self = shift; 240 my $xid = @{ $self->{objects} }; 241 push @{ $self->{objects} }, undef; 242 return $xid; 243} 244 245sub new_file_obj 246{ 247 my ($self, %opt) = @_; 248 my $obj = Prima::PS::TempFile->new(compress => $self->{compress}, %opt) or return; 249 my $xid = @{ $self->{objects} }; 250 push @{ $self->{objects} }, $obj; 251 $obj->{__xid} = $xid; 252 return wantarray ? ( $xid, $obj) : $xid; 253} 254 255sub new_stream_obj 256{ 257 my $self = shift; 258 my $xid = $self->new_dummy_obj; 259 return $xid, { content => '', xid => $xid }; 260} 261 262sub emit_to_stream 263{ 264 my ( $self, $obj, $text ) = @_; 265 $obj->{content} .= $text; 266} 267 268sub emit_stream_obj 269{ 270 my ( $self, $obj, $text ) = @_; 271 $self-> add_xref($obj->{xid}); 272 $self-> emit("$obj->{xid} 0 obj\n<<\n/Length ".length $obj->{content}); 273 $self-> emit( $text ) if defined $text; 274 $self-> emit(">>\nstream"); 275 $self-> emit($obj->{content}); 276 $self-> emit("endstream\nendobj\n"); 277} 278 279sub emit_new_stream_object 280{ 281 my ( $self, $stream, $text ) = @_; 282 my $xid = $self->new_dummy_obj; 283 $self-> add_xref($xid); 284 my $length = length($stream); 285 $self-> emit("$xid 0 obj\n<<\n/Length ".length($stream)); 286 $self-> emit( $text ) if defined $text; 287 $self-> emit(">>\nstream"); 288 $self-> emit($stream); 289 $self-> emit("endstream\nendobj\n"); 290 return $xid; 291} 292 293sub emit_file_obj 294{ 295 my ( $self, $obj, $text ) = @_; 296 $self-> add_xref($obj->{__xid}); 297 my $compress = $obj-> is_deflated; 298 $obj-> reset; 299 $self-> emit("$obj->{__xid} 0 obj\n<<\n/Length ".$obj->{size}); 300 $self-> emit("/Filter /FlateDecode") if $compress; 301 $self-> emit( $text ) if defined $text; 302 $self-> emit(">>\nstream"); 303 $obj-> evacuate( sub { $self->emit( $_[0], 1 ) } ); 304 $self-> emit("\nendstream\nendobj\n"); 305} 306 307sub add_xref 308{ 309 my ($self, $xid) = @_; 310 $self->{xref}->[ $xid ] = $self->{content_size}; 311} 312 313sub emit_new_object 314{ 315 my ($self, $xid, $emit) = @_; 316 $self-> add_xref($xid); 317 $self-> emit("$xid 0 obj"); 318 $self-> emit($emit) if defined $emit; 319} 320 321sub emit_new_dummy_object 322{ 323 my ($self, $emit) = @_; 324 my $xid = $self-> new_dummy_obj; 325 $self-> add_xref($xid); 326 $self-> emit("$xid 0 obj\n<<"); 327 $self-> emit($emit) if defined $emit; 328 $self-> emit(">>\nendobj\n"); 329 return $xid; 330} 331 332sub begin_doc 333{ 334 my ( $self, $docName) = @_; 335 return 0 if $self-> get_paint_state; 336 337 $self-> {ps_data} = ''; 338 $self-> {can_draw} = 1; 339 $self-> {content_size} = 0; 340 341 $docName = $::application ? $::application-> name : "Prima::PS::PDF" 342 unless defined $docName; 343 $docName = Encode::encode('UTF-16', $docName) 344 if Encode::is_utf8($docName); 345 $self-> {fp_hash} = {}; 346 $self-> {xref} = []; 347 348 my ($sec,$min,$hour,$mday,$mon,$year) = localtime; 349 my $date = sprintf("%04d%02d%02d%02d%02d%02d", $year + 1900, $mon, $mday, $hour, $min, $sec); 350 my $four = pack('C*', 0xde, 0xad, 0xbe, 0xef); 351 $self-> emit( <<PDFHEADER); 352%PDF-1.4 353%$four 354PDFHEADER 355 356 $self-> emit_new_object(1, <<PDFINFO); 357<< 358/CreationDate (D:$date+00'00) 359/Creator (Prima::PS::PDF) 360/Title ($docName) 361>> 362endobj 363PDFINFO 364 $self-> emit_new_object(2, <<ROOT); 365<< 366/Type /Catalog 367/Pages 3 0 R 368>> 369endobj 370ROOT 371 372 $self-> {objects} = [(undef) x 4]; 373 $self-> {page_object} = $self->new_dummy_obj; 374 $self-> {pages} = [$self->{page_object} ]; 375 $self-> {page_refs} = []; 376 $self-> {page_patterns} = {}; 377 $self-> {page_images} = []; 378 $self-> {page_fonts} = {}; 379 $self-> {page_rops} = {}; 380 $self-> {all_rops} = {}; 381 $self-> {all_fonts} = {}; 382 unless ($self-> {page_content} = $self->new_file_obj) { 383 $self-> abort_doc; 384 return 0; 385 } 386 387 $self-> {changed} = { map { $_ => 0 } qw( 388 fill lineEnd linePattern lineWidth lineJoin miterLimit font)}; 389 390 $self-> SUPER::begin_paint; 391 $self-> save_state; 392 393 $self-> {delay} = 1; 394 $self-> restore_state; 395 $self-> {delay} = 0; 396 397 $self-> change_transform( 1); 398 $self-> {changed}-> {linePattern} = 0; 399 400 return 1; 401} 402 403sub end_page 404{ 405 my $self = shift; 406 407 $self-> emit_content('Q'); 408 409 my @ps = @{ $self->{pageSize} }; 410 $self-> emit_new_object($self->{page_object}, <<PAGE); 411<< 412/Type /Page 413/Parent 3 0 R 414/MediaBox [ 0 0 @ps ] 415/StructParents 0 416/Contents $self->{page_content} 0 R 417/ProcSet [ /PDF /Text /ImageB /ImageC /ImageI ] 418/Resources << 419/ColorSpace << 420/CS [ /Pattern /Device${ \( $self->{grayscale} ? 'Gray' : 'RGB' ) } ] 421>> 422PAGE 423 if ( keys %{ $self->{page_patterns} } ) { 424 $self-> emit("/Pattern <<"); 425 for my $xid ( keys %{ $self->{page_patterns} } ) { 426 $self-> emit("/P$xid $xid 0 R"); 427 } 428 $self-> emit(">>"); 429 } 430 if ( @{$self->{page_images} } ) { 431 $self-> emit("/XObject <<"); 432 for my $xid ( @{ $self->{page_images} } ) { 433 $self-> emit("/I$xid $xid 0 R"); 434 } 435 $self-> emit(">>"); 436 } 437 if ( keys %{ $self->{page_fonts} } ) { 438 $self-> emit("/Font <<"); 439 for my $xid ( keys %{ $self->{page_fonts} } ) { 440 $self-> emit("/F$xid $xid 0 R"); 441 } 442 $self-> emit(">>"); 443 } 444 $self-> emit(">>"); # % Resources 445 446 if ( keys %{ $self->{page_rops} } ) { 447 $self-> emit("/ExtGState <<"); 448 while ( my ( $name, $xid ) = each %{ $self->{page_rops} } ) { 449 $self-> emit("/GS$name $xid 0 R"); 450 } 451 $self-> emit(">>"); 452 } 453 454 if ( @{ $self->{page_refs} } ) { 455 $self-> emit("/XObject <<"); 456 for my $xid ( @{ $self->{page_refs} } ) { 457 $self-> emit("/X$xid $xid 0 R"); 458 } 459 $self-> emit(">>"); 460 } 461 $self-> emit(">>\nendobj\n"); 462 463 $self-> emit_file_obj($self->{objects}->[$self->{page_content}]); 464 undef $self->{objects}->[$self->{page_content}]; 465} 466 467sub abort_doc 468{ 469 my $self = $_[0]; 470 return unless $self-> {can_draw}; 471 $self-> {can_draw} = 0; 472 $self-> SUPER::end_paint; 473 $self-> restore_state; 474 delete $self-> {$_} for 475 qw (save_state ps_data changed ); 476} 477 478sub begin_paint { return $_[0]-> begin_doc; } 479sub end_paint { $_[0]-> abort_doc; } 480 481sub end_doc 482{ 483 my $self = $_[0]; 484 return 0 unless $self-> {can_draw}; 485 $self-> end_page; 486 487 my $pages = scalar @{ $self->{pages} }; 488 my @kids = map { "$_ 0 R" } @{ $self->{pages} }; 489 490 $self-> emit_new_object(3, <<ENDS); 491<< 492/Type /Pages 493/Count $pages 494/Kids [@kids] 495>> 496endobj 497ENDS 498 499 my $encoding = $self-> new_dummy_obj; 500 $self-> emit_new_object($encoding, <<ENCODING); 501<< 502/Type /Encoding 503/Differences [ 0 504ENCODING 505 for my $x (0..15) { 506 my $n = $x * 16; 507 $self-> emit( join(' ', map { "/a" . ($n + $_) } 0..15)); 508 } 509 $self-> emit( <<END ); 510] 511>> 512endobj 513END 514 515 while ( my ( $font, $v ) = each %{ $self->{all_fonts} }) { 516 next if $v->{native}; 517 518 $self-> {glyph_keeper}-> begin_evacuate( $font ); 519 520 for my $xid ( @{ $v->{xids} } ) { 521 my ( $frec, $charset, $unicode, $width, $content) = $self-> {glyph_keeper}-> evacuate_next_subfont( $font ); 522 523 my $font_file = $self-> emit_new_stream_object( $content, "/Subtype /Type1C"); 524 525 my $font_desc = $self-> new_dummy_obj; 526 my $charset_str = join('', map { "/$_" } @$charset); 527 my @bbox = map { Prima::Utils::floor(($_ // 0) + .5) } @{ $frec->{bbox} }; 528 529 $self-> emit_new_object($font_desc, <<FONT); 530<< 531/Type /FontDescriptor 532/CharSet ($charset_str) 533/FontBBox [ @bbox ] 534/FontFile3 $font_file 0 R 535/FontName /$font 536/Flags 4 537/ItalicAngle $frec->{italic} 538>> 539endobj 540 541FONT 542 543 my ($unicode_xid, $unicode_stream) = $self-> new_stream_obj; 544 my $n_cps = 0; 545 my $maps = ''; 546 $self-> emit_to_stream( $unicode_stream, <<UNICODE); 547/CIDInit /ProcSet findresource begin 54812 dict begin 549begincmap 550/CMapType 2 def 5511 begincodespacerange 552<00><ff> 553endcodespacerange 554UNICODE 555 my @codes; 556 while ( my ( $i, $u ) = each @$unicode ) { 557 $u += 0; 558 if ( $u >= 0x10000 && $u <= 0x10FFFF ) { 559 $u -= 0x10000; 560 push @codes, sprintf("<%02x><%04x%04x>", $i, 561 0xd800 + ($u & 0x3ff), 562 0xdc00 + ($u >> 10) 563 ); 564 } elsif (( $u >= 0xD800 && $u <= 0xDFFF ) || ( $u > 0x10FFFF ) || ( $u == 0 )) { 565 next; 566 } else { 567 push @codes, sprintf("<%02x><%04x>", $i, $u); 568 } 569 } 570 while ( @codes ) { 571 my @section = splice( @codes, 0, 99 ); # spec says max 100 572 $self-> emit_to_stream( $unicode_stream, scalar(@section). " beginbfchar\n"); 573 $self-> emit_to_stream( $unicode_stream, join("\n", @section )); 574 $self-> emit_to_stream( $unicode_stream, "\nendbfchar\n"); 575 } 576 $self-> emit_to_stream( $unicode_stream, <<UNICODE); 577endcmap 578CMapName currentdict /CMap defineresource pop 579end end 580UNICODE 581 $self-> emit_stream_obj( $unicode_stream); 582 583 my $lastchar = $#$charset; 584 $self-> emit_new_object($xid, <<FONT); 585<< 586/Type /Font 587/Subtype /Type1 588/BaseFont /$font 589/Encoding $encoding 0 R 590/ToUnicode $unicode_xid 0 R 591/FontDescriptor $font_desc 0 R 592/FirstChar 0 593/LastChar $lastchar 594/Widths [ 595FONT 596 $self-> emit( join(' ', splice( @$width, 0, 16 )) ) 597 while @$width; 598 $self-> emit( <<END ); 599] 600>> 601endobj 602END 603 } 604 } 605 606 607 my $xref_offset = $self->{content_size}; 608 $self->emit("xref"); 609 my @xrefs = grep { defined } @{ $self->{xref} }; 610 my $xrefs = 1 + @xrefs; 611 $self->emit("0 $xrefs"); 612 $self->emit(sprintf("%010d %05d f ", 0, 65535)); 613 for my $xref ( @xrefs ) { 614 $self->emit(sprintf("%010d %05d n ", $xref, 0)); 615 } 616 $self->emit(<<TRAILER); 617trailer 618<< 619/Info 1 0 R 620/Root 2 0 R 621/Size $xrefs 622>> 623startxref 624$xref_offset 625%%EOF 626TRAILER 627 628 my $ret = $self->spool( $self-> {ps_data} ); 629 $self->{ps_data} = ''; 630 631 $self-> {can_draw} = 0; 632 $self-> SUPER::end_paint; 633 $self-> restore_state; 634 delete $self-> {$_} for 635 qw (save_state changed ps_data glyph_keeper glyph_font); 636 return $ret; 637} 638 639sub new_page 640{ 641 return 0 unless $_[0]-> {can_draw}; 642 my $self = $_[0]; 643 644 $self-> end_page; 645 $self-> {page_object} = $self->new_dummy_obj; 646 push @{$self-> {pages}}, $self->{page_object}; 647 $self-> {page_refs} = []; 648 $self-> {page_patterns} = {}; 649 $self-> {page_images} = []; 650 $self-> {page_fonts} = {}; 651 $self-> {page_rops} = {}; 652 unless ($self-> {page_content} = $self->new_file_obj) { 653 $self-> abort_doc; 654 return 0; 655 } 656 657 { 658 local $self->{delay} = 1; 659 $self-> $_( @{$self-> {save_state}-> {$_}}) for qw( translate clipRect); 660 } 661 $self-> change_transform(1); 662 $self-> {changed}->{font} = 1; 663 return 1; 664} 665 666sub pages { scalar @{ $_[0]-> {pages} } } 667 668sub fillPattern 669{ 670 return $_[0]-> SUPER::fillPattern unless $#_; 671 $_[0]-> SUPER::fillPattern( $_[1]); 672 return unless $_[0]-> {can_draw}; 673 674 my $self = $_[0]; 675 my @fp = @{$self-> SUPER::fillPattern}; 676 my $solidBack = ! grep { $_ != 0 } @fp; 677 my $solidFore = ! grep { $_ != 0xff } @fp; 678 my $fpid; 679 my @scaleto = $self-> pixel2point( 8, 8); 680 my $xid; 681 if ( !$solidBack && !$solidFore) { 682 $fpid = join( '', map { sprintf("%02x", $_)} @fp); 683 unless ( exists $self-> {fp_hash}-> {$fpid}) { 684 $xid = $self-> new_dummy_obj; 685 my $bits = pack('C*', @fp); 686 my $patdef = <<PAT; 687q 688BI 689/IM true 690/W 8 691/H 8 692/BPC 1 693ID $bits 694EI Q 695PAT 696 $self-> emit_new_object( $xid, <<PATTERNDEF); 697<< 698/Type /Pattern 699/BBox [0 0 1 1] 700/Length ${ \length $patdef } 701/PaintType 2 % Uncolored 702/PatternType 1 % Tiling pattern 703/Resources << 704/ProcSet [ /PDF /ImageB ] 705>> 706/TilingType 1 707/XStep 1 708/YStep 1 709>> 710stream 711$patdef 712endstream 713endobj 714PATTERNDEF 715 $self-> {fp_hash}-> {$fpid} = $xid; 716 } else { 717 $xid = $self-> {fp_hash}-> {$fpid}; 718 } 719 $self->{page_patterns}->{$xid}++; 720 } 721 $self-> {fpType} = $solidBack ? 'B' : ( $solidFore ? 'F' : $xid); 722 $self-> {changed}-> {fill} = 1; 723} 724 725sub compress 726{ 727 return $_[0]-> {compress} unless $#_; 728 my $self = $_[0]; 729 $self-> {compress} = $_[1]; 730} 731 732sub arc 733{ 734 my ( $self, $x, $y, $dx, $dy, $start, $end) = @_; 735 ( $x, $y, $dx, $dy) = $self-> pixel2point( $x, $y, $dx, $dy); 736 737 my $cubics = $self-> arc2cubics($x, $y, $dx, $dy, $start, $end); 738 my $content = "@{ $cubics->[0] }[0,1] m\n"; 739 $content .= "@{$_}[2..7] c\n" for @$cubics; 740 $self-> stroke( $content . " S"); 741} 742 743sub chord 744{ 745 my ( $self, $x, $y, $dx, $dy, $start, $end) = @_; 746 ( $x, $y, $dx, $dy) = $self-> pixel2point( $x, $y, $dx, $dy); 747 748 my $cubics = $self-> arc2cubics($x, $y, $dx, $dy, $start, $end); 749 my $content = "@{ $cubics->[0] }[0,1] m\n"; 750 $content .= "@{$_}[2..7] c\n" for @$cubics; 751 $self-> stroke( $content . " h S"); 752} 753 754sub ellipse 755{ 756 my ( $self, $x, $y, $dx, $dy) = @_; 757 ( $x, $y, $dx, $dy) = $self-> pixel2point( $x, $y, $dx, $dy); 758 759 my $cubics = $self-> arc2cubics($x, $y, $dx, $dy, 0, 360); 760 my $content = "@{ $cubics->[0] }[0,1] m\n"; 761 $content .= "@{$_}[2..7] c\n" for @$cubics; 762 $self-> stroke( $content . " h S"); 763} 764 765sub fill_chord 766{ 767 my ( $self, $x, $y, $dx, $dy, $start, $end) = @_; 768 ( $x, $y, $dx, $dy) = $self-> pixel2point( $x, $y, $dx, $dy); 769 770 my $cubics = $self-> arc2cubics($x, $y, $dx, $dy, $start, $end); 771 my $content = "@{ $cubics->[0] }[0,1] m\n"; 772 $content .= "@{$_}[2..7] c\n" for @$cubics; 773 my $F = (($self-> fillMode & fm::Winding) == fm::Alternate) ? 'f*' : 'f'; 774 $self-> fill( $content . " h $F"); 775} 776 777sub fill_ellipse 778{ 779 my ( $self, $x, $y, $dx, $dy) = @_; 780 ( $x, $y, $dx, $dy) = $self-> pixel2point( $x, $y, $dx, $dy); 781 782 my $cubics = $self-> arc2cubics($x, $y, $dx, $dy, 0, 360); 783 my $content = "@{ $cubics->[0] }[0,1] m\n"; 784 $content .= "@{$_}[2..7] c\n" for @$cubics; 785 $self-> stroke( $content . " h f"); 786} 787 788sub sector 789{ 790 my ( $self, $x, $y, $dx, $dy, $start, $end) = @_; 791 ( $x, $y, $dx, $dy) = $self-> pixel2point( $x, $y, $dx, $dy); 792 793 my $cubics = $self-> arc2cubics($x, $y, $dx, $dy, $start, $end); 794 my $content = "$x $y m @{ $cubics->[0] }[0,1] l\n"; 795 $content .= "@{$_}[2..7] c\n" for @$cubics; 796 $self-> stroke( $content . " h S"); 797} 798 799sub fill_sector 800{ 801 my ( $self, $x, $y, $dx, $dy, $start, $end) = @_; 802 ( $x, $y, $dx, $dy) = $self-> pixel2point( $x, $y, $dx, $dy); 803 804 my $cubics = $self-> arc2cubics($x, $y, $dx, $dy, $start, $end); 805 my $content = "$x $y m @{ $cubics->[0] }[0,1] l\n"; 806 $content .= "@{$_}[2..7] c" for @$cubics; 807 my $F = (($self-> fillMode & fm::Winding) == fm::Alternate) ? 'f*' : 'f'; 808 $self-> fill( $content . " h $F"); 809} 810 811sub text_out_outline 812{ 813 my ( $self, $text ) = @_; 814 my $shaped = $self->text_shape($text, level => ts::Glyphs ) or return; 815 $self-> glyph_out_outline($shaped, 0, scalar @{$shaped->glyphs}); 816} 817 818sub glyph_out_outline 819{ 820 my ( $self, $text, $from, $len ) = @_; 821 822 my $glyphs = $text-> glyphs; 823 my $indexes = $text-> indexes; 824 my $advances = $text-> advances; 825 my $positions = $text-> positions; 826 my $fonts = $text-> fonts; 827 my $plaintext = $text-> [Prima::Drawable::Glyphs::CUSTOM()]; 828 my @ix_lengths = defined($plaintext) ? $text-> index_lengths : (); 829 my $adv = 0; 830 my $canvas = $self->glyph_canvas; 831 my $resolution = 72.27 / $self->{resolution}->[0]; 832 my $keeper = $self->{glyph_keeper}; 833 my $font = $self->{glyph_font}; 834 my $div = $self->{font_scale}; 835 my $restore_font; 836 837 $len += $from; 838 my $emit = ''; 839 my $fid = 0; 840 my $ff = $canvas->font; 841 my $curr_subfont = -1; 842 my ($x, $y) = (0,0); 843 for ( my $i = $from; $i < $len; $i++) { 844 my $advance; 845 my $glyph = $glyphs->[$i]; 846 my ($x2, $y2) = ($adv, 0); 847 my $nfid = $fonts ? $fonts->[$i] : 0; 848 if ( $nfid != $fid ) { 849 my $newfont; 850 if ( $nfid == 0 ) { 851 $newfont = $self->{font}; 852 $restore_font = 0; 853 } else { 854 my $src = $self-> fontMapperPalette($nfid); 855 my $dst = \%{$self->{font}}; 856 $newfont = Prima::Drawable->font_match( $src, $dst ); 857 $restore_font = 1; 858 } 859 $self-> glyph_canvas_set_font( %$newfont ); 860 $font = $nfid ? $keeper->get_font($canvas->font) : $self->{glyph_font}; 861 $fid = $nfid; 862 $curr_subfont = -1; 863 } 864 my $char = defined($plaintext) ? 865 substr( $plaintext, $indexes->[$i] & ~to::RTL, $ix_lengths[$i]) : 866 undef; 867 my ($subfont, $gid) = $keeper-> use_char($canvas, $font, $glyph, $char); 868 if ( defined($gid) && $subfont != $curr_subfont ) { 869 $curr_subfont = $subfont; 870 my $xid = $self-> {all_fonts}-> {$font}-> {xids}-> [ $subfont ] //= $self->new_dummy_obj; 871 $self->{page_fonts}->{$xid} //= 1; 872 $emit .= "/F$xid $self->{font}->{size} Tf\n"; 873 } 874 if ( $advances) { 875 $advance = $advances->[$i]; 876 $x2 += $positions->[$i*2]; 877 $y2 += $positions->[$i*2 + 1]; 878 } else { 879 my $xr = $canvas->get_font_abc($glyph, $glyph, to::Glyphs); 880 $advance = ($$xr[0] + $$xr[1] + $$xr[2]) * $div; 881 } 882 $adv += $advance; 883 ($x2, $y2) = map { int( $_ * 100 + 0.5) / 100 } $self->pixel2point($x2, $y2); 884 my $dx = $x2 - $x; 885 my $dy = $y2 - $y; 886 if ($dx != 0 || $dy != 0) { 887 ($dx, $dy) = map { int( $_ * 100 + 0.5) / 100 } ($dx, $dy); 888 $emit .= "$dx $dy Td "; 889 } 890 ($x, $y) = ($x2, $y2); 891 $emit .= sprintf "<%02x> Tj\n", $gid if defined $gid; 892 } 893 894 if ($restore_font) { 895 $self-> glyph_canvas_set_font( %{ $self->{font} }); 896 } 897 $self-> emit_content($emit); 898} 899 900sub text_out 901{ 902 my ( $self, $text, $x, $y, $from, $len) = @_; 903 904 $from //= 0; 905 my $glyphs; 906 if ( ref($text) eq 'Prima::Drawable::Glyphs') { 907 $glyphs = $text->glyphs; 908 $len = @$glyphs if !defined($len) || $len < 0 || $len > @$glyphs; 909 } elsif (ref($text)) { 910 $len //= -1; 911 return $text->text_out($self, $x, $y, $from, $len); 912 } else { 913 $len = length($text) if !defined($len) || $len < 0 || $len > length($text); 914 $text = substr($text, $from, $len); 915 $from = 0; 916 $len = length($text); 917 } 918 return 0 unless $self-> {can_draw} and $len > 0; 919 920 $y += $self-> {font}-> {descent} if !$self-> textOutBaseline; 921 ( $x, $y) = $self-> pixel2point( $x, $y); 922 923 $self-> emit_content("q"); 924 my $wmul = $self-> {font_x_scale}; 925 if ( $self-> {font}-> {direction} != 0) { 926 my $r = $self-> {font}-> {direction}; 927 my $sin1 = sin($r); 928 my $cos = cos($r); 929 my $wcos = cos($r) * $wmul; 930 my $sin2 = -$sin1; 931 $self-> emit_content("$wcos $sin1 $sin2 $cos $x $y cm"); 932 } else { 933 $self-> emit_content("$wmul 0 0 1 $x $y cm"); 934 } 935 936 my @rb; 937 if ( $self-> textOpaque || $self-> {font}-> {style} & (fs::Underlined|fs::StruckOut)) { 938 my ( $ds, $bs) = ( $self-> {font}-> {direction}, $self-> textOutBaseline); 939 $self-> {font}-> {direction} = 0; 940 $self-> textOutBaseline(1) unless $bs; 941 @rb = $self-> pixel2point( @{$self-> get_text_box( $text, $from, $len)}); 942 $self-> {font}-> {direction} = $ds; 943 $self-> textOutBaseline($bs) unless $bs; 944 } 945 if ( $self-> textOpaque) { 946 $self-> emit_content( lc $self-> cmd_rgb( $self-> backColor)); 947 $self-> emit_content( "h @rb[0,1] m @rb[2,3] l @rb[6,7] l @rb[4,5] l f"); 948 } 949 950 $self-> emit_content( lc $self-> cmd_rgb( $self-> color)); 951 952 $self-> emit_content( "BT"); 953 if ( $glyphs ) { 954 $self->glyph_out_outline($text, $from, $len); 955 } else { 956 $self->text_out_outline($text); 957 } 958 $self-> emit_content( "ET"); 959 960 if ( $self-> {font}-> {style} & (fs::Underlined|fs::StruckOut)) { 961 $self-> emit_content( uc $self-> cmd_rgb( $self-> color)); 962 my $lw = int($self-> {font}-> {size} / 40 + .5); # XXX empiric 963 $lw ||= 1; 964 $self-> emit_content("[] 0 d 0 J $lw w"); 965 if ( $self-> {font}-> {style} & fs::Underlined) { 966 $self-> emit_content("h @rb[0,3] m @rb[4,3] l S"); 967 } 968 if ( $self-> {font}-> {style} & fs::StruckOut) { 969 $rb[3] += $rb[1]/2; 970 $self-> emit_content("h @rb[0,3] m @rb[4,3] l S"); 971 } 972 } 973 $self-> emit_content("Q"); 974 return 1; 975} 976 977sub rectangle 978{ 979 my ( $self, $x1, $y1, $x2, $y2) = @_; 980 ( $x1, $y1, $x2, $y2) = $self-> pixel2point( $x1, $y1, $x2, $y2); 981 $x2 -= $x1; 982 $y2 -= $y1; 983 $self-> stroke( "h $x1 $y1 $x2 $y2 re S"); 984} 985 986sub bar 987{ 988 my ( $self, $x1, $y1, $x2, $y2) = @_; 989 ( $x1, $y1, $x2, $y2) = $self-> pixel2point( $x1, $y1, $x2, $y2); 990 $x2 -= $x1; 991 $y2 -= $y1; 992 $self-> fill( "h $x1 $y1 $x2 $y2 re f"); 993} 994 995sub bars 996{ 997 my ( $self, $array) = @_; 998 my $i; 999 my $c = scalar @$array; 1000 my @a = $self-> pixel2point( @$array); 1001 $c = int( $c / 4) * 4; 1002 my $z = ''; 1003 for ( $i = 0; $i < $c; $i += 4) { 1004 $z .= "h @a[$i,$i+1] " . ($a[$i+2] - $a[$i]) . ' ' . ($a[$i+3] - $a[$i+1]) . " re f\n"; 1005 } 1006 $self-> fill( $z); 1007} 1008 1009sub clear 1010{ 1011 my ( $self, $x1, $y1, $x2, $y2) = @_; 1012 if ( grep { ! defined } $x1, $y1, $x2, $y2) { 1013 ($x1, $y1, $x2, $y2) = $self-> clipRect; 1014 unless ( grep { $_ != 0 } $x1, $y1, $x2, $y2) { 1015 ($x1, $y1, $x2, $y2) = (0,0,@{$self-> {size}}); 1016 } 1017 } 1018 ( $x1, $y1, $x2, $y2) = $self-> pixel2point( $x1, $y1, $x2, $y2); 1019 $x2 -= $x1; 1020 $y2 -= $y1; 1021 my $c = lc $self-> cmd_rgb( $self-> backColor); 1022 $self-> emit_content(<<CLEAR); 1023$c 1024h $x1 $y1 $x2 $y2 re f 1025CLEAR 1026 $self-> {changed}-> {fill} = 1; 1027} 1028 1029sub line 1030{ 1031 my ( $self, $x1, $y1, $x2, $y2) = @_; 1032 ( $x1, $y1, $x2, $y2) = $self-> pixel2point( $x1, $y1, $x2, $y2); 1033 $self-> stroke("h $x1 $y1 m $x2 $y2 l S"); 1034} 1035 1036sub lines 1037{ 1038 my ( $self, $array) = @_; 1039 my $i; 1040 my $c = scalar @$array; 1041 my @a = $self-> pixel2point( @$array); 1042 $c = int( $c / 4) * 4; 1043 my $z = ''; 1044 for ( $i = 0; $i < $c; $i += 4) { 1045 $z .= "h @a[$i,$i+1] m @a[$i+2,$i+3] l S\n"; 1046 } 1047 $self-> stroke( $z); 1048} 1049 1050sub polyline 1051{ 1052 my ( $self, $array) = @_; 1053 my $i; 1054 my $c = scalar @$array; 1055 my @a = $self-> pixel2point( @$array); 1056 $c = int( $c / 2) * 2; 1057 return if $c < 2; 1058 my $z = "@a[0,1] m\n"; 1059 for ( $i = 2; $i < $c; $i += 2) { 1060 $z .= "@a[$i,$i+1] l\n"; 1061 } 1062 $self-> stroke($z . 'S'); 1063} 1064 1065sub fillpoly 1066{ 1067 my ( $self, $array) = @_; 1068 my $i; 1069 my $c = scalar @$array; 1070 my @a = $self-> pixel2point( @$array); 1071 $c = int( $c / 2) * 2; 1072 return if $c < 2; 1073 1074 my $z = "@a[0,1] m\n"; 1075 for ( $i = 2; $i < $c; $i += 2) { 1076 $z .= "@a[$i,$i+1] l\n"; 1077 } 1078 $self-> fill($z . 1079 ((($self-> fillMode & fm::Winding) == fm::Alternate) ? 'f*' : 'f') 1080 ); 1081} 1082 1083sub pixel 1084{ 1085 my ( $self, $x, $y, $pix) = @_; 1086 return cl::Invalid unless defined $pix; 1087 my $c = lc $self-> cmd_rgb( $pix); 1088 my $w; 1089 ($x, $y, $w) = $self-> pixel2point( $x, $y, 1); 1090 $self-> emit_content(<<PIXEL); 1091q 1092$c 1093$x $y $w $w re f 1094Q 1095PIXEL 1096 $self-> {changed}-> {fill} = 1; 1097} 1098 1099# methods 1100our @rops; 1101$rops[ &{$rop::{$_}}() ] = $_ for qw( 1102 Multiply Screen Overlay Darken Lighten ColorDodge 1103 ColorBurn HardLight SoftLight Difference Exclusion 1104); 1105 1106sub put_image_indirect 1107{ 1108 return 0 unless $_[0]-> {can_draw}; 1109 my ( $self, $image, $x, $y, $xFrom, $yFrom, $xDestLen, $yDestLen, $xLen, $yLen, $rop) = @_; 1110 return 1 if $rop == rop::NoOper; 1111 1112 my $touch; 1113 $touch = 1, $image = $image-> image if $image-> isa('Prima::DeviceBitmap'); 1114 1115 unless ( $xFrom == 0 && $yFrom == 0 && $xLen == $image-> width && $yLen == $image-> height) { 1116 $image = $image-> extract( $xFrom, $yFrom, $xLen, $yLen); 1117 $touch = 1; 1118 } 1119 1120 my $ib = $image-> get_bpp; 1121 if ( $ib != $self-> get_bpp) { 1122 $image = $image-> dup unless $touch; 1123 if ( $self-> {grayscale} || $image-> type & im::GrayScale) { 1124 $image-> type( im::Byte); 1125 } else { 1126 $image-> type( im::RGB); 1127 } 1128 $touch = 1; 1129 } elsif ( $self-> {grayscale} || $image-> type & im::GrayScale) { 1130 $image = $image-> dup unless $touch; 1131 $image-> type( im::Byte); 1132 $touch = 1; 1133 } 1134 1135 $ib = $image-> get_bpp; 1136 if ($ib != 8 && $ib != 24) { 1137 $image = $image-> dup unless $touch; 1138 $image-> type( im::RGB); 1139 $touch = 1; 1140 } 1141 1142 if ( $image-> type == im::RGB ) { 1143 # invert BGR -> RGB 1144 $image = $image-> dup unless $touch; 1145 $image-> set(data => $image->data, type => im::fmtBGR | im::RGB); 1146 $touch = 1; 1147 } 1148 1149 my @is = $image-> size; 1150 ($x, $y, $xDestLen, $yDestLen) = $self-> pixel2point( $x, $y, $xDestLen, $yDestLen); 1151 my @fullScale = ( 1152 $is[0] / $xLen * $xDestLen, 1153 $is[1] / $yLen * $yDestLen, 1154 ); 1155 1156 my $xid2; 1157 my $mask = ''; 1158 if ( $image-> isa('Prima::Icon')) { 1159 if ( $image-> maskType != 1 && $image-> maskType != 8) { 1160 $image = $image-> dup unless $touch; 1161 $image-> set(maskType => 1); 1162 $touch = 1; 1163 } 1164 my $obj; 1165 ($xid2, $obj) = $self-> new_file_obj; 1166 my $g = $image-> mask; 1167 my $ls = $image-> maskLineSize; 1168 my $bt = ( $image-> maskType == 1 ) ? int($is[0] / 8) + (($is[0] & 7) ? 1 : 0) : $is[0]; 1169 my $xs = $bt * $is[1]; 1170 for ( my $i = 0; $i < $is[1]; $i++) { 1171 $obj-> write( substr($g, ($is[1] - $i - 1) * $ls, $bt) ); 1172 } 1173 my $prefix = <<IMAGE; 1174/Type /XObject 1175/Subtype /Image 1176/Width $is[0] 1177/Height $is[1] 1178IMAGE 1179 if ( $image-> maskType == 1 ) { 1180 $mask = "/Mask $xid2 0 R"; 1181 $self-> emit_file_obj($obj, $prefix . <<OBJ); 1182/BitsPerComponent 1 1183/ImageMask true 1184OBJ 1185 } else { 1186 $mask = "/SMask $xid2 0 R"; 1187 $self-> emit_file_obj($obj, $prefix . <<OBJ); 1188/BitsPerComponent 8 1189/ColorSpace /DeviceGray 1190OBJ 1191 } 1192 undef $g; 1193 } 1194 1195 my ($xid, $obj) = $self-> new_file_obj; 1196 push @{ $self-> {page_images}}, $xid; 1197 1198 my $g = $image-> data; 1199 my $bt = ( $image-> type & im::BPP) * $is[0] / 8; 1200 my $ls = $image-> lineSize; 1201 for ( my $i = 0; $i < $is[1]; $i++) { 1202 $obj-> write( substr($g, ($is[1] - $i - 1) * $ls, $bt) ); 1203 } 1204 undef $g; 1205 1206 my $cs = (($image->type & im::GrayScale) ? 'Gray' : 'RGB'); 1207 $self-> emit_file_obj($obj, <<OBJ); 1208/Type /XObject 1209/Subtype /Image 1210/Width $is[0] 1211/Height $is[1] 1212/ColorSpace /Device$cs 1213/BitsPerComponent 8 1214$mask 1215OBJ 1216 1217 my $gs = ''; 1218 if ( $rop != rop::CopyPut && $rop >= rop::Multiply && $rop <= rop::Exclusion) { 1219 my $text = $rops[$rop]; 1220 $self-> {all_rops}->{ $text } //= { 1221 xid => $self-> emit_new_dummy_object("/Type /ExtGState /BM /$text /AIS false"), 1222 id => "GS$text", 1223 }; 1224 $self-> {page_rops}-> {$text} = $self->{all_rops}->{$text}->{xid}; 1225 $gs = "/$self->{all_rops}->{$text}->{id} gs"; 1226 } 1227 1228 $self-> emit_content(<<PUT); 1229q 1230$gs 1231$fullScale[0] 0 0 $fullScale[1] $x $y cm 1232/I$xid Do 1233Q 1234PUT 1235 return 1; 1236} 1237 1238sub apply_canvas_font 1239{ 1240 my ( $self, $f1000) = @_; 1241 1242 if ($f1000->{vector} == fv::Outline) { 1243 $self-> {glyph_keeper} //= Prima::PS::CFF->new; 1244 $self-> {glyph_font} = $self-> {glyph_keeper}->get_font($f1000); # it wants size=1000 1245 $self-> {all_fonts}->{ $self->{glyph_font} }->{native} //= 0; 1246 } else { 1247 $self-> {glyph_font} = ($f1000->{pitch} == fp::Fixed) ? 'Courier' : 'Helvetica'; 1248 $self-> {all_fonts}->{ $self->{glyph_font} }->{native} //= 1; 1249 } 1250} 1251 1252sub new_path 1253{ 1254 return Prima::PS::PDF::Path->new(@_); 1255} 1256 1257sub region 1258{ 1259 return $_[0]->{region} unless $#_; 1260 my ( $self, $region ) = @_; 1261 if ( $region && !UNIVERSAL::isa($region, "Prima::PS::PDF::Region")) { 1262 warn "Region is not a Prima::PS::PDF::Region"; 1263 return undef; 1264 } 1265 $self->{clipRect} = [0,0,0,0]; 1266 $self->{region} = $region; 1267 $self-> change_transform; 1268} 1269 1270package 1271 Prima::PS::PDF::Path; 1272use base qw(Prima::PS::Drawable::Path); 1273 1274my %dict = ( 1275 lineto => 'l', 1276 moveto => 'm', 1277 curveto => 'c', 1278 stroke => 'S', 1279 closepath => 'h', 1280 fill_alt => 'f*', 1281 fill_wind => 'f', 1282); 1283 1284sub dict { \%dict } 1285 1286sub set_current_point 1287{ 1288 my ( $self, $x, $y ) = @_; 1289 $self-> emit($x, $y, $self->{move_is_line} ? 'l' : 'm'); 1290 $self-> {move_is_line} = 1; 1291} 1292 1293sub region 1294{ 1295 my ($self, $mode) = @_; 1296 my $path = join "\n", @{$self-> entries}; 1297 $path .= ' h' unless $path =~ /h$/; 1298 $path .= ' W'; 1299 $path .= '*' if ($mode // fm::Winding) & fm::Alternate; 1300 return Prima::PS::PDF::Region->new( $path ); 1301} 1302 1303package 1304 Prima::PS::PDF::Region; 1305use base qw(Prima::PS::Drawable::Region); 1306 1307sub other { UNIVERSAL::isa($_[0], "Prima::PS::PDF::Region") ? $_[0] : () } 1308 1309sub equals 1310{ 1311 my $self = shift; 1312 my $other = other(shift) or return; 1313 return $self->{path} eq $other->{path}; 1314} 1315 1316sub combine 1317{ 1318 my $self = shift; 1319 my $other = other(shift) or return; 1320 $self->{path} .= "\n" . $other->apply_offset; 1321} 1322 1323sub is_empty { shift->{path} !~ /[Sf]/ } 1324 13251; 1326 1327=pod 1328 1329=head1 NAME 1330 1331Prima::PS::PDF - PDF interface to Prima::Drawable 1332 1333=head1 SYNOPSIS 1334 1335 use Prima; 1336 use Prima::PS::PDF; 1337 1338 my $x = Prima::PS::PDF-> create( onSpool => sub { 1339 open F, ">> ./test.pdf"; 1340 binmode F; 1341 print F $_[1]; 1342 close F; 1343 }); 1344 die "error:$@" unless $x-> begin_doc; 1345 $x-> font-> size( 30); 1346 $x-> text_out( "hello!", 100, 100); 1347 $x-> end_doc; 1348 1349 1350=head1 DESCRIPTION 1351 1352Realizes the Prima library interface to PDF v1.4. 1353The module is designed to be compliant with Prima::Drawable interface. 1354All properties' behavior is as same as Prima::Drawable's, except those 1355described below. 1356 1357=head2 Inherited properties 1358 1359=over 1360 1361=item ::resolution 1362 1363Can be set while object is in normal stage - cannot be changed if document 1364is opened. Applies to fillPattern realization and general pixel-to-point 1365and vice versa calculations 1366 1367=item ::region 1368 1369- ::region is not realized ( yet?) 1370 1371=back 1372 1373=head2 Specific properties 1374 1375=over 1376 1377=item ::grayscale 1378 1379could be 0 or 1 1380 1381=item ::pageSize 1382 1383physical page dimension, in points 1384 1385=item ::pageMargins 1386 1387non-printable page area, an array of 4 integers: 1388left, bottom, right and top margins in points. 1389 1390=item ::reversed 1391 1392if 1, a 90 degrees rotated document layout is assumed 1393 1394=item ::rotate and ::scale 1395 1396along with Prima::Drawable::translate provide PS-specific 1397transformation matrix manipulations. ::rotate is number, 1398measured in degrees, counter-clockwise. ::scale is array of 1399two numbers, respectively x- and y-scale. 1 is 100%, 2 is 200% 1400etc. 1401 1402=back 1403 1404=head2 Internal methods 1405 1406=over 1407 1408=item pixel2point and point2pixel 1409 1410Helpers for translation from pixel to points and vice versa. 1411 1412=item spool 1413 1414Prima::PS::Drawable is not responsible for output of 1415generated document, it just calls ::spool when document 1416is closed through ::end_doc. By default just skips data. 1417Prima::PS::Printer handles spooling logic. 1418 1419=item fonts 1420 1421Returns Prima::Application::fonts, however with C<iso10646-1> encoding only. 1422That effectively allows only unicode output. 1423 1424=back 1425 1426=cut 1427