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