summaryrefslogtreecommitdiff
path: root/fonts/hershey/hershey.pas
blob: 1a27674f7155dfb5eda260e8c8a3fc24d18d0c2c (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
{$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.