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
|
{$R-} {Range checking off}
{$B-} {Short-circuit Boolean evaluation}
{$S-} {Stack checking off}
{$I+} {I/O checking on}
{$N-} {Numeric coprocessor absent}
{$M 65500, 16384, 655360} {Turbo 3 default stack and heap}
program Hershey; {generates METAFONT source code from a Hershey character
database in SoftCraft format}
const
NMax = 157; {maximum number of plotter pen movement commands for one
character in the databases}
PenUp = $4000;
EndOfChar = 0;
var
H : file of integer; {Hershey database input}
Log : text; {METAFONT source output}
Code, Depth, EndChar, Height, I, J, K, N, StartChar, Width, XMax, XMin, Y0,
YMax, YMin : integer;
XY : array[0..NMax] of integer; {(x, y) coordinates}
Z : array[1..NMax] of byte; {METAFONT variables}
Database : string[7]; {database filename without extension}
procedure ReadH; {reads a plotter directive from the input file}
begin
if Eof(H) then
begin
Writeln('End of file at char = ', Code);
Close(H);
Close(Log);
Halt;
end;
Inc(N);
Read(H, XY[N]);
end; {ReadH}
begin
if ParamCount <> 3 then
begin
Writeln('Usage: HERSHEY database start end');
Halt;
end;
Database := ParamStr(1);
for Code := 1 to 7 do
Database[Code] := UpCase(Database[Code]);
Val(ParamStr(2), StartChar, Code);
if Code <> 0 then
begin
Writeln('Starting character not an integer');
Halt;
end;
Val(ParamStr(3), EndChar, Code);
if Code <> 0 then
begin
Writeln('Ending character not an integer');
Halt;
end;
Assign(H, Database + '.CHR');
Reset(H);
Assign(Log, Database + '.LOG');
Rewrite(Log);
Writeln(Log, '% ', Database + '.CHR ', StartChar, ' to ', EndChar);
for Code := 0 to StartChar do
begin
N := -1;
repeat
ReadH;
until XY[N] = EndOfChar;
end; {skip forward to specified start character}
Z[1] := 1;
for Code := StartChar to EndChar do
begin
Writeln(Log);
Writeln(Log, 'cmchar "', Database, ' ', Code, '";');
N := -1;
ReadH; {the width bytes}
XMin := Lo(XY[0]); {minimum x coordinate}
XMax := Hi(XY[0]); {maximum x coordinate}
Width := XMax - XMin; {width of character}
Y0 := 73; {default y bias}
if Database = 'HERSHEY' then
case Code of
0..88: Y0 := 68;
397..672: Y0 := 70;
end;
{Find minimum and maximum y values.}
YMax := 0;
YMin := 256;
repeat
ReadH;
if (XY[N] <> PenUp) and (XY[N] <> EndOfChar) then
begin
if Hi(XY[N]) > YMax then
YMax := Hi(XY[N]);
if Hi(XY[N]) < YMin then
YMin := Hi(XY[N]);
end; {if a real coordinate}
until XY[N] = EndOfChar;
Height := Y0 - YMin;
if YMax > Y0 then
Depth := YMax - Y0
else
Depth := 0;
Writeln(Log, 'beginchar(', Code mod 128, ', ', Width, 'u#, ', Height,
'u#, ', Depth, 'u#);');
Writeln(Log, 'adjust_fit(0, 0);');
Writeln(Log, 'pickup plotter_pen;');
for I := 2 to Pred(N) do
begin {enumerate unique coordinates}
Z[I] := 0;
if XY[I] <> PenUp then
begin
for J := Pred(I) downto 1 do
if XY[I] = XY[J] then
Z[I] := J;
if Z[I] = 0 then
Z[I] := I;
end;
end;
for I := 1 to Pred(N) do
if Z[I] = I then
Writeln(Log, 'z', I, ' = (', Lo(XY[I]) - XMin, 'u, ', Y0 - Hi(XY[I]),
'u);');
I := 0;
J := 1;
repeat
Inc(I);
if (XY[I] = PenUp) or (XY[I] = EndOfChar) then
begin
case I - J of {number of points joined by consecutive line segments}
0: ;
1: Writeln(Log, 'drawdot z', Z[J], ';');
2: if Z[J] = Z[Succ(J)] then
Writeln(Log, 'drawdot z', Z[J], ';')
else
Writeln(Log, 'draw z', Z[J], '--z', Z[Succ(J)], ';');
else
begin
Write(Log, 'draw z', Z[J]);
for K := Succ(J) to Pred(I) do
Write(Log, '--z', Z[K]);
Writeln(Log, ';');
end; {3 or more}
end; {case}
J := Succ(I);
end; {if a real coordinate}
until I = N;
Writeln(Log, 'endchar;');
end; {specified range of characters}
Close(H);
Close(Log);
end.
|
