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