1package Prima::PS::Type1;
2
3use strict;
4use warnings;
5use Prima::PS::Glyphs;
6use Prima::PS::TempFile;
7use Prima::PS::Unicode;
8use Prima::Utils;
9use base qw(Prima::PS::Glyphs);
10
11sub create_font_entry
12{
13	my ( $self, $key, $font ) = @_;
14
15	my %h;
16	$h{isFixedPitch} = ($font->{pitch} == fp::Fixed) ? 'true'      : 'false';
17	$h{Weight}       = ($font->{style} & fs::Bold)   ? '(Regular)' : '(Bold)';
18	$h{ItalicAngle}  = ($font->{style} & fs::Italic) ? '-10'       : '0';
19
20	return {
21		glyphs   => '',
22		chars    => '',
23		header   => \%h,
24		bbox     => [ undef, undef, undef, undef ],
25		scale    => ($font->{height} - $font->{internalLeading}) / $font->{size},
26	};
27}
28
29my $C1       = 52845;
30my $C2       = 22719;
31my $ENCRYPT1 = 55665;
32my $ENCRYPT2 =  4330;
33my @HEX      = ('0'..'9','a'..'f');
34
35sub encrypt1
36{
37	my ( $R, $str ) = @_;
38	my $ret = '';
39	my $n = 0;
40	for ( map { ord } split //, $str ) {
41		$n++;
42		my $c = $_ ^ ( $$R >> 8 );
43		$$R = (($c + $$R) * $C1 + $C2) & 0xffff;
44		$ret .= $HEX[$c >> 4];
45		$ret .= $HEX[$c & 0xf];
46		$ret .= "\n" unless $n % 32;
47	}
48	return $ret . "\n";
49}
50
51sub encrypt2
52{
53	my $str = shift;
54	my $R   = $ENCRYPT2;
55	my $ret = '';
56	for ( 0,0,0,0, map { ord } split //, $str ) {
57		my $c = $_ ^ ( $R >> 8 );
58		$R = (($c + $R) * $C1 + $C2) & 0xffff;
59		$ret .= chr($c);
60	}
61	return $ret;
62}
63
64sub embed($)
65{
66	my $code = shift;
67	return (4 + length($code)) . ' -| ' . encrypt2($code) . " |\n";
68}
69
70sub embed2($)
71{
72	my $code = shift;
73	return (4 + length($code)) . ' -| ' . encrypt2($code) . " |-\n";
74}
75
76use constant endchar         => "\x{e}";
77use constant xpop            => "\x{c}\x{11}";
78use constant xreturn         => "\x{b}";
79use constant setcurrentpoint => "\x{c}\x{21}";
80use constant callothersubr   => "\x{c}\x{10}";
81use constant callsubr        => "\x{a}";
82
83sub evacuate
84{
85	my ( $self, $emit ) = @_;
86	for my $fn ( sort keys %{ $self->{fonts} }) {
87		my $v = $self->{fonts}->{$fn};
88		next unless $v->{tmpfile};
89
90		my $h = $v->{header};
91
92		$emit->(<<FONT_HDR);
93%%BeginResource: font $fn
9412 dict dup begin
95/FontType 1 def
96/FontName /$fn def
97/FullName ($fn) def
98/FontInfo 13 dict dup begin
99/UnderlinePosition -100 def
100/UnderlineThickness 50 def
101FONT_HDR
102		$emit->("/$_ $h->{$_} def\n") for sort keys %$h;
103		my @bbox = map { Prima::Utils::floor(($_ // 0) + .5) } @{ $v->{bbox} };
104		$emit->(<<FONT_HDR2);
105end def
106/FontBBox {@bbox} def
107/PaintType 0 def
108/FontMatrix [0.001 0 0 0.001 0 0] def
109/Encoding StandardEncoding def
110end
111currentfile eexec
112FONT_HDR2
113
114		my $R = $ENCRYPT1;
115		$emit->(encrypt1(\$R, <<GLYPHS_HDR));
116\0\0\0\0 dup /Private
11713 dict dup begin
118/-| {string currentfile exch readstring pop} def
119/|- {def} def
120/| {put} def
121/BlueValues [$bbox[1] 0] def
122/password 5839 def
123/MinFeature {16 16} def
124/OtherSubrs[{}{}{}{systemdict/internaldict known not{pop 3}{1183615869
125systemdict/internaldict get exec dup/startlock known{/startlock get exec}{dup
126/strtlck known{/strtlck get exec}{pop 3}ifelse}ifelse}ifelse}executeonly]def
127/Subrs 5 array
128GLYPHS_HDR
129		my $subrs =
130			"dup 0 " . embed(num(3,0) . callothersubr . xpop . xpop . setcurrentpoint . xreturn ) .
131			"dup 1 " . embed(num(0,1) . callothersubr . xreturn ) .
132			"dup 2 " . embed(num(0,2) . callothersubr . xreturn ) .
133			"dup 3 " . embed( xreturn ) .
134			"dup 4 " . embed(num(3,1,3) . callothersubr . xpop . callsubr . xreturn ) .
135			"def put dup /CharStrings 257 dict dup begin" .
136			"/.notdef " . embed2( Prima::PS::Glyphs::hsbw(0,0) . endchar )
137			;
138		$emit->(encrypt1(\$R, $subrs));
139		return 0 unless $v->{tmpfile}->evacuate(sub { $emit->(encrypt1(\$R, $_[0])) });
140		$emit->(encrypt1(\$R, <<GLYPHS_FOOTER));
141end put
142end
143dup /FontName get exch definefont pop
144mark
145currentfile closefile
146GLYPHS_FOOTER
147		$emit->(("0" x 64) . "\n") for 1..8;
148		$emit->(<<RESOURCE_END) or return 0;
149cleartomark
150%%EndResource
151
152RESOURCE_END
153	}
154
155	return 1;
156}
157
158sub use_char
159{
160	my ( $self, $canvas, $key, $charid, $suggested_gid) = @_;
161	my $f = $self->{fonts}->{$key} // return;
162
163	my $glyphid;
164	my $vector = 'glyphs';
165	if ( defined($suggested_gid)) {
166		if ( exists $f->{$suggested_gid} ) {
167			goto STD if $f->{$suggested_gid} != $charid;
168		} else {
169			goto STD unless exists $Prima::PS::Unicode->{ $suggested_gid };
170			$f->{$suggested_gid} = $charid;
171		}
172		$glyphid = $Prima::PS::Unicode->{ $suggested_gid };
173		$vector = 'chars';
174	} else {
175	STD:
176		$glyphid = sprintf("g%x", $charid);
177	}
178	return $glyphid if vec($f->{$vector}, $charid, 1);
179
180	vec($f->{$vector}, $charid, 1) = 1;
181	$f->{tmpfile} //= Prima::PS::TempFile->new;
182	my ($code) = $self->get_outline( $canvas, $key, $charid, 1 );
183	$f->{tmpfile}->write("/$glyphid " .embed2($code)) if defined $code;
184
185	return $glyphid;
186}
187
1881;
189
190=pod
191
192=head1 NAME
193
194Prima::PS::Type1 - create Type1 font files
195
196=head1 DESCRIPTION
197
198This module contains helper procedures to store Type1 fonts.
199
200=cut
201