package PDF::API2::Content;

use base 'PDF::API2::Basic::PDF::Dict';

use strict;
no warnings qw( deprecated recursion uninitialized );

our $VERSION = '2.035'; # VERSION

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;

=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;
    if ($self->{-docompress} && $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 and $spf > 0);

    my $d=2*$r;
    my ($beta,$beta_rad,@points);

    $beta=rad2deg(2*asin($z/$d));
    $beta=360-$beta if ($larc and $larc > 0);

    $beta_rad=deg2rad($beta);

    @points=arctocurve($r,$r,90+$alpha+$beta/2,90+$alpha-$beta/2);

    if ($spf and $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 and 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 and 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).

Word spacing might only affect simple fonts and composite fonts where
the space character is a single-byte code.  This is a limitation of
the PDF specification at least as of version 1.7 (see section 9.3.3).
It's possible that a later version of the specification will support
word spacing in fonts that use multi-byte codes.

=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()) {
        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()) {
        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) = @_;
    return 0 unless defined($text) and length($text);
    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 - 1);
        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 - 1);
        my $advance = ($glyph_width+$word_spaces+$char_spaces)*$self->hscale()/100;
        return $advance;
    }
}

=back

=cut

sub text_justified {
    my ($self,$text,$width,%opts) = @_;
    my $initial_width = $self->advancewidth($text);
    my $space_count = scalar split /\s/, $text;
    my $ws = $self->wordspace();
    $self->wordspace(($width - $initial_width) / $space_count) if $space_count > 0;
    $self->text($text,%opts);
    $self->wordspace($ws);
    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 $ws=$self->wordspace();
    my $w=$self->advancewidth($line);
    my $space_count = scalar split /\s/, $line;
    if (($ret||$w>=$width) and $space_count) {
        $self->wordspace(($width - $w) / $space_count);
    }
    $width=$self->text($line,%opts);
    $self->wordspace($ws);
    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 $overflow = '';

    foreach my $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'};
}

=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;
