program w;
{ converts the WORLDDAT.KER file as received by KERMIT into
  the correct WORLD.DAT file as described in R.Miller & F.Reddy
  "Mapping the World in Pascal", BYTE Dec.1987, p.329-334.

  Conversion was necessary because KERMIT inserted "&" (Hex 26) chars
  during binary transfer to indicate that the eighth bit of the following
  byte needed to be set. Apparently, my KERMIT did not transform
  those codes back into the original bytes during transfer but kept
  them in the file.
  Note: Code "f" (=Hex 66) also needed to be filtered out; it actually
        stands for a "true" "&" (Hex 26).

  Andreas Herrmann   06 Apr 1988
  }
const RECSIZ=128;
      RECMAX=127;
      BUFMAX=12;

type llrec = record
             code: array[0..1] of char;
             long,lat: integer;
             end;

var pairs,lines,skipped:integer;    { counters }
    inf: FILE;                      { input file, unformatted }
    outf: FILE of llrec;            { output file, fixed record length }
    rec: array[0..RECMAX] of byte;  { input record }
    fsize,sec,ind:integer;          { file size, sector, sector index }
    ch:byte;                        { input byte }
    ll: llrec;                      { output record }
    done:boolean;                   { = true when thru with input file }

var int:integer;                    { word to hold 16 bit integer }
    pint:integer;                   { pointer to that word }

var buffer:array[1..BUFMAX] of byte;{ display buffer }
    bp:integer;                     { display buffer index }

{$Ihex.pas}

procedure prtbuf;  { displays the current buffer and reset pointer }
var i:integer;
begin
{
if ll.code='LS' then writeln;
write(ll.code:2,ll.long:6,ll.lat:6,'  ');
for i:=1 to bp do write(' ',hexbyte(buffer[i]));
for i:=bp+1 to BUFMAX do write('   ');
for i:=1 to bp do
    if (buffer[i]>=$20) and (buffer[i]<$7F) then
        write(chr(buffer[i]))
    else
        write('.');
writeln;
}
bp:=0;
end;

function getch:byte;  { returns next input byte file, converts special codes }
label exit;
var c:byte;
    flag8:boolean;
begin
flag8:=false;
repeat
  if ind>RECMAX then
    if sec<fsize then
        begin sec:=sec+1; blockread(inf,rec,1); ind:=0; end
    else
        begin done:=true; getch:=-1; goto exit; end;
  c:=rec[ind];
  ind:=ind+1;
  if bp<BUFMAX then
      begin bp:=bp+1; buffer[bp]:=c; end;
  if flag8 then
      begin c:=c or $80; flag8:=false; end
  else if c=ord($26) then flag8:=true
  else if c=ord($66) then c:=ord($26);
until not flag8;
getch:=c;
exit:
end;

function getint:integer;  { returns next 2 input bytes as integer }
begin
Mem[pint]  :=getch;
Mem[pint+1]:=getch;
getint:=int;
end;

procedure getpair;  { reads pair of integers for next record}
begin
ll.long:=getint;
ll.lat :=getint;
pairs:=pairs+1;
end;

procedure getls;  { writes "LS" record }
begin
ch:=getch;
if ch=ord('S') then
    begin
    ll.code:='LS';
    getpair;
    write(outf,ll);
    lines:=lines+1;
    prtbuf;
    end
else
    skipped:=skipped+1;
end;

procedure gets;  { writes "S " record }
begin
ch:=getch;
if ch=ord(' ') then
    begin 
    ll.code:='S ';
    getpair;
    write(outf,ll);
    prtbuf;
    end
else
    skipped:=skipped+1;
end;

begin { Main program }
pint:=addr(int);
assign(inf,'worlddat.ker');
reset(inf);
assign(outf,'world.dat');
rewrite(outf);
fsize:=Filesize(inf);
writeln('Input file Size = ',fsize,' sectors');
sec:=0; bp:=0; lines:=0; pairs:=0; skipped:=0;
done:=false;
repeat
    ch:=getch;
    if not done then
        begin
        if ch=ord('L') then getls
        else if ch=ord('S') then gets
        else skipped:=skipped+1;
        end;
until done;
close(inf); close(outf);
writeln(lines,' curves, ',pairs,' point pairs, ',skipped,' bytes skipped');
end.
