358 lines
9.6 KiB
PostScript
358 lines
9.6 KiB
PostScript
% Copyright (C) 1999 Aladdin Enterprises. All rights reserved.
|
|
%
|
|
% This software is provided AS-IS with no warranty, either express or
|
|
% implied.
|
|
%
|
|
% This software is distributed under license and may not be copied,
|
|
% modified or distributed except as expressly authorized under the terms
|
|
% of the license contained in the file LICENSE in this distribution.
|
|
%
|
|
% For more information about licensing, please refer to
|
|
% http://www.ghostscript.com/licensing/. For information on
|
|
% commercial licensing, go to http://www.artifex.com/licensing/ or
|
|
% contact Artifex Software, Inc., 101 Lucas Valley Road #110,
|
|
% San Rafael, CA 94903, U.S.A., +1(415)492-9861.
|
|
|
|
% $Id: addxchar.ps,v 1.4 2002/02/21 21:49:28 giles Exp $
|
|
% Add the Central European and other Adobe extended Latin characters to a
|
|
% Type 1 font.
|
|
% Requires -dWRITESYSTEMDICT to disable access protection.
|
|
|
|
(type1ops.ps) runlibfile
|
|
|
|
% ---------------- Utilities ---------------- %
|
|
|
|
/addce_dict 50 dict def
|
|
addce_dict begin
|
|
|
|
% Define the added copyright notice.
|
|
/addednotice (. Portions Copyright (C) 1999 Aladdin Enterprises.) def
|
|
|
|
% Open a font for modification by removing the FID and changing the
|
|
% FontName. Removing UniqueID and XUID is not necessary, since we
|
|
% will only be adding characters.
|
|
/openfont { % <name> <font> openfont <name> <font'>
|
|
dup length dict copy
|
|
dup /FID undef
|
|
dup /FontName 3 index put
|
|
} def
|
|
|
|
% Do the equivalent of false charpath for a glyph.
|
|
% This should really be an operator!
|
|
/glyphpath { % <glyph> glyphpath -
|
|
currentfont /Encoding get 0 3 -1 roll put
|
|
<00> false charpath
|
|
} def
|
|
|
|
% Do the equivalent of charpath + pathbbox for a glyph.
|
|
/glyphbbox { % <glyph> glyphbbox <llx> <lly> <urx> <ury>
|
|
% We cache this value, because it's expensive to compute.
|
|
BBoxes 1 index .knownget {
|
|
exch pop
|
|
} {
|
|
gsave newpath 0 0 moveto dup glyphpath [pathbbox] grestore
|
|
BBoxes 3 -1 roll 2 index put
|
|
} ifelse aload pop
|
|
} def
|
|
|
|
% Get the side bearing and width for a glyph.
|
|
/glyphsbw { % <glyph> glyphsbw <lsbx> <wx>
|
|
% We cache this value, because it's expensive to compute.
|
|
SBW 1 index .knownget {
|
|
exch pop
|
|
} {
|
|
dup glyphcs { dup /hsbw eq { pop exit } if } forall
|
|
2 array astore
|
|
SBW 3 -1 roll 2 index put
|
|
} ifelse aload pop
|
|
} def
|
|
|
|
% Get the CharString for a glyph, as an array.
|
|
/glyphcs { % <glyph> glyphcs <array>
|
|
CharStrings exch get
|
|
4330 exch dup length string .type1decrypt exch pop
|
|
dup length lenIV sub lenIV exch getinterval
|
|
0 () /SubFileDecode filter [ exch charstack_read ]
|
|
} def
|
|
|
|
% Find an occurrence of a value in an array.
|
|
/asearch { % <array> <value> asearch <index> true
|
|
% <array> <value> asearch false
|
|
false 0 4 2 roll exch {
|
|
% Stack: false index value element
|
|
2 copy eq { pop pop exch not exch dup exit } if
|
|
exch 1 add exch
|
|
} forall pop pop
|
|
} def
|
|
|
|
% Convert an array back to a CharString.
|
|
/csdef { % <glyph> <array> csdef -
|
|
charproc_string
|
|
4330 exch dup .type1encrypt exch pop readonly
|
|
CharStrings 3 1 roll put
|
|
} def
|
|
|
|
% Split an accented character name.
|
|
/splitaccented { % <Baccent> splitaccented <Baccent> <B> <accent>
|
|
dup =string cvs
|
|
dup 0 1 getinterval cvn
|
|
exch dup length 1 sub 1 exch getinterval cvn
|
|
} def
|
|
|
|
% Begin the definition of a 'seac' character.
|
|
% Defines accent, base, abox, bbox.
|
|
% The initial dx lines up the origins of the base and the accent.
|
|
/beginseac { % <bchar> <achar> beginseac
|
|
% -mark- <lsbx> <wx> /hsbw <asb> <dx>
|
|
/accent exch def /base exch def
|
|
/abox [accent glyphbbox] def
|
|
/bbox [base glyphbbox] def
|
|
[ base glyphsbw /hsbw accent glyphsbw pop
|
|
dup 4 index sub
|
|
} def
|
|
|
|
% Center the accent over the base of a 'seac' character.
|
|
/centeraccent { % <dx> centeraccent <adx>
|
|
bbox 2 get bbox 0 get add 2 div
|
|
abox 2 get abox 0 get add 2 div
|
|
sub add
|
|
} def
|
|
|
|
% Finish the definition of a 'seac' character.
|
|
/finishseac { % <charname> -mark- ... <adx> <ady> finishseac -
|
|
exch cvi exch cvi
|
|
charindex base get charindex accent get /seac ] csdef
|
|
} def
|
|
|
|
% ---------------- Main program ---------------- %
|
|
|
|
% Define accented characters that can be made with seac,
|
|
% with the accent centered over the character.
|
|
/seacchars [
|
|
/Abreve /Amacron
|
|
/Cacute /Ccaron /Dcaron
|
|
/Ecaron /Edotaccent /Emacron
|
|
/Gbreve
|
|
/Idotaccent /Imacron
|
|
/Lacute
|
|
/Nacute /Ncaron
|
|
/Ohungarumlaut /Omacron
|
|
/Racute /Rcaron
|
|
/Sacute /Scedilla
|
|
/Tcaron
|
|
/Uhungarumlaut /Umacron /Uogonek /Uring
|
|
/Zacute /Zdotaccent
|
|
/abreve /amacron
|
|
/cacute /ccaron
|
|
/ecaron /edotaccent /emacron
|
|
/gbreve
|
|
/lacute
|
|
/nacute /ncaron
|
|
/ohungarumlaut /omacron
|
|
/racute /rcaron
|
|
/sacute /scedilla
|
|
/uhungarumlaut /umacron /uring
|
|
/zacute /zdotaccent
|
|
] def
|
|
|
|
% Define seac characters where the accent lines up with the right
|
|
% edge of the character.
|
|
/seacrightchars [
|
|
/Aogonek /Eogonek /Iogonek /aogonek /eogonek /iogonek /uogonek
|
|
] def
|
|
|
|
% Define seac characters where the caron becomes an appended quoteright.
|
|
/seaccaronchars [
|
|
/dcaron /lcaron /tcaron
|
|
] def
|
|
|
|
% Define seac characters using commaaccent.
|
|
/seaccommachars [
|
|
/Gcommaaccent /Kcommaaccent /Lcommaaccent /Ncommaaccent /Rcommaaccent
|
|
/Scommaaccent /Tcommaaccent
|
|
/gcommaaccent /kcommaaccent /lcommaaccent /ncommaaccent /rcommaaccent
|
|
/scommaaccent /tcommaaccent
|
|
] def
|
|
|
|
% Define the characters copied from the Symbol font.
|
|
/symbolchars [
|
|
/Delta /greaterequal /lessequal /lozenge /notequal /partialdiff
|
|
/summation
|
|
] def
|
|
|
|
% Define the procedures for editing the commaaccent character.
|
|
% Delete all the hints, since it's too hard to adjust them.
|
|
/caedit mark
|
|
/rmoveto { exch commatop sub cvi exch }
|
|
/hstem { pop pop pop }
|
|
/vstem 1 index
|
|
/callothersubr {
|
|
dup 3 eq { 4 { pop } repeat /skip true def } if
|
|
}
|
|
/pop { skip { pop /skip false def } if }
|
|
.dicttomark def
|
|
|
|
/addce { % <name> <font> addce <font'>
|
|
20 dict begin
|
|
/origfont 1 index def
|
|
openfont
|
|
dup /CharStrings 2 copy get dup length dict copy put
|
|
dup /Encoding 2 copy get dup length array copy put
|
|
dup /FontInfo 2 copy get dup length dict copy put
|
|
definefont /font exch def
|
|
currentdict font end begin begin
|
|
font 1000 scalefont setfont
|
|
/symbolfont /Symbol findfont def
|
|
/BBoxes CharStrings length dict def
|
|
/SBW CharStrings length dict def
|
|
|
|
/italfactor FontInfo /ItalicAngle .knownget {
|
|
neg dup sin exch cos div
|
|
} {
|
|
0
|
|
} ifelse def
|
|
|
|
% Invert the Encoding (needed for seac).
|
|
|
|
/charindex 256 dict def
|
|
0 1 255 {
|
|
charindex exch Encoding 1 index get exch put
|
|
} for
|
|
|
|
% Add the commaaccent character, by moving the comma downward.
|
|
|
|
/comma glyphbbox /commatop exch def pop pop pop
|
|
/comma glyphcs
|
|
/skip false def
|
|
[ exch { caedit 1 index .knownget { exec } if } forall ]
|
|
/commaaccent exch csdef
|
|
|
|
% Add the accented characters that can be made with seac.
|
|
|
|
seacchars {
|
|
splitaccented beginseac
|
|
centeraccent
|
|
% If the accent would collide with the base character,
|
|
% raise it a little.
|
|
abox 1 get bbox 3 get sub dup 0 le {
|
|
% ... but not if the accent is in the low position.
|
|
abox 1 get 0 gt {
|
|
neg 60 add
|
|
% Adjust the X position if italic.
|
|
dup italfactor mul 3 -1 roll add exch
|
|
} {
|
|
pop 0
|
|
} ifelse
|
|
} {
|
|
pop 0
|
|
} ifelse
|
|
finishseac
|
|
} forall
|
|
|
|
seacrightchars {
|
|
splitaccented beginseac
|
|
bbox 2 get abox 2 get sub add % line up right edges
|
|
0 finishseac
|
|
} forall
|
|
|
|
/dcroat /d /hyphen beginseac
|
|
bbox 2 get abox 2 get sub add % line up right edges
|
|
0 finishseac
|
|
|
|
/imacron /dotlessi /macron beginseac
|
|
centeraccent
|
|
0 finishseac
|
|
|
|
/Lcaron /L /quoteright beginseac
|
|
bbox 2 get abox 2 get sub add % line up right edges
|
|
0 finishseac
|
|
|
|
seaccaronchars {
|
|
dup =string cvs 0 1 getinterval cvn /quoteright beginseac
|
|
% Move the quote to the right of the character.
|
|
bbox 2 get abox 0 get sub 50 add add
|
|
% Adjust the character width as well.
|
|
4 -1 roll abox 2 get abox 0 get sub 50 add add cvi 4 1 roll
|
|
0 finishseac
|
|
} forall
|
|
|
|
seaccommachars {
|
|
dup =string cvs 0 1 getinterval cvn /comma beginseac
|
|
centeraccent
|
|
commatop neg
|
|
% Lower the accent if the character extends below
|
|
% the baseline
|
|
bbox 1 get 0 .min add
|
|
finishseac
|
|
} forall
|
|
|
|
% Add the characters from the Symbol font.
|
|
% We should scale them to match the FontBBox, but we don't.
|
|
|
|
symbolchars {
|
|
symbolfont /CharStrings get 1 index get
|
|
CharStrings 3 1 roll put
|
|
} forall
|
|
|
|
% Add the one remaining character.
|
|
|
|
CharStrings /Dcroat CharStrings /Eth get put
|
|
|
|
% Recompute the FontBBox, since some of the accented characters
|
|
% may have enlarged it.
|
|
|
|
/llx 1000 def /lly 1000 def /urx 0 def /ury 0 def
|
|
CharStrings {
|
|
pop glyphbbox
|
|
ury .max /ury exch def urx .max /urx exch def
|
|
lly .min /lly exch def llx .min /llx exch def
|
|
} forall
|
|
/FontBBox llx cvi lly cvi urx ceiling cvi ury ceiling cvi 4 packedarray def
|
|
|
|
% Restore the Encoding and wrap up.
|
|
|
|
[/Copyright /Notice] {
|
|
FontInfo 1 index .knownget {
|
|
addednotice concatstrings FontInfo 3 1 roll put
|
|
} {
|
|
pop
|
|
} ifelse
|
|
} forall
|
|
FontName font openfont
|
|
dup /Encoding origfont /Encoding get put
|
|
definefont
|
|
|
|
end end
|
|
} def
|
|
|
|
currentdict end readonly pop % addce_dict
|
|
|
|
/addce { addce_dict begin addce end } def
|
|
|
|
% ---------------- Integration ---------------- %
|
|
|
|
% We would like to patch the font loader so that it adds the extended
|
|
% Latin characters automatically. We haven't done this yet.
|
|
|
|
% ---------------- Test program ---------------- %
|
|
|
|
/TEST where { pop TEST } { false } ifelse {
|
|
/FONT where { pop } { /FONT /Palatino-Italic def } ifelse
|
|
(unprot.ps) runlibfile
|
|
unprot
|
|
(wrfont.ps) runlibfile
|
|
wrfont_dict begin
|
|
/eexec_encrypt true def
|
|
/binary_CharStrings true def
|
|
end
|
|
save
|
|
FONT findfont
|
|
/Latin-CE exch addce setfont
|
|
(t.ce.pfb) (w) file dup writefont closefile
|
|
restore
|
|
(prfont.ps) runlibfile
|
|
(t.ce.pfb) (r) file .loadfont
|
|
/Latin-CE DoFont
|
|
quit
|
|
} if
|