librarian/font-optimizer/ext/Font-TTF/lib/Font/TTF/Anchor.pm

   1 package Font::TTF::Anchor;
   2
   3 =head1 NAME
   4
   5 Font::TTF::Anchor - Anchor points for GPOS tables
   6
   7 =head1 DESCRIPTION
   8
   9 The Anchor defines an anchor point on a glyph providing various information
  10 depending on how much is available, including such information as the co-ordinates,
  11 a curve point and even device specific modifiers.
  12
  13 =head1 INSTANCE VARIABLES
  14
  15 =over 4
  16
  17 =item x
  18
  19 XCoordinate of the anchor point
  20
  21 =item y
  22
  23 YCoordinate of the anchor point
  24
  25 =item p
  26
  27 Curve point on the glyph to use as the anchor point
  28
  29 =item xdev
  30
  31 Device table (delta) for the xcoordinate
  32
  33 =item ydev
  34
  35 Device table (delta) for the ycoordinate
  36
  37 =item xid
  38
  39 XIdAnchor for multiple master horizontal metric id
  40
  41 =item yid
  42
  43 YIdAnchor for multiple master vertical metric id
  44
  45 =back
  46
  47 =head1 METHODS
  48
  49 =cut
  50
  51 use strict;
  52 use Font::TTF::Utils;
  53
  54
  55 =head2 new
  56
  57 Creates a new Anchor
  58
  59 =cut
  60
  61 sub new
  62 {
  63     my ($class) = shift;
  64     my ($self) = {@_};
  65
  66     bless $self, $class;
  67 }
  68
  69
  70 =head2 read($fh)
  71
  72 Reads the anchor from the given file handle at that point. The file handle is left
  73 at an arbitrary read point, usually the end of something!
  74
  75 =cut
  76
  77 sub read
  78 {
  79     my ($self, $fh) = @_;
  80     my ($dat, $loc, $fmt, $p, $xoff, $yoff);
  81
  82     $fh->read($dat, 6);
  83     $fmt = unpack('n', $dat);
  84     if ($fmt == 4)
  85     { ($self->{'xid'}, $self->{'yid'}) = TTF_Unpack('S2', substr($dat,2)); }
  86     else
  87     { ($self->{'x'}, $self->{'y'}) = TTF_Unpack('s2', substr($dat,2)); }
  88
  89     if ($fmt == 2)
  90     {
  91         $fh->read($dat, 2);
  92         $self->{'p'} = unpack('n', $dat);
  93     } elsif ($fmt == 3)
  94     {
  95         $fh->read($dat, 4);
  96         ($xoff, $yoff) = unpack('n2', $dat);
  97         $loc = $fh->tell() - 10;
  98         if ($xoff)
  99         {
 100             $fh->seek($loc + $xoff, 0);
 101             $self->{'xdev'} = Font::TTF::Delta->new->read($fh);
 102         }
 103         if ($yoff)
 104         {
 105             $fh->seek($loc + $yoff, 0);
 106             $self->{'ydev'} = Font::TTF::Delta->new->read($fh);
 107         }
 108     }
 109     $self;
 110 }
 111
 112
 113 =head2 out($fh, $style)
 114
 115 Outputs the Anchor to the given file handle at this point also addressing issues
 116 of deltas. If $style is set, then no output is sent to the file handle. The return
 117 value is the output string.
 118
 119 =cut
 120
 121 sub out
 122 {
 123     my ($self, $fh, $style) = @_;
 124     my ($xoff, $yoff, $fmt, $out);
 125
 126     if (defined $self->{'xid'} || defined $self->{'yid'})
 127     { $out = TTF_Pack('SSS', 4, $self->{'xid'}, $self->{'yid'}); }
 128     elsif (defined $self->{'p'})
 129     { $out = TTF_Pack('Ssss', 2, @{$self}{'x', 'y', 'p'}); }
 130     elsif (defined $self->{'xdev'} || defined $self->{'ydev'})
 131     {
 132         $out = TTF_Pack('Sss', 3, @{$self}{'x', 'y'});
 133         if (defined $self->{'xdev'})
 134         {
 135             $out .= pack('n2', 10, 0);
 136             $out .= $self->{'xdev'}->out($fh, 1);
 137             $yoff = length($out) - 10;
 138         }
 139         else
 140         { $out .= pack('n2', 0, 0); }
 141         if (defined $self->{'ydev'})
 142         {
 143             $yoff = 10 unless $yoff;
 144             substr($out, 8, 2) = pack('n', $yoff);
 145             $out .= $self->{'ydev'}->out($fh, 1);
 146         }
 147     } else
 148     { $out = TTF_Pack('Sss', 1, @{$self}{'x', 'y'}); }
 149     $fh->print($out) unless $style;
 150     $out;
 151 }
 152
 153
 154 sub signature
 155 {
 156     my ($self) = @_;
 157     return join (",", map {"${_}=$self->{$_}"} qw(x y p xdev ydev xid yid));
 158 }
 159
 160
 161 =head2 $a->out_xml($context)
 162
 163 Outputs the anchor in XML
 164
 165 =cut
 166
 167 sub out_xml
 168 {
 169     my ($self, $context, $depth) = @_;
 170     my ($fh) = $context->{'fh'};
 171     my ($end);
 172
 173     $fh->print("$depth<anchor x='$self->{'x'}' y='$self->{'y'}'");
 174     $fh->print(" p='$self->{'p'}'") if defined ($self->{'p'});
 175     $end = (defined $self->{'xdev'} || defined $self->{'ydev'} || defined $self->{'xid'} || defined $self->{'yid'});
 176     unless ($end)
 177     {
 178         $fh->print("/>\n");
 179         return $self;
 180     }
 181
 182     if (defined $self->{'xdev'})
 183     {
 184         $fh->print("$depth$context->{'indent'}<xdev>\n");
 185         $self->{'xdev'}->out_xml($context, $depth . ($context->{'indent'} x 2));
 186         $fh->print("$depth$context->{'indent'}</xdev>\n");
 187     }
 188
 189     if (defined $self->{'ydev'})
 190     {
 191         $fh->print("$depth$context->{'indent'}<ydev>\n");
 192         $self->{'ydev'}->out_xml($context, $depth . ($context->{'indent'} x 2));
 193         $fh->print("$depth$context->{'indent'}</ydev>\n");
 194     }
 195
 196     if (defined $self->{'xid'} || defined $self->{'yid'})
 197     {
 198         $fh->print("$depth$context->{'indent'}<mmaster");
 199         $fh->print(" xid='$self->{'xid'}'") if defined ($self->{'xid'});
 200         $fh->print(" yid='$self->{'yid'}'") if defined ($self->{'yid'});
 201         $fh->print("/>\n");
 202     }
 203     $fh->print("$depth</anchor>\n");
 204     $self;
 205 }
 206
 207
 208 =head1 AUTHOR
 209
 210 Martin Hosken Martin_Hosken@sil.org. See L<Font::TTF::Font> for copyright and
 211 licensing.
 212
 213 =cut
 214
 215 1;
 216