1994 Developer Conference in Champaign, Ill.

Roland Jakschewitz

What is it (good for)?

Functionality

Using Hershey font descriptions, this Notebook provides scalable Graphics text at user-specifiable angles, which can be seen on screen & in print, independent of hardware and operating system — which cannot be done with Mathematica (v2.2) Graphics Text on all (especially non-Display PostScript) platforms.

Hershey Fonts are vector fonts of more than a thousand glyphs, which produce quite acceptabel results when used at adequate scaling for printer or screen resolution. Obviously they cannot be used as flexibly as PostScript or TrueType fonts, which use splines for the definition of glyph shapes, and contain additional kerning informationen.

Origin

The Hershey Fonts were originally created by Dr. A. V. Hershey while working at the U. S. National Bureau of Standards.

General Setup

Raw/compact data

The format of the Font data in this (the Internet) distribution was originally created by
					James Hurt
					Cognition, Inc.
					900 Technology Park Drive
					Billerica, MA 01821
					(mit-eddie!ci-dandelion!hurt)

There is one file containing vector descriptions of 1605 (occidental) glyphs — these are not in an ASCII sequence. The index files — one for each of 24 96-character-cut (roman, bold, italic, ²) — contain indices into the glyph description file, thus providing translation tables for the  ASCII characters between ' ' and 0x7F.

Compiled version (larger but faster to load)

Thee glyph and font index files in Mathematica format (for shorter loading time) were produced with Mathematica functions defined below in the Functions Defined:Data Conversion subsection.

hglyph.m

hfonts1.m
hfonts2.m
²

What does it show — aside from Graphics text?

Mathematica«s extensibility

Using Mathematica«s programming language it is straightforward and easy — and very clear, considering one has to look at only 5-20 lines of function definitions each — to extend Mathematica«s Graphics text capability.

extremely short code compared to C package

For the 2D functionality, alone, about 20 lines of Mathematica code produce the same functionality as about 20 pages of C code provided with the font descriptions (Hershey font data and accompanying VOGL library source code are available on various servers on the Internet (see archie)).

As I will show in the following examples, it takes only another handful of lines of Mathematica input to extend this functionality to 3D text.

Setup

Preliminaries

Off[ General::spell1 ];

SetDirectory@"swap:hersh:"

Read Fonts

This will take about 36 seconds on a 486/33MHz under Windows:

<<"hglyph.m";
<<"hfonts0.m";
<<"hfonts1.m";

Check

?@*Font

Length@h == 1605 (* glyphs/letters are defined in hglyph.m *)

ByteCount@h (* this is how much RAM we need for all these fonts *)

h[[7]] (* number, width, coordinates *)

Show@Graphics[ { Thickness@.05, Line/@h[[7,3]] },
	       AspectRatio->Automatic,
	       PlotRange->All,
	       Axes->True
];

Last@h (* character number not equal to index in h! *)

Show@Graphics[ Line/@h[[ Position[ h, {3813, _,_}, {1} ][[1,1]], 3 ]],
	       AspectRatio->Automatic,
	       PlotRange->All,
	       Axes->True
];

Show@Graphics[ hText[ "R", {10,11}, .01, 45 Degree,
					  hFont->timesBFont ],
	       AspectRatio->Automatic,
	       PlotRange->All,
	       Axes->True
];

2D Examples

Text along 2D Lines

streckenWinkel[p1:{_,_}, p2:{_,_}] :=
	(#[[2]]/#[[1]]&[p2-p1] // ArcTan) / Degree // N

streckenWinkel[ {8,8},{15,15} ]

streckenWinkel[ {16,-3},{15,15} ]

streckenWinkel[ {8,8},{16,-3} ]

Show@Graphics[ {
		Thickness@.001,
		hText[ "45 Degree Text", {10,11}, .015, 45 Degree ],
		Line[ {{8,8},{15,15}} ],
		
		hText[ "-86 Degree Text", {16,7.5}, .015, -86.8202 Degree ],
		Line[ {{16,-3},{15,15}} ],
		
		hText[ "-53 Degree Text", {10.5,3.5}, .015, -53.9726 Degree ],
		Line[ {{8,8},{16,-3}} ]
      },
 	  AspectRatio->Automatic,
	  PlotRange->All,
	  Axes->True
];

Text around Circle

Show@Graphics[ {
		Thickness@.001,
		MapThread[ hText[ #1, 10{Cos@#, Sin@#}&[#2],		
				  .05, #2 - 90 Degree, hFont->timesBFont ]&,
				   { Characters@"TEXT UM EINEN KREIS HERUM",
				     Range[180, -150, -13.75] Degree }
		],
		{ GrayLevel@.5, Disk[ {0,0}, 8 ], Circle[ {0,0}, 12 ] }
       },
       AspectRatio->Automatic,
       PlotRange->All
];

roundText = 
Show@Graphics[ {
		Thickness@.001,
		MapThread[ hText[ #1, 10{Cos@#, Sin@#}&[#2],		
				  .05, #2 - 90 Degree, hFont->timesBFont ]&,
				   { Characters@"TEXT RUNNING ROUND CIRCLE",
				     Range[180, -150, -13.75] Degree }
		]
	},
	AspectRatio->Automatic,
	PlotRange->All
];

Multi-line Text

SetOptions[ hText, hFont->timesFont, hAlign->AlignCenter ];
multiLine = Show@Graphics[ {
				Thickness@.001,
				hText[ "A 4 line", {130,0} ],
				hText[ "text block", {130,-35} ],
				hText[ "for Graphics3D", {130,-70} ],
				hText[ "generation.", {130,-105} ]
			   },
			   AspectRatio->Automatic,
			   PlotRange->All
];

² same with a tilt (the title lines)

SetOptions[ hText, hFont->timesBFont, hAlign->AlignCenter ];
titleOfNB = Show@Graphics[ {
				Thickness@.003,
				hText[ "Hershey Text", {0,0} ],
				hText[ "in", {0,-35} ],
				{RGBColor[1,0,0],
				 hText[ "Mathematica",
					{-50,-110}, 1.5, 12 Degree,
					hFont->timesIFont ]
				},
				hText[ "Graphics", {0,-135} ]
			   },
			   AspectRatio->Automatic,
			   PlotRange->All
];

3D Examples

Projection onto plane surface

It is easy to transform the 2D graphics text into a Graphics3D object:

zPlane = First@multiLine /. coord2D -> {x,    240+1.7 y, 30};

xPlane = First@multiLine /. coord2D -> {0,    280-x,     y-20};

yPlane = First@multiLine /. coord2D -> {20+x, 0,         y-20};

Show @ Graphics3D[ { { EdgeForm@Thickness@.001, GrayLevel@.7,
		       Cuboid[{0,0,-150},{310,300,10}]
		     },
		     xPlane, yPlane, zPlane
		   },
		   ViewPoint->{-3.590, -3.040, 3.630},
		   Boxed->False,
		   Lighting->False
       ];

Projection onto cylindrical surface

Needs@"Calculus`VectorAnalysis`";

Zylinder =
	First[multiLine] /.
	coord2D -> CoordinatesToCartesian[
						{ (* radius: *) 190,
						  (* theta:  *) x/120,
						  (* height: *) 1.5 y },
						Cylindrical
					  ];

Show @ Graphics3D[ Zylinder,
		   ViewPoint->{0.698,1.293,0.046},
		   Boxed->False
       ];

Zylinder =
	First[roundText] /.
	{x_/;NumberQ@N@x, y_/;NumberQ@N@y} -> CoordinatesToCartesian[
						{20, x/12, 1.5 y},
						Cylindrical
					  ];

Show[ { Graphics3D[ {Zylinder,
		      { EdgeForm[], GrayLevel@.7,
				Cylinder[19.8, 20, 100]
		      }
		    }
        ],
        { TranslateShape[ Graphics3D @ Cylinder[20, 2, 102], {0, 0, 21} ],
		  TranslateShape[ Graphics3D @ Cylinder[20, 2, 102], {0, 0, -21} ]
		}
   },
   ViewPoint->{4.000,-0.670,-0.800},
   Boxed->False,
   Lighting->False
];

Projection onto sphere

toSphere[ p:{x_, y_}, r_ ] := With[ { denom= 2r + x^2 + y^2 },
	{ x/denom, y/denom, -2r/denom }
]

kugelText =
	First[multiLine] /. coord2D -> toSphere[ {x-100, 60+y}, 20000 ];

Show @ Graphics3D[ kugelText,
		   ViewPoint->{0.000,0.000,-1.580},
		   Boxed->False
       ];

Show @ Graphics3D[ kugelText,
		   ViewPoint->{0.000,0.000,1.0},
		   Boxed->False
	   ];

3D Text

threeDstring = make3Dstring[ hText[ "W.R.I.", {10.,11.}, .01, 0,
									hFont->futuraFont ],
						     (* zPlane: *) 10,
						     (* zDepth: *) .2,
						     (* yScale: *) 1.7
];

Show @ Graphics3D[ threeDstring,
		   ViewPoint->{0.058,-0.107,3.428},
		   Boxed->False
	   ];

threeDcity = make3Dstring[ hText[ "Champaign", {10.,11.}, .01, 0,
								  hFont->futuraFont ],
						   (* zPlane: *) 10,
						   (* zDepth: *) .2,
						   (* yScale: *) 1.7
];

Show @ Graphics3D[ threeDcity,
		   ViewPoint->{0.058,-0.107,3.428},
		   Boxed->False
	   ];

3D Animations

Animation of string in whole

SetOptions[ Graphics3D, Boxed->False ];

SpinShow[ Graphics3D @ { EdgeForm[], threeDstring } ];

SpinShow[ Graphics3D @ { EdgeForm[], threeDcity },
	  SpinTilt->{12,30}
];

Animation of characters of Hershey strings

SetOptions[ Graphics3D, Boxed->False,
			ViewPoint->{0.0,-0.079,2.199} ];

anim2 =
  make3Dstring[ hText[ "Mathematica", {0,0}, 1, 0,
				       hFont->timesIFont ],
				(* zPlane: *) 10,
				(* depth : *) 10,
				(* yScale: *) 1.7
  ];

Show @ Graphics3D @ anim2;

Unprotect@Out; Clear@Out; Protect@Out;

rotateEachLetter[ anim2, 15 Degree, 23 ];

Scan[ Show, % ];

Perspectives

Enhancements of Functions

For further use of Hershey text as Graphics3D object, function hText could be modified/extended to allow strings to be positioned in R3 directly, or to have a certain 3D tilt, ².

Variations of Data Conversion

Since loading the Hershey database into Mathematica is not as fast as one would wish: there are at least three ways in which reading the data  can be speeded up.

Data Reduction

If it is known in advance that only a small subset of fonts will be needed, a reduced version of database file hersh.oc.mma could be used, thus saving on disk space compared to the following solution. In this case the Hershey data would be converted on the fly (using functions hconvert and loadFont).

Conversion of External Data only Once (this method has been used here)

The overall fastest solution is probably to convert the database once into Mathematica format, and Getting these data when needed. One major drawback is that the converted database file (hglyph.m) is about four times as big as the original (compact) version.

Conversion with external MathLink-connected program

In this case the compact database version — possibly cut down to needed fonts only — could be used to be converted on the fly by an external MathLink program. One drawback here is that C code is not as portable across platforms as pure Mathematica code.

Code for reading raw data & saving converted data

On the fly conversion of compact database:

h = hconvert /@ ReadList[ "hersh.oc.mma",
						  { Number, Number, Character, String }
				];

timesFont   = loadFont[ "romanc.hmp" ];
timesBFont  = loadFont[ "romant.hmp" ];
futuraFont  = loadFont[ "romans.hmp" ];
futuraBFont = loadFont[ "romand.hmp" ];

timesIFont  = loadFont[ "italicc.hmp" ];
symbolFont  = loadFont[ "symbol.hmp"  ];

Saving databse in Mathematica format for later use:

Save[ "hglyph.m", h ];
Save[ "hfonts0.m", timesFont,  timesBFont,
				   futuraFont, futuraBFont ];
Save[ "hfonts1.m", timesIFont,  symbolFont ];

Functions defined

Packages used

Needs@"Geometry`Rotations`";

Needs@"Graphics`Shapes`";

Unprotect@RotateShape;

RotateShape[ shape_, rotmat_ ] :=
	shape /. { poly:Polygon[_] :> Map[(rotmat . #)&, poly, {2}],
		   line:Line[_]    :> Map[(rotmat . #)&, line, {2}],
		   point:Point[_]  :> Map[(rotmat . #)&, point,{1}] }

Protect@RotateShape;

Needs@"Graphics`Animation`";

Data Conversion

rCode = First @ ToCharacterCode @ "R"

makeLines[ a_List ] := Block[ { pl, pos = -1 }, (*
----------------------------------------------- *)
	If[ (pl = Flatten @ Position[ a, {32,_}, {1} ]) == {},
		{a},
		AppendTo[ pl, Length[a]+1 ];
		Take[ a, { pos+2, pos = #-1 } ]& /@ pl
	]
]

hconvert[ { charNo_, _, _, charVector_ } ] := Block[ (*
---------------------------------------------------- *)
	{ coordVector = Partition[ ToCharacterCode @ charVector, 2],
	  width
	},
	{
		charNo,
		width = #[[2]]-#[[1]]&[ First @ coordVector ],
	 	width = Round[ .5 width];
	 	makeLines @ Rest @ coordVector /.
	 		{x_Integer, y_Integer} :> {width + x-rCode, rCode-y}
	}
];

loadFont[ translationFile_String ] := Module[ { glyphNumbers }, (*
------ *)
	glyphNumbers = 
		ReadList[ translationFile, {Number, Number} ] /.
				{a_, 0} -> a /. {a_, b_} :> Range[a,b] // Flatten;
	Position[ h, {#,_,_}, {1} ]& /@ glyphNumbers // Flatten
]

Basic Hershey Text Generation

Options[ hText ] = { hFont->futuraFont,
				     hAlign->AlignLeft };

hText[ s_String, pos:{x_,y_}, scale_:1, angle_:0, opts___ ] := (*
-------------------------------------------------------------- *)
Module[
	{ sCodes,	(* indices in h of letters of string s *)
	  font = hFont /. {opts} /. Options[ hText ],
	  mat = N @ RotationMatrix2D @ (-angle),
	  widths,	(* horizontal offsets of single letters in string *)
	  align,	(* horizontal alignment of string *)
	  sGraph	(* vector description of string s *)
	},
	sCodes = font[[ ToCharacterCode@s - 31 ]]; (* only letters >= ' ' *)
	
	widths = FoldList[Plus, 0, h[[ sCodes, 2 ]] ];
	align = Switch[ hAlign /. {opts} /. Options[ hText ],
					AlignLeft,		0,
					AlignCenter,	.5 Last[ widths ],
					AlignRight,		Last[ widths ]
			];
	widths = Drop[ widths, -1 ];
	
	sGraph = MapThread[ (#1 /. {cx_Integer, cy_Integer} -> {cx+#2, cy})&,
						{h[[sCodes,3]], widths}
			 ];
	
	Map[ Line, (* perform 2D-transformation of string: *)
		 sGraph /. {cx_Integer, cy_Integer} -> {x-align,y} + mat.{scale cx, scale cy},
		 {2}
	]
]

3D Functions

coord2D = {x_/;NumberQ@x, y_/;NumberQ@y };
coord3D = {x_/;NumberQ@x, y_/;NumberQ@y, z_/;NumberQ@z };

make3Dstring[ theString_List, zPlane_, zDepth_, yScale_ ] := (*
------------------------------------------------------------ *)
Module[ { z1, z2 },

    z1 = theString /. coord2D -> {x, yScale y, zPlane};
    z2 = z1 /. coord3D -> {x, y, z+zDepth};
    Map[
		Polygon[Join[ #[[1]], Reverse[ #[[2]] ], {#[[1,1]]} ]]&,
		(* collect corresponding line sequences: *)
		Map[ Transpose, 
	     Map[ Flatten[#,1]&,
		  (* collect corresponding letters: *)
		  Transpose[ {z1,z2} /. Line[x_]:>Partition[ x, 2, 1 ] ],
		  {-5}
	     ],
	     {-5}
		],
		{-4}
    ]
]

rotateEachLetter[ threeDhershey_, degreesPerStep_, steps_ ] := (*
-------------------------------------------------------------- *)
Module[ { centers, rotation },

	(* center of each character in string *)
	centers = Map[ { .5 (Min@#[[1]] + Max@#[[1]]), (* x center *)
					 .5 (Min@#[[2]] + Max@#[[2]]), (* y center *)
					 Min@#[[3]]					   (* z bottom *)
			       }&,
   	  		       Transpose /@ Map[ Flatten[ #, 1 ]&,
									 Level[ #, {-3} ]& /@ threeDhershey
							    ]
			  ];

	(* rotation in xz-plane around y-axis *)
	rotation = { { Cos[degreesPerStep], 0, -Sin[degreesPerStep] },
			     { 0,		    1, 0 },
			     { Sin[degreesPerStep], 0, Cos[degreesPerStep] } } // N;

	(* apply rotation around its center to each character *)
	NestList[
    	  Function[ obj,    
	 		MapThread[
				TranslateShape[
				    RotateShape[ TranslateShape[ #1, -#2 ], rotation ],
				    #2 ]&,
				{ obj, centers }
	 	    ]
    	  ],
    	  Graphics3D@{EdgeForm[], #}& /@ threeDhershey,
    	  steps
	]
]

Further Reference

Data conversion functions and basic Hershey text generation function have been extensively covered in a Notebook/article in Carsten Herrmann«s book "Mathematica: Probleme, LÜsungen, Beispiele", ISBN 3-929821-10-9, due to be available in May 1994.