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
|
{$R-} {Range checking off}
{$B-} {Short-circuit Boolean evaluation}
{$S-} {Stack checking off}
{$I+} {I/O checking on}
{$N-} {No numeric coprocessor}
{$M 65500, 16384, 655360} {Turbo 3 default stack and heap}
program ACWtoSC; {converts the Hershey font tables distributed by The Austin
Code Works to the format expected by the Cfont program of SoftCraft, Inc.}
const
PenUp : integer = $4000;
type
S3 = string[3];
var
Buf1 : array[1..$2000] of char;
F1 : text;
H : file of integer;
L1 : string[80];
Fn : array[1..2] of string[64];
Code, I, L, M, XY : integer;
X, Y : array[1..144] of integer;
Eoc : boolean;
function V(S : S3) : integer;
var
I : integer;
begin
Val(S, I, Code);
if (Code <> 0) or ((I < -49) and (I <> -64)) or (I > 49) then
begin
Writeln(L1);
Writeln('Code = ', Code);
Halt(3);
end;
V := I;
end;
begin
if ParamCount <> 2 then
begin
Writeln('Usage: ACWTOSC file1 file2');
Halt(3);
end;
for L := 1 to 2 do
begin
Fn[L] := ParamStr(L);
for M := 1 to Length(Fn[L]) do
Fn[L][M] := UpCase(Fn[L][M]);
end;
Assign(F1, Fn[1]);
SetTextBuf(F1, Buf1);
{$I-} Reset(F1); {$I+}
if IOResult <> 0 then
begin
Writeln('Cannot open ', Fn[1]);
Halt(3);
end;
Assign(H, Fn[2]);
{$I-} Rewrite(H); {$I+}
if IOResult <> 0 then
begin
Writeln('Cannot open ', Fn[2]);
Close(F1);
Halt(3);
end;
while not Eof(F1) do
begin
Readln(F1, L1);
if Copy(L1, 5, 1) <> ' ' then
begin
M := 0;
Eoc := false;
end;
L := 0;
repeat
Inc(L);
Inc(M);
X[M] := V(Copy(L1, 8 * L + 1, 3));
Y[M] := V(Copy(L1, 8 * L + 5, 3));
if (X[M] = -64) and (Y[M] = -64) then
begin
Eoc := true;
Write(H, Code); {two bytes of zeros before each character}
XY := 256 * (Y[1] + 64) + X[1] + 64; {width of character}
Write(H, XY);
for I := 2 to Pred(M) do
if X[I] = -64 then
Write(H, PenUp)
else
begin
XY := 256 * (73 + Y[I]) + X[I] + 64;
Write(H, XY);
end;
end;
until (L = 8) or Eoc;
end;
Write(H, Code); {two bytes of zeros at end of file}
Close(F1);
Close(H);
end.
|
