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