<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Font::TTF::GrFeat;

=head1 NAME

Font::TTF::GrFeat - Graphite Font Features

=head1 DESCRIPTION

=head1 INSTANCE VARIABLES

=over 4

=item version

=item features

An array of hashes of the following form

=over 8

=item feature

feature id number

=item name

name index in name table

=item exclusive

exclusive flag

=item default

the default setting number

=item settings

hash of setting number against name string index

=back

=back

=head1 METHODS

=cut

use strict;
use vars qw(@ISA);

use Font::TTF::Utils;

require Font::TTF::Table;

@ISA = qw(Font::TTF::Table);

=head2 $t-&gt;read

Reads the features from the TTF file into memory

=cut

sub read
{
	my ($self) = @_;
	my ($featureCount, $features);

	return $self if $self-&gt;{' read'};
	$self-&gt;SUPER::read_dat or return $self;

	($self-&gt;{'version'}, $featureCount) = TTF_Unpack("vS", $self-&gt;{' dat'});

	$features = [];
	foreach (1 .. $featureCount) {
		my ($feature, $nSettings, $settingTable, $featureFlags, $nameIndex, $reserved);
		if ($self-&gt;{'version'} == 1)
		{
			($feature, $nSettings, $settingTable, $featureFlags, $nameIndex)
				= TTF_Unpack("SSLSS", substr($self-&gt;{' dat'}, $_ * 12, 12));
			#The version 1 Feat table ends with a feature (id 1) named NoName
			#with zero settings but with an offset to the last entry in the setting
			#array. This last setting has id 0 and an invalid name id. This last
			#feature is changed to have one setting.
			if ($_ == $featureCount &amp;&amp; $nSettings == 0) {$nSettings = 1;}
		}
		else #version == 2
			{($feature, $nSettings, $reserved, $settingTable, $featureFlags, $nameIndex)
				= TTF_Unpack("LSSLSS", substr($self-&gt;{' dat'}, 12 + ($_ - 1) * 16, 16))};
		my $feature = 
			{
				'feature'	=&gt; $feature,
				'name'		=&gt; $nameIndex,
			};
			
		#interpret the featureFlags &amp; store settings
		$feature-&gt;{'exclusive'} = (($featureFlags &amp; 0x8000) != 0);
		
		my @settings = TTF_Unpack("S*", substr($self-&gt;{' dat'}, $settingTable, $nSettings * 4));
		if ($featureFlags &amp; 0x4000)
			{$feature-&gt;{'default'} = $featureFlags &amp; 0x00FF;}
		else
			{$feature-&gt;{'default'} = @settings[0];}
		$feature-&gt;{'settings'} = {@settings};
		
		push(@$features, $feature);
	}
	
	$self-&gt;{'features'} = $features;
	
	delete $self-&gt;{' dat'}; # no longer needed, and may become obsolete
	$self-&gt;{' read'} = 1;
	$self;
}

=head2 $t-&gt;out($fh)

Writes the features to a TTF file

=cut

sub out
{
	my ($self, $fh) = @_;
	my ($features, $numFeatures, $settings, $featureFlags, $featuresData, $settingsData);
	
	return $self-&gt;SUPER::out($fh) unless $self-&gt;{' read'};

	$features = $self-&gt;{'features'};
	$numFeatures = @$features;
	$featuresData, $settingsData = ('', '');

	foreach (@$features) {
		$settings = $_-&gt;{'settings'};
		$featureFlags = ($_-&gt;{'exclusive'} ? 0x8000 : 0x0000);
		
#		output default setting first instead of using the featureFlags (as done below)
#		$featureFlags = ($_-&gt;{'exclusive'} ? 0x8000 : 0x0000) |
#								($_-&gt;{'default'} != 0 ? 0x4000 | ($_-&gt;{'default'} &amp; 0x00FF) 
#														: 0x0000);
		if ($self-&gt;{'version'} == 1)
		{
			$featuresData .= TTF_Pack("SSLSS",
										$_-&gt;{'feature'},
										scalar keys %$settings,
										12 + 12 * $numFeatures + length $settingsData,
										$featureFlags, 
										$_-&gt;{'name'});
		}
		else #version == 2
		{
			$featuresData .= TTF_Pack("LSSLSS",
										$_-&gt;{'feature'},
										scalar keys %$settings,
										0, 
										12 + 16 * $numFeatures + length $settingsData,
										$featureFlags, 
										$_-&gt;{'name'});
		}
		
		#output default setting first
		#the settings may not be in their original order
		my $defaultSetting = $_-&gt;{'default'};
		$settingsData .= TTF_Pack("SS", $defaultSetting, $settings-&gt;{$defaultSetting});
		foreach (sort {$a &lt;=&gt; $b} keys %$settings) {
			if ($_ == $defaultSetting) {next;} #skip default setting
			$settingsData .= TTF_Pack("SS", $_, $settings-&gt;{$_});
		}
	}

	$fh-&gt;print(TTF_Pack("vSSL", $self-&gt;{'version'}, $numFeatures, 0, 0));
	$fh-&gt;print($featuresData);
	$fh-&gt;print($settingsData);

	$self;
}

=head2 $t-&gt;print($fh)

Prints a human-readable representation of the table

=cut

sub print
{
	my ($self, $fh) = @_;
	my ($names, $features, $settings);

	$self-&gt;read;

	$names = $self-&gt;{' PARENT'}-&gt;{'name'};
	$names-&gt;read;

	$fh = 'STDOUT' unless defined $fh;

	$features = $self-&gt;{'features'};
	foreach (@$features) {
		$fh-&gt;printf("Feature %d, %s, default: %d name %d # '%s'\n",
					$_-&gt;{'feature'},
					($_-&gt;{'exclusive'} ? "exclusive" : "additive"),
					$_-&gt;{'default'}, 
					$_-&gt;{'name'},
					$names-&gt;{'strings'}[$_-&gt;{'name'}][3][1]{1033});
		$settings = $_-&gt;{'settings'};
		foreach (sort { $a &lt;=&gt; $b } keys %$settings) {
			$fh-&gt;printf("\tSetting %d, name %d # '%s'\n",
						$_, $settings-&gt;{$_}, $names-&gt;{'strings'}[$settings-&gt;{$_}][3][1]{1033});
		}
	}
	
	$self;
}

sub settingName
{
	my ($self, $feature, $setting) = @_;

	$self-&gt;read;

	my $names = $self-&gt;{' PARENT'}-&gt;{'name'};
	$names-&gt;read;
	
	my $features = $self-&gt;{'features'};
	my ($featureEntry) = grep { $_-&gt;{'feature'} == $feature } @$features;
	my $featureName = $names-&gt;{'strings'}[$featureEntry-&gt;{'name'}][3][1]{1033};
	my $settingName = $featureEntry-&gt;{'exclusive'}
			? $names-&gt;{'strings'}[$featureEntry-&gt;{'settings'}-&gt;{$setting}][3][1]{1033}
			: $names-&gt;{'strings'}[$featureEntry-&gt;{'settings'}-&gt;{$setting &amp; ~1}][3][1]{1033}
				. (($setting &amp; 1) == 0 ? " On" : " Off");

	($featureName, $settingName);
}

1;

=head1 BUGS

The version 1 Feat table ends with a feature (id 1) named NoName
with zero settings but with an offset to the last entry in the setting
array. This last setting has id 0 and an invalid name id. This last
feature is changed to have one setting.

=head1 AUTHOR

Alan Ward (derived from Jonathan Kew's Feat.pm).
See L&lt;Font::TTF::Font&gt; for copyright and licensing.

=cut

</pre></body></html>