Subversion Repositories planix.SVN

%    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,v 1.4 2002/02/21 21:49:28 giles Exp $

% 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

} 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

  } {

  } ifelse def

	% Invert the Encoding (needed for seac).

  /charindex 256 dict def

    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

  } forall

  /dcroat /d /hyphen beginseac

    bbox 2 get abox 2 get sub add	% line up right edges

  /imacron /dotlessi /macron beginseac

    centeraccent

  /Lcaron /L /quoteright beginseac

    bbox 2 get abox 2 get sub add	% line up right edges

  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

  } 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