package PDF::API2::Content;
our $VERSION = '2.028'; # VERSION
use base 'PDF::API2::Basic::PDF::Dict';
use Carp;
use Compress::Zlib qw();
use Encode;
use Math::Trig;
use PDF::API2::Matrix;
use PDF::API2::Basic::PDF::Utils;
use PDF::API2::Util;
no warnings qw( deprecated recursion uninitialized );
=head1 NAME
PDF::API2::Content - Methods for adding graphics and text to a PDF
=head1 SYNOPSIS
# Start with a PDF page (new or opened)
my $pdf = PDF::API2->new();
my $page = $pdf->page();
# Add a new content object
my $content = $page->gfx();
my $content = $page->text();
# Then call the methods below add graphics and text to the page.
=head1 METHODS
=cut
sub new {
my ($class)=@_;
my $self = $class->SUPER::new(@_);
$self->{' stream'}='';
$self->{' poststream'}='';
$self->{' font'}=undef;
$self->{' fontset'}=0;
$self->{' fontsize'}=0;
$self->{' charspace'}=0;
$self->{' hscale'}=100;
$self->{' wordspace'}=0;
$self->{' lead'}=0;
$self->{' rise'}=0;
$self->{' render'}=0;
$self->{' matrix'}=[1,0,0,1,0,0];
$self->{' textmatrix'}=[1,0,0,1,0,0];
$self->{' textlinematrix'}=[0,0];
$self->{' fillcolor'}=[0];
$self->{' strokecolor'}=[0];
$self->{' translate'}=[0,0];
$self->{' scale'}=[1,1];
$self->{' skew'}=[0,0];
$self->{' rotate'}=0;
$self->{' apiistext'}=0;
return $self;
}
sub outobjdeep {
my $self = shift @_;
$self->textend;
foreach my $k (qw[ api apipdf apiistext apipage font fontset fontsize
charspace hscale wordspace lead rise render matrix
textmatrix textlinematrix fillcolor strokecolor
translate scale skew rotate ]) {
$self->{" $k"}=undef;
delete($self->{" $k"});
}
if ($self->{-docompress}==1 && $self->{Filter}) {
$self->{' stream'}=Compress::Zlib::compress($self->{' stream'});
$self->{' nofilt'}=1;
delete $self->{-docompress};
}
$self->SUPER::outobjdeep(@_);
}
=head2 Coordinate Transformations
The methods in this section change the coordinate system for the
current content object relative to the rest of the document.
If you call more than one of these methods, the PDF specification
recommends calling them in the following order: translate, rotate,
scale, skew. Each change builds on the last, and you can get
unexpected results when calling them in a different order.
=over
=item $content->translate($x, $y)
Moves the origin along the x and y axes.
=cut
sub _translate {
my ($x,$y)=@_;
return(1,0,0,1,$x,$y);
}
sub translate {
my ($self,$x,$y)=@_;
$self->transform(-translate=>[$x,$y]);
}
=item $content->rotate($degrees)
Rotates the coordinate system counter-clockwise.
Use a negative argument to rotate clockwise.
=cut
sub _rotate {
my ($a)=@_;
return (cos(deg2rad($a)), sin(deg2rad($a)),-sin(deg2rad($a)), cos(deg2rad($a)),0,0);
}
sub rotate {
my ($self,$a)=@_;
$self->transform(-rotate=>$a);
}
=item $content->scale($sx, $sy)
Scales (stretches) the coordinate systems along the x and y axes.
=cut
sub _scale {
my ($x,$y)=@_;
return ($x,0,0,$y,0,0);
}
sub scale {
my ($self,$sx,$sy)=@_;
$self->transform(-scale=>[$sx,$sy]);
}
=item $content->skew($sa, $sb)
Skews the coordinate system by C<$sa> degrees (counter-clockwise) from
the x axis and C<$sb> degrees (clockwise) from the y axis.
=cut
sub _skew {
my ($a,$b)=@_;
return (1, tan(deg2rad($a)),tan(deg2rad($b)),1,0,0);
}
sub skew {
my ($self,$a,$b)=@_;
$self->transform(-skew=>[$a,$b]);
}
=item $content->transform(%options)
$content->transform(
-translate => [$x, $y],
-rotate => $degrees,
-scale => [$sx, $sy],
-skew => [$sa, $sb],
)
Performs multiple coordinate transformations at once, in the order
recommended by the PDF specification (translate, rotate, scale, then
skew).
This is equivalent to making each transformation separately.
=cut
sub _transform {
my (%opt)=@_;
my $mtx=PDF::API2::Matrix->new([1,0,0],[0,1,0],[0,0,1]);
foreach my $o (qw( -matrix -skew -scale -rotate -translate )) {
next unless(defined($opt{$o}));
if ($o eq '-translate') {
my @mx=_translate(@{$opt{$o}});
$mtx=$mtx->multiply(PDF::API2::Matrix->new(
[$mx[0],$mx[1],0],
[$mx[2],$mx[3],0],
[$mx[4],$mx[5],1]
));
}
elsif ($o eq '-rotate') {
my @mx=_rotate($opt{$o});
$mtx=$mtx->multiply(PDF::API2::Matrix->new(
[$mx[0],$mx[1],0],
[$mx[2],$mx[3],0],
[$mx[4],$mx[5],1]
));
}
elsif ($o eq '-scale') {
my @mx=_scale(@{$opt{$o}});
$mtx=$mtx->multiply(PDF::API2::Matrix->new(
[$mx[0],$mx[1],0],
[$mx[2],$mx[3],0],
[$mx[4],$mx[5],1]
));
}
elsif ($o eq '-skew') {
my @mx=_skew(@{$opt{$o}});
$mtx=$mtx->multiply(PDF::API2::Matrix->new(
[$mx[0],$mx[1],0],
[$mx[2],$mx[3],0],
[$mx[4],$mx[5],1]
));
}
elsif ($o eq '-matrix') {
my @mx=@{$opt{$o}};
$mtx=$mtx->multiply(PDF::API2::Matrix->new(
[$mx[0],$mx[1],0],
[$mx[2],$mx[3],0],
[$mx[4],$mx[5],1]
));
}
}
if ($opt{-point}) {
my $mp=PDF::API2::Matrix->new([$opt{-point}->[0],$opt{-point}->[1],1]);
$mp=$mp->multiply($mtx);
return($mp->[0][0],$mp->[0][1]);
}
return (
$mtx->[0][0],$mtx->[0][1],
$mtx->[1][0],$mtx->[1][1],
$mtx->[2][0],$mtx->[2][1]
);
}
sub transform {
my ($self,%opt)=@_;
$self->matrix(_transform(%opt));
if ($opt{-translate}) {
@{$self->{' translate'}}=@{$opt{-translate}};
}
else {
@{$self->{' translate'}}=(0,0);
}
if ($opt{-rotate}) {
$self->{' rotate'}=$opt{-rotate};
}
else {
$self->{' rotate'}=0;
}
if ($opt{-scale}) {
@{$self->{' scale'}}=@{$opt{-scale}};
}
else {
@{$self->{' scale'}}=(1,1);
}
if ($opt{-skew}) {
@{$self->{' skew'}}=@{$opt{-skew}};
}
else {
@{$self->{' skew'}}=(0,0);
}
return $self;
}
=item $content->transform_rel(%options)
Makes transformations similarly to C<transform>, except that it adds
to the previously set values.
=cut
sub transform_rel {
my ($self,%opt)=@_;
my ($sa1,$sb1)=@{$opt{-skew} ? $opt{-skew} : [0,0]};
my ($sa0,$sb0)=@{$self->{" skew"}};
my ($sx1,$sy1)=@{$opt{-scale} ? $opt{-scale} : [1,1]};
my ($sx0,$sy0)=@{$self->{" scale"}};
my $rot1=$opt{"-rotate"} || 0;
my $rot0=$self->{" rotate"};
my ($tx1,$ty1)=@{$opt{-translate} ? $opt{-translate} : [0,0]};
my ($tx0,$ty0)=@{$self->{" translate"}};
$self->transform(
-skew=>[$sa0+$sa1,$sb0+$sb1],
-scale=>[$sx0*$sx1,$sy0*$sy1],
-rotate=>$rot0+$rot1,
-translate=>[$tx0+$tx1,$ty0+$ty1],
);
return $self;
}
=item $content->matrix($a, $b, $c, $d, $e, $f)
(Advanced) Sets the current transformation matrix manually. Unless
you have a particular need to enter transformations manually, you
should use the C<transform> method instead.
=cut
sub _matrix_text {
my ($a,$b,$c,$d,$e,$f)=@_;
return (floats($a,$b,$c,$d,$e,$f),'Tm');
}
sub _matrix_gfx {
my ($a,$b,$c,$d,$e,$f)=@_;
return (floats($a,$b,$c,$d,$e,$f),'cm');
}
sub matrix {
my $self=shift @_;
my ($a,$b,$c,$d,$e,$f)=@_;
if (defined $a) {
if ($self->_in_text_object()) {
$self->add(_matrix_text($a,$b,$c,$d,$e,$f));
@{$self->{' textmatrix'}}=($a,$b,$c,$d,$e,$f);
@{$self->{' textlinematrix'}}=(0,0);
}
else {
$self->add(_matrix_gfx($a,$b,$c,$d,$e,$f));
}
}
if ($self->_in_text_object()) {
return @{$self->{' textmatrix'}};
}
else {
return $self;
}
}
sub matrix_update {
my ($self,$tx,$ty)=@_;
$self->{' textlinematrix'}->[0]+=$tx;
$self->{' textlinematrix'}->[1]+=$ty;
return $self;
}
=back
=head2 Graphics State Parameters
=over
=item $content->save
Saves the current graphics state and text state on a stack.
=cut
sub _save {
return 'q';
}
sub save {
my $self = shift;
unless ($self->_in_text_object()) {
$self->add(_save());
}
}
=item $content->restore
Restores the most recently saved graphics state and text state,
removing it from the stack.
=cut
sub _restore {
return 'Q';
}
sub restore {
my $self = shift;
unless ($self->_in_text_object()) {
$self->add(_restore());
}
}
=item $content->linewidth($width)
Sets the width of the stroke.
=cut
sub _linewidth {
my ($linewidth)=@_;
return ($linewidth, 'w');
}
sub linewidth {
my ($this,$linewidth)=@_;
$this->add(_linewidth($linewidth));
}
=item $content->linecap($style)
Sets the style to be used at the end of a stroke.
=over
=item 0 = Butt Cap
The stroke ends at the end of the path, with no projection.
=item 1 = Round Cap
An arc is drawn around the end of the path with a diameter equal to
the line width, and is filled in.
=item 2 = Projecting Square Cap
The stroke continues past the end of the path for half the line width.
=back
=cut
sub _linecap {
my ($linecap)=@_;
return ($linecap, 'J');
}
sub linecap {
my ($self,$linecap)=@_;
$self->add(_linecap($linecap));
}
=item $content->linejoin($style)
Sets the style of join to be used at corners of a path.
=over
=item 0 = Miter Join
The outer edges of the stroke extend until they meet, up to the limit
specified below. If the limit would be surpassed, a bevel join is
used instead.
=item 1 = Round Join
A circle with a diameter equal to the linewidth is drawn around the
corner point, producing a rounded corner.
=item 2 = Bevel Join
A triangle is drawn to fill in the notch between the two strokes.
=back
=cut
sub _linejoin {
my ($linejoin)=@_;
return ($linejoin, 'j');
}
sub linejoin {
my ($this,$linejoin)=@_;
$this->add(_linejoin($linejoin));
}
=item $content->miterlimit($ratio)
Sets the miter limit when the line join style is a miter join.
The C<$ratio> is the maximum length of the miter (inner to outer
corner) divided by the line width. Any miter above this ratio will be
converted to a bevel join. The practical effect is that lines meeting
at shallow angles are chopped off instead of producing long pointed
corners.
There is no documented default miter limit.
=cut
sub miterlimit {
my ($self, $limit) = @_;
$self->add(_miterlimit($limit));
}
sub _miterlimit {
my ($limit) = @_;
return ($limit, 'M');
}
# Deprecated: miterlimit was originally named incorrectly
sub meterlimit { return miterlimit(@_) }
sub _meterlimit { return _miterlimit(@_) }
=item $content->linedash()
=item $content->linedash($length)
=item $content->linedash($dash_length, $gap_length, ...)
=item $content->linedash(-pattern => [$dash_length, $gap_length, ...], -shift => $offset)
Sets the line dash pattern.
If called without any arguments, a solid line will be drawn.
If called with one argument, the dashes and gaps will have equal
lengths.
If called with two or more arguments, the arguments represent
alternating dash and gap lengths.
If called with a hash of arguments, a dash phase may be set, which
specifies the distance into the pattern at which to start the dash.
=cut
sub _linedash {
my @a = @_;
unless (scalar @a) {
return ('[', ']', '0', 'd');
}
else {
if ($a[0] =~ /^\-/) {
my %a = @a;
# Deprecated: the -full and -clear options will be removed in a future release
$a{'-pattern'} = [$a{'-full'} || 0, $a{'-clear'} || 0] unless exists $a{'-pattern'};
return ('[', floats(@{$a{'-pattern'}}), ']', ($a{'-shift'} || 0), 'd');
}
else {
return ('[', floats(@a), '] 0 d');
}
}
}
sub linedash {
my ($self,@a)=@_;
$self->add(_linedash(@a));
}
=item $content->flatness($tolerance)
(Advanced) Sets the maximum variation in output pixels when drawing
curves.
=cut
sub _flatness {
my ($flatness)=@_;
return ($flatness, 'i');
}
sub flatness {
my ($self,$flatness)=@_;
$self->add(_flatness($flatness));
}
=item $content->egstate($object)
(Advanced) Adds an Extended Graphic State object containing additional
state parameters.
=cut
sub egstate {
my $self = shift;
my $egs = shift;
$self->add('/'.$egs->name,'gs');
$self->resource('ExtGState',$egs->name,$egs);
return $self;
}
=back
=head2 Path Construction (Drawing)
=over
=item $content->move($x, $y)
Starts a new path at the specified coordinates.
=cut
sub _move {
my($x,$y)=@_;
return (floats($x,$y), 'm');
}
sub move {
my $self=shift @_;
my ($x,$y);
while(defined($x = shift)) {
$y = shift;
$self->{' x'}=$x;
$self->{' y'}=$y;
$self->{' mx'}=$x;
$self->{' my'}=$y;
if ($self->_in_text_object()) {
$self->add_post(floats($x,$y), 'm');
}
else {
$self->add(floats($x,$y), 'm');
}
}
return $self;
}
=item $content->line($x, $y)
Extends the path in a line from the current coordinates to the
specified coordinates, and updates the current position to be the new
coordinates.
Note: The line will not appear until you call C<stroke>.
=cut
sub _line {
my ($x,$y) = @_;
return (floats($x,$y), 'l');
}
sub line {
my $self = shift;
my ($x,$y);
while(defined($x = shift)) {
$y = shift;
$self->{' x'}=$x;
$self->{' y'}=$y;
if ($self->_in_text_object()) {
$self->add_post(floats($x,$y), 'l');
}
else {
$self->add(floats($x,$y), 'l');
}
}
return $self;
}
=item $content->hline($x)
=item $content->vline($y)
Shortcut for drawing horizontal and vertical lines from the current
position.
=cut
sub hline {
my ($self, $x) = @_;
if ($self->_in_text_object()) {
$self->add_post(floats($x,$self->{' y'}),'l');
}
else {
$self->add(floats($x,$self->{' y'}),'l');
}
$self->{' x'}=$x;
return $self;
}
sub vline {
my ($self, $y) = @_;
if ($self->_in_text_object()) {
$self->add_post(floats($self->{' x'},$y),'l');
}
else {
$self->add(floats($self->{' x'},$y),'l');
}
$self->{' y'}=$y;
return $self;
}
=item $content->poly($x1, $y1, ..., $xn, $yn)
Shortcut for creating a polyline path. Moves to C<[$x1, $y1]>, and
then extends the path in lines along the specified coordinates.
=cut
sub poly {
my $self = shift;
my $x = shift;
my $y = shift;
$self->move($x,$y);
$self->line(@_);
return $self;
}
=item $content->curve($cx1, $cy1, $cx2, $cy2, $x, $y)
Extends the path in a curve from the current point to C<($x, $y)>,
using the two specified points to create a cubic Bezier curve, and
updates the current position to be the new point.
Note: The curve will not appear until you call C<stroke>.
=cut
sub curve {
my $self = shift;
my($x1,$y1,$x2,$y2,$x3,$y3);
while (defined($x1 = shift)) {
$y1 = shift;
$x2 = shift;
$y2 = shift;
$x3 = shift;
$y3 = shift;
if ($self->_in_text_object()) {
$self->add_post(floats($x1,$y1,$x2,$y2,$x3,$y3),'c');
}
else {
$self->add(floats($x1,$y1,$x2,$y2,$x3,$y3),'c');
}
$self->{' x'}=$x3;
$self->{' y'}=$y3;
}
return $self;
}
=item $content->spline($cx1, $cy1, $x, $y)
Extends the path in a curve from the current point to C<($x, $y)>,
using the two specified points to create a spline, and updates the
current position to be the new point.
Note: The curve will not appear until you call C<stroke>.
=cut
sub spline {
my $self = shift;
while(scalar @_ >= 4) {
my $cx = shift;
my $cy = shift;
my $x = shift;
my $y = shift;
my $c1x = (2*$cx+$self->{' x'})/3;
my $c1y = (2*$cy+$self->{' y'})/3;
my $c2x = (2*$cx+$x)/3;
my $c2y = (2*$cy+$y)/3;
$self->curve($c1x,$c1y,$c2x,$c2y,$x,$y);
}
}
=item $content->arc($x, $y, $a, $b, $alpha, $beta, $move)
Extends the path along an arc of an ellipse centered at C<[x, y]>.
The major and minor axes of the ellipse are C<$a> and C<$b>,
respectively, and the arc moves from C<$alpha> degrees to C<$beta>
degrees. The current position is then set to the endpoint of the arc.
Set C<$move> to a true value if this arc is the beginning of a new
path instead of the continuation of an existing path.
=cut
# Private
sub arctocurve {
my ($a,$b,$alpha,$beta) = @_;
if (abs($beta-$alpha) > 30) {
return (
arctocurve($a,$b,$alpha,($beta+$alpha)/2),
arctocurve($a,$b,($beta+$alpha)/2,$beta)
);
}
else {
$alpha = ($alpha * pi / 180);
$beta = ($beta * pi / 180);
my $bcp = (4.0/3 * (1 - cos(($beta - $alpha)/2)) / sin(($beta - $alpha)/2));
my $sin_alpha = sin($alpha);
my $sin_beta = sin($beta);
my $cos_alpha = cos($alpha);
my $cos_beta = cos($beta);
my $p0_x = $a * $cos_alpha;
my $p0_y = $b * $sin_alpha;
my $p1_x = $a * ($cos_alpha - $bcp * $sin_alpha);
my $p1_y = $b * ($sin_alpha + $bcp * $cos_alpha);
my $p2_x = $a * ($cos_beta + $bcp * $sin_beta);
my $p2_y = $b * ($sin_beta - $bcp * $cos_beta);
my $p3_x = $a * $cos_beta;
my $p3_y = $b * $sin_beta;
return ($p0_x,$p0_y,$p1_x,$p1_y,$p2_x,$p2_y,$p3_x,$p3_y);
}
}
sub arc {
my ($self,$x,$y,$a,$b,$alpha,$beta,$move) = @_;
my @points = arctocurve($a,$b,$alpha,$beta);
my ($p0_x,$p0_y,$p1_x,$p1_y,$p2_x,$p2_y,$p3_x,$p3_y);
$p0_x= $x + shift @points;
$p0_y= $y + shift @points;
$self->move($p0_x,$p0_y) if($move);
while (scalar @points > 0) {
$p1_x = $x + shift @points;
$p1_y = $y + shift @points;
$p2_x = $x + shift @points;
$p2_y = $y + shift @points;
$p3_x = $x + shift @points;
$p3_y = $y + shift @points;
$self->curve($p1_x,$p1_y,$p2_x,$p2_y,$p3_x,$p3_y);
shift @points;
shift @points;
$self->{' x'}=$p3_x;
$self->{' y'}=$p3_y;
}
return $self;
}
=item $content->bogen($x1, $y1, $x2, $y2, $radius, $move, $outer, $reverse)
Extends the path along an arc of a circle of the specified radius
between C<[x1, y1]> to C<[x2, y2]>. The current position is then set
to the endpoint of the arc.
Set C<$move> to a true value if this arc is the beginning of a new
path instead of the continuation of an existing path.
Set C<$outer> to a true value to draw the larger arc between the two
points instead of the smaller one.
Set C<$reverse> to a true value to draw the mirror image of the
specified arc.
C<$radius * 2> cannot be smaller than the distance from C<[x1, y1]> to
C<[x2, y2]>.
Note: The curve will not appear until you call C<stroke>.
=cut
sub bogen {
my ($self,$x1,$y1,$x2,$y2,$r,$move,$larc,$spf) = @_;
my ($p0_x,$p0_y,$p1_x,$p1_y,$p2_x,$p2_y,$p3_x,$p3_y);
my $x = $x2-$x1;
my $y = $y2-$y1;
my $z = sqrt($x**2+$y**2);
my $alpha_rad = asin($y/$z);
$alpha_rad+=pi/2 if($x<0 and $y>0);
$alpha_rad-=pi/2 if($x<0 and $y<0);
my $alpha=rad2deg($alpha_rad);
# use the complement angle for span
$alpha -= 180 if($spf>0);
my $d=2*$r;
my ($beta,$beta_rad,@points);
$beta=rad2deg(2*asin($z/$d));
$beta=360-$beta if($larc>0);
$beta_rad=deg2rad($beta);
@points=arctocurve($r,$r,90+$alpha+$beta/2,90+$alpha-$beta/2);
if ($spf>0) {
my @pts=@points;
@points=();
while ($y=pop @pts) {
$x=pop @pts;
push(@points,$x,$y);
}
}
$p0_x=shift @points;
$p0_y=shift @points;
$x=$x1-$p0_x;
$y=$y1-$p0_y;
$self->move($x1,$y1) if($move);
while(scalar @points > 0) {
$p1_x= $x + shift @points;
$p1_y= $y + shift @points;
$p2_x= $x + shift @points;
$p2_y= $y + shift @points;
# if we run out of data points, use the end point instead
if (scalar @points == 0) {
$p3_x = $x2;
$p3_y = $y2;
}
else {
$p3_x= $x + shift @points;
$p3_y= $y + shift @points;
}
$self->curve($p1_x,$p1_y,$p2_x,$p2_y,$p3_x,$p3_y);
shift @points;
shift @points;
}
return $self;
}
=item $content->close
Closes and ends the current path by extending a line from the current
position to the starting position.
=cut
sub close {
my $self = shift;
$self->add('h');
$self->{' x'}=$self->{' mx'};
$self->{' y'}=$self->{' my'};
return $self;
}
=item $content->endpath
Ends the current path without explicitly enclosing it.
=cut
sub endpath {
my $self = shift;
$self->add('n');
return $self;
}
=item $content->ellipse($x, $y, $a, $b)
Creates an elliptical path centered on C<[$x, $y]>, with major and
minor axes specified by C<$a> and C<$b>, respectively.
Note: The ellipse will not appear until you call C<stroke> or C<fill>.
=cut
sub ellipse {
my ($self,$x,$y,$a,$b) = @_;
$self->arc($x,$y,$a,$b,0,360,1);
$self->close;
return $self;
}
=item $content->circle($x, $y, $radius)
Creates a circular path centered on C<[$x, $y]> with the specified
radius.
Note: The circle will not appear until you call C<stroke> or C<fill>.
=cut
sub circle {
my ($self,$x,$y,$r) = @_;
$self->arc($x,$y,$r,$r,0,360,1);
$self->close;
return $self;
}
=item $content->pie($x, $y, $a, $b, $alpha, $beta)
Creates a pie-shaped path from an ellipse centered on C<[$x, $y]>.
The major and minor axes of the ellipse are C<$a> and C<$b>,
respectively, and the arc moves from C<$alpha> degrees to C<$beta>
degrees.
Note: The pie will not appear until you call C<stroke> or C<fill>.
=cut
sub pie {
my $self = shift;
my ($x,$y,$a,$b,$alpha,$beta)=@_;
my ($p0_x,$p0_y)=arctocurve($a,$b,$alpha,$beta);
$self->move($x,$y);
$self->line($p0_x+$x,$p0_y+$y);
$self->arc($x,$y,$a,$b,$alpha,$beta);
$self->close;
}
=item $content->rect($x1, $y1, $w1, $h1, ..., $xn, $yn, $wn, $hn)
Creates paths for one or more rectangles, with their lower left points
at C<[$x, $y]> and with the specified widths and heights.
Note: The rectangle will not appear until you call C<stroke> or C<fill>.
=cut
sub rect {
my $self = shift;
my ($x,$y,$w,$h);
while (defined($x = shift)) {
$y = shift;
$w = shift;
$h = shift;
$self->add(floats($x,$y,$w,$h),'re');
}
$self->{' x'}=$x;
$self->{' y'}=$y;
return $self;
}
=item $content->rectxy($x1, $y1, $x2, $y2)
Creates a rectangular path, with C<[$x1, $y1]> and and C<[$x2, $y2]>
specifying opposite corners.
Note: The rectangle will not appear until you call C<stroke> or C<fill>.
=cut
sub rectxy {
my ($self,$x,$y,$x2,$y2)=@_;
$self->rect($x,$y,($x2-$x),($y2-$y));
return $self;
}
=back
=head2 Path Painting (Drawing)
=over
=item $content->stroke
Strokes the current path.
=cut
sub _stroke {
return 'S';
}
sub stroke {
my $self = shift;
$self->add(_stroke);
return $self;
}
=item $content->fill($use_even_odd_fill)
Fills the current path.
If the path intersects with itself, the nonzero winding rule will be
used to determine which part of the path is filled in. If you would
prefer to use the even-odd rule, pass a true argument.
See the PDF Specification, section 8.5.3.3, for more details on
filling.
=cut
sub fill {
my $self = shift;
$self->add(shift() ? 'f*' : 'f');
return $self;
}
=item $content->fillstroke($use_even_odd_fill)
Fills and then strokes the current path.
=cut
sub fillstroke {
my $self = shift;
$self->add(shift() ? 'B*' : 'B');
return $self;
}
=item $content->clip($use_even_odd_fill)
Modifies the current clipping path by intersecting it with the current
path.
=cut
sub clip {
my $self = shift;
$self->add(shift() ? 'W*' : 'W');
return $self;
}
=back
=head2 Colors
=over
=item $content->fillcolor($color)
=item $content->strokecolor($color)
Sets the fill or stroke color.
# Use a named color
$content->fillcolor('blue');
# Use an RGB color (start with '#')
$content->fillcolor('#FF0000');
# Use a CMYK color (start with '%')
$content->fillcolor('%FF000000');
RGB and CMYK colors can have one-byte, two-byte, three-byte, or
four-byte values for each color. For instance, cyan can be given as
C<%F000> or C<%FFFF000000000000>.
=cut
# default colorspaces: rgb/hsv/named cmyk/hsl lab
# ... only one text string
#
# pattern or shading space
# ... only one object
#
# legacy greylevel
# ... only one value
#
#
sub _makecolor {
my ($self,$sf,@clr)=@_;
if ($clr[0]=~/^[a-z\#\!]+/) {
# colorname or #! specifier
# with rgb target colorspace
# namecolor returns always a RGB
return(namecolor($clr[0]),($sf?'rg':'RG'));
}
elsif($clr[0]=~/^[\%]+/) {
# % specifier
# with cmyk target colorspace
return(namecolor_cmyk($clr[0]),($sf?'k':'K'));
}
elsif($clr[0]=~/^[\$\&]/) {
# &$ specifier
# with L*a*b target colorspace
if (!defined $self->resource('ColorSpace','LabS')) {
my $dc=PDFDict();
my $cs=PDFArray(PDFName('Lab'),$dc);
$dc->{WhitePoint}=PDFArray(map { PDFNum($_) } qw(1 1 1));
$dc->{Range}=PDFArray(map { PDFNum($_) } qw(-128 127 -128 127));
$dc->{Gamma}=PDFArray(map { PDFNum($_) } qw(2.2 2.2 2.2));
$self->resource('ColorSpace','LabS',$cs);
}
return('/LabS',($sf?'cs':'CS'),namecolor_lab($clr[0]),($sf?'sc':'SC'));
}
elsif((scalar @clr == 1) && ref($clr[0])) {
# pattern or shading space
return('/Pattern',($sf?'cs':'CS'),'/'.($clr[0]->name),($sf?'scn':'SCN'));
}
elsif(scalar @clr == 1) {
# grey color spec.
return($clr[0],($sf?'g':'G'));
}
elsif(scalar @clr > 1 && ref($clr[0])) {
# indexed colorspace plus color-index
# or custom colorspace plus param
my $cs=shift @clr;
return('/'.($cs->name),($sf?'cs':'CS'),$cs->param(@clr),($sf?'sc':'SC'));
}
elsif(scalar @clr == 2) {
# indexed colorspace plus color-index
# or custom colorspace plus param
return('/'.($clr[0]->name),($sf?'cs':'CS'),$clr[0]->param($clr[1]),($sf?'sc':'SC'));
}
elsif(scalar @clr == 3) {
# legacy rgb color-spec (0 <= x <= 1)
return(floats($clr[0],$clr[1],$clr[2]),($sf?'rg':'RG'));
}
elsif(scalar @clr == 4) {
# legacy cmyk color-spec (0 <= x <= 1)
return(floats($clr[0],$clr[1],$clr[2],$clr[3]),($sf?'k':'K'));
}
else {
die 'invalid color specification.';
}
}
sub _fillcolor {
my ($self,@clrs)=@_;
if (ref($clrs[0]) =~ m|^PDF::API2::Resource::ColorSpace|) {
$self->resource('ColorSpace',$clrs[0]->name,$clrs[0]);
}
elsif (ref($clrs[0]) =~ m|^PDF::API2::Resource::Pattern|) {
$self->resource('Pattern',$clrs[0]->name,$clrs[0]);
}
return $self->_makecolor(1,@clrs);
}
sub fillcolor {
my $self = shift;
if (scalar @_) {
@{$self->{' fillcolor'}}=@_;
$self->add($self->_fillcolor(@_));
}
return @{$self->{' fillcolor'}};
}
sub _strokecolor {
my ($self,@clrs)=@_;
if (ref($clrs[0]) =~ m|^PDF::API2::Resource::ColorSpace|) {
$self->resource('ColorSpace',$clrs[0]->name,$clrs[0]);
}
elsif (ref($clrs[0]) =~ m|^PDF::API2::Resource::Pattern|) {
$self->resource('Pattern',$clrs[0]->name,$clrs[0]);
}
return $self->_makecolor(0,@clrs);
}
sub strokecolor {
my $self = shift;
if (scalar @_) {
@{$self->{' strokecolor'}}=@_;
$self->add($self->_strokecolor(@_));
}
return @{$self->{' strokecolor'}};
}
sub shade {
my $self = shift;
my $shade = shift;
my @cord = @_;
my @tm = (
$cord[2]-$cord[0] , 0,
0 , $cord[3]-$cord[1],
$cord[0] , $cord[1]
);
$self->save;
$self->matrix(@tm);
$self->add('/'.$shade->name,'sh');
$self->resource('Shading',$shade->name,$shade);
$self->restore;
return $self;
}
=back
=head2 External Objects
=over
=item $content->image($image_object, $x, $y, $width, $height)
=item $content->image($image_object, $x, $y, $scale)
=item $content->image($image_object, $x, $y)
# Example
my $image_object = $pdf->image_jpeg($my_image_file);
$content->image($image_object, 100, 200);
Places an image on the page in the specified location.
If coordinate transformations have been made (see Coordinate
Transformations above), the position and scale will be relative to the
updated coordinates. Otherwise, [0,0] will represent the bottom left
corner of the page, and C<$width> and C<$height> will be measured at
72dpi.
For example, if you have a 600x600 image that you would like to be
shown at 600dpi (i.e. one inch square), set the width and height to 72.
=cut
sub image {
my $self = shift;
my $img = shift;
my ($x,$y,$w,$h) = @_;
if (defined $img->{Metadata}) {
$self->metaStart('PPAM:PlacedImage',$img->{Metadata});
}
$self->save;
if (!defined $w) {
$h=$img->height;
$w=$img->width;
}
elsif (!defined $h) {
$h=$img->height*$w;
$w=$img->width*$w;
}
$self->matrix($w,0,0,$h,$x,$y);
$self->add("/".$img->name,'Do');
$self->restore;
$self->{' x'}=$x;
$self->{' y'}=$y;
$self->resource('XObject',$img->name,$img);
if(defined $img->{Metadata}) {
$self->metaEnd;
}
return $self;
}
=item $content->formimage($form_object, $x, $y, $scale)
=item $content->formimage($form_object, $x, $y)
Places an XObject on the page in the specified location.
=cut
sub formimage {
my $self = shift;
my $img = shift;
my ($x,$y,$s) = @_;
$self->save;
if (!defined $s) {
$self->matrix(1,0,0,1,$x,$y);
}
else {
$self->matrix($s,0,0,$s,$x,$y);
}
$self->add('/'.$img->name,'Do');
$self->restore;
$self->resource('XObject',$img->name,$img);
return $self;
}
=back
=head2 Text State Parameters
All of the following parameters that take a size are applied before
any scaling takes place, so you don't need to adjust values to
counteract scaling.
=over
=item $spacing = $content->charspace($spacing)
Sets the spacing between characters. This is initially zero.
=cut
sub _charspace {
my ($para) = @_;
return float($para, 6) . ' Tc';
}
sub charspace {
my ($self, $para) = @_;
if (defined $para) {
$self->{' charspace'}=$para;
$self->add(_charspace($para));
}
return $self->{' charspace'};
}
=item $spacing = $content->wordspace($spacing)
Sets the spacing between words. This is initially zero (or, in other
words, just the width of the space).
=cut
sub _wordspace {
my ($para) = @_;
return float($para, 6) . ' Tw';
}
sub wordspace {
my ($self, $para) = @_;
if (defined $para) {
$self->{' wordspace'}=$para;
$self->add(_wordspace($para));
}
return $self->{' wordspace'};
}
=item $scale = $content->hscale($scale)
Sets and returns the percentage of horizontal text scaling. Enter a
scale greater than 100 to stretch text, less than 100 to squeeze
text, or 100 to disable any existing scaling.
=cut
sub _hscale {
my ($scale) = @_;
return float($scale, 6) . ' Tz';
}
sub hscale {
my ($self, $scale) = @_;
if (defined $scale) {
$self->{' hscale'} = $scale;
$self->add(_hscale($scale));
}
return $self->{' hscale'};
}
# Deprecated: hscale was originally named incorrectly (as hspace)
sub hspace { return hscale(@_) }
sub _hspace { return _hscale(@_) }
=item $leading = $content->lead($leading)
Sets the text leading, which is the distance between baselines. This
is initially zero (i.e. the lines will be printed on top of each
other).
=cut
sub _lead {
my ($para) = @_;
return float($para) . ' TL';
}
sub lead {
my ($self,$para) = @_;
if (defined ($para)) {
$self->{' lead'} = $para;
$self->add(_lead($para));
}
return $self->{' lead'};
}
=item $mode = $content->render($mode)
Sets the text rendering mode.
=over
=item 0 = Fill text
=item 1 = Stroke text (outline)
=item 2 = Fill, then stroke text
=item 3 = Neither fill nor stroke text (invisible)
=item 4 = Fill text and add to path for clipping
=item 5 = Stroke text and add to path for clipping
=item 6 = Fill, then stroke text and add to path for clipping
=item 7 = Add text to path for clipping
=back
=cut
sub _render {
my ($para) = @_;
return intg($para) . ' Tr';
}
sub render {
my ($self, $para) = @_;
if (defined ($para)) {
$self->{' render'} = $para;
$self->add(_render($para));
}
return $self->{' render'};
}
=item $distance = $content->rise($distance)
Adjusts the baseline up or down from its current location. This is
initially zero.
Use this for creating superscripts or subscripts (usually with an
adjustment to the font size as well).
=cut
sub _rise {
my ($para) = @_;
return float($para) . ' Ts';
}
sub rise {
my ($self, $para) = @_;
if (defined ($para)) {
$self->{' rise'} = $para;
$self->add(_rise($para));
}
return $self->{' rise'};
}
=item %state = $content->textstate(charspace => $value, wordspace => $value, ...)
Shortcut for setting multiple text state parameters at once.
This can also be used without arguments to retrieve the current text
state settings.
Note: This does not currently work with the C<save> and C<restore> commands.
=cut
sub textstate {
my $self = shift;
my %state;
if (scalar @_) {
%state = @_;
foreach my $k (qw( charspace hscale wordspace lead rise render )) {
next unless($state{$k});
$self->can($k)->($self, $state{$k});
}
if ($state{font} && $state{fontsize}) {
$self->font($state{font},$state{fontsize});
}
if ($state{textmatrix}) {
$self->matrix(@{$state{textmatrix}});
@{$self->{' translate'}}=@{$state{translate}};
$self->{' rotate'}=$state{rotate};
@{$self->{' scale'}}=@{$state{scale}};
@{$self->{' skew'}}=@{$state{skew}};
}
if ($state{fillcolor}) {
$self->fillcolor(@{$state{fillcolor}});
}
if ($state{strokecolor}) {
$self->strokecolor(@{$state{strokecolor}});
}
%state = ();
}
else {
foreach my $k (qw( font fontsize charspace hscale wordspace lead rise render )) {
$state{$k}=$self->{" $k"};
}
$state{matrix}=[@{$self->{" matrix"}}];
$state{textmatrix}=[@{$self->{" textmatrix"}}];
$state{textlinematrix}=[@{$self->{" textlinematrix"}}];
$state{rotate}=$self->{" rotate"};
$state{scale}=[@{$self->{" scale"}}];
$state{skew}=[@{$self->{" skew"}}];
$state{translate}=[@{$self->{" translate"}}];
$state{fillcolor}=[@{$self->{" fillcolor"}}];
$state{strokecolor}=[@{$self->{" strokecolor"}}];
}
return %state;
}
=item $content->font($font_object, $size)
# Example
my $pdf = PDF::API2->new();
my $font = $pdf->corefont('Helvetica');
$content->font($font, 12);
Sets the font and font size.
=cut
sub _font {
my ($font, $size) = @_;
if ($font->isvirtual == 1) {
return('/'.$font->fontlist->[0]->name.' '.float($size).' Tf');
}
else {
return('/'.$font->name.' '.float($size).' Tf');
}
}
sub font {
my ($self, $font, $size) = @_;
unless ($size) {
croak q{A font size is required};
}
$self->fontset($font, $size);
$self->add(_font($font, $size));
$self->{' fontset'} = 1;
return $self;
}
sub fontset {
my ($self,$font,$size)=@_;
$self->{' font'}=$font;
$self->{' fontsize'}=$size;
$self->{' fontset'}=0;
if ($font->isvirtual == 1) {
foreach my $f (@{$font->fontlist}) {
$self->resource('Font', $f->name, $f);
}
}
else {
$self->resource('Font', $font->name, $font);
}
return $self;
}
=back
=head2 Text-Positioning
Note: There is a very good chance that these commands will be replaced
in a future release.
=over
=item $content->distance($dx, $dy)
Moves to the start of the next line, offset by the given amounts,
which are both required.
=cut
sub distance {
my ($self,$dx,$dy)=@_;
$self->add(float($dx),float($dy),'Td');
$self->matrix_update($dx,$dy);
$self->{' textlinematrix'}->[0]=$dx;
}
=item $content->cr()
=item $content->cr($vertical_offset)
Moves the cursor to the start of the line when called without an
argument. If leading has been set, the cursor will move to the next
line instead.
An offset can be passed as an argument to override the leading value.
A positive offset will move the cursor up, and a negative offset will
move the cursor down.
Pass zero as the argument to ignore the leading and get just a
carriage return.
=cut
sub cr {
my ($self, $offset) = @_;
if (defined $offset) {
$self->add(0, float($offset), 'Td');
$self->matrix_update(0, $offset);
}
else {
$self->add('T*');
$self->matrix_update(0, $self->lead() * -1);
}
$self->{' textlinematrix'}->[0] = 0;
}
=item $content->nl()
Moves to the start of the next line.
=cut
sub nl {
my $self = shift();
$self->add('T*');
$self->matrix_update(0, $self->lead() * -1);
$self->{' textlinematrix'}->[0] = 0;
}
=item ($tx, $ty) = $content->textpos()
Gets the current estimated text position.
Note: This does not affect the PDF in any way.
=cut
sub _textpos {
my ($self,@xy)=@_;
my ($x,$y)=(0,0);
while (scalar @xy > 0) {
$x+=shift @xy;
$y+=shift @xy;
}
my (@m)=_transform(
-matrix=>$self->{" textmatrix"},
-point=>[$x,$y]
);
return($m[0],$m[1]);
}
sub textpos {
my $self=shift @_;
return($self->_textpos(@{$self->{" textlinematrix"}}));
}
sub textpos2 {
my $self=shift @_;
return(@{$self->{" textlinematrix"}});
}
=back
=head2 Text-Showing
=over
=item $width = $content->text($text, %options)
Adds text to the page.
Options:
=over
=item -indent
Indents the text by the number of points.
=item -underline => 'auto'
=item -underline => $distance
=item -underline => [$distance, $thickness, ...]
Underlines the text. C<$distance> is the number of units beneath the
baseline, and C<$thickness> is the width of the line.
Multiple underlines can be made by passing several distances and
thicknesses.
=back
=cut
sub _text_underline {
my ($self,$xy1,$xy2,$underline,$color) = @_;
$color||='black';
my @underline=();
if (ref($underline) eq 'ARRAY') {
@underline=@{$underline};
}
else {
@underline=($underline,1);
}
push @underline,1 if(@underline%2);
my $underlineposition=(-$self->{' font'}->underlineposition()*$self->{' fontsize'}/1000||1);
my $underlinethickness=($self->{' font'}->underlinethickness()*$self->{' fontsize'}/1000||1);
my $pos=1;
while(@underline) {
$self->add_post(_save);
my $distance=shift @underline;
my $thickness=shift @underline;
my $scolor=$color;
if (ref $thickness) {
($thickness,$scolor)=@{$thickness};
}
if ($distance eq 'auto') {
$distance=$pos*$underlineposition;
}
if ($thickness eq 'auto') {
$thickness=$underlinethickness;
}
my ($x1,$y1)=$self->_textpos(@{$xy1},0,-($distance+($thickness/2)));
my ($x2,$y2)=$self->_textpos(@{$xy2},0,-($distance+($thickness/2)));
$self->add_post($self->_strokecolor($scolor));
$self->add_post(_linewidth($thickness));
$self->add_post(_move($x1,$y1));
$self->add_post(_line($x2,$y2));
$self->add_post(_stroke);
$self->add_post(_restore);
$pos++;
}
}
sub text {
my ($self, $text, %opt) = @_;
my $wd = 0;
if ($self->{' fontset'}==0) {
unless (defined $self->{' font'} and $self->{' fontsize'}) {
croak q{Can't add text without first setting a font and font size};
}
$self->font($self->{' font'},$self->{' fontsize'});
$self->{' fontset'}=1;
}
if (defined $opt{-indent}) {
$wd+=$opt{-indent};
$self->matrix_update($wd,0);
}
my $ulxy1=[$self->textpos2];
if (defined $opt{-indent}) {
# changed fot acrobat 8 and possible others
# $self->add('[',(-$opt{-indent}*(1000/$self->{' fontsize'})*(100/$self->hscale())),']','TJ');
$self->add($self->{' font'}->text($text, $self->{' fontsize'}, (-$opt{-indent}*(1000/$self->{' fontsize'})*(100/$self->hscale()))));
}
else {
$self->add($self->{' font'}->text($text,$self->{' fontsize'}));
}
$wd = $self->advancewidth($text);
$self->matrix_update($wd,0);
my $ulxy2 = [$self->textpos2];
if (defined $opt{-underline}) {
$self->_text_underline($ulxy1,$ulxy2,$opt{-underline},$opt{-strokecolor});
}
return $wd;
}
=item $content->text_center($text)
As C<text>, but centered on the current point.
=cut
sub text_center {
my ($self,$text,@opts)=@_;
my $width=$self->advancewidth($text);
return $self->text($text,-indent=>-($width/2),@opts);
}
=item $txt->text_right $text, %options
As C<text>, but right-aligned to the current point.
=cut
sub text_right {
my ($self,$text,@opts) = @_;
my $width=$self->advancewidth($text);
return $self->text($text,-indent=>-$width,@opts);
}
=item $width = $txt->advancewidth($string, %text_state)
Returns the width of the string based on all currently set text-state
attributes. These can optionally be overridden.
=cut
sub advancewidth {
my ($self,$text,@opts) = @_;
if(scalar @opts > 1) {
my %opts=@opts;
foreach my $k (qw[ font fontsize wordspace charspace hscale]) {
$opts{$k}=$self->{" $k"} unless(defined $opts{$k});
}
my $glyph_width = $opts{font}->width($text)*$opts{fontsize};
my $num_space = $text =~ y/\x20/\x20/;
my $num_char = length($text);
my $word_spaces = $opts{wordspace}*$num_space;
my $char_spaces = $opts{charspace}*$num_char;
my $advance = ($glyph_width+$word_spaces+$char_spaces)*$opts{hscale}/100;
return $advance;
}
else {
my $glyph_width = $self->{' font'}->width($text)*$self->{' fontsize'};
my $num_space = $text =~ y/\x20/\x20/;
my $num_char = length($text);
my $word_spaces = $self->wordspace*$num_space;
my $char_spaces = $self->charspace*$num_char;
my $advance = ($glyph_width+$word_spaces+$char_spaces)*$self->hscale()/100;
return $advance;
}
}
=back
=cut
sub text_justified {
my ($self,$text,$width,%opts) = @_;
my $hs = $self->hscale();
$self->hscale($hs*($width/$self->advancewidth($text)));
$self->text($text,%opts);
$self->hscale($hs);
return $width;
}
sub _text_fill_line {
my ($self,$text,$width,$over) = @_;
my @txt = split(/\x20/,$text);
my @line = ();
local $";
$"=' ';
while (@txt) {
push @line,(shift @txt);
last if($self->advancewidth("@line")>$width);
}
if (!$over && (scalar @line > 1) && ($self->advancewidth("@line") > $width)) {
unshift @txt,pop @line;
}
my $ret = "@txt";
my $line = "@line";
return ($line,$ret);
}
sub text_fill_left {
my ($self,$text,$width,%opts) = @_;
my $over=(not(defined($opts{-spillover}) and $opts{-spillover} == 0));
my ($line,$ret)=$self->_text_fill_line($text,$width,$over);
$width=$self->text($line,%opts);
return ($width,$ret);
}
sub text_fill_center {
my ($self,$text,$width,%opts) = @_;
my $over=(not(defined($opts{-spillover}) and $opts{-spillover} == 0));
my ($line,$ret)=$self->_text_fill_line($text,$width,$over);
$width=$self->text_center($line,%opts);
return ($width,$ret);
}
sub text_fill_right {
my ($self,$text,$width,%opts) = @_;
my $over=(not(defined($opts{-spillover}) and $opts{-spillover} == 0));
my ($line,$ret)=$self->_text_fill_line($text,$width,$over);
$width=$self->text_right($line,%opts);
return ($width,$ret);
}
sub text_fill_justified {
my ($self,$text,$width,%opts) = @_;
my $over=(not(defined($opts{-spillover}) and $opts{-spillover} == 0));
my ($line,$ret)=$self->_text_fill_line($text,$width,$over);
my $hs=$self->hscale();
my $w=$self->advancewidth($line);
if ($ret||$w>=$width) {
$self->hscale($hs*($width/$w));
}
$width=$self->text($line,%opts);
$self->hscale($hs);
return($width,$ret);
}
# =item $overflow_text = $txt->paragraph $text, $width, $height, %options
#
# ** DEVELOPER METHOD **
#
# Apply the text within the rectangle and return any leftover text.
#
# B<Options>
#
# =over 4
#
# =item -align => $choice
#
# Choice is 'justified', 'right', 'center', 'left'
# Default is 'left'
#
# =item -underline => $distance
#
# =item -underline => [ $distance, $thickness, ... ]
#
# If a scalar, distance below baseline,
# else array reference with pairs of distance and line thickness.
#
# =item -spillover => $over
#
# Controls if words in a line which exceed the given width should be "spilled over" the bounds or if a new line should be used for this word.
#
# Over is 1 or 0
# Default is 1
#
# =back
#
# B<Example:>
#
# $txt->font($font,$fontsize);
# $txt->lead($lead);
# $txt->translate($x,$y);
# $overflow = $txt->paragraph( 'long paragraph here ...',
# $width,
# $y+$lead-$bottom_margin );
#
# =cut
sub paragraph {
my ($self,$text,$width,$height,%opts) = @_;
my @line=();
my $nwidth=0;
my $lead=$self->lead();
while (length($text)>0) {
last if ($height -= $lead) < 0;
if ($opts{-align}=~/^j/i) {
($nwidth,$text)=$self->text_fill_justified($text,$width,%opts);
}
elsif ($opts{-align}=~/^r/i) {
($nwidth,$text)=$self->text_fill_right($text,$width,%opts);
}
elsif ($opts{-align}=~/^c/i) {
($nwidth,$text)=$self->text_fill_center($text,$width,%opts);
}
else {
($nwidth,$text)=$self->text_fill_left($text,$width,%opts);
}
$self->nl;
}
if (wantarray) {
return ($text,$height);
}
return $text;
}
# =item $overflow_text = $txt->section $text, $width, $height, %options
#
# ** DEVELOPER METHOD **
#
# Split paragraphs by newline and loop over them, reassemble leftovers
# when box is full and apply the text within the rectangle and return
# any leftover text.
#
# =cut
sub section {
my ($self,$text,$width,$height,%opts)=@_;
my ($para,$overflow) = ("","");
foreach $para (split(/\n/,$text)) {
if(length($overflow) > 0) {
$overflow .= "\n" . $para;
next;
}
($para,$height) = $self->paragraph($para,$width,$height,%opts);
$overflow .= $para if (length($para) > 0);
}
if (wantarray) {
return ($overflow,$height);
}
return $overflow;
}
sub textlabel {
my ($self,$x,$y,$font,$size,$text,%opts,$wht) = @_;
my %trans_opts=( -translate => [$x,$y] );
my %text_state=();
$trans_opts{-rotate} = $opts{-rotate} if($opts{-rotate});
my $wastext = $self->_in_text_object;
if ($wastext) {
%text_state=$self->textstate;
$self->textend;
}
$self->save;
$self->textstart;
$self->transform(%trans_opts);
$self->fillcolor(ref($opts{-color}) ? @{$opts{-color}} : $opts{-color}) if($opts{-color});
$self->strokecolor(ref($opts{-strokecolor}) ? @{$opts{-strokecolor}} : $opts{-strokecolor}) if($opts{-strokecolor});
$self->font($font,$size);
$self->charspace($opts{-charspace}) if($opts{-charspace});
$self->hscale($opts{-hscale}) if($opts{-hscale});
$self->wordspace($opts{-wordspace}) if($opts{-wordspace});
$self->render($opts{-render}) if($opts{-render});
if ($opts{-right} || $opts{-align}=~/^r/i) {
$wht = $self->text_right($text,%opts);
}
elsif ($opts{-center} || $opts{-align}=~/^c/i) {
$wht = $self->text_center($text,%opts);
}
else {
$wht = $self->text($text,%opts);
}
$self->textend;
$self->restore;
if ($wastext) {
$self->textstart;
$self->textstate(%text_state);
}
return $wht;
}
sub metaStart {
my $self=shift @_;
my $tag=shift @_;
my $obj=shift @_;
$self->add("/$tag");
if (defined $obj) {
my $dict=PDFDict();
$dict->{Metadata}=$obj;
$self->resource('Properties',$obj->name,$dict);
$self->add('/'.($obj->name));
$self->add('BDC');
}
else {
$self->add('BMC');
}
return $self;
}
sub metaEnd {
my $self=shift @_;
$self->add('EMC');
return $self;
}
=head2 Advanced Methods
=over
=item $content->add @content
Add raw content to the PDF stream. You will generally want to use the
other methods in this class instead.
=cut
sub add_post {
my $self = shift;
if (scalar @_) {
$self->{' poststream'} .= ($self->{' poststream'} =~ m|\s$|o ? '' : ' ') . join(' ', @_) . ' ';
}
return $self;
}
sub add {
my $self = shift;
if (scalar @_) {
$self->{' stream'} .= encode('iso-8859-1', ($self->{' stream'} =~ m|\s$|o ? '' : ' ') . join(' ', @_) . ' ');
}
return $self;
}
# Shortcut method for determining if we're inside a text object
# (i.e. between BT and ET). See textstart and textend.
sub _in_text_object {
my $self = shift();
return defined($self->{' apiistext'}) && $self->{' apiistext'} == 1;
}
=item $content->compressFlate
Marks content for compression on output. This is done automatically
in nearly all cases, so you shouldn't need to call this yourself.
=cut
sub compressFlate {
my $self=shift @_;
$self->{'Filter'}=PDFArray(PDFName('FlateDecode'));
$self->{-docompress}=1;
return $self;
}
=item $content->textstart
Starts a text object. You will likely want to use the C<text> method
instead.
=cut
sub textstart {
my ($self) = @_;
unless ($self->_in_text_object()) {
$self->add(' BT ');
$self->{' apiistext'}=1;
$self->{' font'}=undef;
$self->{' fontset'}=0;
$self->{' fontsize'}=0;
$self->{' charspace'}=0;
$self->{' hscale'}=100;
$self->{' wordspace'}=0;
$self->{' lead'}=0;
$self->{' rise'}=0;
$self->{' render'}=0;
@{$self->{' matrix'}}=(1,0,0,1,0,0);
@{$self->{' textmatrix'}}=(1,0,0,1,0,0);
@{$self->{' textlinematrix'}}=(0,0);
@{$self->{' fillcolor'}}=(0);
@{$self->{' strokecolor'}}=(0);
@{$self->{' translate'}}=(0,0);
@{$self->{' scale'}}=(1,1);
@{$self->{' skew'}}=(0,0);
$self->{' rotate'}=0;
}
return $self;
}
=item $content->textend
Ends a text object.
=cut
sub textend {
my ($self) = @_;
if ($self->_in_text_object()) {
$self->add(' ET ', $self->{' poststream'});
$self->{' apiistext'} = 0;
$self->{' poststream'} = '';
}
return $self;
}
=back
=cut
sub resource {
my ($self, $type, $key, $obj, $force) = @_;
if ($self->{' apipage'}) {
# we are a content stream on a page.
return $self->{' apipage'}->resource($type, $key, $obj, $force);
}
else {
# we are a self-contained content stream.
$self->{Resources}||=PDFDict();
my $dict=$self->{Resources};
$dict->realise if(ref($dict)=~/Objind$/);
$dict->{$type}||= PDFDict();
$dict->{$type}->realise if(ref($dict->{$type})=~/Objind$/);
unless (defined $obj) {
return($dict->{$type}->{$key} || undef);
}
else {
if ($force) {
$dict->{$type}->{$key}=$obj;
}
else {
$dict->{$type}->{$key}||=$obj;
}
return $dict;
}
}
}
1;