package Prima::PS::Type1;

use strict;
use warnings;
use Prima::PS::Glyphs;
use Prima::PS::TempFile;
use Prima::PS::Unicode;
use Prima::Utils;
use base qw(Prima::PS::Glyphs);

sub create_font_entry
{
	my ( $self, $key, $font ) = @_;

	my %h;
	$h{isFixedPitch} = ($font->{pitch} == fp::Fixed) ? 'true'      : 'false';
	$h{Weight}       = ($font->{style} & fs::Bold)   ? '(Regular)' : '(Bold)';
	$h{ItalicAngle}  = ($font->{style} & fs::Italic) ? '-10'       : '0';

	return {
		glyphs   => '',
		chars    => '',
		header   => \%h,
		bbox     => [ undef, undef, undef, undef ],
		scale    => ($font->{height} - $font->{internalLeading}) / $font->{size},
	};
}

sub int32($)
{
	my ( $self, $n ) = @_;
	$n = Prima::Utils::nearest_i( $n );
	if (-107 <= $n && $n <= 107) {
		return chr($n + 139);
	} elsif (108 <= $n && $n <= 1131) {
		$n -= 108;
		return chr(($n >> 8) + 247).chr($n & 0xff);
	} elsif (-1131 <= $n && $n <= -108) {
		$n = -$n - 108;
		return chr(($n >> 8) + 251).chr($n & 0xff);
	} else {
		return pack('CN', 255, $n);
	}
}


my $C1       = 52845;
my $C2       = 22719;
my $ENCRYPT1 = 55665;
my $ENCRYPT2 =  4330;
my @HEX      = ('0'..'9','a'..'f');

sub encrypt1
{
	my ( $R, $str ) = @_;
	my $ret = '';
	my $n = 0;
	for ( map { ord } split //, $str ) {
		$n++;
		my $c = $_ ^ ( $$R >> 8 );
		$$R = (($c + $$R) * $C1 + $C2) & 0xffff;
		$ret .= $HEX[$c >> 4];
		$ret .= $HEX[$c & 0xf];
		$ret .= "\n" unless $n % 32;
	}
	return $ret . "\n";
}

sub encrypt2
{
	my $str = shift;
	my $R   = $ENCRYPT2;
	my $ret = '';
	for ( 0,0,0,0, map { ord } split //, $str ) {
		my $c = $_ ^ ( $R >> 8 );
		$R = (($c + $R) * $C1 + $C2) & 0xffff;
		$ret .= chr($c);
	}
	return $ret;
}

sub embed($)
{
	my $code = shift;
	return (4 + length($code)) . ' -| ' . encrypt2($code) . " |\n";
}

sub embed2($)
{
	my $code = shift;
	return (4 + length($code)) . ' -| ' . encrypt2($code) . " |-\n";
}

use constant endchar         => "\x{e}";
use constant xpop            => "\x{c}\x{11}";
use constant xreturn         => "\x{b}";
use constant setcurrentpoint => "\x{c}\x{21}";
use constant callothersubr   => "\x{c}\x{10}";
use constant callsubr        => "\x{a}";

sub evacuate
{
	my ( $self, $emit ) = @_;
	for my $fn ( sort keys %{ $self->{fonts} }) {
		my $v = $self->{fonts}->{$fn};
		next unless $v->{tmpfile};

		my $h = $v->{header};

		$emit->(<<FONT_HDR);
%%BeginResource: font $fn
12 dict dup begin
/FontType 1 def
/FontName /$fn def
/FullName ($fn) def
/FontInfo 13 dict dup begin
/UnderlinePosition -100 def
/UnderlineThickness 50 def
FONT_HDR
		$emit->("/$_ $h->{$_} def\n") for sort keys %$h;
		my @bbox = Prima::Utils::nearest_i( map {$_ // 0} @{ $v->{bbox} } );
		$emit->(<<FONT_HDR2);
end def
/FontBBox {@bbox} def
/PaintType 0 def
/FontMatrix [0.001 0 0 0.001 0 0] def
/Encoding StandardEncoding def
end
currentfile eexec
FONT_HDR2

		my $R = $ENCRYPT1;
		$emit->(encrypt1(\$R, <<GLYPHS_HDR));
\0\0\0\0 dup /Private
13 dict dup begin
/-| {string currentfile exch readstring pop} def
/|- {def} def
/| {put} def
/BlueValues [$bbox[1] 0] def
/password 5839 def
/MinFeature {16 16} def
/OtherSubrs[{}{}{}{systemdict/internaldict known not{pop 3}{1183615869
systemdict/internaldict get exec dup/startlock known{/startlock get exec}{dup
/strtlck known{/strtlck get exec}{pop 3}ifelse}ifelse}ifelse}executeonly]def
/Subrs 5 array
GLYPHS_HDR
		my $subrs =
			"dup 0 " . embed($self->num(3,0) . callothersubr . xpop . xpop . setcurrentpoint . xreturn ) .
			"dup 1 " . embed($self->num(0,1) . callothersubr . xreturn ) .
			"dup 2 " . embed($self->num(0,2) . callothersubr . xreturn ) .
			"dup 3 " . embed( xreturn ) .
			"dup 4 " . embed($self->num(3,1,3) . callothersubr . xpop . callsubr . xreturn ) .
			"def put dup /CharStrings 257 dict dup begin" .
			"/.notdef " . embed2( $self->hsbw(0,0) . endchar )
			;
		$emit->(encrypt1(\$R, $subrs));
		return 0 unless $v->{tmpfile}->evacuate(sub { $emit->(encrypt1(\$R, $_[0])) });
		$emit->(encrypt1(\$R, <<GLYPHS_FOOTER));
end put
end
dup /FontName get exch definefont pop
mark
currentfile closefile
GLYPHS_FOOTER
		$emit->(("0" x 64) . "\n") for 1..8;
		$emit->(<<RESOURCE_END) or return 0;
cleartomark
%%EndResource

RESOURCE_END
	}

	return 1;
}

sub use_char
{
	my ( $self, $canvas, $key, $charid, $suggested_gid) = @_;
	my $f = $self->{fonts}->{$key} // return;

	my $glyphid;
	my $vector = 'glyphs';
	if ( defined($suggested_gid)) {
		if ( exists $f->{$suggested_gid} ) {
			goto STD if $f->{$suggested_gid} != $charid;
		} else {
			goto STD unless exists $Prima::PS::Unicode->{ $suggested_gid };
			$f->{$suggested_gid} = $charid;
		}
		$glyphid = $Prima::PS::Unicode->{ $suggested_gid };
		$vector = 'chars';
	} else {
	STD:
		$glyphid = sprintf("g%x", $charid);
	}
	return $glyphid if vec($f->{$vector}, $charid, 1);

	vec($f->{$vector}, $charid, 1) = 1;
	$f->{tmpfile} //= Prima::PS::TempFile->new;
	my ($code) = $self->get_outline( $canvas, $key, $charid, 1 );
	$f->{tmpfile}->write("/$glyphid " .embed2($code)) if defined $code;

	return $glyphid;
}

1;

=pod

=head1 NAME

Prima::PS::Type1 - create Type1 font files

=head1 DESCRIPTION

This module contains helper procedures to store Type1 fonts.

=cut
