program DEC2DAT;

(* DEC2DAT Converter für PicoBlaze-Cores, LongWord-DATs    *)
(* für Borland Pascal 7, von C. Meyer 2/2009 (!)    *)

{$R-} (* Array-Bereichs-Check ausschalten! *)

uses  dos;

const signon = ^m^j'Dec2Dat Converter 4 Bytes/Line LSB first'^m^j;

var   decfilename,datfilename,filext : string;

(* Untersuchen eines Dateinamens auf Angabe einer extension,   *)
(* gefundene extension wird (Upcase) in FILEXT gespeichert.    *)

function hasextension(s:string):boolean;
var i,j : integer;
begin
  hasextension:=false;
  filext:='';
  for i:=length(s) downto 2 do begin
    if s[i]='.' then begin
      hasextension:=true;
      filext:=copy(s,succ(i),255);
      for j:=1 to length(filext) do
        filext[j]:=upcase(filext[j]);
      exit;
      end;
    end;
  end;

function extractfilename(s:string):string;
var j : integer;
begin
  j:=pos('.',s);
  extractfilename:=copy(s,0,j-1);
end;

procedure gethexfile;
var decfile          : text;
    binfil: file of LongInt; {ggf. ändern auf Word oder Byte}
    s               : string;
    i,n : byte;
    zeile       : word;
    wert	    : longint; {ggf. ändern auf Word oder Byte}

  function gethex(ziffern:byte):longint;
  var st  : string;
      x : longint;
      converr: Integer;
  begin
    st:=copy(s,0,ziffern);
    val(st,x,converr);
    gethex:=x;
    if converr <> 0 then
    begin
      writeln('Error at line ',zeile);
      halt;
    end;
  end;

begin
  assign(decfile,decfilename);
  {$I-} reset(decfile); {$I+}
  if ioresult<>0 then begin
    writeln('Error opening ',decfilename);
    halt;
  end;
  assign(binfil,datfilename);
  rewrite(binfil);
  zeile:=0;
  while not eof(decfile) do begin
    readln(decfile,s);
    if s[1] <> '@' then
    begin
      n:=length(s);
      inc(zeile);
      wert:=gethex(n);
      write(binfil,wert);
    end;
  end;
  close(decfile);
  close(binfil);
  write(zeile);
  writeln(' lines read');
  write(zeile*4);
  writeln(' Bytes written to file ', datfilename);
end;


(*---------------------------- MAIN ---------------------------*)

begin
  writeln(signon);
  if paramcount>0 then decfilename:=paramstr(1) else begin
    write('DEC-Filename: ');
    readln(decfilename);
    if decfilename='' then halt;
    end;
  if hasextension(decfilename) then
    begin
      datfilename:=extractfilename(decfilename)+'.DAT';
      gethexfile;
    end
  else
  begin
    datfilename:=decfilename+'.DAT';
    decfilename:=decfilename+'.DEC';
    gethexfile;
  end;
end.