program D2C(input,output);

(* Convert ASCII Dump to .COM file *)

(* ASCII line shows like this: *)

(* "08B0| 02 41 44 43 20 48 02 41 44 43 20 4C 02 41 44 43 |.ADC H.ADC L.ADC" *)

const
  DEBUG        = FALSE;
type
  FSTR         = string[ 14];
  LSTR         = string[255];
  FileC        = file;
var
  bytecount,
  recptr       : integer;
  recbuff      : array[0..127] of byte;
  Fi           : text;
  Fo           : FileC;
  FNi,
  FNo          : FSTR;

procedure OpenInfile(var F:text);
var
  i            : integer;
Begin
  if ParamCount<>1 then
  repeat
    write('Name of file: ');
    readln(FNi);
  until length(FNi)<>0
  else FNi:=ParamStr(1);
  for i:=1 to length(FNi) do FNi[i]:=upcase(FNi[i]);
  assign(F,FNi);
  {$I-}reset(F);{$I+}
  if IOresult<>0 then
  begin
    writeln('Cannot find file ',FNi,' - abort');
    halt;
  end;
  if DEBUG then writeln('Opened file ',FNi);
End;

procedure OpenOutfile(var F:FileC);
var
  ext          : integer;
Begin
  ext:=pos('.',FNi);
  if ext=0 then ext:=length(FNi)
           else ext:=pred(ext);
  FNo:=copy(FNi,1,ext)+'.COM';
  assign(F,FNo);
  {$I-}rewrite(F);{$I+}
  if IOresult<>0 then
  begin
    writeln('Cannot create file ',FNo,' - abort');
    halt;
  end;
  recptr:=0;
  bytecount:=0;
  if DEBUG then writeln('Created file ',FNo);
End;

procedure writetofile;
var
  res          : integer;
Begin
  {$I-}blockwrite(Fo,recbuff,1,res);{$I+}
  if res<>1 then
  begin
    writeln('Cannot write to file ',FNo,' - abort');
    halt;
  end;
  recptr:=0;
End;

procedure putbyte(b:byte);
Begin
  if DEBUG then
  begin
    writeln('Pointer=',recptr);
  end;
  if recptr=128 then writetofile;
  recbuff[recptr]:=b;
  recptr:=succ(recptr);
  bytecount:=succ(bytecount);
End;

procedure ConvertLines;
var
  Fileend      : boolean;
  Line         : LSTR;
  beg          : integer;

  procedure illcode;
  begin
    writeln('Invalid line >',Line,'<');
    writeln('Abort');
    halt;
  end;

  function a2h:byte;
  var
    ch         : char;
  begin
    beg:=succ(beg);
    ch:=Line[beg];
    case ch of
      '0'..'9' : a2h:=ord(ch)-ord('0');
      'A'..'F' : a2h:=ord(ch)-ord('A')+10;
      else illcode;
    end;
  end;

  procedure getHex;
  var
    hex        : byte;
    i          : integer;
  begin
    beg:=pos('|',Line);
    if beg=0 then illcode;
    for i:=1 to 16 do
    begin
      beg:=succ(beg);
      if Line[beg]<>' ' then illcode;
      hex:=16*a2h+a2h;
      putbyte(hex);
    end;
    if Line[beg+1]<>' ' then illcode;
    if Line[beg+2]<>'|' then illcode;
  end;

  procedure flushbuffer;
  begin
    if recptr<>0 then writetofile;
  end;

Begin (* ConvertLines *)
  Fileend:=false;
  while not Fileend do
  begin
    Fileend:=eof(Fi);
    if not Fileend then
    begin
      readln(Fi,Line);
      if DEBUG then writeln('Read line ',Line);
      Fileend:=length(Line)=0;
      if not Fileend then getHex;
    end;
  end;
  flushbuffer;
End;

BEGIN (* M A I N *)
  OpenInfile(Fi);
  OpenOutfile(Fo);
  ConvertLines;
  close(Fi);
  close(Fo);
  writeln(bytecount,' bytes written to file ',FNo);
END.