program TSTFDmovfix;
uses crt, dos;

type
    fourbyte   = array [1..4] of byte;
    hfile      = array [1..12] of byte;
    fileinmix = Record
      name:string[20];
      ID:fourbyte;
    end;
const
    intr0:fileinmix = (name: 'intr0.vqa';
                       ID:   ($25, $70, $42, $B1));
    intr1:fileinmix = (name: 'intr1.vqa';
                       ID:   ($BB, $70, $E8, $7D));
    intro:fileinmix = (name: 'intro.vqa';
                       ID:   ($19, $F3, $32, $C4));
    fullHeader:hfile  = ($FF, $FF, $FF, $FF,
                         $FF, $FF, $FF, $FF,
                         $FF, $FF, $FF, $FF);
    hardsilent:boolean=false;
    hardmode:integer=3;
     // 1=write
     // 2=undo
     // 3=toggle
var
  mode,hack1done,hack2done:integer;
  beta,silent:boolean;
  f:file;

procedure cntin;
var pause: char;
begin
   writeln;
   writeln('Press any key to continue.');
   repeat until keypressed;
    pause:=ReadKey();
end; {cntin}

function openFile(filename:String) : boolean;
var
  status:integer;
begin
  assign(f,filename);
  {$I-}
  reset(f,1);
  status:=IOResult;
  if status<>0 then
   begin
    writeln();
    writeln();
    writeln('Error opening "',filename,'".');
    writeln();
    openFile:=false;
    {$I+}
   end
  else openFile:=true;
end; {openFile}


procedure CloseFile();
begin
  close(f);
  {$I+}
end;


function hfile2fourbyte(data:hfile):fourbyte;
var i:integer;
begin
  for i:=1 to 4 do
    hfile2fourbyte[i]:=data[i];
end;

function fourbyte2int(data:fourbyte):longword;
var i:integer;
begin
  fourbyte2int:=0;
  for i:=4 downto 1 do
    fourbyte2int:=fourbyte2int*$100+data[i];
end;

function hfile2int(data:hfile):longword;
begin
  hfile2int:=fourbyte2int(hfile2fourbyte(data));
end;

function fourbyte2hexstr(hex:fourbyte):string;
var i:integer;
begin
  fourbyte2hexstr:='';
  for i:=4 downto 1 do
   begin
    if ((hex[i] div 16) >=10) then fourbyte2hexstr:=fourbyte2hexstr+char((hex[i] div 16)+55)
    else fourbyte2hexstr:=fourbyte2hexstr+char((hex[i] div 16)+48);
    if ((hex[i] mod 16) >=10) then fourbyte2hexstr:=fourbyte2hexstr+char((hex[i] mod 16)+55)
    else fourbyte2hexstr:=fourbyte2hexstr+char((hex[i] mod 16)+48);
   end;
end;

function hfile2hexstr(hex:hfile):string;
begin
  hfile2hexstr:=fourbyte2hexstr(hfile2fourbyte(hex));
end;


procedure rewriteHeader(filenm:String);
var
  i,j,files,usedindex:integer;
  actual:word;
  size: array[1..2] of byte;
  oldheader: array [1..255] of hfile;
  newheader: array [1..255] of hfile;
begin
  usedindex:=1;
  if not silent then write('Rewriting MIX header of file: ',filenm);
 {} if beta then writeln();
  if (openFile(filenm)) then
   begin
    seek(f,4);
    blockread(f,size,2,actual);
    files:=size[1]+size[2]*$100;
    if beta then writeln('Number of files: ',files);
 {} if beta then cntin;
    for i:=1 to files do
     Begin
      seek(f,10+((i-1)*12));
      blockread(f,oldheader[i],12,actual);
  {}  if beta then writeln (hfile2hexstr(oldheader[i]));
      if (oldheader[i][4] >= $80) then oldheader[i][4]:=oldheader[i][4]-$80
      else oldheader[i][4]:=oldheader[i][4]+$80;
     end;
    if beta then writeln('Header read.');
 {} if beta then cntin;
    for i:=1 to files do
     begin
      newheader[i]:=fullHeader;
      usedindex:=1;
      for j:=1 to files do
       begin
  {  if beta then writeln (i,' ',j,' - ',hfile2hexstr(newheader[i]),' - ',hfile2hexstr(oldheader[j])); //}
  {  if beta then cntin;                                                                               //}
        if (hfile2int(newheader[i])> hfile2int(oldheader[j])) then
         begin
          newheader[i]:=oldheader[j];
          usedindex:=j;
         end;
       end;
  {}  if beta then writeln (hfile2hexstr(newheader[i]));
      oldheader[usedindex]:=fullHeader;
     end;
 {} if beta then writeln('Initial sort done.');
 {} if beta then cntin;
     for i:=1 to files do
      Begin
       if (newheader[i][4] >= $80) then newheader[i][4]:=newheader[i][4]-$80
       else newheader[i][4]:=newheader[i][4]+$80;
  {}  if beta then writeln (hfile2hexstr(newheader[i]));
      End;
  {}  if beta then writeln('Header sorted.');
  {}  if beta then cntin;
    for i:=1 to files do
     begin
      seek(f,10+((i-1)*12));
      blockwrite(f,newheader[i],12,actual);
  {}  if beta then writeln (hfile2hexstr(newheader[i]));
     end;
  {} if not beta and not silent then write(' - ');
    if not silent then writeln('Header saved.');
    CloseFile();
   end;
end; {rewriteHeader}


function hackdat(filenm:String;orig:fileinmix;replace:fileinmix):integer;
var
  i,j,files:integer;
  fixed:boolean;
  actual:word;
  size: array[1..2] of byte;
  ID:fourbyte;
begin
  hackdat:=-1;
  fixed:=false;
  writeln('Patching file: ',filenm);
  write('Replacing filename "',orig.name,'" by "',replace.name,'"');
 {} if beta then writeln();
 {} if beta then writeln('(replacing file ID "',fourbyte2hexstr(orig.ID),'" by "',fourbyte2hexstr(replace.ID),'")');
  if (openFile(filenm)) then
   begin
    seek(f,4);
    blockread(f,size,2,actual);
    files:=size[1]+size[2]*$100;
    if beta then writeln('Number of files: ',files);
 {} if beta then cntin;
    i:=1;
    while (i<=files) and (fixed<>true) do
     Begin
      seek(f,10+((i-1)*12));
      blockread(f,ID,4,actual);
 {}   if beta then writeln(fourbyte2hexstr(ID),' - ',fourbyte2hexstr(orig.ID));
      if (ID[4] = orig.ID[4]) then
       begin
 {}   if beta then writeln('index ',i,': first byte matches. Checking full ID...');
        fixed:=true;
        for j:=1 to 3 do
         if (ID[j]<>orig.ID[j]) then fixed:=false;
    {}   if beta and (not fixed) then writeln('No match.');
       end;
      if (fixed=true) then
       begin
    {}  if beta then writeln('Match found.');
        seek(f,10+((i-1)*12));
        blockwrite(f,replace.ID,4,actual);
      end
      else i:=i+1;
     end;
     if (fixed) then
      begin
    {}  if not beta then write(' - ');
       writeln('Done!');
    {}  if beta then cntin;
       hackdat:=1;
      end
     else
      begin
    {}  if not beta then write(' - ');
       writeln('Data not found.');
    {}  if beta then cntin;
       hackdat:=0;
      end;
    CloseFile();
   end;
end; {hackdat}

procedure exec();
begin
  if (mode=1) then
   begin
     hack1done:=hackdat('movies01.mix',intr0,intro);
     hack2done:=hackdat('movies02.mix',intr1,intro);
     if (hack1done=0) and (hack2done=0) then
      begin
        writeln;
        writeln('Filenames not found: mixfiles are already patched.');
      end;
   end
  else if (mode=2) then
   begin
     hack1done:=hackdat('movies01.mix',intro,intr0);
     hack2done:=hackdat('movies02.mix',intro,intr1);
     if (hack1done=0) and (hack2done=0) then
      begin
        writeln;
        writeln('Filenames not found: nothing to undo.');
      end;
   end
  else
   begin
     hack1done:=hackdat('movies01.mix',intr0,intro);
     hack2done:=hackdat('movies02.mix',intr1,intro);
     if (hack1done=0) and (hack2done=0) then
      begin
        writeln;
        writeln('Filenames not found in mixfiles: reverting to original names.');
        writeln;
        hack1done:=hackdat('movies01.mix',intro,intr0);
        hack2done:=hackdat('movies02.mix',intro,intr1);
      end;
   end;
  if ((hack1done=1) or (hack2done=1)) and not silent then writeln;
  if (hack1done=1) then rewriteHeader('movies01.mix');
  if (hack2done=1) then rewriteHeader('movies02.mix');
  if not silent then cntin;
end; {exec}

procedure checkparams();
var
  param:byte;
  modetmp,i:integer;
  nodisplayset,nomodeset:boolean;
begin
  nomodeset:=true;
  nodisplayset:=true;
  for i:=1 to ParamCount do
   begin
    param:=byte(ParamStr(i)[1]);
    modetmp:=param-$30;
    if ((mode=0) and (modetmp>0) and (modetmp<9)) then begin nomodeset:=false; mode:=modetmp; end
    else if (ParamStr(i) = 'beta') then begin nodisplayset:=false; silent:=false; beta:=true; end
    else if nodisplayset and ((char(param) = 's') or (char(param+$20) = 's')) then begin nodisplayset:=false; silent:=true; end
    else if nomodeset and ((char(param) = 'w') or (char(param) = 'W')) then begin nomodeset:=false; mode:=1; end
    else if nomodeset and ((char(param) = 'u') or (char(param) = 'U')) then begin nomodeset:=false; mode:=2; end
    else if nomodeset and ((char(param) = 't') or (char(param) = 'T')) then begin nomodeset:=false; mode:=3; end;
  end;
end; {checkparams}

begin
  mode:=hardmode;
  silent:=hardsilent;
  if ParamCount <> 0 then
    checkparams();
  exec();
end.