src/librarian/font-optimizer/ext/Font-TTF/lib/Font/TTF/OldCmap.pm

   1 package Font::TTF::OldCmap;
   2
   3 =head1 NAME
   4
   5 Font::TTF::OldCmap - Character map table
   6
   7 This module is deprecated
   8
   9 =head1 DESCRIPTION
  10
  11 Looks after the character map. The primary structure used for handling a cmap
  12 is the L<Font::TTF::Segarr> which handles the segmented arrays of format 4 tables,
  13 and in a simpler form for format 0 tables.
  14
  15 Due to the complexity of working with segmented arrays, most of the handling of
  16 such arrays is via methods rather than via instance variables.
  17
  18 One important feature of a format 4 table is that it always contains a segment
  19 with a final address of 0xFFFF. If you are creating a table from scratch this is
  20 important (although L<Font::TTF::Segarr> can work quite happily without it).
  21
  22
  23 =head1 INSTANCE VARIABLES
  24
  25 The instance variables listed here are not preceeded by a space due to their
  26 emulating structural information in the font.
  27
  28 =over 4
  29
  30 =item Num
  31
  32 Number of subtables in this table
  33
  34 =item Tables
  35
  36 An array of subtables ([0..Num-1])
  37
  38 =back
  39
  40 Each subtables also has its own instance variables which are, again, not
  41 preceeded by a space.
  42
  43 =over 4
  44
  45 =item Platform
  46
  47 The platform number for this subtable
  48
  49 =item Encoding
  50
  51 The encoding number for this subtable
  52
  53 =item Format
  54
  55 Gives the stored format of this subtable
  56
  57 =item Ver
  58
  59 Gives the version (or language) information for this subtable
  60
  61 =item val
  62
  63 This points to a L<Font::TTF::Segarr> which contains the content of the particular
  64 subtable.
  65
  66 =back
  67
  68 =head1 METHODS
  69
  70 =cut
  71
  72 use strict;
  73 use vars qw(@ISA);
  74 require Font::TTF::Table;
  75 require Font::TTF::Segarr;
  76
  77 @ISA = qw(Font::TTF::Table);
  78
  79
  80 =head2 $t->read
  81
  82 Reads the cmap into memory. Format 4 subtables read the whole subtable and
  83 fill in the segmented array accordingly.
  84
  85 Format 2 subtables are not read at all.
  86
  87 =cut
  88
  89 sub read
  90 {
  91     my ($self) = @_;
  92     my ($dat, $i, $j, $k, $id, @ids, $s);
  93     my ($start, $end, $range, $delta, $form, $len, $num, $ver);
  94     my ($fh) = $self->{' INFILE'};
  95
  96     $self->SUPER::read or return $self;
  97     $fh->read($dat, 4);
  98     $self->{'Num'} = unpack("x2n", $dat);
  99     $self->{'Tables'} = [];
 100     for ($i = 0; $i < $self->{'Num'}; $i++)
 101     {
 102         $s = {};
 103         $fh->read($dat, 8);
 104         ($s->{'Platform'}, $s->{'Encoding'}, $s->{'LOC'}) = (unpack("nnN", $dat));
 105         $s->{'LOC'} += $self->{' OFFSET'};
 106         push(@{$self->{'Tables'}}, $s);
 107     }
 108     for ($i = 0; $i < $self->{'Num'}; $i++)
 109     {
 110         $s = $self->{'Tables'}[$i];
 111         $fh->seek($s->{'LOC'}, 0);
 112         $fh->read($dat, 6);
 113         ($form, $len, $ver) = (unpack("n3", $dat));
 114
 115         $s->{'Format'} = $form;
 116         $s->{'Ver'} = $ver;
 117         if ($form == 0)
 118         {
 119             $s->{'val'} = Font::TTF::Segarr->new;
 120             $fh->read($dat, 256);
 121             $s->{'val'}->fastadd_segment(0, 2, unpack("C*", $dat));
 122             $s->{'Start'} = 0;
 123             $s->{'Num'} = 256;
 124         } elsif ($form == 6)
 125         {
 126             my ($start, $ecount);
 127
 128             $fh->read($dat, 4);
 129             ($start, $ecount) = unpack("n2", $dat);
 130             $fh->read($dat, $ecount << 1);
 131             $s->{'val'} = Font::TTF::Segarr->new;
 132             $s->{'val'}->fastadd_segment($start, 2, unpack("n*", $dat));
 133             $s->{'Start'} = $start;
 134             $s->{'Num'} = $ecount;
 135         } elsif ($form == 2)
 136         {
 137 # no idea what to do here yet
 138         } elsif ($form == 4)
 139         {
 140             $fh->read($dat, 8);
 141             $num = unpack("n", $dat);
 142             $num >>= 1;
 143             $fh->read($dat, $len - 14);
 144             $s->{'val'} = Font::TTF::Segarr->new;
 145             for ($j = 0; $j < $num; $j++)
 146             {
 147                 $end = unpack("n", substr($dat, $j << 1, 2));
 148                 $start = unpack("n", substr($dat, ($j << 1) + ($num << 1) + 2, 2));
 149                 $delta = unpack("n", substr($dat, ($j << 1) + ($num << 2) + 2, 2));
 150                 $delta -= 65536 if $delta > 32767;
 151                 $range = unpack("n", substr($dat, ($j << 1) + $num * 6 + 2, 2));
 152                 @ids = ();
 153                 for ($k = $start; $k <= $end; $k++)
 154                 {
 155                     if ($range == 0)
 156                     { $id = $k + $delta; }
 157                     else
 158                     { $id = unpack("n", substr($dat, ($j << 1) + $num * 6 +
 159                                         2 + ($k - $start) * 2 + $range, 2)) + $delta; }
 160                             $id -= 65536 if $id > 65536;
 161                     push (@ids, $id);
 162                 }
 163                 $s->{'val'}->fastadd_segment($start, 0, @ids);
 164             }
 165             $s->{'val'}->tidy;
 166             $s->{'Num'} = 0x10000;               # always ends here
 167             $s->{'Start'} = $s->{'val'}[0]{'START'};
 168         }
 169     }
 170     $self;
 171 }
 172
 173
 174 =head2 $t->ms_lookup($uni)
 175
 176 Given a Unicode value in the MS table (Platform 3, Encoding 1) locates that
 177 table and looks up the appropriate glyph number from it.
 178
 179 =cut
 180
 181 sub ms_lookup
 182 {
 183     my ($self, $uni) = @_;
 184
 185     $self->find_ms || return undef unless (defined $self->{' mstable'});
 186     return $self->{' mstable'}{'val'}->at($uni);
 187 }
 188
 189
 190 =head2 $t->find_ms
 191
 192 Finds the Microsoft Unicode table and sets the C<mstable> instance variable
 193 to it if found. Returns the table it finds.
 194
 195 =cut
 196 sub find_ms
 197 {
 198     my ($self) = @_;
 199     my ($i, $s, $alt);
 200
 201     return $self->{' mstable'} if defined $self->{' mstable'};
 202     $self->read;
 203     for ($i = 0; $i < $self->{'Num'}; $i++)
 204     {
 205         $s = $self->{'Tables'}[$i];
 206         if ($s->{'Platform'} == 3)
 207         {
 208             $self->{' mstable'} = $s;
 209             last if ($s->{'Encoding'} == 1);
 210         } elsif ($s->{'Platform'} == 0 || ($s->{'Platform'} == 2 && $s->{'Encoding'} == 1))
 211         { $self->{' mstable'} = $s; }
 212     }
 213     $self->{' mstable'};
 214 }
 215
 216
 217 =head2 $t->out($fh)
 218
 219 Writes out a cmap table to a filehandle. If it has not been read, then
 220 just copies from input file to output
 221
 222 =cut
 223
 224 sub out
 225 {
 226     my ($self, $fh) = @_;
 227     my ($loc, $s, $i, $base_loc, $j);
 228
 229     return $self->SUPER::out($fh) unless $self->{' read'};
 230
 231     $base_loc = $fh->tell();
 232     $fh->print(pack("n2", 0, $self->{'Num'}));
 233
 234     for ($i = 0; $i < $self->{'Num'}; $i++)
 235     { $fh->print(pack("nnN", $self->{'Tables'}[$i]{'Platform'}, $self->{'Tables'}[$i]{'Encoding'}, 0)); }
 236
 237     for ($i = 0; $i < $self->{'Num'}; $i++)
 238     {
 239         $s = $self->{'Tables'}[$i];
 240         $s->{'val'}->tidy;
 241         $s->{' outloc'} = $fh->tell();
 242         $fh->print(pack("n3", $s->{'Format'}, 0, $s->{'Ver'}));       # come back for length
 243         if ($s->{'Format'} == 0)
 244         {
 245             $fh->print(pack("C256", $s->{'val'}->at(0, 256)));
 246         } elsif ($s->{'Format'} == 6)
 247         {
 248             $fh->print(pack("n2", $s->{'Start'}, $s->{'Num'}));
 249             $fh->print(pack("n*", $s->{'val'}->at($s->{'Start'}, $s->{'Num'})));
 250         } elsif ($s->{'Format'} == 2)
 251         {
 252         } elsif ($s->{'Format'} == 4)
 253         {
 254             my ($num, $sRange, $eSel);
 255             my (@deltas, $delta, @range, $flat, $k, $segs, $count);
 256
 257             $num = $#{$s->{'val'}} + 1;
 258             $segs = $s->{'val'};
 259             for ($sRange = 1, $eSel = 0; $sRange <= $num; $eSel++)
 260             { $sRange <<= 1;}
 261             $eSel--;
 262             $fh->print(pack("n4", $num * 2, $sRange, $eSel, ($num * 2) - $sRange));
 263             $fh->print(pack("n*", map {$_->{'START'} + $_->{'LEN'} - 1} @$segs));
 264             $fh->print(pack("n", 0));
 265             $fh->print(pack("n*", map {$_->{'START'}} @$segs));
 266
 267             for ($j = 0; $j < $num; $j++)
 268             {
 269                 $delta = $segs->[$j]{'VAL'}[0]; $flat = 1;
 270                 for ($k = 1; $k < $segs->[$j]{'LEN'}; $k++)
 271                 {
 272                     if ($segs->[$j]{'VAL'}[$k] == 0)
 273                     { $flat = 0; }
 274                     if ($delta + $k != $segs->[$j]{'VAL'}[$k])
 275                     {
 276                         $delta = 0;
 277                         last;
 278                     }
 279                 }
 280                 push (@range, $flat);
 281                 push (@deltas, ($delta ? $delta - $segs->[$j]{'START'} : 0));
 282             }
 283             $fh->print(pack("n*", @deltas));
 284
 285             $count = 0;
 286             for ($j = 0; $j < $num; $j++)
 287             {
 288                 $delta = $deltas[$j];
 289                 if ($delta != 0 && $range[$j] == 1)
 290                 { $range[$j] = 0; }
 291                 else
 292                 {
 293                     $range[$j] = ($count + $num - $j) << 1;
 294                     $count += $segs->[$j]{'LEN'};
 295                 }
 296             }
 297
 298             $fh->print(pack("n*", @range));
 299
 300             for ($j = 0; $j < $num; $j++)
 301             {
 302                 next if ($range[$j] == 0);
 303                 for ($k = 0; $k < $segs->[$j]{'LEN'}; $k++)
 304                 { $fh->print(pack("n", $segs->[$j]{'VAL'}[$k])); }
 305             }
 306         }
 307
 308         $loc = $fh->tell();
 309         $fh->seek($s->{' outloc'} + 2, 0);
 310         $fh->print(pack("n", $loc - $s->{' outloc'}));
 311         $fh->seek($base_loc + 8 + ($i << 3), 0);
 312         $fh->print(pack("N", $s->{' outloc'} - $base_loc));
 313         $fh->seek($loc, 0);
 314     }
 315     $self;
 316 }
 317
 318
 319 =head2 @map = $t->reverse([$num])
 320
 321 Returns a reverse map of the table of given number or the Microsoft
 322 cmap. I.e. given a glyph gives the Unicode value for it.
 323
 324 =cut
 325
 326 sub reverse
 327 {
 328     my ($self, $tnum) = @_;
 329     my ($table) = defined $tnum ? $self->{'Tables'}[$tnum] : $self->find_ms;
 330     my (@res, $i, $s, $first);
 331
 332     foreach $s (@{$table->{'val'}})
 333     {
 334         $first = $s->{'START'};
 335         map {$res[$_] = $first unless $res[$_]; $first++;} @{$s->{'VAL'}};
 336     }
 337     @res;
 338 }
 339
 340 1;
 341
 342 =head1 BUGS
 343
 344 =over 4
 345
 346 =item *
 347
 348 No support for format 2 tables (MBCS)
 349
 350 =back
 351
 352 =head1 AUTHOR
 353
 354 Martin Hosken Martin_Hosken@sil.org. See L<Font::TTF::Font> for copyright and
 355 licensing.
 356
 357 =cut
 358