%    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 defaddce_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