uses lacrt; {For unit LACRT download the source code of Blocek or Kasmar}

Procedure Mode_Create(fname,title:string);
var t:text;
    u:file;
    s,o,k,d1,d2:string;
    a,j:word;
    b:integer;
    i1,i2:integer;
    ut:array[0..255] of word;

begin
If not ExistFile(fname) then writeln('File: "'+fname+'" does not exist.')
   else begin
   j:=IzolujPrvniCislo(fname);
   if j=0 then o:=StripName(fname)+'.tbl' else
   if j<999 then o:='cp'+MyStr(j)+'uni.tbl'
            else o:='c'+MyStr(j)+'uni.tbl';

   Assign(u,o);
   Rewrite(u,1);
   k:=title+#13#10+#1; {ta #1 specifikuje subformat TBL souboru (ASCII->Unicode)}
   BlockWrite(u,k[1],Length(k));

   Assign(t,fname);
   Reset(t);

   for a:=0 to 255 do ut[a]:=a;

   while not Eof(t) do
      begin
      readln(t,s);
      s:=SkipBegSpaces(s);
      if s[1]<>'#' then
         begin
         NahradZnaky(s,#9,' ');
         d1:=VratSlovo(s,1);
         d2:=VratSlovo(s,2);
         delete(d1,1,2);       {smaze prefix "0x" z prvniho slova}
         delete(d2,1,2);       {smaze prefix "0x" z druheho slova}
         i1:=hex2dec(d1);
         i2:=hex2dec(d2);
         ut[i1]:=i2;
         end;
      end;

   for a:=128 to 255 do BlockWrite(u,ut[a],2);
   Close(t);
   Close(u);
   end;

writeln('File "'+o+'" was successfuly created.');
end;




Procedure Mode_Modify(fname,title:string);
var s:string;
    l,g:longint;
    P:pchar;
    t,u:file;
    a,b:byte;

begin
If not ExistFile(fname) then writeln('File: "'+fname+'" does not exist.')
   else begin
   assign(t,fname);
   Reset(t,1);
   l:=FileSize(t);
   GetMem(p,l);
   BlockRead(t,p^,l);       {nacte cely soubor do bufferu}
   Close(t);
   b:=0;
   if l>255 then g:=255 else g:=l;
   for a:=0 to g do
       if p[a]=#13 then
          begin
          if p[a+1]=#10 then b:=a+1 else b:=a;
          Break;
          end;
   if b=0 then writeln('Incorrect format of file: ',fname)
      else begin
      if title='' then title:='*'#13#10 else title:=title+#13#10;
      Assign(u,'_temp_.tmp');
      Rewrite(u,1);
      BlockWrite(u,title[1],Length(title));
      BlockWrite(u,p[b+1],l-b-1);
      Close(u);
      Erase(t);
      Rename(u,fname);
      end;
   end;
end;


var s,t:string;
    a:byte;
    alt,syn_ok:boolean;

begin
s:=GetCommandLine;

alt:=false;
a:=LFNparamcount(s);
if a=2 then syn_ok:=true else
if a=3 then
   begin
   t:=Convert_up(lfnparamstr(s,1));
   if (t='/A') or (t='-A') then begin syn_ok:=true;alt:=true;end else syn_ok:=false;
   end else syn_ok:=false;

if syn_ok=false then
   begin
   writeln('USAGE:');
   writeln('TXT2UNI [/A] <infile> <table name>');
   writeln('/A : alternate function - does not create a new .TBL file but');
   writeln('changes the description title inside existing <infile> .TBL file.');
   writeln;
   writeln('When the /A is omited then following syntax is used:');
   writeln('<infile>     : The source .TXT file you want to covert from');
   writeln('<table name> : Description title inside generated .UNI file');
   writeln('               (can be written inside quotes like "Czech 895")');
   writeln('Note: File name for output file will be generetad automaticaly.');
   writeln;
   writeln('Note 2: source input files for unicode <> codepade conversions can be found');
   writeln('on the various places including the unicode servers like here:');
   writeln('ftp://ftp.unicode.org/Public/MAPPINGS/');
   halt(0);
   end;

if alt=true then Mode_Modify(LFNparamstr(s,2),LFNparamstr(s,3))
            else Mode_Create(LFNparamstr(s,1),LFNparamstr(s,2));

end.
