summaryrefslogtreecommitdiff
path: root/dviware/psprint/unix/fontlist.ps
blob: 4bcd9d57b105c964f42945cfb59a212f0e687eed (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
% Produces an alphabetical list of fonts available in printer.

/MaxNrOfFonts 50 def    % Maximum numbers of fonts...
/Xpos 136 def
/Ypos 690 def
/num 0 def              % local counter
/incr {
  /num num 1 add def
} def

/s40 { 40 string } def  % Proper length of the fontname

/showline {             % Show and newlines
  show
  newline
} def

/newline {              % Spacing between lines
  /Ypos Ypos 12 sub def
  Xpos Ypos moveto
} def

/CountFonts {           % Count the fonts and put the names into array
  FontDirectory
  {
    pop
    s40
    cvs
    incr
  }
  forall
  /FontArray num array def
  FontArray astore
  pop
} def

/ListFonts {            % Sort the fonts and show them on paper
  Bubbelsort
  FontArray
  {
    showline
  }
  forall
} def

/Bubbelsort {           % Here is the sorting routine
  1 1 num 1 sub
  {
    /localcount exch def
    num 1 sub -1 localcount
    {
      /innercount exch def
      /firststring FontArray innercount 1 sub get def
      /secondstring FontArray innercount get def
      firststring secondstring gt
      {
         FontArray innercount 1 sub secondstring put
         FontArray innercount firststring put
      } if
    } for
  } for
} def

/prettyline
{  /YPOSition exch def
   newpath
     Xpos Ypos YPOSition add moveto
     Xpos 100 add Ypos YPOSition add lineto
   stroke
} def

/Times-Roman findfont 12 scalefont setfont
14 prettyline

Xpos Ypos 18 add moveto
CountFonts
(Number of fonts: ) show
num s40 cvs show

30 prettyline
Xpos Ypos moveto
ListFonts
newline

/Times-Bold findfont 12 scalefont setfont
(Total memory: ) show
vmstatus s40 cvs show newline
(Memory used: ) show
s40 cvs show newline
pop
(Free memory: ) show
vmstatus exch sub s40 cvs show newline newline
pop
/Times-Roman findfont 12 scalefont setfont
(From ulfis@nada.kth.se, 88-10-05) show

showpage