[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / Pastel / Font / TTF.pm

package  Pastel::Font::TTF;

use Pastel::Mixin::Mixin;
use IO::File;
use Carp;
@ISA = qw(Pastel::Mixin::Mixin);
use strict;

my $PLATFORM_ID = 3;
my $ENCODING_ID = 1;

sub new
{
    my $arg = shift;
    my $class = ref($arg) || $arg;
    my $self = {};

    bless $self, $class;
    $self->_init(@_);
   
    return $self;

}

sub _init {

    my ($self, @args) = @_;
    $self->{_fh} = undef;
    $self->{family} = undef;
    $self->{glyphs} = [];
    $self->{tables} = {};
    $self->{platform} = 3;
    $self->{encoding} = 1;
    $self->{subfamily} = undef;
}

sub create_from_file {
    my ($self,@args) = @_;
    my $mod = Pastel::Font::TTF->new();
    my ($path, $file) = $mod->_rearrange(["PATH","FILE"],@args);
    my $fh;
    
    if(defined($path) || defined($file)){

	if(defined($path)){
	    $mod->set_file_handle($path);
	    return $mod;
	}
	if(defined($file)){
	    $mod->set_file_handle($file);
	    return $mod;
	}
	
    } else {
	croak "Supply filename in Pastel::Font::TTF::create_from_file()\n";
    }
}

sub set_file_handle {
    my $self = shift;
    my $path = shift;
    my $fh = IO::File->new();

    if($fh->open("< $path")){
	binmode($fh);
	$self->{_fh} = $fh;
    } else {
	croak "Could not open $path in Pastel::Font::TTF::set_file_handle\n";
	}
    $self->make_directory_entry();
    
}

sub get_file_handle {
    my $self = shift;
    if (defined($self->{_fh})){
	return $self->{_fh};
    } else {
	return 0;
    }
}

sub make_directory_entry {
    my $self = shift;
    my $fh = $self->get_file_handle();
    my $buf="";

    eval{read($fh, $buf, 12)};
    if($@){
	croak "Read error in Pastel::Font::TTF::make_directory_entry\n";
    }
     
    my ($version, $number) = unpack("Nn", $buf);
    #print "Version = $version, Number of tables = $number\n";
    # print "\nTABLE\tOFFSET\tLENGTH\n";

    for(my $i = 0; $i < $number; $i++){
    #print "Inside for\n";
     read($fh, $buf, 16);
     my ( $table, $offset, $length) = unpack("a4x4NN", $buf);
    $self->{table}->{$table} = $offset;
     
#print "$table\t$offset\t$length\n";
}
    #print $self->{table}->{'OS/2'};
}

#sub get_font_family {
#    my $self = shift;
#    my $buf;
#    my $fh = $self->get_file_handle();

#    my  $LANGUAGE_ID;
#    my $PLATFORM_ID = $self->{platform};
#    my $ENCODING_ID = $self->{encoding};
    
#    if ( $self->{platform} =="1" && $self->{encoding} =="0"){
#	$LANGUAGE_ID = 0;
#    }
#    else {
#	$LANGUAGE_ID = 1033;
#    }

#    my $add = $self->get_table_address('name');

#    seek ($fh, $add, 0);
#    read($fh, $buf, 6);
#    my ( $num , $offset) = unpack ("x2nn", $buf);
#    #print "*******NAME : Number of records, $num, Offset: $offset\n";

#    my ($copyright_offset, $font_family_name_offset,
#	$subfamily_offset, $id_offset,$full_name_offset,
#	$version_string_offset, $postscript_offset, $trademark_offset);

#    my ($copyright_length, $font_family_length,
#	$subfamily_length, $id_length, $full_name_length,
#	$version_length, $postscript_length, $trademark_length);
    
#    for (my $i = 0; $i < $num; $i++){
#	read ($fh, $buf, 12);
#	my ($id, $encoding, $language, $name_id, $length, $string_offset)
#	   = unpack("n6", $buf);
#	#print "****NAMERECORDS: $id, $encoding, $language, $name_id, $length, $string_offset\n";

#	if ( ($id == $PLATFORM_ID)&&         # Windows??
#	     ($encoding == $ENCODING_ID) &&  #UGL??
#	     ($language == $LANGUAGE_ID)
#	   ) {
#	    if ($name_id == 0 ) { #Copyright
#		$copyright_offset = $string_offset;
#		$copyright_length = $length;
#	    }
#	    if ($name_id == 1 ) { # Familyname
#		$font_family_name_offset = $string_offset;
#		$font_family_length =  $length;
#	    }
#	    if ($name_id == 2 ) { # Subfamily
#		$subfamily_offset = $string_offset;
#		$subfamily_length = $length;
#	    }
#	    if ($name_id == 3 ) { # Identifier
#		$id_offset = $string_offset;
#		$id_length = $length;
#	    }
#	    if ($name_id == 4 ) { # Full name
#	        $full_name_offset = $string_offset;
#		$full_name_length = $length;
#	    }
#	    if ($name_id == 5 ) { #version string
#		$version_string_offset = $string_offset;
#		$version_length = $length;
#	    }
#	    if ( $name_id == 6) { # Postscript name
#		$postscript_offset = $string_offset;
#		$postscript_length = $length;
#	    }
#	    if ($name_id == 7 ) { # Trademark
#		$trademark_offset = $string_offset;
# 		$trademark_length = $length;
#	    }
#	}

#    } # End for loop;

#    # Print copyright
#    seek ( $fh, $add + $offset + $copyright_offset, 0);
#    read ($fh, $buf, $copyright_length);
#   # print "COPYRIGHT: $buf\n\n";

#    # Print familyname
#    seek ($fh, $add + $offset + $font_family_name_offset, 0 );
#    read ( $fh, $buf, $font_family_length);
#    return $buf;
## print "FAMILY: $buf\n\n";
    
#    #Print Subfamily
#    seek ($fh, $add + $offset + $subfamily_offset, 0);
#    read ($fh, $buf, $subfamily_length);
#    #print "SUBFAMILY: $buf\n\n";

#    #Print Identifier
#    seek ( $fh, $add + $offset +$id_offset, 0);
#     read ($fh, $buf, $id_length);
#    #print "ID: $buf\n\n";

#    #Print Full name
#    seek ( $fh, $add + $offset +$full_name_offset, 0);
#     read ($fh, $buf, $full_name_length);
#    #print "FULL NAME: $buf\n\n";

#    #Print Version string
#    seek ( $fh, $add + $offset +$version_string_offset, 0);
#     read ($fh, $buf, $version_length);
#    #print "VERSION: $buf\n\n";


#    #Print Postscript
#    seek ( $fh, $add + $offset +$postscript_offset, 0);
#     read ($fh, $buf, $postscript_length);
#    #print "Postscript: $buf\n\n";

##Print Trademark
#    seek ( $fh, $add + $offset +$trademark_offset, 0);
#     read ($fh, $buf, $trademark_length);
#    #print "TRADEMARK: $buf\n\n";


#}

sub get_table_address {
    my $self = shift;
    my $table_name = shift;

    if (defined($self->{table}->{$table_name})){
	return $self->{table}->{$table_name};
    } else {
	croak "Undefined table address in Pastel::Font::TTF::get_table_address()\n";
	}
}

sub make_glyph_index {
    my $self = shift;
    my $buf;
    my $offset;
    my $fh = $self->get_file_handle();
    my $PLATFORM_ID = $self->{platform};
    my $ENCODING_ID = $self->{encoding};
    # Glyph indices are stored in "cmap" table. We get the offset of the
    # "cmap" table from the %table hash

    my $cmap = $self->get_table_address('cmap');

    #Go there
    seek ($fh, $cmap, 0);

    #'cmap' table starts with
    # USHORT    Table version number
    # USHORT    Number of encoding tables
    # Read 4 bytes
    read ($fh, $buf, 4);

    #Get number of tables and skip the version number
    my ($num) = unpack ("x2n", $buf);

    # Read the tables. There will $num tables
    # Each one for a specific encoding and platform id
    # There are three most important id and encoding-
    # Windows        :      ID=3    Encoding = 1
    # Windows symbol :      ID=3    Encoding = 0
    # Mac/Poscript   :      ID=1    Encoding = 0

    #Each subtable:
    # USHORT         Platform ID
    # USHORT         Platform specific encoding ID
    # ULONG          Byte ofset from the begining of the 'cmap' table
    
    for(my $i = 0; $i < $num; $i++){
       read($fh, $buf, 8); 
       my($id, $encoding, $off) = unpack("nnN", $buf);

       if($id == $PLATFORM_ID && $encoding == $ENCODING_ID){
              $offset = $off;
       }
   }

    #Goto the specific table
    seek($fh, $cmap + $offset, 0);

    # Mac/Poscript table with encoding 0 use the following format
    # USHORT    format set to 0
    # USHORT    length
    # USHORT    version starts at 0
    # BYTE      glyphIdArray[256] There is no trick here just read the whole
    #           thing as 256 array

    # If MAC/Postcript table
    if ($PLATFORM_ID =="1" && $ENCODING_ID=="0"){
	# Skip the format, length and version information
	read($fh, $buf, 6);
	#print (unpack("nnn", $buf));
	# Now read the 256 element array directly

	for (my $i =0; $i < 256; $i++){
	    read($fh, $buf,1);
	    #print $buf;
	    $self->{glyphs}->[$i] = unpack("C", $buf);
	    #print $self->{glyphs}->[$i];
	    print "Char $i\t\t-> Index $self->{glyphs}->[$i]\n";
	}

    }

    # Windows  table with encoding 1 use the following format FORMAT 4
 #   USHORT         format                 Format number is set to 4. 
#    USHORT         length                 Length in bytes. 
#    USHORT         version                Version number (starts at 0).
#    USHORT         segCountX2             2 x segCount.
#    USHORT         searchRange            2 x (2**floor(log2(segCount)))
#    USHORT         entrySelector          log2(searchRange/2)
#    USHORT         rangeShift             2 x segCount - searchRange
#    USHORT         endCount[segCount]     End characterCode for each segment,
#                                           last =0xFFFF.
#    USHORT         reservedPad            Set to 0.
#    USHORT         startCount[segCount]   Start character code for each segment.
#    USHORT         idDelta[segCount]      Delta for all character codes in segment.
#    USHORT         idRangeOffset[segCount]Offsets into glyphIdArray or 0
#    USHORT         glyphIdArray[ ]        Glyph index array (arbitrary length)
    if ( $PLATFORM_ID == "3" && $ENCODING_ID =="1"){
	 read ($fh, $buf, 6);
	 my ($format, $length, $version) = unpack("nnn", $buf);
	 #print "Format: $format\tLength: $length\tVersion: $version\n\n";
	 read ($fh, $buf,8);
	 my ($seg_countX2, $search_range, $entry_selector, $range_shift)  
	   = unpack("nnnn", $buf);
	 my $seg_count = $seg_countX2 / 2;
	# print "SegcountX2:\t\t$seg_countX2\n";
#	 print "Search Range:\t$search_range\n";
#	 print "Entry:\t$entry_selector\n";
#	 print "Range Shift:\t$range_shift\n";
    
	 read($fh, $buf, 2 * $seg_count);
	 my(@end_count) = unpack("n" x $seg_count, $buf);
	 #print "EndCount: ", join("\t",@end_count), "\n";
	 read($fh, $buf, 2);
	 my $reserve_pad = unpack("n", $buf);
	 #print "Reserve Pad: $reserve_pad\n";

	 read($fh, $buf, 2 * $seg_count);
	 my(@start_count) = unpack("n" x $seg_count, $buf);
	 #print "Start Count: ", join("\t",@start_count), "\n";

	 read($fh, $buf, 2 * $seg_count);
	 my(@id_delta) = unpack("n" x $seg_count, $buf);
	 #print "idDelta: ", join("\t",@id_delta), "\n";

	 read($fh, $buf, 2 * $seg_count);
	 my(@id_range_offset) = unpack("n" x $seg_count, $buf);
	 #print "idRangeOffset: ", join("\t",@id_range_offset), "\n";

	 my $num = read($fh, $buf, $length - ($seg_count * 8) - 16);
	 my (@glyph_id) = unpack("n" x ($num / 2), $buf);

#	 for(my $i = 0; $i <@end_count; $i++){
#           if ( ($INDEX <= $end_count[$i]) && ($INDEX >= $start_count[$i]) ){
#              if ($id_range_offset[$i] == 0){
#                 return $INDEX + $id_delta[$i] -($id_delta[$i]> 32767 ? 65536: 0);
#              }
#              else {
#                   my $offset = $INDEX - $start_count[$i];
#                   print "OFFSET ===== $offset\n";
#                   if ($glyph_id[$offset] == 0){
                      
#                      return 0;
#                   }
#                   else{
                      
#                      return $glyph_id[$offset] + $id_delta[$i] - ($id_delta[$i]> 32767 ? 65536: 0);
                   
#                   }   
#              }
#	  }
	   
#       }

	 for ( my $i = 0; $i < 256; $i++){
	     for (my $j = 0; $j <$seg_count; $j++){

		 if ($end_count[$j] >= $i && $start_count[$j] <= $i){
		     #print "ID RANGE OFFSET $id_range_offset[$j]", "\n";
		     if ($id_range_offset[$j] != 0){
			 
			 $self->{glyphs}->[$i] = $glyph_id[$id_range_offset[$j]/2 + ($i - $start_count[$j]) - ($seg_count - $j)];
		     }
		     else {
			$self->{glyphs}->[$i] = ($id_delta[$j] + $i) % 65536;
		       }
		 }
	     }
	   if (!defined($self->{glyphs}->[$i])){
	       #$self->{glyphs}->[$i] = $glyph_id[0];
	       $self->{glyphs}->[$i] = 0;
	   }
	   #print "Char $i -> \t\t $self->{glyphs}->[$i]\n";    
	}
	     
     }
}

sub get_advance_width {
    my $self = shift;
    my $fh = $self->get_file_handle();
    my $buf;
    
    seek($fh, $self->{table}->{"hhea"}, 0);
    read($fh, $buf, 36) == 36 || die "reading hhea table";
    my($h_num) = unpack("x34n", $buf);
    my $num = $h_num;
    my $index = shift;
    seek($fh, $self->{table}->{"hmtx"}, 0);
    read($fh, $buf, 4 * $num) == 4 * $num || die "reading hmtx table";
    my (@h_temp) = unpack("n" x (2 * $num), $buf);
   # print "******@h_temp\n";
    my (@advanced_width);
    my (@lsb);
    for (my $i = 0; $i < @h_temp; $i +=2){
        push (@advanced_width,$h_temp[$i]);
        #print $h_temp[$i];
    }
    for (my $i = 1; $i < @h_temp; $i +=2){   
        push (@lsb,$h_temp[$i]);
    }
#print @advanced_width, "\n";
#print @lsb;
    
    if ($index > @lsb){$index = @lsb;}
    my $a = $advanced_width[$index] - ($advanced_width[$index] > 32768 ? 65536 : 0);
    my $l = $lsb[$index] - ($lsb[$index] > 32768 ? 65536 :0);
    
    #return $a, $l;
    return $a;
 }

sub get_leading {
    my $self = shift;
    if (defined($self->{leading})){
	return $self->{leading};
    } else {
	$self->_parse_os2();
        #$self->{leading} = $self->_get_leading();
	return $self->{leading};
	}
}

sub _get_leading {
    my $self = shift;
    my $fh = $self->get_file_handle();

    # Get the adress of the OS/2 table
    my $add = $self->get_table_address('OS/2');
    my $buf;
    #print $add, "\n";

    #Leading is sTypoLineGap in OS/2 table
    seek($fh, $add, 0);
    read($fh, $buf, 74) == 74 || die "reading OS/2 table";
    my ($leading) = unpack("x72n", $buf);
    #print join(" ",@panose), "\n";
    #print $leading, "\n";
    return $leading - ($leading > 32768 ? 65536 : 0);
}

sub get_units_per_em {
    my $self = shift;

    # Get Headtable address
    my $add = $self->get_table_address("head");
    my $buf;
    my $fh = $self->get_file_handle();
    
    seek($fh, $add, 0);

    read($fh, $buf, 54) == 54 || die "reading head table";
    my($units_per_em, $index_to_loc) = unpack("x18nx30n", $buf);

   # print "Unit/EM: $units_per_em\tIndex_to_loc: $index_to_loc\n\n";

    return $units_per_em;
}

    
sub get_ascent {
    my $self = shift;
    if (defined($self->{ascent})){
	return $self->{ascent};
    } else {
	$self->_parse_os2();
        #$self->{ascent} = $self->_get_ascent();
	return $self->{ascent};
	}
}

sub _get_ascent {
    my $self = shift;
    my $fh = $self->get_file_handle();

    # Get the adress of the OS/2 table
    my $add = $self->get_table_address('OS/2');
    my $buf;
    #print $add, "\n";

    # Ascent is  is sTypoAscender in OS/2 table
    seek($fh, $add, 0);
    read($fh, $buf, 70) == 70 || die "reading OS/2 table";
    my ($ascent) = unpack("x68n", $buf);
    #print join(" ",@panose), "\n";
    #print $ascent, "\n";
    return $ascent - ($ascent > 32768 ? 65536 : 0);
}

sub get_descent {
    my $self = shift;
    if (defined($self->{descent})){
	return $self->{descent};
    } else {
	$self->_parse_os2();
        #$self->{descent} = $self->_get_descent();
	return $self->{descent};
	}
}
    
sub _parse_os2 {
    my $self = shift;
    my $fh = $self->get_file_handle();
    my $add = $self->get_table_address('OS/2');
    my $buf;

    seek($fh, $add, 0);
    read($fh, $buf, 74) == 74 || die "reading OS/2 table";
    my ($ascent, $descent, $leading) =
               unpack("x68nnn", $buf);
    $self->{ascent} = $ascent - ($ascent > 32768 ? 65536 : 0);
    $self->{descent} = $descent - ($descent > 32768 ? 65536 :0);
    $self->{leading} = $leading - ($leading > 32768 ? 65536 :0);
}
sub get_font_family {
  my $self = shift;
  if ( defined($self->{family}) ){
    return $self->{family};
  } else {
    $self->_parse_name_table();
  }
  return $self->{family};
}

sub get_subfamily {
  my $self = shift;
  if ( defined( $self->{subfamily})){
    return $self->{subfamily};
  } else {
    $self->_parse_name_table();
    }
return $self->{subfamily};
 }

sub _parse_name_table {

  my $self = shift;
  my $buf;
  my $fh = $self->get_file_handle();

   my  $LANGUAGE_ID;
    
    if ( $PLATFORM_ID =="1" && $ENCODING_ID =="0"){
	$LANGUAGE_ID = 0;
    }
    else {
	$LANGUAGE_ID = 1033;
    }
    my $add = $self->get_table_address("name");
    seek ($fh, $add, 0);
    read($fh, $buf, 6);
    my ( $num , $offset) = unpack ("x2nn", $buf);
    #print "*******NAME : Number of records, $num, Offset: $offset\n";

    my ($copyright_offset, $font_family_name_offset,
	$subfamily_offset, $id_offset,$full_name_offset,
	$version_string_offset, $postscript_offset, $trademark_offset);

    my ($copyright_length, $font_family_length,
	$subfamily_length, $id_length, $full_name_length,
	$version_length, $postscript_length, $trademark_length);
    
    for (my $i = 0; $i < $num; $i++){
	read ($fh, $buf, 12);
	my ($id, $encoding, $language, $name_id, $length, $string_offset)
	   = unpack("n6", $buf);
	#print "****NAMERECORDS: $id, $encoding, $language, $name_id, $length, $string_offset\n";

	if ( ($id == $PLATFORM_ID)&&         # Windows??
	     ($encoding == $ENCODING_ID) &&  #UGL??
	     ($language == $LANGUAGE_ID)
	   ) {
	    if ($name_id == 0 ) { #Copyright
		$copyright_offset = $string_offset;
		$copyright_length = $length;
	    }
	    if ($name_id == 1 ) { # Familyname
		$font_family_name_offset = $string_offset;
		$font_family_length =  $length;
	    }
	    if ($name_id == 2 ) { # Subfamily
		$subfamily_offset = $string_offset;
		$subfamily_length = $length;
	    }
	    if ($name_id == 3 ) { # Identifier
		$id_offset = $string_offset;
		$id_length = $length;
	    }
	    if ($name_id == 4 ) { # Full name
	        $full_name_offset = $string_offset;
		$full_name_length = $length;
	    }
	    if ($name_id == 5 ) { #version string
		$version_string_offset = $string_offset;
		$version_length = $length;
	    }
	    if ( $name_id == 6) { # Postscript name
		$postscript_offset = $string_offset;
		$postscript_length = $length;
	    }
	    if ($name_id == 7 ) { # Trademark
		$trademark_offset = $string_offset;
 		$trademark_length = $length;
	    }
	}

    } # End for loop;

    # Print copyright
    seek ( $fh, $self->get_table_address("name") + $offset + $copyright_offset, 0);
    read ($fh, $buf, $copyright_length);
   # print "COPYRIGHT: $buf\n\n";

    # Print familyname
    seek ($fh, $self->get_table_address("name") + $offset + $font_family_name_offset, 0 );
    read ( $fh, $buf, $font_family_length);
 
  
    #print $s;
    $self->{family}=  $self->_remove_white_space($buf, $font_family_length);
    #print  "\n****", "@char", "*****\n"; 
    #return "@char";
# print "FAMILY: $buf\n\n";
    
    #Print Subfamily
    seek ($fh, $self->get_table_address('name') + $offset + $subfamily_offset, 0);
    read ($fh, $buf, $subfamily_length);
    #print "SUBFAMILY: $buf\n\n";
   $self->{subfamily} = $self->_remove_white_space($buf, $subfamily_length);

    #Print Identifier
    seek ( $fh, $self->get_table_address('name') + $offset +$id_offset, 0);
     read ($fh, $buf, $id_length);
    #print "ID: $buf\n\n";

    #Print Full name
    seek ( $fh, $self->get_table_address('name') + $offset +$full_name_offset, 0);
     read ($fh, $buf, $full_name_length);
    #print "FULL NAME: $buf\n\n";

    #Print Version string
    seek ( $fh, $self->get_table_address('name') + $offset +$version_string_offset, 0);
     read ($fh, $buf, $version_length);
    #print "VERSION: $buf\n\n";


    #Print Postscript
    seek ( $fh, $self->get_table_address('name') + $offset +$postscript_offset, 0);
     read ($fh, $buf, $postscript_length);
    #print "Postscript: $buf\n\n";

#Print Trademark
    seek ( $fh, $self->get_table_address('name') + $offset +$trademark_offset, 0);
     read ($fh, $buf, $trademark_length);
    #print "TRADEMARK: $buf\n\n";


}

sub _remove_white_space {
  my $self = shift;
  my $buf = shift;
  my $font_family_length = shift;
     my @char = unpack("C*",$buf);
    my $i = $font_family_length;
   my $s = "";
    my $j = 0;
    while ( $j < $i){  
      if (defined $char[$j+1]){
      $s .= pack("C",$char[$j+1]);}
      $j += 2;
    }
  return $s;
}
1;
Commit	Line	Data
86530b38 AT	1	package Pastel::Font::TTF;
	2
	3	use Pastel::Mixin::Mixin;
	4	use IO::File;
	5	use Carp;
	6	@ISA = qw(Pastel::Mixin::Mixin);
	7	use strict;
	8
	9	my $PLATFORM_ID = 3;
	10	my $ENCODING_ID = 1;
	11
	12	sub new
	13	{
	14	my $arg = shift;
	15	my $class = ref($arg) \|\| $arg;
	16	my $self = {};
	17
	18	bless $self, $class;
	19	$self->_init(@_);
	20
	21	return $self;
	22
	23	}
	24
	25	sub _init {
	26
	27	my ($self, @args) = @_;
	28	$self->{_fh} = undef;
	29	$self->{family} = undef;
	30	$self->{glyphs} = [];
	31	$self->{tables} = {};
	32	$self->{platform} = 3;
	33	$self->{encoding} = 1;
	34	$self->{subfamily} = undef;
	35	}
	36
	37	sub create_from_file {
	38	my ($self,@args) = @_;
	39	my $mod = Pastel::Font::TTF->new();
	40	my ($path, $file) = $mod->_rearrange(["PATH","FILE"],@args);
	41	my $fh;
	42
	43	if(defined($path) \|\| defined($file)){
	44
	45	if(defined($path)){
	46	$mod->set_file_handle($path);
	47	return $mod;
	48	}
	49	if(defined($file)){
	50	$mod->set_file_handle($file);
	51	return $mod;
	52	}
	53
	54	} else {
	55	croak "Supply filename in Pastel::Font::TTF::create_from_file()\n";
	56	}
	57	}
	58
	59	sub set_file_handle {
	60	my $self = shift;
	61	my $path = shift;
	62	my $fh = IO::File->new();
	63
	64	if($fh->open("< $path")){
65	binmode($fh);
66	$self->{_fh} = $fh;
67	} else {
68	croak "Could not open $path in Pastel::Font::TTF::set_file_handle\n";
69	}
70	$self->make_directory_entry();
71
72	}
73
74	sub get_file_handle {
75	my $self = shift;
76	if (defined($self->{_fh})){
77	return $self->{_fh};
78	} else {
79	return 0;
80	}
81	}
82
83	sub make_directory_entry {
84	my $self = shift;
85	my $fh = $self->get_file_handle();
86	my $buf="";
87
88	eval{read($fh, $buf, 12)};
89	if($@){
90	croak "Read error in Pastel::Font::TTF::make_directory_entry\n";
91	}
92
93	my ($version, $number) = unpack("Nn", $buf);
94	#print "Version = $version, Number of tables = $number\n";
95	# print "\nTABLE\tOFFSET\tLENGTH\n";
96
97	for(my $i = 0; $i < $number; $i++){
98	#print "Inside for\n";
99	read($fh, $buf, 16);
100	my ( $table, $offset, $length) = unpack("a4x4NN", $buf);
101	$self->{table}->{$table} = $offset;
102
103	#print "$table\t$offset\t$length\n";
104	}
105	#print $self->{table}->{'OS/2'};
106	}
107
108	#sub get_font_family {
109	# my $self = shift;
110	# my $buf;
111	# my $fh = $self->get_file_handle();
112
113	# my $LANGUAGE_ID;
114	# my $PLATFORM_ID = $self->{platform};
115	# my $ENCODING_ID = $self->{encoding};
116
117	# if ( $self->{platform} =="1" && $self->{encoding} =="0"){
118	# $LANGUAGE_ID = 0;
119	# }
120	# else {
121	# $LANGUAGE_ID = 1033;
122	# }
123
124	# my $add = $self->get_table_address('name');
125
126	# seek ($fh, $add, 0);
127	# read($fh, $buf, 6);
128	# my ( $num , $offset) = unpack ("x2nn", $buf);
129	# #print "*******NAME : Number of records, $num, Offset: $offset\n";
130
131	# my ($copyright_offset, $font_family_name_offset,
132	# $subfamily_offset, $id_offset,$full_name_offset,
133	# $version_string_offset, $postscript_offset, $trademark_offset);
134
135	# my ($copyright_length, $font_family_length,
136	# $subfamily_length, $id_length, $full_name_length,
137	# $version_length, $postscript_length, $trademark_length);
138
139	# for (my $i = 0; $i < $num; $i++){
140	# read ($fh, $buf, 12);
141	# my ($id, $encoding, $language, $name_id, $length, $string_offset)
142	# = unpack("n6", $buf);
143	# #print "****NAMERECORDS: $id, $encoding, $language, $name_id, $length, $string_offset\n";
144
145	# if ( ($id == $PLATFORM_ID)&& # Windows??
146	# ($encoding == $ENCODING_ID) && #UGL??
147	# ($language == $LANGUAGE_ID)
148	# ) {
149	# if ($name_id == 0 ) { #Copyright
150	# $copyright_offset = $string_offset;
151	# $copyright_length = $length;
152	# }
153	# if ($name_id == 1 ) { # Familyname
154	# $font_family_name_offset = $string_offset;
155	# $font_family_length = $length;
156	# }
157	# if ($name_id == 2 ) { # Subfamily
158	# $subfamily_offset = $string_offset;
159	# $subfamily_length = $length;
160	# }
161	# if ($name_id == 3 ) { # Identifier
162	# $id_offset = $string_offset;
163	# $id_length = $length;
164	# }
165	# if ($name_id == 4 ) { # Full name
166	# $full_name_offset = $string_offset;
167	# $full_name_length = $length;
168	# }
169	# if ($name_id == 5 ) { #version string
170	# $version_string_offset = $string_offset;
171	# $version_length = $length;
172	# }
173	# if ( $name_id == 6) { # Postscript name
174	# $postscript_offset = $string_offset;
175	# $postscript_length = $length;
176	# }
177	# if ($name_id == 7 ) { # Trademark
178	# $trademark_offset = $string_offset;
179	# $trademark_length = $length;
180	# }
181	# }
182
183	# } # End for loop;
184
185	# # Print copyright
186	# seek ( $fh, $add + $offset + $copyright_offset, 0);
187	# read ($fh, $buf, $copyright_length);
188	# # print "COPYRIGHT: $buf\n\n";
189
190	# # Print familyname
191	# seek ($fh, $add + $offset + $font_family_name_offset, 0 );
192	# read ( $fh, $buf, $font_family_length);
193	# return $buf;
194	## print "FAMILY: $buf\n\n";
195
196	# #Print Subfamily
197	# seek ($fh, $add + $offset + $subfamily_offset, 0);
198	# read ($fh, $buf, $subfamily_length);
199	# #print "SUBFAMILY: $buf\n\n";
200
201	# #Print Identifier
202	# seek ( $fh, $add + $offset +$id_offset, 0);
203	# read ($fh, $buf, $id_length);
204	# #print "ID: $buf\n\n";
205
206	# #Print Full name
207	# seek ( $fh, $add + $offset +$full_name_offset, 0);
208	# read ($fh, $buf, $full_name_length);
209	# #print "FULL NAME: $buf\n\n";
210
211	# #Print Version string
212	# seek ( $fh, $add + $offset +$version_string_offset, 0);
213	# read ($fh, $buf, $version_length);
214	# #print "VERSION: $buf\n\n";
215
216
217	# #Print Postscript
218	# seek ( $fh, $add + $offset +$postscript_offset, 0);
219	# read ($fh, $buf, $postscript_length);
220	# #print "Postscript: $buf\n\n";
221
222	##Print Trademark
223	# seek ( $fh, $add + $offset +$trademark_offset, 0);
224	# read ($fh, $buf, $trademark_length);
225	# #print "TRADEMARK: $buf\n\n";
226
227
228	#}
229
230	sub get_table_address {
231	my $self = shift;
232	my $table_name = shift;
233
234	if (defined($self->{table}->{$table_name})){
235	return $self->{table}->{$table_name};
236	} else {
237	croak "Undefined table address in Pastel::Font::TTF::get_table_address()\n";
238	}
239	}
240
241	sub make_glyph_index {
242	my $self = shift;
243	my $buf;
244	my $offset;
245	my $fh = $self->get_file_handle();
246	my $PLATFORM_ID = $self->{platform};
247	my $ENCODING_ID = $self->{encoding};
248	# Glyph indices are stored in "cmap" table. We get the offset of the
249	# "cmap" table from the %table hash
250
251	my $cmap = $self->get_table_address('cmap');
252
253	#Go there
254	seek ($fh, $cmap, 0);
255
256	#'cmap' table starts with
257	# USHORT Table version number
258	# USHORT Number of encoding tables
259	# Read 4 bytes
260	read ($fh, $buf, 4);
261
262	#Get number of tables and skip the version number
263	my ($num) = unpack ("x2n", $buf);
264
265	# Read the tables. There will $num tables
266	# Each one for a specific encoding and platform id
267	# There are three most important id and encoding-
268	# Windows : ID=3 Encoding = 1
269	# Windows symbol : ID=3 Encoding = 0
270	# Mac/Poscript : ID=1 Encoding = 0
271
272	#Each subtable:
273	# USHORT Platform ID
274	# USHORT Platform specific encoding ID
275	# ULONG Byte ofset from the begining of the 'cmap' table
276
277	for(my $i = 0; $i < $num; $i++){
278	read($fh, $buf, 8);
279	my($id, $encoding, $off) = unpack("nnN", $buf);
280
281	if($id == $PLATFORM_ID && $encoding == $ENCODING_ID){
282	$offset = $off;
283	}
284	}
285
286	#Goto the specific table
287	seek($fh, $cmap + $offset, 0);
288
289	# Mac/Poscript table with encoding 0 use the following format
290	# USHORT format set to 0
291	# USHORT length
292	# USHORT version starts at 0
293	# BYTE glyphIdArray[256] There is no trick here just read the whole
294	# thing as 256 array
295
296	# If MAC/Postcript table
297	if ($PLATFORM_ID =="1" && $ENCODING_ID=="0"){
298	# Skip the format, length and version information
299	read($fh, $buf, 6);
300	#print (unpack("nnn", $buf));
301	# Now read the 256 element array directly
302
303	for (my $i =0; $i < 256; $i++){
304	read($fh, $buf,1);
305	#print $buf;
306	$self->{glyphs}->[$i] = unpack("C", $buf);
307	#print $self->{glyphs}->[$i];
308	print "Char $i\t\t-> Index $self->{glyphs}->[$i]\n";
309	}
310
311	}
312
313	# Windows table with encoding 1 use the following format FORMAT 4
314	# USHORT format Format number is set to 4.
315	# USHORT length Length in bytes.
316	# USHORT version Version number (starts at 0).
317	# USHORT segCountX2 2 x segCount.
318	# USHORT searchRange 2 x (2**floor(log2(segCount)))
319	# USHORT entrySelector log2(searchRange/2)
320	# USHORT rangeShift 2 x segCount - searchRange
321	# USHORT endCount[segCount] End characterCode for each segment,
322	# last =0xFFFF.
323	# USHORT reservedPad Set to 0.
324	# USHORT startCount[segCount] Start character code for each segment.
325	# USHORT idDelta[segCount] Delta for all character codes in segment.
326	# USHORT idRangeOffset[segCount]Offsets into glyphIdArray or 0
327	# USHORT glyphIdArray[ ] Glyph index array (arbitrary length)
328	if ( $PLATFORM_ID == "3" && $ENCODING_ID =="1"){
329	read ($fh, $buf, 6);
330	my ($format, $length, $version) = unpack("nnn", $buf);
331	#print "Format: $format\tLength: $length\tVersion: $version\n\n";
332	read ($fh, $buf,8);
333	my ($seg_countX2, $search_range, $entry_selector, $range_shift)
334	= unpack("nnnn", $buf);
335	my $seg_count = $seg_countX2 / 2;
336	# print "SegcountX2:\t\t$seg_countX2\n";
337	# print "Search Range:\t$search_range\n";
338	# print "Entry:\t$entry_selector\n";
339	# print "Range Shift:\t$range_shift\n";
340
341	read($fh, $buf, 2 * $seg_count);
342	my(@end_count) = unpack("n" x $seg_count, $buf);
343	#print "EndCount: ", join("\t",@end_count), "\n";
344	read($fh, $buf, 2);
345	my $reserve_pad = unpack("n", $buf);
346	#print "Reserve Pad: $reserve_pad\n";
347
348	read($fh, $buf, 2 * $seg_count);
349	my(@start_count) = unpack("n" x $seg_count, $buf);
350	#print "Start Count: ", join("\t",@start_count), "\n";
351
352	read($fh, $buf, 2 * $seg_count);
353	my(@id_delta) = unpack("n" x $seg_count, $buf);
354	#print "idDelta: ", join("\t",@id_delta), "\n";
355
356	read($fh, $buf, 2 * $seg_count);
357	my(@id_range_offset) = unpack("n" x $seg_count, $buf);
358	#print "idRangeOffset: ", join("\t",@id_range_offset), "\n";
359
360	my $num = read($fh, $buf, $length - ($seg_count * 8) - 16);
361	my (@glyph_id) = unpack("n" x ($num / 2), $buf);
362
363	# for(my $i = 0; $i <@end_count; $i++){
364	# if ( ($INDEX <= $end_count[$i]) && ($INDEX >= $start_count[$i]) ){
365	# if ($id_range_offset[$i] == 0){
366	# return $INDEX + $id_delta[$i] -($id_delta[$i]> 32767 ? 65536: 0);
367	# }
368	# else {
369	# my $offset = $INDEX - $start_count[$i];
370	# print "OFFSET ===== $offset\n";
371	# if ($glyph_id[$offset] == 0){
372
373	# return 0;
374	# }
375	# else{
376
377	# return $glyph_id[$offset] + $id_delta[$i] - ($id_delta[$i]> 32767 ? 65536: 0);
378
379	# }
380	# }
381	# }
382
383	# }
384
385	for ( my $i = 0; $i < 256; $i++){
386	for (my $j = 0; $j <$seg_count; $j++){
387
388	if ($end_count[$j] >= $i && $start_count[$j] <= $i){
389	#print "ID RANGE OFFSET $id_range_offset[$j]", "\n";
390	if ($id_range_offset[$j] != 0){
391
392	$self->{glyphs}->[$i] = $glyph_id[$id_range_offset[$j]/2 + ($i - $start_count[$j]) - ($seg_count - $j)];
393	}
394	else {
395	$self->{glyphs}->[$i] = ($id_delta[$j] + $i) % 65536;
396	}
397	}
398	}
399	if (!defined($self->{glyphs}->[$i])){
400	#$self->{glyphs}->[$i] = $glyph_id[0];
401	$self->{glyphs}->[$i] = 0;
402	}
403	#print "Char $i -> \t\t $self->{glyphs}->[$i]\n";
404	}
405
406	}
407	}
408
409	sub get_advance_width {
410	my $self = shift;
411	my $fh = $self->get_file_handle();
412	my $buf;
413
414	seek($fh, $self->{table}->{"hhea"}, 0);
415	read($fh, $buf, 36) == 36 \|\| die "reading hhea table";
416	my($h_num) = unpack("x34n", $buf);
417	my $num = $h_num;
418	my $index = shift;
419	seek($fh, $self->{table}->{"hmtx"}, 0);
420	read($fh, $buf, 4 * $num) == 4 * $num \|\| die "reading hmtx table";
421	my (@h_temp) = unpack("n" x (2 * $num), $buf);
422	# print "******@h_temp\n";
423	my (@advanced_width);
424	my (@lsb);
425	for (my $i = 0; $i < @h_temp; $i +=2){
426	push (@advanced_width,$h_temp[$i]);
427	#print $h_temp[$i];
428	}
429	for (my $i = 1; $i < @h_temp; $i +=2){
430	push (@lsb,$h_temp[$i]);
431	}
432	#print @advanced_width, "\n";
433	#print @lsb;
434
435	if ($index > @lsb){$index = @lsb;}
436	my $a = $advanced_width[$index] - ($advanced_width[$index] > 32768 ? 65536 : 0);
437	my $l = $lsb[$index] - ($lsb[$index] > 32768 ? 65536 :0);
438
439	#return $a, $l;
440	return $a;
441	}
442
443	sub get_leading {
444	my $self = shift;
445	if (defined($self->{leading})){
446	return $self->{leading};
447	} else {
448	$self->_parse_os2();
449	#$self->{leading} = $self->_get_leading();
450	return $self->{leading};
451	}
452	}
453
454	sub _get_leading {
455	my $self = shift;
456	my $fh = $self->get_file_handle();
457
458	# Get the adress of the OS/2 table
459	my $add = $self->get_table_address('OS/2');
460	my $buf;
461	#print $add, "\n";
462
463	#Leading is sTypoLineGap in OS/2 table
464	seek($fh, $add, 0);
465	read($fh, $buf, 74) == 74 \|\| die "reading OS/2 table";
466	my ($leading) = unpack("x72n", $buf);
467	#print join(" ",@panose), "\n";
468	#print $leading, "\n";
469	return $leading - ($leading > 32768 ? 65536 : 0);
470	}
471
472	sub get_units_per_em {
473	my $self = shift;
474
475	# Get Headtable address
476	my $add = $self->get_table_address("head");
477	my $buf;
478	my $fh = $self->get_file_handle();
479
480	seek($fh, $add, 0);
481
482	read($fh, $buf, 54) == 54 \|\| die "reading head table";
483	my($units_per_em, $index_to_loc) = unpack("x18nx30n", $buf);
484
485	# print "Unit/EM: $units_per_em\tIndex_to_loc: $index_to_loc\n\n";
486
487	return $units_per_em;
488	}
489
490
491	sub get_ascent {
492	my $self = shift;
493	if (defined($self->{ascent})){
494	return $self->{ascent};
495	} else {
496	$self->_parse_os2();
497	#$self->{ascent} = $self->_get_ascent();
498	return $self->{ascent};
499	}
500	}
501
502	sub _get_ascent {
503	my $self = shift;
504	my $fh = $self->get_file_handle();
505
506	# Get the adress of the OS/2 table
507	my $add = $self->get_table_address('OS/2');
508	my $buf;
509	#print $add, "\n";
510
511	# Ascent is is sTypoAscender in OS/2 table
512	seek($fh, $add, 0);
513	read($fh, $buf, 70) == 70 \|\| die "reading OS/2 table";
514	my ($ascent) = unpack("x68n", $buf);
515	#print join(" ",@panose), "\n";
516	#print $ascent, "\n";
517	return $ascent - ($ascent > 32768 ? 65536 : 0);
518	}
519
520	sub get_descent {
521	my $self = shift;
522	if (defined($self->{descent})){
523	return $self->{descent};
524	} else {
525	$self->_parse_os2();
526	#$self->{descent} = $self->_get_descent();
527	return $self->{descent};
528	}
529	}
530
531	sub _parse_os2 {
532	my $self = shift;
533	my $fh = $self->get_file_handle();
534	my $add = $self->get_table_address('OS/2');
535	my $buf;
536
537	seek($fh, $add, 0);
538	read($fh, $buf, 74) == 74 \|\| die "reading OS/2 table";
539	my ($ascent, $descent, $leading) =
540	unpack("x68nnn", $buf);
541	$self->{ascent} = $ascent - ($ascent > 32768 ? 65536 : 0);
542	$self->{descent} = $descent - ($descent > 32768 ? 65536 :0);
543	$self->{leading} = $leading - ($leading > 32768 ? 65536 :0);
544	}
545	sub get_font_family {
546	my $self = shift;
547	if ( defined($self->{family}) ){
548	return $self->{family};
549	} else {
550	$self->_parse_name_table();
551	}
552	return $self->{family};
553	}
554
555	sub get_subfamily {
556	my $self = shift;
557	if ( defined( $self->{subfamily})){
558	return $self->{subfamily};
559	} else {
560	$self->_parse_name_table();
561	}
562	return $self->{subfamily};
563	}
564
565	sub _parse_name_table {
566
567	my $self = shift;
568	my $buf;
569	my $fh = $self->get_file_handle();
570
571	my $LANGUAGE_ID;
572
573	if ( $PLATFORM_ID =="1" && $ENCODING_ID =="0"){
574	$LANGUAGE_ID = 0;
575	}
576	else {
577	$LANGUAGE_ID = 1033;
578	}
579	my $add = $self->get_table_address("name");
580	seek ($fh, $add, 0);
581	read($fh, $buf, 6);
582	my ( $num , $offset) = unpack ("x2nn", $buf);
583	#print "*******NAME : Number of records, $num, Offset: $offset\n";
584
585	my ($copyright_offset, $font_family_name_offset,
586	$subfamily_offset, $id_offset,$full_name_offset,
587	$version_string_offset, $postscript_offset, $trademark_offset);
588
589	my ($copyright_length, $font_family_length,
590	$subfamily_length, $id_length, $full_name_length,
591	$version_length, $postscript_length, $trademark_length);
592
593	for (my $i = 0; $i < $num; $i++){
594	read ($fh, $buf, 12);
595	my ($id, $encoding, $language, $name_id, $length, $string_offset)
596	= unpack("n6", $buf);
597	#print "****NAMERECORDS: $id, $encoding, $language, $name_id, $length, $string_offset\n";
598
599	if ( ($id == $PLATFORM_ID)&& # Windows??
600	($encoding == $ENCODING_ID) && #UGL??
601	($language == $LANGUAGE_ID)
602	) {
603	if ($name_id == 0 ) { #Copyright
604	$copyright_offset = $string_offset;
605	$copyright_length = $length;
606	}
607	if ($name_id == 1 ) { # Familyname
608	$font_family_name_offset = $string_offset;
609	$font_family_length = $length;
610	}
611	if ($name_id == 2 ) { # Subfamily
612	$subfamily_offset = $string_offset;
613	$subfamily_length = $length;
614	}
615	if ($name_id == 3 ) { # Identifier
616	$id_offset = $string_offset;
617	$id_length = $length;
618	}
619	if ($name_id == 4 ) { # Full name
620	$full_name_offset = $string_offset;
621	$full_name_length = $length;
622	}
623	if ($name_id == 5 ) { #version string
624	$version_string_offset = $string_offset;
625	$version_length = $length;
626	}
627	if ( $name_id == 6) { # Postscript name
628	$postscript_offset = $string_offset;
629	$postscript_length = $length;
630	}
631	if ($name_id == 7 ) { # Trademark
632	$trademark_offset = $string_offset;
633	$trademark_length = $length;
634	}
635	}
636
637	} # End for loop;
638
639	# Print copyright
640	seek ( $fh, $self->get_table_address("name") + $offset + $copyright_offset, 0);
641	read ($fh, $buf, $copyright_length);
642	# print "COPYRIGHT: $buf\n\n";
643
644	# Print familyname
645	seek ($fh, $self->get_table_address("name") + $offset + $font_family_name_offset, 0 );
646	read ( $fh, $buf, $font_family_length);
647
648
649	#print $s;
650	$self->{family}= $self->_remove_white_space($buf, $font_family_length);
651	#print "\n**", "@char", "***\n";
652	#return "@char";
653	# print "FAMILY: $buf\n\n";
654
655	#Print Subfamily
656	seek ($fh, $self->get_table_address('name') + $offset + $subfamily_offset, 0);
657	read ($fh, $buf, $subfamily_length);
658	#print "SUBFAMILY: $buf\n\n";
659	$self->{subfamily} = $self->_remove_white_space($buf, $subfamily_length);
660
661	#Print Identifier
662	seek ( $fh, $self->get_table_address('name') + $offset +$id_offset, 0);
663	read ($fh, $buf, $id_length);
664	#print "ID: $buf\n\n";
665
666	#Print Full name
667	seek ( $fh, $self->get_table_address('name') + $offset +$full_name_offset, 0);
668	read ($fh, $buf, $full_name_length);
669	#print "FULL NAME: $buf\n\n";
670
671	#Print Version string
672	seek ( $fh, $self->get_table_address('name') + $offset +$version_string_offset, 0);
673	read ($fh, $buf, $version_length);
674	#print "VERSION: $buf\n\n";
675
676
677	#Print Postscript
678	seek ( $fh, $self->get_table_address('name') + $offset +$postscript_offset, 0);
679	read ($fh, $buf, $postscript_length);
680	#print "Postscript: $buf\n\n";
681
682	#Print Trademark
683	seek ( $fh, $self->get_table_address('name') + $offset +$trademark_offset, 0);
684	read ($fh, $buf, $trademark_length);
685	#print "TRADEMARK: $buf\n\n";
686
687
688	}
689
690	sub _remove_white_space {
691	my $self = shift;
692	my $buf = shift;
693	my $font_family_length = shift;
694	my @char = unpack("C*",$buf);
695	my $i = $font_family_length;
696	my $s = "";
697	my $j = 0;
698	while ( $j < $i){
699	if (defined $char[$j+1]){
700	$s .= pack("C",$char[$j+1]);}
701	$j += 2;
702	}
703	return $s;
704	}
705	1;