The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Prima::PS::Encodings;
use vars qw(%files %fontspecific %cache);

use strict;
use warnings;
use Prima::Utils;

%files = (
	'default'    => 'PS/locale/ascii',
	'1276'       => 'PS/locale/ps-standart',
	'ps-standart'=> 'PS/locale/ps-standart',
	'1277'       => 'PS/locale/ps-iso-latin1',
	'ps-latin1'  => 'PS/locale/ps-iso-latin1',
	'Latin1'     => 'PS/locale/ps-iso-latin1',
	'Western'    => 'PS/locale/ps-iso-latin1',
	'iso8859-1'  => 'PS/locale/iso8859-1',
	'iso8859-2'  => 'PS/locale/iso8859-2',
	'iso8859-3'  => 'PS/locale/iso8859-3',
	'iso8859-4'  => 'PS/locale/iso8859-4',
	'iso8859-7'  => 'PS/locale/iso8859-7',
	'iso8859-9'  => 'PS/locale/iso8859-9',
	'iso8859-10' => 'PS/locale/iso8859-10',
	'iso8859-11' => 'PS/locale/iso8859-11',
	'iso8859-13' => 'PS/locale/iso8859-13',
	'iso8859-14' => 'PS/locale/iso8859-14',
	'iso8859-15' => 'PS/locale/iso8859-15',
	'ibm-437'    => 'PS/locale/ibm-cp437',
	'437'        => 'PS/locale/ibm-cp437',
	'ibm-850'    => 'PS/locale/ibm-cp850',
	'850'        => 'PS/locale/ibm-cp850',
	'win-1250'   => 'PS/locale/win-cp1250',
	'1250'       => 'PS/locale/win-cp1250',
	'win-1252'   => 'PS/locale/win-cp1252',
	'1252'       => 'PS/locale/win-cp1252',
);

%fontspecific = (
	'Specific' => 1,
);

sub exists
{
	my $cp = defined( $_[0]) ? ( lc $_[0]) : 'default';
	$cp = $1 if $cp =~ /\.([^\.]*)$/;
	$cp =~ s/_//g;
	return exists($files{$cp});
}

sub unique
{
	my %h;
	my @ret;
	for (sort keys %files) {
		next if m/^\d+$/ || $h{$files{$_}};
		$h{$files{$_}} = 1;
		push @ret, $_;
	}
	return @ret;
}

sub load
{
	my $cp = defined( $_[0]) ? $_[0] : 'default';
	$cp = $1 if $cp =~ /\.([^\.]*)$/;
	$cp =~ s/_//g;

	if ( $cp eq 'null') {
		return $cache{null} if exists $cache{null};
		return $cache{null} = [('.notdef') x 256];
	}

	my $fx = exists($files{$cp}) ? $files{$cp} : $files{default};

	return $cache{$fx} if exists $cache{$fx};

	my $f = Prima::Utils::find_image( $fx); 
	unless ( $f) {
		warn("Prima::PS::Encodings: cannot find encoding file for $cp\n");
		return load('default') unless $cp eq 'default';
		return;
	}

	unless ( open F, $f) {
		warn("Prima::PS::Encodings: cannot load $f\n");
		return load('default') unless $cp eq 'default';
		return;
	}
	my @f = map { chomp; length($_) ? $_ : ()} <F>;
	close F;
	splice( @f, 256) if 256 < @f;
	push( @f, '.notdef') while 256 > @f;
	return $cache{$fx} = \@f;
}

__END__

=pod

=head1 NAME

Prima::PS::Encodings -  manage latin-based encodings

=head1 SYNOPSIS

	use Prima::PS::Encodings;

=head1 DESCRIPTION

This module provides code tables for major latin-based encodings, for 
the glyphs that usually provided by every PS-based printer or interpreter.
Prima::PS::Drawable uses these encodings when it decides whether the document
have to be supplied with a bitmap character glyph or a character index, 
thus relying on PS interpreter capabilities. Latter is obviously preferable,
but as it's not possible to know beforehand what glyphs are supported by
PS interpreter, the Latin glyph set was selected as a ground level.

=over

=item exists $encoding

Returns whether C<$encoding> exists in the list of internal list of recognized names

=item files

It's unlikely that users will need to supply their own encodings, however
this can be accomplished by:

	use Prima::PS::Encodings;
	$Prima::PS::Encodings::files{iso8859-5} = 'PS/locale/greek-iso';

=item fontspecific

The only non-latin encoding currently present is 'Specific'.
If any other specific-encoded fonts are to be added,
the encoding string must be added as a key to %fontspecific

=item load

Loads encoding file by given string. Tries to be smart to guess
actual file from identifier string returned from setlocale(NULL).
If fails, loads default encoding, which defines only glyphs from
32 to 126. Special case is 'null' encoding, returns array of
256 .notdef's.

=item unique

Returns list of Latin-based encoding string unique keys.

=back

=cut