diff options
Diffstat (limited to 'Master/xemtex/gslib/addxchar.ps')
| -rw-r--r-- | Master/xemtex/gslib/addxchar.ps | 358 |
1 files changed, 358 insertions, 0 deletions
diff --git a/Master/xemtex/gslib/addxchar.ps b/Master/xemtex/gslib/addxchar.ps new file mode 100644 index 00000000000..e85ddb659f3 --- /dev/null +++ b/Master/xemtex/gslib/addxchar.ps @@ -0,0 +1,358 @@ +% Copyright (C) 1999 Aladdin Enterprises. All rights reserved. +% +% This program is free software; you can redistribute it and/or modify it +% under the terms of the GNU General Public License as published by the +% Free Software Foundation; either version 2 of the License, or (at your +% option) any later version. +% +% This program is distributed in the hope that it will be useful, but +% WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General +% Public License for more details. +% +% You should have received a copy of the GNU General Public License along +% with this program; if not, write to the Free Software Foundation, Inc., +% 59 Temple Place, Suite 330, Boston, MA, 02111-1307. + +% $Id: addxchar.ps,v 1.2.6.1.2.1 2003/04/12 14:02:38 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 |