home *** CD-ROM | disk | FTP | other *** search
/ jppd.dyndns.org / jppd.dyndns.org.tar / jppd.dyndns.org / QUERYPRO / Impressora_PDF / converter.exe / GPLGS / addxchar.ps < prev    next >
Text File  |  2002-02-22  |  10KB  |  358 lines
  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
  358.