summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlgs/lib/addxchar.ps
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlgs/lib/addxchar.ps')
-rw-r--r--Master/tlpkg/tlgs/lib/addxchar.ps357
1 files changed, 357 insertions, 0 deletions
diff --git a/Master/tlpkg/tlgs/lib/addxchar.ps b/Master/tlpkg/tlgs/lib/addxchar.ps
new file mode 100644
index 00000000000..ddfc7e334a5
--- /dev/null
+++ b/Master/tlpkg/tlgs/lib/addxchar.ps
@@ -0,0 +1,357 @@
+% 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 6300 2005-12-28 19:56:24Z giles $
+% 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