blob: 4c44f593b7fff544a14f05ca1d23d2330d289f4a (
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
|
program pfbnames;
uses Dos;
var DirInfo: SearchRec;
function getFontName (fn: string): string;
const separators = [' ', ^I, ^M, ^J];
var f: file of char;
{ 'text' would sometimes interpret one of the first 6 binary
(block header) bytes as EOF . On the other hand, 'file of char'
is slow (stupid Turbo, probably not buffering file input other
than 'text' (Does Turbo-7 remedy this?). Maybe 'file' with
block operations should be used. }
lasttoken: string;
lastch: char;
procedure getchar;
begin
if eof (f) then lastch := chr (0)
else read (f, lastch)
end;
procedure gettoken;
begin
while lastch in separators do getchar;
if lastch = '/' then begin
lasttoken := '/';
getchar;
end else lasttoken := '';
while not eof (f) and not (lastch in separators + ['/']) do begin
lasttoken := lasttoken + lastch;
getchar;
end;
end;
begin
assign (f, fn);
reset (f);
lastch := ' ';
lasttoken := '';
while not eof (f) and (lasttoken <> '/FontName')
do gettoken;
gettoken;
getFontName := lasttoken;
close (f)
end;
begin
if paramcount > 0 then writeln (getFontName (paramstr (1)))
else begin
FindFirst ('*.pfb', $00, DirInfo);
while DosError = 0 do begin
writeln (DirInfo.Name, ':', ' ': 13 - length (DirInfo.Name),
getFontName (DirInfo.Name));
FindNext (DirInfo)
end
end
end.
|
