sys/lib/ghostscript/addxchar.ps

   1 %    Copyright (C) 1999 Aladdin Enterprises.  All rights reserved.
   2 %
   3 % This software is provided AS-IS with no warranty, either express or
   4 % implied.
   5 %
   6 % This software is distributed under license and may not be copied,
   7 % modified or distributed except as expressly authorized under the terms
   8 % of the license contained in the file LICENSE in this distribution.
   9 %
  10 % For more information about licensing, please refer to
  11 % http://www.ghostscript.com/licensing/. For information on
  12 % commercial licensing, go to http://www.artifex.com/licensing/ or
  13 % contact Artifex Software, Inc., 101 Lucas Valley Road #110,
  14 % San Rafael, CA  94903, U.S.A., +1(415)492-9861.
  15
  16 % $Id: addxchar.ps,v 1.4 2002/02/21 21:49:28 giles Exp $
  17 % Add the Central European and other Adobe extended Latin characters to a
  18 % Type 1 font.
  19 % Requires -dWRITESYSTEMDICT to disable access protection.
  20
  21 (type1ops.ps) runlibfile
  22
  23 % ---------------- Utilities ---------------- %
  24
  25 /addce_dict 50 dict def
  26 addce_dict begin
  27
  28 % Define the added copyright notice.
  29 /addednotice (. Portions Copyright (C) 1999 Aladdin Enterprises.) def
  30
  31 % Open a font for modification by removing the FID and changing the
  32 % FontName.  Removing UniqueID and XUID is not necessary, since we
  33 % will only be adding characters.
  34 /openfont {             % <name> <font> openfont <name> <font'>
  35   dup length dict copy
  36   dup /FID undef
  37   dup /FontName 3 index put
  38 } def
  39
  40 % Do the equivalent of false charpath for a glyph.
  41 % This should really be an operator!
  42 /glyphpath {            % <glyph> glyphpath -
  43   currentfont /Encoding get 0 3 -1 roll put
  44   <00> false charpath
  45 } def
  46
  47 % Do the equivalent of charpath + pathbbox for a glyph.
  48 /glyphbbox {            % <glyph> glyphbbox <llx> <lly> <urx> <ury>
  49         % We cache this value, because it's expensive to compute.
  50   BBoxes 1 index .knownget {
  51     exch pop
  52   } {
  53     gsave newpath 0 0 moveto dup glyphpath [pathbbox] grestore
  54     BBoxes 3 -1 roll 2 index put
  55   } ifelse aload pop
  56 } def
  57
  58 % Get the side bearing and width for a glyph.
  59 /glyphsbw {             % <glyph> glyphsbw <lsbx> <wx>
  60         % We cache this value, because it's expensive to compute.
  61   SBW 1 index .knownget {
  62     exch pop
  63   } {
  64     dup glyphcs { dup /hsbw eq { pop exit } if } forall
  65     2 array astore
  66     SBW 3 -1 roll 2 index put
  67   } ifelse aload pop
  68 } def
  69
  70 % Get the CharString for a glyph, as an array.
  71 /glyphcs {              % <glyph> glyphcs <array>
  72   CharStrings exch get
  73   4330 exch dup length string .type1decrypt exch pop
  74   dup length lenIV sub lenIV exch getinterval
  75   0 () /SubFileDecode filter [ exch charstack_read ]
  76 } def
  77
  78 % Find an occurrence of a value in an array.
  79 /asearch {              % <array> <value> asearch <index> true
  80                         % <array> <value> asearch false
  81   false 0 4 2 roll exch {
  82                 % Stack: false index value element
  83     2 copy eq { pop pop exch not exch dup exit } if
  84     exch 1 add exch
  85   } forall pop pop
  86 } def
  87
  88 % Convert an array back to a CharString.
  89 /csdef {                % <glyph> <array> csdef -
  90   charproc_string
  91   4330 exch dup .type1encrypt exch pop readonly
  92   CharStrings 3 1 roll put
  93 } def
  94
  95 % Split an accented character name.
  96 /splitaccented {        % <Baccent> splitaccented <Baccent> <B> <accent>
  97     dup =string cvs
  98     dup 0 1 getinterval cvn
  99     exch dup length 1 sub 1 exch getinterval cvn
 100 } def
 101
 102 % Begin the definition of a 'seac' character.
 103 % Defines accent, base, abox, bbox.
 104 % The initial dx lines up the origins of the base and the accent.
 105 /beginseac {            % <bchar> <achar> beginseac
 106                         %   -mark- <lsbx> <wx> /hsbw <asb> <dx>
 107   /accent exch def /base exch def
 108   /abox [accent glyphbbox] def
 109   /bbox [base glyphbbox] def
 110   [ base glyphsbw /hsbw accent glyphsbw pop
 111   dup 4 index sub
 112 } def
 113
 114 % Center the accent over the base of a 'seac' character.
 115 /centeraccent {         % <dx> centeraccent <adx>
 116   bbox 2 get bbox 0 get add 2 div
 117   abox 2 get abox 0 get add 2 div
 118   sub add
 119 } def
 120
 121 % Finish the definition of a 'seac' character.
 122 /finishseac {           % <charname> -mark- ... <adx> <ady> finishseac -
 123   exch cvi exch cvi
 124   charindex base get charindex accent get /seac ] csdef
 125 } def
 126
 127 % ---------------- Main program ---------------- %
 128
 129 % Define accented characters that can be made with seac,
 130 % with the accent centered over the character.
 131 /seacchars [
 132   /Abreve /Amacron
 133   /Cacute /Ccaron /Dcaron
 134   /Ecaron /Edotaccent /Emacron
 135   /Gbreve
 136   /Idotaccent /Imacron
 137   /Lacute
 138   /Nacute /Ncaron
 139   /Ohungarumlaut /Omacron
 140   /Racute /Rcaron
 141   /Sacute /Scedilla
 142   /Tcaron
 143   /Uhungarumlaut /Umacron /Uogonek /Uring
 144   /Zacute /Zdotaccent
 145   /abreve /amacron
 146   /cacute /ccaron
 147   /ecaron /edotaccent /emacron
 148   /gbreve
 149   /lacute
 150   /nacute /ncaron
 151   /ohungarumlaut /omacron
 152   /racute /rcaron
 153   /sacute /scedilla
 154   /uhungarumlaut /umacron /uring
 155   /zacute /zdotaccent
 156 ] def
 157
 158 % Define seac characters where the accent lines up with the right
 159 % edge of the character.
 160 /seacrightchars [
 161   /Aogonek /Eogonek /Iogonek /aogonek /eogonek /iogonek /uogonek
 162 ] def
 163
 164 % Define seac characters where the caron becomes an appended quoteright.
 165 /seaccaronchars [
 166   /dcaron /lcaron /tcaron
 167 ] def
 168
 169 % Define seac characters using commaaccent.
 170 /seaccommachars [
 171   /Gcommaaccent /Kcommaaccent /Lcommaaccent /Ncommaaccent /Rcommaaccent
 172   /Scommaaccent /Tcommaaccent
 173   /gcommaaccent /kcommaaccent /lcommaaccent /ncommaaccent /rcommaaccent
 174   /scommaaccent /tcommaaccent
 175 ] def
 176
 177 % Define the characters copied from the Symbol font.
 178 /symbolchars [
 179   /Delta /greaterequal /lessequal /lozenge /notequal /partialdiff
 180   /summation
 181 ] def
 182
 183 % Define the procedures for editing the commaaccent character.
 184 % Delete all the hints, since it's too hard to adjust them.
 185 /caedit mark
 186   /rmoveto { exch commatop sub cvi exch }
 187   /hstem { pop pop pop }
 188   /vstem 1 index
 189   /callothersubr {
 190     dup 3 eq { 4 { pop } repeat /skip true def } if
 191   }
 192   /pop { skip { pop /skip false def } if }
 193 .dicttomark def
 194
 195 /addce {                % <name> <font> addce <font'>
 196   20 dict begin
 197   /origfont 1 index def
 198   openfont
 199   dup /CharStrings 2 copy get dup length dict copy put
 200   dup /Encoding 2 copy get dup length array copy put
 201   dup /FontInfo 2 copy get dup length dict copy put
 202   definefont /font exch def
 203   currentdict font end begin begin
 204   font 1000 scalefont setfont
 205   /symbolfont /Symbol findfont def
 206   /BBoxes CharStrings length dict def
 207   /SBW CharStrings length dict def
 208
 209   /italfactor FontInfo /ItalicAngle .knownget {
 210     neg dup sin exch cos div
 211   } {
 212     0
 213   } ifelse def
 214
 215         % Invert the Encoding (needed for seac).
 216
 217   /charindex 256 dict def
 218   0 1 255 {
 219     charindex exch Encoding 1 index get exch put
 220   } for
 221
 222         % Add the commaaccent character, by moving the comma downward.
 223
 224   /comma glyphbbox /commatop exch def pop pop pop
 225   /comma glyphcs
 226     /skip false def
 227     [ exch { caedit 1 index .knownget { exec } if } forall ]
 228   /commaaccent exch csdef
 229
 230         % Add the accented characters that can be made with seac.
 231
 232   seacchars {
 233     splitaccented beginseac
 234       centeraccent
 235                 % If the accent would collide with the base character,
 236                 % raise it a little.
 237       abox 1 get bbox 3 get sub dup 0 le {
 238                 % ... but not if the accent is in the low position.
 239         abox 1 get 0 gt {
 240           neg 60 add
 241                 % Adjust the X position if italic.
 242           dup italfactor mul 3 -1 roll add exch
 243         } {
 244           pop 0
 245         } ifelse
 246       } {
 247         pop 0
 248       } ifelse
 249     finishseac
 250   } forall
 251
 252   seacrightchars {
 253     splitaccented beginseac
 254     bbox 2 get abox 2 get sub add       % line up right edges
 255     0 finishseac
 256   } forall
 257
 258   /dcroat /d /hyphen beginseac
 259     bbox 2 get abox 2 get sub add       % line up right edges
 260   0 finishseac
 261
 262   /imacron /dotlessi /macron beginseac
 263     centeraccent
 264   0 finishseac
 265
 266   /Lcaron /L /quoteright beginseac
 267     bbox 2 get abox 2 get sub add       % line up right edges
 268   0 finishseac
 269
 270   seaccaronchars {
 271     dup =string cvs 0 1 getinterval cvn /quoteright beginseac
 272                 % Move the quote to the right of the character.
 273     bbox 2 get abox 0 get sub 50 add add
 274                 % Adjust the character width as well.
 275     4 -1 roll abox 2 get abox 0 get sub 50 add add cvi 4 1 roll
 276     0 finishseac
 277   } forall
 278
 279   seaccommachars {
 280     dup =string cvs 0 1 getinterval cvn /comma beginseac
 281       centeraccent
 282       commatop neg
 283                 % Lower the accent if the character extends below
 284                 % the baseline
 285       bbox 1 get 0 .min add
 286     finishseac
 287   } forall
 288
 289         % Add the characters from the Symbol font.
 290         % We should scale them to match the FontBBox, but we don't.
 291
 292   symbolchars {
 293     symbolfont /CharStrings get 1 index get
 294     CharStrings 3 1 roll put
 295   } forall
 296
 297         % Add the one remaining character.
 298
 299   CharStrings /Dcroat CharStrings /Eth get put
 300
 301         % Recompute the FontBBox, since some of the accented characters
 302         % may have enlarged it.
 303
 304   /llx 1000 def /lly 1000 def /urx 0 def /ury 0 def
 305   CharStrings {
 306     pop glyphbbox
 307     ury .max /ury exch def urx .max /urx exch def
 308     lly .min /lly exch def llx .min /llx exch def
 309   } forall
 310   /FontBBox llx cvi lly cvi urx ceiling cvi ury ceiling cvi 4 packedarray def
 311
 312         % Restore the Encoding and wrap up.
 313
 314   [/Copyright /Notice] {
 315     FontInfo 1 index .knownget {
 316       addednotice concatstrings FontInfo 3 1 roll put
 317     } {
 318       pop
 319     } ifelse
 320   } forall
 321   FontName font openfont
 322   dup /Encoding origfont /Encoding get put
 323   definefont
 324
 325   end end
 326 } def
 327
 328 currentdict end readonly pop    % addce_dict
 329
 330 /addce { addce_dict begin addce end } def
 331
 332 % ---------------- Integration ---------------- %
 333
 334 % We would like to patch the font loader so that it adds the extended
 335 % Latin characters automatically.  We haven't done this yet.
 336
 337 % ---------------- Test program ---------------- %
 338
 339 /TEST where { pop TEST } { false } ifelse {
 340   /FONT where { pop } { /FONT /Palatino-Italic def } ifelse
 341   (unprot.ps) runlibfile
 342   unprot
 343   (wrfont.ps) runlibfile
 344   wrfont_dict begin
 345     /eexec_encrypt true def
 346     /binary_CharStrings true def
 347   end
 348   save
 349     FONT findfont
 350     /Latin-CE exch addce setfont
 351     (t.ce.pfb) (w) file dup writefont closefile
 352   restore
 353   (prfont.ps) runlibfile
 354   (t.ce.pfb) (r) file .loadfont
 355   /Latin-CE DoFont
 356   quit
 357 } if