+++ /dev/null
-package Font::TTF::Segarr;
-
-=head1 NAME
-
-Font::TTF::Segarr - Segmented array
-
-=head1 DESCRIPTION
-
-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.
-
-=head1 INSTANCE VARIABLES
-
-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:
-
-=over 4
-
-=item START
-
-In terms of the array, the address for the 0th element in this segment.
-
-=item LEN
-
-Number of elements in this segment
-
-=item VAL
-
-The array which contains the elements
-
-=back
-
-=head1 METHODS
-
-=cut
-
-use strict;
-use vars qw(@types $VERSION);
-$VERSION = 0.0001;
-
-@types = ('', 'C', 'n', '', 'N');
-
-=head2 Font::TTF::Segarr->new($size)
-
-Creates a new segmented array with a given data size
-
-=cut
-
-sub new
-{
- my ($class) = @_;
- my ($self) = [];
-
- bless $self, (ref($class) || $class);
-}
-
-
-=head2 $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 C<undef>s 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.
-
-=cut
-
-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);
-}
-
-
-=head2 $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.
-
-=cut
-
-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;
-}
-
-
-=head2 $s->tidy
-
-Merges any immediately adjacent segments
-
-=cut
-
-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;
-}
-
-
-=head2 $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.
-
-=cut
-
-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];
-}
-
-
-=head2 $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 C<at>, including padding with
-undef, but it deletes stuff as it goes.
-
-=cut
-
-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];
-}
-
-
-=head2 $s->copy
-
-Deep copies this array
-
-=cut
-
-sub copy
-{
- my ($self) = @_;
- my ($res, $p);
-
- $res = [];
- foreach $p (@$self)
- { push (@$res, $self->copy_seg($p)); }
- $res;
-}
-
-
-=head2 $s->copy_seg($seg)
-
-Creates a deep copy of a segment
-
-=cut
-
-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;
-
-=head1 BUGS
-
-No known bugs.
-
-=head1 AUTHOR
-
-Martin Hosken Martin_Hosken@sil.org. See L<Font::TTF::Font> for copyright and
-licensing.
-
-=cut
-
fnp / librarian.git / blobdiff