summaryrefslogtreecommitdiff
path: root/fonts/utilities/TrueTypeToType42/TrueTypeToType42.ps
blob: 006582a85183181a25704472b3139a940c5099f8 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
%!PS-Adobe-3.0
%%Title: TrueTypeToType42.ps
%%Creator: T.H.Barton
%%CreationDate: May 2001
%%BoundingBox: 0 0 612 792
%%Pages: 1
% Usage:
% This program runs under GhostScript, (NB it will not run under GhostView),
% to produce the PostScript type 42 font equivalent of a TrueType font. It
% uses the GhostScript .loadttfont procedure to load the Type 42 font
% dictionary on the stack and, to have access to this command, you must
% use a recent version of GhostScript. I developed the program using
% GhostScript 6.51 and am now running it under version 7.00.
% The command line is:
% <Full path name to GhostScript exec file> -IC:\GS\GS7.00 == <Full path name of this file> <Full path name of the input ttf file>
% In my own case, the full path name of my GhostScript file is:
%     C:\GS\GS7.00\bin\gswin32.exe
% The full path name of this file, i.e. the file you are reading, is:
%     D:\Fonts\TrueType\Utilities\TrueTypeToType42.ps
% All my TrueType fonts are in folder C:\Winnt\Fonts so that the
% full path name of Arial.ttf is:
%     C:\Winnt\Fonts\Arial.ttf
% and the command to start the conversion on my machine is:
%    C:\GS\GS6.50\bin\gswin32.exe -IC:\GS\GS6.51 == D:\Fonts\TrueType\Utilities\TrueTypeToType42.ps C:\Winnt\Fonts\Arial.ttf
% I have incorporated most of this into a batch file so that I
% only have to enter the root name, i.e. without the extension .TTF,
% of the True Type font file.
%
% Three output files are produced, all in the directory designated as
% the value of the /Path key. Change this value to suit your needs.
% Search for /Path, you will find it about line 306. 
% One output file is the PostScript Type 42 file. Its root name
% is the name of the font. In the case of Arial, it is ArialMT.
% Its extension is .pfa.
% The second output file is called ShowAllGlyphs.ps. It is a PostScript
% file which, when viewed in GhostScript or downloaded to a PostScript
% printer, will display all the glyphs defined by the font alongside
% their names in ASCII sort order. This file contains
% in its prologue a copy of the Type 42 font file so that it is
% and independent entity, i.e. you do not need the font in your
% printer. The price paid for this convenience is the large size
% of the file.
% The third file is a permanent copy of the report made to the
% GhostScript standard output window during execution of the
% program. It is called TrueTypeToType42.out.
%
% Many TrueType fonts define a large number of glyphs, Arial.ttf defines
% 1296, and program execution can take a long time even on a fairly
% modern system. You are reassured that progress is being made during
% the periods of seeming inactivity by numerous messages displayed on
% the GhostScript standard output screen. These messages are also
% copied to file TrueTypeToType42 so that you have a permanent record.
% The screen shows a list of  all the required and optional components
% of the Type 42 file as listed in Tables 5.2, 5.3, and 5.7 of the
% PostScript Language Reference. It states whether a component was
% found or not found. If a required component is not found, you are
% warned that PostScript will reject the font. The number of glyphs
% defined by the font is displayed along with other potentially
% useful information.
%
% The program uses three internally defined GhostScript commands,
% .loadttfont, concatstrings, and .quit, which are not recognized
% by standard PostScript.
%    .loadttfont is defined in the GhostScript file gs_tt.ps. It
%    converts a TrueType font to Type 42 and loads the Type 42 font
%    dictionary on the stack.
%    concatstrings takes two strings as its arguments, pops them
%    from the stack, concatenates them and leaves the result on
%    the stack.
%    I have not found a definition of .quit but it seems to require
%    two integers as input parameters and stops processing with the
%    GhostScript stdout window displaying an error code whose value
%    is the second of the two integers.
%
% TrueType fonts frequently define very large numbers of glyphs and,
% as a consequence, may be large. My copy of Arial, defines 1296
% glyphs and occupies 267 KB. Because the translation to Type 42
% requires the conversion of eight bit character strings in sfnts
% to hexadecimal strings, the Type 42 font file is almost twice as
% long as the True Type file. In my case ArialMT.pfa contains 496 KB.
%
% I have set setpagedevice for simplex printing from the manual
% input tray of my printer. You will wish to change these to
% suit your printer. Search for setpagedevice and follow the comments
% just above it. (You will find it at about line 619.)
%
%%EndComments
%%BeginProlog
% Procedure AAA takes a keyname expressed as a string as it sole
% argument. Prior to use of AAA, the dictionary loaded on the stack
% by applying .loadttfont to the TrueType font file, is given the name TTF.
% Within the procedure, the string argument to AAA is called KN
% and when required it is converted to a keyname by cvn. First,
% it is established whether the key is defined within TTF
% or not using the PostScript command known. If not, a message is
% printed on stdout (the screen) and false is loaded on the stack.
% If it is defined, the value of the key KN and true are loaded on
% the stack, true in the top position and the value below it.
%
/AAA {
  /KN exch def
  TTF KN cvn known  {
    TTF KN cvn get
    KN ( is defined in this font.\n) concatstrings print
    RFO KN ( is defined in this font.\n) concatstrings writestring
    true 
  }
  {
    KN ( not defined in this font.\n) concatstrings print
    RFO KN ( not defined in this font.\n) concatstrings writestring
    false
  } ifelse
} def
/R 1 def /O 0 def
% The following procedures translate the various components to suit the
% Type 42 format. Some are used more than once, justifying their
% creation. as procedures. Some are only used once but having them
% as procedures clarifies the main program.
/NumberProc {
  /RorO exch def   % RorO = Required or Optional
  {
    Outfile (  /) KN concatstrings ( ) concatstrings writestring
    20 string cvs (\n) concatstrings Outfile exch writestring
  }
  {
    RorO 1 eq {
      Outfile (% /) KN concatstrings ( is not defined in this font file.\n) concatstrings writestring
      Outfile (% Because it is a required parameter, the font will not be\n) writestring
      Outfile (% acceptable to PostScript.\n) writestring
    }
    {
      Outfile (% /) KN concatstrings ( is not defined in this font file.\n) concatstrings writestring
      Outfile (% Because it is not a required parameter, the font will be\n) writestring
      Outfile (% acceptable to PostScript.\n) writestring
    } ifelse
  } ifelse
} def
/NumericalMatrixProc {
  /RorO exch def
  {
    Outfile (  /) KN concatstrings ( [ ) concatstrings writestring
    {20 string cvs ( ) concatstrings Outfile exch writestring} forall
    Outfile (]\n) writestring
  }
  {
    RorO 1 eq {
      Outfile (% /) KN concatstrings ( is not defined in this font file.\n) concatstrings writestring
      Outfile (% Because it is a required parameter, the font will not be\n) writestring
      Outfile (% acceptable to PostScript.\n) writestring
    }
    {
      Outfile (% /) KN concatstrings ( is not defined in this font file.\n) concatstrings writestring
      Outfile (% Because it is a required parameter, the font will not be\n) writestring
      Outfile (% acceptable to PostScript.\n) writestring
    } ifelse
  } ifelse
} def
/NameProc {
  /RorO exch def
  {
    (  /FontName /) exch concatstrings (\n) concatstrings Outfile exch writestring
  }
  {
    Outfile (% /) KN concatstrings ( is not defined in this font file.\n) concatstrings writestring
    RorO 1 eq {
      Outfile (% Because it is a required parameter, the font will not be\n) writestring
      Outfile (% acceptable to PostScript.\n) writestring
    }
    {
      Outfile (% Because it is not a required parameter, the font will be\n) writestring
      Outfile (% acceptable to PostScript.\n) writestring
    } ifelse
  } ifelse
} def
/DictProc {
  /RorO exch def
  {
    Outfile (  /FontInfo\n  <<\n) writestring
    {
      exch 20 string cvs Outfile (    /) writestring
      Outfile exch writestring Outfile ( ) writestring
      dup type (stringtype) eq {
        Outfile (\() writestring
        Outfile exch writestring
        Outfile (\)\n) writestring
      }
      {
        20 string cvs Outfile exch writestring
        Outfile (\n) writestring
      } ifelse
    } forall
    Outfile (  >>\n) writestring
  }
  {
    RorO 1 eq {
      Outfile (% /) KN concatstrings ( is not defined in this font file.\n) concatstrings writestring
      Outfile (% Because it is a required parameter, the font will not be\n) writestring
      Outfile (% acceptable to PostScript.\n) writestring
    }
    {
      Outfile (% Because it is not a required parameter, the font will be\n) writestring
      Outfile (% acceptable to PostScript.\n) writestring
    } ifelse
  } ifelse
} def
/EncodingProc {
  /RorO exch def
  {
    Outfile (  /Encoding [\n) writestring
    {
      Outfile (    /) writestring
      48 string cvs Outfile exch writestring
      Outfile (\n) writestring
    } forall
    Outfile (  ]\n) writestring
  }
  {
    RorO 1 eq {
      Outfile (% /) KN concatstrings ( is not defined in this font file.\n) concatstrings writestring
      Outfile (% Because it is a required parameter, the font will not be\n) writestring
      Outfile (% acceptable to PostScript.\n) writestring
    }
    {
      Outfile (% Because it is not a required parameter, the font will be\n) writestring
      Outfile (% acceptable to PostScript.\n) writestring
    } ifelse
  } ifelse
} def
/CharStringsProc {
%  /NG 0 def
  /RorO exch def
  {
    Outfile (  /CharStrings\n  <<\n) writestring
    {
      exch
      Outfile (    /) writestring
      48 string cvs dup Outfile exch writestring
      GlyphArray i 3 2 roll put
      Outfile ( ) writestring
      48 string cvs Outfile exch writestring
      Outfile (\n) writestring
      /i i 1 add def 
    } forall
    Outfile (  >>\n) writestring
    NG 20 string cvs print ( glyphs are defined in this font.\n) print flush
    RFO NG 20 string cvs ( glyphs are defined in this font.\n) concatstrings writestring
  }
  {
    RorO 1 eq {
      Outfile (% /) KN concatstrings ( is not defined in this font file.\n) concatstrings writestring
      Outfile (% Because it is a required parameter, the font will not be\n) writestring
      Outfile (% acceptable to PostScript.\n) writestring
    }
    {
      Outfile (% Because it is not a required parameter, the font will be\n) writestring
      Outfile (% acceptable to PostScript.\n) writestring
    } ifelse
  } ifelse
} def
/SfntsProc {
  /RorO exch def
  {
    /S1 1 string def
    Outfile (  /sfnts [\n) writestring
    {
      Outfile (    <\n    ) writestring
      /ln 0 def
      {
        S1 exch 0 exch put
        Outfile S1 writehexstring
        /ln ln 1 add def
        ln 36 eq {
          /ln 0 def
          Outfile (\n    ) writestring
        } if
      } forall
      Outfile (>\n) writestring
    } forall
    Outfile (  ]\n) writestring
  }
  {
    RorO 1 eq {
      Outfile (% /) KN concatstrings ( is not defined in this font file.\n) concatstrings writestring
      Outfile (% Because it is a required parameter, the font will not be\n) writestring
      Outfile (% acceptable to PostScript.\n) writestring
    }
    {
      Outfile (% Because it is not a required parameter, the font will be\n) writestring
      Outfile (% acceptable to PostScript.\n) writestring
    } ifelse
  } ifelse
} def
% PSS, = Print Stack and Stop, is a debugging aid. When called it prints
% the contents of the stack at the time of the call and stops with error
% code 88
/PSS {(\n\nStack contents =\n) print pstack (End of stack contents\n\n) print 8 88 .quit} def
%%EndProlog
%%BeginSetup
%
% The value of the keyname Path is the full path to the location where you
% want the output files. As you can see, I create them in D:\Temp\ and
% transfer them from there to where I really wand them. You should change
% this path to suit your needs.
%
/Path (D:\\Temp\\) def
%%EndSetup
mark
shellarguments
{
  counttomark /narg exch def
  narg 1 eq not {
    (Error message #2 from TrueTypeToType42.ps\n) print
    (The call to TrueTypeToType42.ps must have one command line argument.\n) print
    (   The path name of the TTF file\n) print
    (You have ) print narg 10 string cvs print ( arguments.\n) print
    (Please correct and try again.\n\n\n) print
    9 99 .quit
  } if
}
{
  (Error message #1 from TrueTypeToType42.ps\n) print
  (You must use the -- command line switch in the call to GhostScript.\n) print
  (Please correct and try again.\n\n\n) print
  9 99 .quit
} ifelse

% The command line argument, converted to a string, is now on the stack.
% It is the full path name of the TrueType font file.
/InfilePath exch def pop

% Open the TrueType font file for reading and call it Infile
InfilePath (r) file /Infile exch def

% Convert Infile to a Type 42 font dictionary, call that dictionary TTF,
% and close Infile.
Infile .loadttfont /TTF exch def
Infile closefile

% Get the number of glyphs and define an array to receive their names.
TTF /CharStrings get length /NG exch def
/GlyphArray NG array def /i 0 def

% Get the PostScript name of the font and open the output
% file using that for its root and .pfa for its extension.
% Call this file Outfile.
Path TTF /FontName get concatstrings (.pfa) concatstrings (w) file /Outfile exch def
Outfile (%!PS-TrueType font\n) writestring

% Open the report file in the current directory. This file receives,
% in ASCII text format, the same report on the progress of this program
% as is written to the GhostScript standard output window.
/ReportFile (TrueTypeToType42.out) def
Path ReportFile concatstrings /ReportPath exch def
ReportPath (w) file /RFO exch def
RFO (Report from TrueTypeToType42 on the conversion of file ) InfilePath concatstrings (\n) concatstrings writestring
(\nThe font name is ) TTF /FontName get concatstrings (\n\n) concatstrings dup print
RFO exch writestring
% Open the Type 42 font dictionary file with left double guillemets.
Outfile (<<\n) writestring

% The next section is a search, and processing if found, of all the
% required and optional elements of a Type 42 font dictionary as
% laid out in tables 5.2, 5.3, and 5.7 of the PostScript Language
% Reference, PLR.

% Entries common to all font dictionaries, Table 5.2 of PLR

% The value of FontType is an integer. Required
(FontType) AAA R NumberProc

% The value of Fontmatrix is a numerical matrix containing six numbers. Required
(FontMatrix) AAA R NumericalMatrixProc

% The value of /FontName is a name type object, e.g. /Times-Roman. Required
(FontName) AAA R NameProc

% The value of FontInfo is a dictionary whose contents are defined in
% Table 5.5 of PLR. Optional
(FontInfo) AAA O DictProc

% The value of LanguageLevel is an integer. Optional
(LanguageLevel) AAA O NumberProc

% The value of WMode is an integer. Optional
(WMode) AAA O NumberProc

% Additional entries common to all base fonts, Table 5.3 of PLR

% The value of Encoding is an array of names. Required
(Encoding) AAA R EncodingProc

% The value of FontBBox is a numerical array. Required
(FontBBox) AAA R NumericalMatrixProc

% The value of UniqueID is an integer. Optional
(UniqueID) AAA O NumberProc

% The value of XUID is a numerical array. Optional
(XUID) AAA O NumericalMatrixProc

% Additional entries specific to Type 42 fonts, Table 5.7

% The value of CharStrings is a dictionary of glyph names and numbers.
% Required
(CharStrings) AAA R CharStringsProc

% The value of sfnts is an array of strings. Required
(sfnts) AAA R SfntsProc

% The value of PaintType is an integer. Required
(PaintType) AAA R NumberProc

% The value of StrokeWidth is a number. Optional
(StrokeWidth) AAA O NumberProc

% The following four items are all optional and seem to rarely occur
% in a TrueType font file. (I have not so far encountered any of them.)
% If one or more are found, that will be the time to add the appropriate
% processing procedure.

% The value of Metrica is a dictionary. Optional
(Metrics) AAA {
 ==
} if

% The value of Metrics2 is a dictionary. Optional
(Metrics2) AAA {
 ==
} if

% The value of CDevProc is a procedure. Optional
(CDevProc) AAA {
 ==
} if

% The value of GlyphDirectory is either an array or dictionary. Optional
(GlyphDirectory) AAA {
 ==
} if

% Terminate the Type 42 font dictionary and name the font with the
% name found as the value of the key /FontName
Outfile (>> begin FontName currentdict end definefont pop\n) writestring
Outfile closefile
% Sorting the glyph names. A bubble sort is used. This is slow but is
% easy to write. Please feel free to substitute a more efficient
% algorithm.
(Sorting the glyph names into ASCII order.\n) print
(This may take several minutes depending on the number of glyphs.\n) print
(PLEASE BE PATIENT.\n) print flush
RFO (\nSorting the glyph names into ASCII order.\n) writestring
RFO (This may take several minutes depending on the number of glyphs.\n) writestring
RFO (PLEASE BE PATIENT.\n) writestring
/nit 0 def
{
  /i 0 def /j 1 def /nex 0 def
  /nit nit 1 add def
  {
    GlyphArray i get /S1 exch def
    GlyphArray j get /S2 exch def
    S1 S2 gt {
      GlyphArray i S2 put
      GlyphArray j S1 put
      /nex nex 1 add def
    } if
    /i i 1 add def /j j 1 add def
    j NG eq {
      exit
    } if
  } loop
  nex 0 eq {exit} if
  nit 100 mod 0 eq {
    (Traversed the array of glyph names ) print nit 20 string cvs print ( times.\n) print flush
    RFO (Traversed the array of glyph names ) nit 20 string cvs concatstrings ( times.\n) concatstrings writestring
  } if
  nit NG 2 mul eq {
   (Error message from TrueTypeToType42\n) print
   (Bubble sort of glyph names not completed because of\n) print
   (an excessive number of iterations.\n) print
   (   nit = ) print 20 string cvs print (\n) print
   RFO (\nError message from TrueTypeToType42\n) writestring
   RFO (Bubble sort of glyph names not completed because of\n) writestring
   RFO (an excessive number of iterations.\n) writestring
   RFO (   nit = ) 20 string cvs concatstrings (\n) concatstrings writestrings
   8 88 .quit
  } if
} loop
(Sort completed. The glyph array has been traversed ) print nit 20 string cvs print ( times.\n\n) print
RFO (\nSort completed. The glyph array has been traversed ) nit 20 string cvs concatstrings ( times\n) concatstrings writestring
% The glyph names are now in ASCII sort order in an array called GlyphArray.
% Now determine the number of pages of output required for displaying all the glyphs
NG 141 sub dup 0 le {pop /iii 0 def}{/iii exch def} ifelse
iii 150 mod 0 eq {
  iii 150 idiv 1 add /NPG exch def}
  {
    iii 150 idiv 2 add /NPG exch def
} ifelse
(Now create the file ShowAllGlyphs.ps which will display all ) print NG 20 string cvs print (\n) print
(glyphs in ASCII sort order on ) print NPG 20 string cvs print ( pages of output.\n) print
% Creating the PostScript file which will print the glyphs.
% Open the output file for writing
(D:\\Temp\\ShowAllGlyphs.ps) (w) file /OF exch def
OF (%%!PS-Adobe-3.0\n) writestring
OF (%%Title: ShowAllGlyphs.ps\n) writestring
OF (%%Creator: TrueTypeTpType42.ps\n) writestring
OF (%%CreationDate: April 2002\n) writestring
OF (%%BoundingBox: 0 0 612 792\n) writestring
OF (%%Pages: ) NPG 10 string cvs concatstrings (\n) concatstrings writestring 
OF (%%EndComments\n) writestring
OF (%%BeginProlog\n) writestring 
% concatstrings is defined in GhostScript but not in PostScript so it
% is put here for printing on a PostScript printer.
OF (/concatstrings {\n) writestring
OF (  /concatdict 6 dict def\n) writestring
OF (  concatdict begin\n) writestring
OF (    /s2 exch def\n) writestring
OF (    /s1 exch def\n) writestring
OF (    s1 length /l1 exch def\n) writestring
OF (    s2 length /l2 exch def\n) writestring
OF (    /strng l1 l2 add string def\n) writestring
OF (    strng 0 s1 putinterval\n) writestring
OF (    strng l1 s2 putinterval\n) writestring
OF (    strng\n) writestring
OF (  end\n) writestring
OF (} def\n) writestring
% Procedure ctr centers a string
OF (/ctr{\n) writestring
OF (  4 -2 roll 2 copy translate\n) writestring
OF (  4 -2 roll exch dup rotate exch\n) writestring
OF (  dup stringwidth pop 2 div neg 0 moveto show\n) writestring
OF (  neg rotate\n) writestring
OF (  neg exch neg exch translate\n) writestring
OF (} def\n) writestring
% Procedure dl draws a line between two points
OF (/dl{moveto lineto stroke} def\n) writestring
OF (/mt{moveto} def\n) writestring
% Procedure nl starts a new line
OF (/nl {\n) writestring
OF (  count 0 eq {1.0}{\n) writestring
OF (    dup type 20 string cvs dup\n) writestring
OF (    (integertype) eq exch\n) writestring
OF (    (realtype) eq xor not {1.0} if\n) writestring
OF (  } ifelse\n) writestring
OF (  dy mul neg yp add /yp exch store xp yp moveto\n) writestring
OF (} def\n) writestring
% Procedure rj right justifies a string
OF (/rj{\n) writestring
OF (  4 -2 roll 2 copy translate\n) writestring
OF (  4 -2 roll exch dup rotate exch\n) writestring
OF (  dup stringwidth pop neg 0 moveto show\n) writestring
OF (  neg rotate\n) writestring
OF (  neg exch neg exch translate\n) writestring
OF (} def\n) writestring
OF (/sg{setgray} def\n) writestring
% Procedure PB1 grids the first page
OF (/PB1 {\n) writestring
OF (  0.7 sg 2.0 slw 36 36 540 720 rectstroke\n) writestring
OF (  36 711 576 711 dl\n) writestring
OF (  216 36 216 711 dl 396 36 396 711 dl 0 sg\n) writestring
OF (} def\n) writestring
% Procedure PBX grids all pages after the first. It takes a single integer
% argument, the page number and prints Page <number> at top right of page.
OF (/PBX {\n) writestring
OF (  gsave\n) writestring
OF (  /ipg exch def\n) writestring
OF (  594 766 0 /Times-Bold 14 selectfont) ((Page )) concatstrings ( ipg 10 string cvs concatstrings rj\n) concatstrings writestring
OF (  0.7 sg 2.0 slw 36 36 540 720 rectstroke\n) writestring
OF (  216 36 216 756 dl 396 36 396 756 dl 0 sg\n) writestring
OF (  grestore\n) writestring
OF (} def\n) writestring
OF (/sh{show} def\n) writestring
OF (/slw{setlinewidth} def\n) writestring
% Procedure F1 defines 12 point Times Roman for printing the glyph names and
% procedure F2 defines the TrueType font at 12 points for printing the glyphs.
OF (/F1 {/Times-Roman 12 selectfont} def\n) writestring
OF (/F2 \{/) TTF /FontName get concatstrings ( 12 selectfont} def\n) concatstrings writestring
% Open the Type 42 version of the font file for reading and call it FF
Path TTF /FontName get concatstrings (.pfa) concatstrings (r) file /FF exch def
% The following loop copies the Type 42 version of the font file to the glyph display file
{
  FF 500 string readline { % I have had problems with the length of this string. It seems to be long enough now but if you get an error message from readline, try increasing it.
    OF exch (\n) concatstrings writestring
  }
  {
    pop exit
  } ifelse
} loop
FF closefile
% 
OF (%%EndProlog\n) writestring
OF (%%BeginSetup\n) writestring
% I have set Duplex to false so that you can use this with a simplex only printer.
% However, if you have duplex capability, you will probably want to use it
% so change the value of Duplex to true.
% I have also set MediaPosition to 3 to suit my printer. You will probably
% have to change the value to suit your printer.
OF (<< /Duplex false /MediaPosition 3 >> setpagedevice\n) writestring
OF (/NG ) NG 20 string cvs concatstrings ( def\n) concatstrings writestring
OF (%%EndSetup\n) writestring
OF (%%Page: 1 1\n) writestring
OF (/ypo 710 def /dy 14 def /xpo 42 def /xppo xpo 147 add def\n) writestring
OF (PB1\n) writestring
OF (/Times-Bold 18 selectfont\n) writestring
OF ( 306 738 0 \() TTF /FontName get concatstrings ( Glyphs) concatstrings (\) ctr\n) concatstrings writestring
OF (/Times-Bold 12 selectfont\n) writestring
OF (306 723 0 (All ) NG 20 string cvs concatstrings ( glyphs are shown in ASCII sort order) concatstrings ctr\n) writestring
OF (F2\n) writestring
% Now print the first page
(Creating the first page\n) print
OF (/yp ypo def /xp xpo 180 sub def /xpp xp 147 add def\n) writestring
/IG 0 def
NG 144 gt {/RPT 144 def}{/RPT NG def} ifelse
3 {
  IG NG ge {exit} if
  OF (/yp ypo def /xp xp 180 add def /xpp xpp 180 add def\n) writestring
  48 {
    OF (1.0 nl F1 \() GlyphArray IG get concatstrings (\) show) concatstrings ( xpp yp mt ) concatstrings writestring
    OF (F2 /) GlyphArray IG get concatstrings ( glyphshow\n) concatstrings writestring
    /IG IG 1 add def
    IG NG ge {exit} if
  } repeat
} repeat
OF (showpage\n) writestring
% If IG is greater than or equal to NG the job is done, else create subsequent pages.
OF (/ypo ypo dy 3 mul add def\n) writestring
/IPG 1 def
{
  IG NG ge {exit} if
% The next line is a safety switch. If something goes wrong you may be stuck in this
% loop forever. The next line exits if IPG exceeds 20. This allows for a maximum of
% 3013 glyphs which is well beyond anything I have encountered. If it is too small,
% increase the maximum page number to suit.
  IPG 20 gt {exit} if
  /IPG IPG 1 add def
  (Creating page ) IPG 10 string cvs concatstrings (\n) concatstrings print
  OF (%%Page: ) IPG 10 string cvs concatstrings ( ) concatstrings IPG 10 string cvs concatstrings (\n) concatstrings writestring
  OF (/yp ypo def /xp xpo def\n) writestring
  OF IPG 10 string cvs ( PBX\n) concatstrings writestring
  OF (/yp ypo def /xp xpo 180 sub def /xpp xp 147 add def\n) writestring
  NG 144 gt {/RPT 144 def}{/RPT NG def} ifelse
  3 {
    IG NG ge {exit} if
    OF (/yp ypo def /xp xp 180 add def /xpp xpp 180 add def\n) writestring
    51 {
      OF (1.0 nl F1 \() GlyphArray IG get concatstrings (\) show) concatstrings ( xpp yp mt ) concatstrings writestring
      OF (F2 /) GlyphArray IG get concatstrings ( glyphshow\n) concatstrings writestring 
      /IG IG 1 add def
      IG NG ge {exit} if
    } repeat
  } repeat
  OF (showpage\n) writestring
} loop
OF (%%Trailer\n) writestring
OF (%%EOF) writestring
OF closefile
(Three output files have been created:\n) print
(      ) TTF /FontName get concatstrings (.pfa,\n) concatstrings print
(      ShowAllGlyphs.ps\n) print
(      TrueTypeToType42.out\n) print
(They will be found in folder ) Path concatstrings (\n) concatstrings print
%%Trailer
%%EOF