#=======================================================================
# ____ ____ _____ _ ____ ___ ____
# | _ \| _ \| ___| _ _ / \ | _ \_ _| |___ \
# | |_) | | | | |_ (_) (_) / _ \ | |_) | | __) |
# | __/| |_| | _| _ _ / ___ \| __/| | / __/
# |_| |____/|_| (_) (_) /_/ \_\_| |___| |_____|
#
# A Perl Module Chain to faciliate the Creation and Modification
# of High-Quality "Portable Document Format (PDF)" Files.
#
# Copyright 1999-2005 Alfred Reibenschuh <areibens@cpan.org>.
#
#=======================================================================
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
#
# $Id: Content.pm,v 2.10 2008/02/15 15:22:41 areibens Exp $
#
#=======================================================================
package PDF::API3::Compat::API2::Content;
BEGIN {
use strict;
use vars qw(@ISA $VERSION);
use PDF::API3::Compat::API2::Basic::PDF::Dict;
use PDF::API3::Compat::API2::Basic::PDF::Utils;
use PDF::API3::Compat::API2::Util;
use PDF::API3::Compat::API2::Matrix;
use Math::Trig;
use Encode;
use Compress::Zlib qw[];
@ISA = qw(PDF::API3::Compat::API2::Basic::PDF::Dict);
( $VERSION ) = sprintf '%i.%03i', split(/\./,('$Revision: 2.10 $' =~ /Revision: (\S+)\s/)[0]); # $Date: 2008/02/15 15:22:41 $
}
no warnings qw[ deprecated recursion uninitialized ];
=head1 $co = PDF::API3::Compat::API2::Content->new @parameters
Returns a new content object (called from $page->text/gfx).
=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->{' hspace'}=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;
# $self->save;
return($self);
}
sub outobjdeep {
my $self = shift @_;
$self->textend;
foreach my $k (qw[ api apipdf apiistext apipage font fontset fontsize
charspace hspace 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(@_);
}
=item $co->add @content
Adds @content to the object.
=cut
sub add_post
{
my $self=shift @_;
if(scalar @_>0)
{
$self->{' poststream'}.=($self->{' poststream'}=~m|\s$|o?'':' ').join(' ',@_).' ';
}
$self;
}
sub add
{
my $self=shift @_;
if(scalar @_>0)
{
$self->{' stream'}.=encode("iso-8859-1",($self->{' stream'}=~m|\s$|o?'':' ').join(' ',@_).' ');
}
$self;
}
=item $co->save
Saves the state of the object.
=cut
sub _save
{
return('q');
}
sub save
{
my $self=shift @_;
unless(defined($self->{' apiistext'}) && $self->{' apiistext'} == 1)
{
$self->add(_save());
}
}
=item $co->restore
Restores the state of the object.
=cut
sub _restore
{
return('Q');
}
sub restore
{
my $self=shift @_;
unless(defined($self->{' apiistext'}) && $self->{' apiistext'} == 1) {
$self->add(_restore());
}
}
=item $co->compressFlate
Marks content for compression on output.
=cut
sub compressFlate
{
my $self=shift @_;
$self->{'Filter'}=PDFArray(PDFName('FlateDecode'));
$self->{-docompress}=1;
return($self);
}
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);
}
=item $co->flatness $flat
Sets flatness.
=cut
sub _flatness
{
my ($flatness)=@_;
return($flatness,'i');
}
sub flatness
{
my ($self,$flatness)=@_;
$self->add(_flatness($flatness));
}
=item $co->linecap $cap
Sets linecap.
=cut
sub _linecap
{
my ($linecap)=@_;
return($linecap,'J');
}
sub linecap
{
my ($self,$linecap)=@_;
$self->add(_linecap($linecap));
}
=item $co->linedash @dash
Sets linedash.
=cut
sub _linedash
{
my (@a)=@_;
if(scalar @a < 1)
{
return('[',']','0','d');
}
else
{
if($a[0]=~/^\-/)
{
my %a=@a;
$a{-pattern}=[$a{-full}||0,$a{-clear}||0] unless(ref $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 $co->linejoin $join
Sets linejoin.
=cut
sub _linejoin
{
my ($linejoin)=@_;
return($linejoin,'j');
}
sub linejoin
{
my ($this,$linejoin)=@_;
$this->add(_linejoin($linejoin));
}
=item $co->linewidth $width
Sets linewidth.
=cut
sub _linewidth
{
my ($linewidth)=@_;
return($linewidth,'w');
}
sub linewidth
{
my ($this,$linewidth)=@_;
$this->add(_linewidth($linewidth));
}
=item $co->meterlimit $limit
Sets meterlimit.
=cut
sub _meterlimit
{
my ($limit)=@_;
return($limit,'M');
}
sub meterlimit
{
my ($this, $limit)=@_;
$this->add(_meterlimit($limit));
}
=item $co->matrix $a,$b,$c,$d,$e,$f
Sets matrix transformation.
=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(defined($self->{' apiistext'}) && $self->{' apiistext'} == 1)
{
$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(defined($self->{' apiistext'}) && $self->{' apiistext'} == 1)
{
return(@{$self->{' textmatrix'}});
}
else
{
return($self);
}
}
=item $co->translate $x,$y
Sets translation transformation.
=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 $co->scale $sx,$sy
Sets scaleing transformation.
=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 $co->skew $sa,$sb
Sets skew transformation.
=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 $co->rotate $rot
Sets rotation transformation.
=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 $co->transform %opts
Sets transformations (eg. translate, rotate, scale, skew) in pdf-canonical order.
B<Example:>
$co->transform(
-translate => [$x,$y],
-rotate => $rot,
-scale => [$sx,$sy],
-skew => [$sa,$sb],
)
=cut
sub _transform
{
my (%opt)=@_;
my $mtx=PDF::API3::Compat::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::API3::Compat::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::API3::Compat::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::API3::Compat::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::API3::Compat::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::API3::Compat::API2::Matrix->new(
[$mx[0],$mx[1],0],
[$mx[2],$mx[3],0],
[$mx[4],$mx[5],1]
));
}
}
if($opt{-point})
{
my $mp=PDF::API3::Compat::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 $co->fillcolor @colors
=item $co->strokecolor @colors
Sets fill-/strokecolor, see PDF::API3::Compat::API2::Util for a list of possible color specifiers.
B<Examples:>
$co->fillcolor('blue'); # blue
$co->strokecolor('#FF0000'); # red
$co->fillcolor('%FFF000000'); # cyan
=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::API3::Compat::API2::Resource::ColorSpace|)
{
$self->resource('ColorSpace',$clrs[0]->name,$clrs[0]);
}
elsif(ref($clrs[0]) =~ m|^PDF::API3::Compat::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::API3::Compat::API2::Resource::ColorSpace|)
{
$self->resource('ColorSpace',$clrs[0]->name,$clrs[0]);
}
elsif(ref($clrs[0]) =~ m|^PDF::API3::Compat::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'}});
}
=head1 GRAPHICS METHODS
=over 4
=item $gfx->move $x, $y
=cut
sub _move
{
my($x,$y)=@_;
return(floats($x,$y),'m');
}
sub move
{ # x,y ...
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(defined($self->{' apiistext'}) && $self->{' apiistext'} == 1)
{
$self->add_post(floats($x,$y),'m');
}
else
{
$self->add(floats($x,$y),'m');
}
}
return($self);
}
=item $gfx->line $x, $y
=cut
sub _line
{
my($x,$y)=@_;
return(floats($x,$y),'l');
}
sub line
{ # x,y ...
my $self=shift @_;
my($x,$y);
while(defined($x=shift @_))
{
$y=shift @_;
$self->{' x'}=$x;
$self->{' y'}=$y;
if(defined($self->{' apiistext'}) && $self->{' apiistext'} == 1)
{
$self->add_post(floats($x,$y),'l');
}
else
{
$self->add(floats($x,$y),'l');
}
}
return($self);
}
=item $gfx->hline $x
=cut
sub hline
{
my($self,$x)=@_;
if(defined($self->{' apiistext'}) && $self->{' apiistext'} == 1)
{
$self->add_post(floats($x,$self->{' y'}),'l');
}
else
{
$self->add(floats($x,$self->{' y'}),'l');
}
$self->{' x'}=$x;
return($self);
}
=item $gfx->vline $y
=cut
sub vline
{
my($self,$y)=@_;
if(defined($self->{' apiistext'}) && $self->{' apiistext'} == 1)
{
$self->add_post(floats($self->{' x'},$y),'l');
}
else
{
$self->add(floats($self->{' x'},$y),'l');
}
$self->{' y'}=$y;
return($self);
}
=item $gfx->curve $cx1, $cy1, $cx2, $cy2, $x, $y
=cut
sub curve
{ # x1,y1,x2,y2,x3,y3 ...
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(defined($self->{' apiistext'}) && $self->{' apiistext'} == 1)
{
$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 $gfx->spline $cx1, $cy1, $x, $y
=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);
}
}
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);
}
}
=item $gfx->arc $x, $y, $a, $b, $alfa, $beta, $move
will draw an arc centered at x,y with minor/major-axis
given by a,b from alfa to beta (degrees). move must be
set to 1, unless you want to continue an existing path.
=cut
sub arc
{ # x,y,a,b,alf,bet[,mov]
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 $gfx->ellipse $x, $y, $a, $b
=cut
sub ellipse
{
my ($self,$x,$y,$a,$b) = @_;
$self->arc($x,$y,$a,$b,0,360,1);
$self->close;
return($self);
}
=item $gfx->circle $x, $y, $r
=cut
sub circle
{
my ($self,$x,$y,$r) = @_;
$self->arc($x,$y,$r,$r,0,360,1);
$self->close;
return($self);
}
=item $gfx->bogen $x1, $y1, $x2, $y2, $r, $move, $larc, $span
will draw an arc of a circle from x1,y1 to x2,y2 with radius r.
move must be set to 1, unless you want to continue an existing path.
larc can be set to 1, if you want to draw the larger instead of the
shorter arc. span can be set to 1, if you want to draw the arc
on the other side. NOTE: 2*r cannot be smaller than the distance
from x1,y1 to x2,y2.
=cut
sub bogen
{ # x1,y1,x2,y2,r[,move[,large-arc[,span-factor]]]
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 $alfa_rad=asin($y/$z);
$alfa_rad+=pi/2 if($x<0 and $y>0);
$alfa_rad-=pi/2 if($x<0 and $y<0);
my $alfa=rad2deg($alfa_rad);
# use the complement angle for span
$alfa -= 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+$alfa+$beta/2,90+$alfa-$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($x,$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;
# 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 $gfx->pie $x, $y, $a, $b, $alfa, $beta
=cut
sub pie
{
my $self=shift @_;
my ($x,$y,$a,$b,$alfa,$beta)=@_;
my ($p0_x,$p0_y)=arctocurve($a,$b,$alfa,$beta);
$self->move($x,$y);
$self->line($p0_x+$x,$p0_y+$y);
$self->arc($x,$y,$a,$b,$alfa,$beta);
$self->close;
}
=item $gfx->rect $x1,$y1, $w1,$h1, ..., $xn,$yn, $wn,$hn
=cut
sub rect
{ # x,y,w,h ...
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 $gfx->rectxy $x1,$y1, $x2,$y2
=cut
sub rectxy
{
my ($self,$x,$y,$x2,$y2)=@_;
$self->rect($x,$y,($x2-$x),($y2-$y));
return($self);
}
=item $gfx->poly $x1,$y1, ..., $xn,$yn
=cut
sub poly
{
my $self=shift @_;
my($x,$y);
$x=shift @_;
$y=shift @_;
$self->move($x,$y);
$self->line(@_);
return($self);
}
=item $gfx->close
=cut
sub close
{
my $self=shift @_;
$self->add('h');
$self->{' x'}=$self->{' mx'};
$self->{' y'}=$self->{' my'};
return($self);
}
=item $gfx->endpath
=cut
sub endpath
{
my $self=shift @_;
$self->add('n');
return($self);
}
=item $gfx->clip $nonzero
=cut
sub clip
{ # nonzero
my $self=shift @_;
$self->add(!(shift @_)?'W':'W*');
return($self);
}
=item $gfx->stroke
=cut
sub _stroke
{
return('S');
}
sub stroke
{
my $self=shift @_;
$self->add(_stroke);
return($self);
}
=item $gfx->fill $nonzero
=cut
sub fill
{ # nonzero
my $self=shift @_;
$self->add(!(shift @_)?'f':'f*');
return($self);
}
=item $gfx->fillstroke $nonzero
=cut
sub fillstroke
{ # nonzero
my $self=shift @_;
$self->add(!(shift @_)?'B':'B*');
return($self);
}
=item $gfx->image $imgobj, $x,$y, $w,$h
=item $gfx->image $imgobj, $x,$y, $scale
=item $gfx->image $imgobj, $x,$y
B<Please Note:> The width/height or scale given
is in user-space coordinates which is subject to
transformations which may have been specified beforehand.
Per default this has a 72dpi resolution, so if you want an
image to have a 150 or 300dpi resolution, you should specify
a scale of 72/150 (or 72/300) or adjust width/height accordingly.
=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 $gfx->formimage $imgobj, $x, $y, $scale
=item $gfx->formimage $imgobj, $x, $y
Places the X-Object (or XO-Form) at x/y with optional scale.
=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);
}
=item $gfx->shade $shadeobj, $x1,$y1, $x2,$y2
=cut
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);
}
=item $gfx->egstate $egsobj
=cut
sub egstate
{
my $self=shift @_;
my $egs=shift @_;
$self->add("/".$egs->name,'gs');
$self->resource('ExtGState',$egs->name,$egs);
return($self);
}
=item $hyb->textstart
=cut
sub textstart
{
my ($self)=@_;
if(!defined($self->{' apiistext'}) || $self->{' apiistext'} != 1)
{
$self->add(' BT ');
$self->{' apiistext'}=1;
$self->{' font'}=undef;
$self->{' fontset'}=0;
$self->{' fontsize'}=0;
$self->{' charspace'}=0;
$self->{' hspace'}=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 %state = $txt->textstate %state
Sets or gets the current text-object state.
=cut
sub textstate
{
my $self=shift @_;
my %state;
if(scalar @_)
{
%state=@_;
foreach my $k (qw( charspace hspace 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 hspace 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);
}
sub textstate2
{
my $self=shift @_;
my %state;
if(scalar @_)
{
%state=@_;
foreach my $k (qw[ charspace hspace wordspace lead rise render ])
{
next unless($state{$k});
if($self->{" $k"} ne $state{$k})
{
$self->can($k)->($self, $state{$k});
}
}
if($state{font} && $state{fontsize})
{
if($self->{" font"} ne $state{font} || $self->{" fontsize"} ne $state{fontsize})
{
$self->font($state{font},$state{fontsize});
}
}
if($state{fillcolor})
{
$self->fillcolor(@{$state{fillcolor}});
}
if($state{strokecolor})
{
$self->strokecolor(@{$state{strokecolor}});
}
%state=();
}
else
{
foreach my $k (qw[ font fontsize charspace hspace wordspace lead rise render ])
{
$state{$k}=$self->{" $k"};
}
$state{fillcolor}=[@{$self->{" fillcolor"}}];
$state{strokecolor}=[@{$self->{" strokecolor"}}];
}
return(%state);
}
=item ($tx,$ty) = $txt->textpos
Gets the current estimated text position.
B<Note:> This is relative to text-space.
=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"}});
}
=item $txt->transform_rel %opts
Sets transformations (eg. translate, rotate, scale, skew) in pdf-canonical order,
but relative to the previously set values.
B<Example:>
$txt->transform_rel(
-translate => [$x,$y],
-rotate => $rot,
-scale => [$sx,$sy],
-skew => [$sa,$sb],
)
=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);
}
sub matrix_update {
use PDF::API3::Compat::API2::Matrix;
my ($self,$tx,$ty)=@_;
$self->{' textlinematrix'}->[0]+=$tx;
$self->{' textlinematrix'}->[1]+=$ty;
return($self);
}
=item $txt->font $fontobj,$size
=item $txt->fontset $fontobj,$size
I<The fontset method WILL NOT APPLY the font+size to the pdf-stream, but
which will later be done by the text-methods.>
B<Only use fontset if you know what you are doing, there is no super-secret failsave!>
=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)=@_;
$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);
}
=item $spacing = $txt->charspace $spacing
=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 = $txt->wordspace $spacing
=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 $spacing = $txt->hspace $spacing
=cut
sub _hspace
{
my ($para)=@_;
return(float($para,6).' Tz');
}
sub hspace
{
my ($self,$para)=@_;
if(defined $para)
{
$self->{' hspace'}=$para;
$self->add(_hspace($para));
}
return $self->{' hspace'};
}
=item $leading = $txt->lead $leading
=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 $rise = $txt->rise $rise
=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 $rendering = $txt->render $rendering
=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 $txt->cr $linesize
takes an optional argument giving a custom leading between lines.
=cut
sub cr
{
my ($self,$para)=@_;
if(defined($para))
{
$self->add(0,float($para),'Td');
$self->matrix_update(0,$para);
}
else
{
$self->add('T*');
$self->matrix_update(0,$self->lead);
}
$self->{' textlinematrix'}->[0]=0;
}
=item $txt->nl
=cut
sub nl
{
my ($self,$width)=@_;
$self->add('T*');
$self->matrix_update(-($width||0),-$self->lead);
$self->{' textlinematrix'}->[0]=0;
}
=item $txt->distance $dx,$dy
=cut
sub distance
{
my ($self,$dx,$dy)=@_;
$self->add(float($dx),float($dy),'Td');
$self->matrix_update($dx,$dy);
$self->{' textlinematrix'}->[0]=$dx;
}
=item $width = $txt->advancewidth $string [, %textstate]
Returns the width of the string based on all currently set text-attributes
or on those overridden by %textstate.
=cut
sub advancewidth
{
my ($self,$text,@opts)=@_;
if(scalar @opts > 1)
{
my %opts=@opts;
foreach my $k (qw[ font fontsize wordspace charspace hspace])
{
$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{hspace}/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->hspace/100;
return $advance;
}
}
=item $width = $txt->text $text, %options
Applys text to the content and optionally returns the width of the given text.
Options
=ovar 4
=item -indent
Indent the text by the number of points.
=item -underline
If this is a scalar, it is the distance, in points, below the baseline where
the line is drawn. The line thickness is one point. If it is a reference to an
array, each pair is the distance below the baseline and the thickness of the
line (ie., C<-underline=E<gt>[2,1,4,2]> will draw a double underline
with the lower twice as thick as the upper).
If thickness is a reference to an array, the first value is the thickness
and the second value is the color of the line (ie.,
C<-underline=E<gt>[2,[1,'red'],4,[2,'#0000ff']]> will draw a "red" and a
"blue" line).
You can also use the string C<'auto'> for either or both distance and thickness
values to auto-magically calculate best values from the font-definition.
=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)
{
$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->hspace)),']','TJ');
$self->add($self->{' font'}->text($text, $self->{' fontsize'}, (-$opt{-indent}*(1000/$self->{' fontsize'})*(100/$self->hspace))));
}
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 $txt->text_center $text
=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
=cut
sub text_right
{
my ($self,$text,@opts)=@_;
my $width=$self->advancewidth($text);
return $self->text($text,-indent=>-$width,@opts);
}
=item $width = $txt->text_justified $text, $width, %options
** DEVELOPER METHOD **
=cut
sub text_justified
{
my ($self,$text,$width,%opts)=@_;
my $hs=$self->hspace;
$self->hspace($hs*($width/$self->advancewidth($text)));
$self->text($text,%opts);
$self->hspace($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);
}
=item ($width,$chunktext) = $txt->text_fill_left $text, $width
** DEVELOPER METHOD **
=cut
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);
}
=item ($width,$chunktext) = $txt->text_fill_center $text, $width, %options
** DEVELOPER METHOD **
=cut
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);
}
=item ($width,$chunktext) = $txt->text_fill_right $text, $width
** DEVELOPER METHOD **
=cut
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);
}
=item ($width,$chunktext) = $txt->text_fill_justified $text, $width
** DEVELOPER METHOD **
=cut
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->hspace;
my $w=$self->advancewidth($line);
if($ret||$w>=$width)
{
$self->hspace($hs*($width/$w));
}
$width=$self->text($line,%opts);
$self->hspace($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);
}
=item $hyb->textend
=cut
sub textend {
my ($self)=@_;
if($self->{' apiistext'} == 1) {
$self->add(' ET ',$self->{' poststream'});
$self->{' apiistext'}=0;
$self->{' poststream'}='';
}
return($self);
}
=item $width = $txt->textlabel $x, $y, $font, $size, $text, %options
Applys text with options, but without teststart/end
and optionally returns the width of the given text.
B<Example:>
$t = $page->gfx;
$t->textlabel(300,700,$myfont,20,'Page Header',
-rotate => -30,
-color => '#FF0000',
-hspace => 120,
-align => 'center',
);
$t->textlabel(500,500,$myfont,20,'Page Header',
-rotate => 30,
-color => '#0000FF',
-hspace => 80,
-align => 'right',
);
=cut
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->{' apiistext'};
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->hspace($opts{-hspace}) if($opts{-hspace});
$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 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;
__END__
=head1 AUTHOR
alfred reibenschuh
=cut