PDF::API3::Compat::API2::Basic::TTF::Segarr - Segmented array

PDF-API3 documentation Contained in the PDF-API3 distribution.

Index

Code Index:

NAME

Top

PDF::API3::Compat::API2::Basic::TTF::Segarr - Segmented array

DESCRIPTION

Top

Holds data either directly or indirectly as a series of arrays. This class looks after the set of arrays and masks the individual sub-arrays, thus saving a class, we hope.

INSTANCE VARIABLES

Top

All instance variables do not start with a space.

The segmented array is simply an array of segments

Each segment is a more complex affair:

START

In terms of the array, the address for the 0th element in this segment.

LEN

Number of elements in this segment

VAL

The array which contains the elements

METHODS

Top

PDF::API3::Compat::API2::Basic::TTF::Segarr->new($size)

Creates a new segmented array with a given data size

$s->fastadd_segment($start, $is_sparse, @dat)

Creates a new segment and adds it to the array assuming no overlap between the new segment and any others in the array. $is_sparse indicates whether the passed in array contains undefs or not. If false no checking is done (which is faster, but riskier). If equal to 2 then 0 is considered undef as well.

Returns the number of segments inserted.

$s->add_segment($start, $overwrite, @dat)

Creates a new segment and adds it to the array allowing for possible overlaps between the new segment and the existing ones. In the case of overlaps, elements from the new segment are deleted unless $overwrite is set in which case the elements already there are over-written.

This method also checks the data coming in to see if it is sparse (i.e. contains undef values). Gaps cause new segments to be created or not to over-write existing values.

$s->tidy

Merges any immediately adjacent segments

$s->at($addr, [$len])

Looks up the data held at the given address by locating the appropriate segment etc. If $len > 1 then returns an array of values, spaces being filled with undef.

$s->remove($addr, [$len])

Removes the item or items from addr returning them as an array or the first value in a scalar context. This is very like at, including padding with undef, but it deletes stuff as it goes.

$s->copy

Deep copies this array

$s->copy_seg($seg)

Creates a deep copy of a segment

BUGS

Top

No known bugs.

AUTHOR

Top

Martin Hosken Martin_Hosken@sil.org. See PDF::API3::Compat::API2::Basic::TTF::Font for copyright and licensing.

PDF-API3 documentation Contained in the PDF-API3 distribution. 
#=======================================================================
#    ____  ____  _____              _    ____ ___   ____
#   |  _ \|  _ \|  ___|  _   _     / \  |  _ \_ _| |___ \
#   | |_) | | | | |_    (_) (_)   / _ \ | |_) | |    __) |
#   |  __/| |_| |  _|    _   _   / ___ \|  __/| |   / __/
#   |_|   |____/|_|     (_) (_) /_/   \_\_|  |___| |_____|
#
#   A Perl Module Chain to faciliate the Creation and Modification
#   of High-Quality "Portable Document Format (PDF)" Files.
#
#=======================================================================
#
#   THIS IS A REUSED PERL MODULE, FOR PROPER LICENCING TERMS SEE BELOW:
#
#
#   Copyright Martin Hosken <Martin_Hosken@sil.org>
#
#   No warranty or expression of effectiveness, least of all regarding
#   anyone's safety, is implied in this software or documentation.
#
#   This specific module is licensed under the Perl Artistic License.
#
#
#   $Id: Segarr.pm,v 2.0 2005/11/16 02:16:00 areibens Exp $
#
#=======================================================================
package PDF::API3::Compat::API2::Basic::TTF::Segarr;


use strict;
use vars qw(@types $VERSION);
$VERSION = 0.0001;

@types = ('', 'C', 'n', '', 'N');


sub new
{
    my ($class) = @_;
    my ($self) = [];

    bless $self, (ref($class) || $class);
}



sub fastadd_segment
{
    my ($self) = shift;
    my ($start) = shift;
    my ($sparse) = shift;
    my ($p, $i, $seg, @seg);


    if ($sparse)
    {
        for ($i = 0; $i <= $#_; $i++)
        {
            if (!defined $seg && (($sparse != 2 && defined $_[$i]) || $_[$i] != 0))
            { $seg->{'START'} = $start + $i; $seg->{'VAL'} = []; }

            if (defined $seg && (($sparse == 2 && $_[$i] == 0) || !defined $_[$i]))
            {
                $seg->{'LEN'} = $start + $i - $seg->{'START'};
                push(@seg, $seg);
                $seg = undef;
            } elsif (defined $seg)
            { push (@{$seg->{'VAL'}}, $_[$i]); }
        }
        if (defined $seg)
        {
            push(@seg, $seg);
            $seg->{'LEN'} = $start + $i - $seg->{'START'};
        }
    } else
    {
        $seg->{'START'} = $start;
        $seg->{'LEN'} = $#_ + 1;
        $seg->{'VAL'} = [@_];
        @seg = ($seg);
    }

    for ($i = 0; $i <= $#$self; $i++)
    {
        if ($self->[$i]{'START'} > $start)
        {
            splice(@$self, $i, 0, @seg);
            return wantarray ? @seg : scalar(@seg);
        }
    }
    push(@$self, @seg);
    return wantarray ? @seg : scalar(@seg);
}



sub add_segment
{
    my ($self) = shift;
    my ($start) = shift;
    my ($over) = shift;
    my ($seg, $i, $s, $offset, $j, $newi);

    return $self->fastadd_segment($start, $over, @_) if ($#$self < 0);
    $offset = 0;
    for ($i = 0; $i <= $#$self && $offset <= $#_; $i++)
    {
        $s = $self->[$i];
        if ($s->{'START'} <= $start + $offset)              # only < for $offset == 0
        {
            if ($s->{'START'} + $s->{'LEN'} > $start + $#_)
            {
                for ($j = $offset; $j <= $#_; $j++)
                {
                    if ($over)
                    { $s->{'VAL'}[$start - $s->{'START'} + $j] = $_[$j] if defined $_[$j]; }
                    else
                    { $s->{'VAL'}[$start - $s->{'START'} + $j] ||= $_[$j] if defined $_[$j]; }
                }
                $offset = $#_ + 1;
                last;
            } elsif ($s->{'START'} + $s->{'LEN'} > $start + $offset)        # is $offset needed here?
            {
                for ($j = $offset; $j < $s->{'START'} + $s->{'LEN'} - $start; $j++)
                {
                    if ($over)
                    { $s->{'VAL'}[$start - $s->{'START'} + $j] = $_[$j] if defined $_[$j]; }
                    else
                    { $s->{'VAL'}[$start - $s->{'START'} + $j] ||= $_[$j] if defined $_[$j]; }
                }
                $offset = $s->{'START'} + $s->{'LEN'} - $start;
            }
        } else                                              # new seg please
        {
            if ($s->{'START'} > $start + $#_ + 1)
            {
                $i += $self->fastadd_segment($start + $offset, 1, @_[$offset .. $#_]) - 1;
                $offset = $#_ + 1;
            }
            else
            {
                $i += $self->fastadd_segment($start + $offset, 1, @_[$offset .. $s->{'START'} - $start]) - 1;
                $offset = $s->{'START'} - $start + 1;
            }
        }
    }
    if ($offset <= $#_)
    {
        $seg->{'START'} = $start + $offset;
        $seg->{'LEN'} = $#_ - $offset + 1;
        $seg->{'VAL'} = [@_[$offset .. $#_]];
        push (@$self, $seg);
    }
    $self->tidy;
}



sub tidy
{
    my ($self) = @_;
    my ($i, $sl, $s);

    for ($i = 1; $i <= $#$self; $i++)
    {
        $sl = $self->[$i - 1];
        $s = $self->[$i];
        if ($s->{'START'} == $sl->{'START'} + $sl->{'LEN'})
        {
            $sl->{'LEN'} += $s->{'LEN'};
            push (@{$sl->{'VAL'}}, @{$s->{'VAL'}});
            splice(@$self, $i, 1);
            $i--;
        }
    }
    $self;
}



sub at
{
    my ($self, $addr, $len) = @_;
    my ($i, $dat, $s, @res, $offset);

    $len = 1 unless defined $len;
    $offset = 0;
    for ($i = 0; $i <= $#$self; $i++)
    {
        $s = $self->[$i];
        next if ($s->{'START'} + $s->{'LEN'} < $addr + $offset);        # only fires on $offset == 0
        if ($s->{'START'} > $addr + $offset)
        {
            push (@res, (undef) x ($s->{'START'} > $addr + $len ?
                    $len - $offset : $s->{'START'} - $addr - $offset));
            $offset = $s->{'START'} - $addr;
        }
        last if ($s->{'START'} >= $addr + $len);

        if ($s->{'START'} + $s->{'LEN'} >= $addr + $len)
        {
            push (@res, @{$s->{'VAL'}}[$addr + $offset - $s->{'START'} ..
                    $addr + $len - $s->{'START'} - 1]);
            $offset = $len;
            last;
        } else
        {
            push (@res, @{$s->{'VAL'}}[$addr + $offset - $s->{'START'} .. $s->{'LEN'} - 1]);
            $offset = $s->{'START'} + $s->{'LEN'} - $addr;
        }
    }
    push (@res, (undef) x ($len - $offset)) if ($offset < $len);
    return wantarray ? @res : $res[0];
}



sub remove
{
    my ($self, $addr, $len) = @_;
    my ($i, $dat, $s, @res, $offset);

    $len = 1 unless defined $len;
    $offset = 0;
    for ($i = 0; $i <= $#$self; $i++)
    {
        $s = $self->[$i];
        next if ($s->{'START'} + $s->{'LEN'} < $addr + $offset);
        if ($s->{'START'} > $addr + $offset)
        {
            push (@res, (undef) x ($s->{'START'} > $addr + $len ?
                    $len - $offset : $s->{'START'} - $addr - $offset));
            $offset = $s->{'START'} - $addr;
        }
        last if ($s->{'START'} >= $addr + $len);

        unless ($s->{'START'} == $addr + $offset)
        {
            my ($seg) = {};

            $seg->{'START'} = $s->{'START'};
            $seg->{'LEN'} = $addr + $offset - $s->{'START'};
            $seg->{'VAL'} = [splice(@{$s->{'VAL'}}, 0, $addr + $offset - $s->{'START'})];
            $s->{'LEN'} -= $addr + $offset - $s->{'START'};
            $s->{'START'} = $addr + $offset;

            splice(@$self, $i, 0, $seg);
            $i++;
        }

        if ($s->{'START'} + $s->{'LEN'} >= $addr + $len)
        {
            push (@res, splice(@{$s->{'VAL'}}, 0, $len - $offset));
            $s->{'LEN'} -= $len - $offset;
            $s->{'START'} += $len - $offset;
            $offset = $len;
            last;
        } else
        {
            push (@res, @{$s->{'VAL'}});
            $offset = $s->{'START'} + $s->{'LEN'} - $addr;
            splice(@$self, $i, 0);
            $i--;
        }
    }
    push (@res, (undef) x ($len - $offset)) if ($offset < $len);
    return wantarray ? @res : $res[0];
}



sub copy
{
    my ($self) = @_;
    my ($res, $p);

    $res = [];
    foreach $p (@$self)
    { push (@$res, $self->copy_seg($p)); }
    $res;
}



sub copy_seg
{
    my ($self, $seg) = @_;
    my ($p, $res);

    $res = {};
    $res->{'VAL'} = [@{$seg->{'VAL'}}];
    foreach $p (keys %$seg)
    { $res->{$p} = $seg->{$p} unless defined $res->{$p}; }
    $res;
}


1;