program xPak; (* .PAK file manipulator *)

{$M 16384,102400,655360}   {Enough heap to load PAK0.PAK directory min}

uses wildmat,dos,crt;

const
     LUMP_NAME_SIZE      = $40-8;
     END_CHARS           = [#10,#0];
     PAK_HEADER          = 'PACK';
     PAK_PROTECTED       = 'PAK0.PAK';
     MAX_BLOCK_SIZE:word = 65528;

     {HALT codes, not fully implemented yet}
     HALT_PARSE          = 1;
     HALT_SAFETY         = 3;
     HALT_QUIT           = 4;

type
    Buffer= array[1..65528] of byte;
    LumpNameType= array[1..LUMP_NAME_SIZE] of char;
    Modes=(None,List,Extract,Add,Remove,Rename,Merge);

    DirEntry=record
      Lumpname : LumpNameType;
      Pos      : Longint;
      Size     : LongInt;
    end;

    PFileSpecList=^TFileSpecList;
    TFileSpecList=record
      FileSpec : string[140];
      LumpName : string[LUMP_NAME_SIZE];
      Remapped : boolean;
      included : boolean;
      Next     : PFileSpecList;
    end;

    PMasterDir=^TMasterDir;
    TMasterDir=record         {212 bytes}
      Dir      : DirEntry;
      Filename : string[140];
      Prev     : PMasterDir;
      Next     : PMasterDir;
    end;

    TFlags=record
      Override : boolean;
      Verbose  : boolean;
      Force    : boolean;
      Interact : boolean;
      Query    : boolean;
      AccessPAK: boolean;
      Backup   : boolean;
      JustName : boolean;
      Debug    : boolean;
    end;


var
   Flags: TFlags;
{   o: text;}


procedure Help;
  begin
       Writeln('usage: xpak <pakfile> -l|-e|-a|-r|-n [lumpname:]filespec [switches]');
       Writeln;
       Writeln('Command line must contain *one* of the following switches:');
       writeln('           (r) = read; (c) = create; (m) = modify');
       writeln('    -l (r) List contents of PAK file');
       writeln('    -e (r) Extract specified files to directory tree');
       writeln('    -a (c) Add specified files to PAK file (also create and update files)');
       writeln('    -r (m) Remove specified lumps');
       writeln('    -n (m) Rename lump in PAK file (renames to :filename');
       writeln('Notice: -u and old -c have been removed.  They have been integrated into -a');
       writeln(#13#10,'Press any key for next page');ReadKey;
       writeln(#13#10,'Modification switches:');
       writeln('    -o     Overrides some of the safety features in xpak.  These include');
       writeln('           not writing to ID1.PAK and requiring existance of ./quake.exe');
       writeln('    -j     (with -l) display just names only (useful to create @file lists)');
       writeln('    -v     verbose mode.  Display names of lumps during processing.');
       writeln('    -d     debug mode.  Displays all sorts of useless debugging info.');
       writeln('    -i     (with -e) Interactive mode.  Prompt to overwrite files');
       writeln('    -f     (with -e) Force overwrites.  Default is to skip existing files');
       writeln(' #  -q     Query mode, ask before adding/extracting/removing each file');
       writeln(' #  -b     backup PAK file before modification / existing extract targets');
       writeln;
       writeln('Lump names may be specified as free * and ? wildcards, but filenames');
       writeln('(excludes -e) require DOS style paths and wildcards.  To access a lump name');
       writeln('with a different filename, use the syntax lumpname:filename.  Wildcards not');
       writeln('allowed.  File lists can be referenced as @filename. # denotes comment line');
       writeln;
       writeln('Remember that this is an early version, and may have ''problems'' =) Note also');
       writeln('that xpak is now more-or-less unsupported, as I am working on a rewrite, sixpak');
       halt;
  end;


procedure Lower4(var Str: String);
  InLine(          {Adapted From SWAG}
    $8C/$DA/$5E/$1F/$FC/$AC/$30/$E4/$89/$C1/$E3/$12/$BB/Ord('A')/Ord('Z')/
    $AC/$38/$D8/$72/$08/$38/$F8/$77/$04/$80/$44/$FF/$20/$E2/$F1/$8E/$DA);


procedure cvBackSlash(var ForeStr: string);
  var i: byte;
  begin
       for i:=1 to Length(ForeStr) do
           if ForeStr[i]='/' then ForeStr[i]:='\';
  end;


procedure cvForeSlash(var BackStr: string);
  var i: byte;
  begin
       for i:=1 to Length(BackStr) do
           if BackStr[i]='\' then BackStr[i]:='/';
  end;


procedure SetStr(var st:string; const ar:LumpNameType);
  var
     i: byte;
  begin
       st:='';
       for i:=1 to LUMP_NAME_SIZE do
           begin
           if ar[i] in END_CHARS then begin dec(i); break end;
           st[i]:=ar[i];
           end;
       st[0]:=Char(i);
  end;


procedure SetArr(var ar: LumpNameType; const st:string);
  var
     i,j: byte;
  begin
       FillChar(ar,SizeOf(ar),0);
       j:=Length(st);
       if Length(st)>LUMP_NAME_SIZE then j:=LUMP_NAME_SIZE;
       for i:=1 to j do
           ar[i]:=st[i];
  end;


function Exist(const filename:string): boolean;
  var
     DirInfo:SearchRec;
  begin
       FindFirst(filename,Anyfile,DirInfo);
        Exist:=(DosError=0);
  end;


function MakePAKFilename(const oldname:string):string;
  begin
       if Pos('.',oldname)>0 then
          MakePAKFilename:=oldname
       else
           MakePAKFilename:=oldname+'.pak';
  end;


procedure AddFileSpec(fs:string; yn: boolean; var TempPos: PFileSpecList);
  var
     spec,lump:string;
     cpos: byte;
     remap:boolean;
  begin
       lump:=fs;spec:=fs;
       cpos:=pos(':',fs);
       remap:=false;
       if cpos>0 then
          begin
          if pos('*',fs)>0 then
             begin writeln('addspec: no wildcards allowed with alternate filenames (yet)'); exit end;
          if pos('?',fs)>0 then
             begin writeln('addspec: no wildcards allowed with alternate filenames (yet)'); exit end;
          lump:=Copy(fs,1,cpos-1);
          spec:=Copy(fs,cpos+1,255);
          remap:=true;
          end;
       New(TempPos^.Next);
       TempPos:=TempPos^.Next;
       cvBackslash(spec);
       cvForeslash(lump);
       Lower4(lump);
       TempPos^.Filespec:=spec;
       TempPos^.Lumpname:=lump;
       TempPos^.Included:=yn;
       TempPos^.Remapped:=remap;
       TempPos^.Next:=nil;
  end;


procedure FromFile(fn:string;Incl: boolean; var ListTemp: PFileSpecList);
  var
     ff: text;
     fs: string;
  begin
       if fn[1]='@' then Delete(fn,1,1);
       Assign(ff,fn);
       {$I-}
       Reset(ff);
       if IOResult<>0 then
          begin writeln('parse: unable to open filespec list file.'); exit end;
       {$I+}
       while not eof(ff) do
             begin
             ReadLn(ff,fs);
             if fs<>'' then
                if fs[1]<>'#' then
                   if fs[1]='!' then
                      AddFileSpec(Copy(fs,2,Length(fs)-1),not incl,ListTemp)
                   else
                       AddFileSpec(fs,incl,ListTemp);
             end;
  end;


function CheckParams(var MainPAK:string; var Files: PFileSpecList):Modes;
  var
     Param:string;
     i:byte;
     TempSpec:PFileSpecList;
     SpecStart: PFileSpecList;
     TempMode: Modes;
     Include: boolean;
  begin
       TempMode:=None;Include:=True;MainPAK:='';
       FillChar(Flags,SizeOf(Flags),0);
       New(Files); TempSpec:=Files;
       TempSpec^.Filespec:='*';
       TempSpec^.Included:=True;
       TempSpec^.Next:=nil;
       if ParamCount=0 then begin writeln('Type `xpak -?` for help.');halt end;
       for i:=1 to ParamCount do
           begin
           Param:=ParamStr(i);
           If Param[1]='-' then
              if Length(Param)=1 then begin Writeln('parse: bad parameter ',Param);halt(1) end
              else
                  Case UpCase(Param[2]) of
                       '?': Help;
                       'B': Flags.Backup:=True;
                       'D': Flags.Debug:=True;
                       'F': Flags.Force:=True;
                       'I': Flags.Interact:=True;
                       'J': Flags.JustName:=True;
                       'O': Flags.Override:=True;
                       'Q': Flags.Query:=True;
                       'V': Flags.Verbose:=True;
                       'X': Include:=not Include;
                       'L': if TempMode=None then TempMode:=List
                               else begin writeln('parse: mode already set ',Param);halt(1) end;
                       'E': if TempMode=None then TempMode:=Extract
                               else begin writeln('parse: mode already set ',Param);halt(1) end;
                       'A': if TempMode=None then TempMode:=Add
                               else begin writeln('parse: mode already set ',Param);halt(1) end;
                       'R': if TempMode=None then TempMode:=Remove
                               else begin writeln('parse: mode already set ',Param);halt(1) end;
                       'N': if TempMode=None then TempMode:=Rename
                               else begin writeln('parse: mode already set ',Param);halt(1) end;
                       else begin writeln('parse: unknown parameter ',Param);halt(1) end;
                  end
           else if Param[1]='@' then
                   if Length(Param)=1 then begin Writeln('parse: no file specified ',Param);halt(1) end
                   else
                       FromFile(Param,Include,TempSpec)
           else
               if Length(MainPAK)=0 then
                  MainPAK:=MakePakFilename(Param)
               else
                   AddFilespec(Param,Include,TempSpec);
           end;
       if TempMode=None then begin writeln('parse: no operating mode specified'); halt(1) end;
       if MainPAK =''   then begin writeln('parse: no .PAK file specified'); halt(1) end;
       {
       if (not exist('QUAKE.EXE')) and (not Flags.Override) then begin
          writeln('safety: You must run xpak in the same directory as QUAKE.EXE'); halt(3) end;
       }  {old qtest thing}
       CheckParams:=TempMode;
       end;


function Match(TestStr:string; SpecList: PFileSpecList):boolean;
  var
     Matched: boolean;
     ListTemp: PFileSpecList;
  begin
       cvForeslash(testStr);Lower4(TestStr);
       ListTemp:=SpecList^.Next;
       if ListTemp=nil then Match:=True else Match:=False;
       while ListTemp<>nil do
             begin
             if WildCardMatch(ListTemp^.Lumpname,TestStr) then{in wildmat.tpu}
                Match:=ListTemp^.Included;
             ListTemp:=ListTemp^.Next;
             end;
  end;


function GetEntry(srch:string;ListTemp:PMasterDir):PMasterDir;
  var
     fn:string;
  begin
       GetEntry:=nil;
       cvForeslash(srch);Lower4(srch);
       while ListTemp<>nil do
             begin
             SetStr(fn,ListTemp^.Dir.Lumpname);
             if srch=fn then
                begin
                GetEntry:=ListTemp;
                exit;
                end;
             ListTemp:=ListTemp^.Next;
             end;
  end;


function OpenPak(var Handle: file; filename: string):boolean;
  var
     IdStr: string[4];
     check: word;
  begin
       Assign(Handle,filename);
       OpenPAK:=False;

       {$I-}
       Reset(Handle,1);
       case IOResult of
            0:;
            2:begin writeln('open: file not found'); exit end;
            3:begin writeln('open: path not found'); exit end;
            5:begin writeln('open: access denied'); exit end;
            else begin writeln('open: error accessing file'); exit end;
       end;
       {$I+}

       IdStr[0]:=#4;
       BlockRead(Handle,IdStr[1],4,check);
       if check<>4 then begin writeln('open/idstr: read size mismatch.  requested 4, received ',check);OpenPAK:=False end;
       if IdStr<>PAK_HEADER then begin writeln('open: not a valid PAK file.'); exit end;
       OpenPAK:=True;
  end;


procedure WriteHeader(var pak:file);
  const
       Header:array[1..12] of char=PAK_HEADER+#12#0#0#0#0#0#0#0;
  begin
       if Flags.Verbose then writeln('writehdr: writing PAK header');
       BlockWrite(pak,Header,12);
  end;


function ReadDirectory(var pak: file): PMasterDir;
  var
     check: word;
     TempDir: DirEntry;
     LumpNum: word;
     ListTemp: PMasterDir;
     ListStart: PmasterDir;
     filename: string;

  begin
       readDirectory:=nil;
       New(ListStart);ListTemp:=ListStart;
       BlockRead(pak,TempDir.Pos,4,check);
       if check<>4 then begin writeln('readdir/dirpos: read size mismatch.  requested 4, received ',check);exit end;
       BlockRead(pak,TempDir.Size,4,check);
       if check<>4 then begin writeln('readdir/dirsize: read size mismatch.  requested 4, received ',check);exit end;
       if TempDir.Size=0 then exit;

       if Flags.Verbose then writeln('readdir: reading PAK directory');
       Seek(pak,TempDir.Pos);
       for LumpNum:=1 to TempDir.Size div SizeOf(DirEntry) do
           begin
           BlockRead(pak,TempDir,SizeOf(DirEntry),check);
           if check<>SizeOf(DirEntry) then
              begin writeln('readdir/entries: read size mismatch.  requested ',SizeOf(DirEntry),' received ',check);exit end;
           SetStr(filename,TempDir.Lumpname);
           cvBackslash(filename);
           New(ListTemp^.Next);
           ListTemp^.Next^.Prev:=ListTemp;
           ListTemp^.Next^.Next:=nil;
           ListTemp:=ListTemp^.Next;
           ListTemp^.Dir:=TempDir;
           ListTemp^.Filename:=filename;
           end;
       ListTemp:=ListStart^.Next;
       ListTemp^.Prev:=nil;
       Dispose(ListStart);
       ReadDirectory:=ListTemp;
  end;


function CreateDirectory(Files:PFileSpecList):PMasterDir;
  var
     MstrTemp: PMasterDir;
     MstrStart: PMasterDir;
     MstrMatch: PMAsterDir;
     SpecTemp: PFileSpecList;
     TempStr,TempFile: string;
     DirInfo: SearchRec;
     p:DirStr; f:NameStr; e:ExtStr;
  begin
       New(MstrStart);MstrTemp:=MstrStart;MstrTemp^.Next:=nil;
       SpecTemp:=Files^.Next;
       while SpecTemp<>nil do
             begin
             TempStr:=SpecTemp^.Filespec;
             cvBackslash(TempStr);
             FSplit(TempStr,p,f,e);
             FindFirst(Tempstr,Anyfile-Directory-Hidden-VolumeID,DirInfo);
             while DosError=0 do
                   begin
                   TempFile:=p+DirInfo.Name;
                   cvForeSlash(TempFile);Lower4(TempFile);
                   MstrMatch:=nil;
                   if SpecTemp^.Remapped then
                      begin
                      MstrMatch:=GetEntry(SpecTemp^.Lumpname,MstrStart);
                      if MstrMatch<>nil then
                         begin
                         MstrMatch^.Filename:=p+DirInfo.Name;
                         MstrTemp^.Dir.Size:=DirInfo.Size;
                         end;
                      TempFile:=SpecTemp^.Lumpname;
                      end;
                   if MstrMatch=nil then
                      begin
                      New(MstrTemp^.Next);
                      MstrTemp^.Next^.Prev:=MstrTemp;
                      MstrTemp:=MstrTemp^.Next;
                      MstrTemp^.Next:=nil;
                      MstrTemp^.Filename:=p+DirInfo.name;
                      SetArr(MstrTemp^.Dir.Lumpname,Tempfile);
                      MstrTemp^.Dir.Size:=DirInfo.Size;
                      MstrTemp^.Dir.Pos:=0;
                      end;
                   FindNext(DirInfo);
                   end;
             SpecTemp:=SpecTemp^.Next;
       end;
       MstrTemp:=MstrStart^.Next;
       MstrTemp^.Prev:=nil;
       Dispose(MstrStart);
       CreateDirectory:=MstrTemp;
  end;


function WriteDirectory(var pak:file;ListTemp:PMasterDir): boolean;
  var
     DirPos,DirLen: Longint;
     check:word;
  begin
       WriteDirectory:=False;
       seek(pak,FileSize(pak));
       DirPos:=FilePos(pak);
       if Flags.Verbose then writeln('writedir: writing new PAK directory');
       DirLen:=0;
       while ListTemp<>nil do
             begin
             BlockWrite(pak,ListTemp^.Dir,Sizeof(DirEntry),check);
             if check<SizeOf(DirEntry) then begin
                writeln('writedir: write size mismatch.  requested ',SizeOf(DirEntry),' wrote ',check,'. out of disk space?');
                close(pak); exit end;
             Inc(DirLen,SizeOf(DirEntry));
             ListTemp:=ListTemp^.Next;
             end;
       Seek(pak,4);
       BlockWrite(pak,DirPos,4);
       BlockWrite(pak,DirLen,4);
       WriteDirectory:=True;
  end;


procedure CropDirectory(var pak:file);
  var
     DirPos,DirLen:LongInt;
  begin
       Reset(pak,1);
       Seek(pak,4);
       BlockRead(pak,DirPos,4);
       BlockRead(pak,DirLen,4);
       Seek(pak,DirPos);
       Truncate(pak);Close(pak);Reset(pak,1);
  end;


procedure RemapFilenames(MstrList:PMasterDir; Filespec:PFilespecList);
  var
     SpecTemp: PFileSPecList;
     lumpname: string;
  begin
       while MstrList<>nil do
             begin
             SetStr(lumpname,MstrList^.Dir.Lumpname);
             SpecTemp:=FileSpec;
             while SpecTemp<>nil do
                   begin
                   if SpecTemp^.Remapped then
                      if lumpname=SpecTemp^.Lumpname then
                         MstrList^.Filename:=SpecTemp^.filespec;
                   SpecTemp:=SpecTemp^.Next;
                   end;
             MstrList:=MstrList^.Next;
             end;
  end;


procedure MakePath(const pname: string);
  var
     slashpos: byte;
     TempStr: string;
  begin
       {$I-}
       for slashpos:=1 to Length(pname) do
           if pname[slashpos]='\' then
              begin
              TempStr:=Copy(Pname,1,slashpos-1);
              mkdir(TempStr);
              if IOResult=0 then
                 if Flags.Verbose then
                    begin
                    cvForeslash(tempstr);Lower4(tempstr);
                    writeln('mkdir: ',TempStr);
                    end;
              end;
       {$I+}
  end;


procedure BAKFile(Filename:string);
  var
     p:Dirstr;n:NameStr;e:extstr;
     NewName:String;
     Regs:Registers;
  begin
       if Flags.Verbose then writeln('backup: ',Filename);
       FSplit(Filename,p,n,e);
       NewName:=p+n+'.bak'+#0;
       Filename:=Filename+#0;
       Regs.AH := $56;
       Regs.DS := Seg(FileName);
       Regs.DX := Ofs(FileName) + 1;
       Regs.ES := Seg(NewName);
       Regs.DI := Ofs(NewName) + 1;
       MsDos(Regs);
  end;


function CopyData(var src,dest: file; Amount:LongInt):boolean;
  var
     Buf: ^Buffer;
     BlockSize:word;
     check:word;
  begin
       CopyData:=False;
       New(buf);
       If Flags.Debug then writeln('copy: copying ',Amount,' bytes. srcpos=',FilePos(src),' destpos=',FilePos(dest));
       While Amount>0 do
             begin
             if Amount>MAX_BLOCK_SIZE then
                BlockSize:=MAX_BLOCK_SIZE
             else
                 BlockSize:=Amount;
             Dec(Amount,BlockSize);
             BlockRead(src,buf^,Blocksize,check);
             if check<>BlockSize then begin
                writeln('copy: read size mismatch.  requested ',BlockSize,' received ',check);
                Dispose(Buf);exit end;
             BlockWrite(dest,buf^,Blocksize,check);
             if check<>BlockSize then begin
                writeln('copy: write size mismatch.  requested ',Blocksize,' wrote ',check,'. out of disk space?');
                Dispose(Buf);exit end;
             end;
       Dispose(buf);
       CopyData:=True;
  end;


function MoveData(var handle:file;fPos,Size,Offset:LongInt):boolean;
  var                                 {rPos is startpos}
     Buf: ^Buffer;                    {rSize is amout to move}
     Blocksize:Longint;               {rOffset is amount to move by, +/-}
     EndPos:Longint;
     check:word;
  begin
       if (Size=0) or (Offset=0) then begin MoveData:=True;exit end;
       MoveData:=False;
       New(Buf);
       If Flags.Debug then writeln('move: moving ',Size,' bytes from ',fPos,' by ',Offset,' bytes. (to ',fpos+Offset,')');
       if Offset>0 then Inc(fPos,Size);
       while Size>0 do
             begin
             if Size>MAX_BLOCK_SIZE then
                BlockSize:=MAX_BLOCK_SIZE
             else
                 BlockSize:=Size;
             Dec(Size,BlockSize);
             if OffSet>0 then
                Seek(Handle,fpos-BlockSize)
             else
                 Seek(handle,fPos);
             BlockRead(handle,Buf^,Blocksize,check);
             if check<>BlockSize then begin
                writeln('move: read size mismatch.  requested ',Blocksize,' received ',check);
                Dispose(Buf);Close(handle);exit end;
             Seek(handle,Filepos(Handle)-BlockSize+Offset);
             BlockWrite(handle,buf^,Blocksize,check);
             if check<>BlockSize then begin
                writeln('delete: write size mismatch.  requested ',Blocksize,' wrote ',check,'. out of disk space?');
                Dispose(Buf);Close(handle); exit end;
             if Offset>0 then
                Dec(fpos,BlockSize)
             else
                 Inc(fpos,BlockSize);
             end;
       Dispose(Buf);
       MoveData:=True;
  end;


procedure ListLump(Entry: DirEntry);
  var
     TempStr: string;
     DispStr: string[40];
  begin
       SetStr(TempStr,Entry.Lumpname);
       if Flags.JustName then
          Writeln(TempStr)
       else
           begin
           FillChar(DispStr[1],40,' ');
           DispStr:=TempStr;
           DispStr[0]:=#40;
           Write(DispStr);
           Write('Pos=',Entry.Pos:8);
           Writeln('  Size=',Entry.Size:8,' (bytes)');
       end;
  end;


procedure ExtractLump(var pak:file;const Entry: PMasterDir);
  var
     lname:string;
     op: file;
     ky:char;
     tempstr:string;

  begin
       SetStr(lname,Entry^.Dir.Lumpname);
       MakePath(Entry^.Filename);
       tempstr:=Entry^.Filename;cvForeslash(tempstr);Lower4(tempstr);
       if not Flags.Force then
          if exist(Entry^.Filename) then
             if Flags.Interact then
                begin
                write('extract: overwrite file ',tempstr,'? [ynasq]');
                ky:=ReadKey;
                case UpCase(ky) of
                  'N':;
                  'A':Flags.Force:=True;
                  'S':Flags.Interact:=False;
                  'Q':halt(HALT_QUIT);
                  'Y':;
                  else ky:='n';
                  end;
                writeln(ky);
                if UpCase(ky)='N' then exit;
                end
             else
                 begin
                 writeln ('extract: ',tempstr,' exists.  skipping');
                 exit
                 end;
       if Flags.BAckup then
          if Exist(Entry^.Filename) then
             BAKFile(Entry^.Filename);
       if Flags.Verbose then
          if tempstr=lname then
             writeln('extract: ',lname)
          else
              writeln('extract: ',lname,' from file ',tempstr);
       Assign(op,Entry^.Filename);
       Rewrite(op,1);
       if IOResult<>0 then begin writeln('extract: unable to open ',tempstr); exit end;

       Seek(pak,Entry^.Dir.Pos);
       CopyData(pak,op,Entry^.Dir.Size);
       Close(op);
  end;


function AddLump(var Handle: file; Filename: string):Longint;
  var
     ip: file;
     buf: ^Buffer;
     BlockSize: word;
     check: word;

  begin
       AddLump:=0;
       New(buf);
       Assign(ip,Filename);
       ReSet(ip,1);
       AddLump:=FileSize(Handle);
       Seek(Handle,FileSize(Handle));
       while not eof(ip) do
             begin
             BlockRead(ip,buf^,MAX_BLOCK_SIZE,BlockSize);
             BlockWrite(Handle,buf^,BlockSize,check);
             if check<BlockSize then begin
                writeln('addlump: write size mismatch.  Requested ',SizeOf(DirEntry),' wrote ',check,'. out of disk space?');
                Dispose(Buf);Close(Handle);close(ip);AddLump:=0; exit end;
             end;
       Dispose(buf);
       Close(ip);
  end;


function UpdateLump(var pak:file;Entry:PMasterDir;ListTemp:PMasterDir):boolean;
  var
     lumpname,tempstr: string;
     ip: file;
  begin
       UpdateLump:=False;
       SetStr(Lumpname,Entry^.Dir.Lumpname);
       if Flags.Verbose then
          begin
          tempstr:=Entry^.filename;cvForeslash(Tempstr);Lower4(tempstr);
          writeln('update: ',lumpname,' with file ',tempstr);
          end;

       Assign(ip,Entry^.Filename);
       ReSet(ip,1);
       if not MoveData(pak,Entry^.Dir.Pos+Entry^.Dir.Size,
                           FileSize(pak)-Entry^.Dir.Pos-Entry^.Dir.Size,
                           FileSize(ip)-Entry^.Dir.Size) then begin
          writeln('update: error moving data in PAK file.');Close(ip);exit end;
       Seek(pak,Entry^.Dir.Pos);
       if not CopyData(ip,pak,FileSize(ip)) then begin
          writeln('update: error reading from file.');close(ip);exit end;
       if FileSize(ip) < Entry^.Dir.Size then
          begin
          Seek(pak,FileSize(pak)+FileSize(ip)-Entry^.Dir.Size);
          Truncate(pak);Close(pak);Reset(pak,1);
          end;
       While ListTemp<>nil do
             begin
             if ListTemp^.Dir.Pos>Entry^.Dir.Pos then
                if ListTemp^.Dir.Pos<>0 then
                   Inc(ListTemp^.Dir.Pos,FileSize(ip)-Entry^.Dir.Size)
                else
             else if ListTemp^.Dir.Pos=Entry^.Dir.Pos then
                  ListTemp^.Dir.Size:=FileSize(ip);  {Original record}
             ListTemp:=ListTemp^.Next;
             end;
       Close(ip);
       UpdateLump:=true;
  end;


procedure RemoveLump(var pak:file;Lump: PMasterDir; var MasterDir:PMasterDir);
  var
     ListTemp : PMasterDir;
  begin
       if Lump=nil then exit;
       if Lump^.Prev=nil then
          begin
          Lump:=MasterDir;
          MasterDir:=Lump^.Next;
          MasterDir^.Prev:=nil
          end
       else
           begin
           Lump^.Prev^.Next:=Lump^.Next;
           if Lump^.Next<>nil then Lump^.Next^.Prev:=Lump^.Prev;
           end;

       if not MoveData(pak,Lump^.Dir.Pos+Lump^.Dir.Size,
                           FileSize(pak)-Lump^.Dir.Pos-Lump^.Dir.Size,
                           -Lump^.Dir.Size)
          then begin writeln('remove: error moving data in PAK file.'); exit end;
       Seek(pak,FileSize(pak)-Lump^.Dir.Size);
       Truncate(pak);Close(pak);Reset(pak,1);

       ListTemp:=MasterDir;
       while ListTemp<>nil do
             begin
             if ListTemp^.Dir.Pos>Lump^.Dir.Pos then
                Dec(ListTemp^.Dir.Pos,Lump^.Dir.Size);
             ListTemp:=ListTemp^.Next;
             end;
       Dispose(Lump);
  end;


procedure SafetyPAK(pakfile:string);
  begin
       if not Flags.OverRide then
          begin
          lower4(pakfile);
          if Copy(pakfile,Length(pakfile)-7,7)='pak0.pak' then
             begin writeln('safety: will not write to PAK0.PAK'); halt(HALT_SAFETY) end;
          end;
  end;


procedure ListPAK(pakfile:string;filespec:PFilespecList);
  var
     ListTemp:PMasterDir;
     pak: file;
  begin
       if not OpenPAK(pak,pakfile) then exit;
       ListTemp:=ReadDirectory(pak);
       Close(pak);
       while ListTemp<>nil do
             begin
             if Match(ListTemp^.Dir.Lumpname,FileSpec) then
                ListLump(ListTemp^.Dir);
             ListTemp:=ListTemp^.Next;
             end;

  end;


procedure ExtractPAK(pakfile:string;filespec:PFilespecList);
  var
     ListTemp: PMasterDir;
     pak:file;
  begin
       if not OpenPAK(pak,pakfile) then exit;
       ListTemp:=ReadDirectory(pak);
       RemapFilenames(ListTemp,filespec);
       while ListTemp<>nil do
             begin
             if Match(ListTemp^.Dir.Lumpname,filespec) then
                ExtractLump(pak,ListTemp);
             ListTemp:=ListTemp^.Next;
             end;
  end;


procedure AddPAK(pakfile:string;filespec:PFilespecList);
  var
     ListPrev,ListTemp,OldEntry:PMasterDir;
     pak:file;
     MstrStart: PMasterDir;
     NewStart: PMAsterDir;
     srcfile,srclump:string;
     tempstr:string;
     ky: char;
     SkipUpdate: boolean;
  begin
       SafetyPAK(pakfile);
       SkipUpdate:=False;

       if not exist(pakfile) then
          begin
          Assign(pak,pakfile);ReWrite(pak,1);
          WriteHeader(pak);Close(pak);
          end;
       if not OpenPAK(pak,pakfile) then exit;

       NewStart:=CreateDirectory(filespec);     {Get New lumps}
       MstrStart:=ReadDirectory(pak);           {Get original directory}
       ListPrev:=MstrStart;
       if ListPrev<>nil then
          begin
          while ListPrev^.Next<>nil do
                ListPrev:=ListPrev^.Next;
          ListPrev^.Next:=NewStart;
          NewStart^.Prev:=ListPrev; {Paste New lumps onto end of original}
          end
       else
           begin
           MstrStart:=NewStart;
           NewStart^.Prev:=nil;
           end;

       CropDirectory(pak);

       ListTemp:=NewStart;
       while ListTemp<>nil do
             begin
             srcfile:=ListTemp^.Filename;
             SetStr(srclump,ListTemp^.Dir.Lumpname);
             OldEntry:=GetEntry(srclump,MstrStart);
             if OldEntry = ListTemp then
                begin
                if Flags.Verbose then
                   begin
                   tempstr:=srcfile;cvForeslash(tempstr);Lower4(tempstr);
                   if tempstr=srclump then
                      writeln('add: ',srclump)
                   else
                       writeln('add: ',srclump,' from file ',tempstr);
                   end;
                ListTemp^.Dir.Pos:=AddLump(pak,srcfile);
                if ListTemp^.Dir.Pos=0 then
                   begin
                        ListPrev^.Next:=ListTemp^.Next;
                        if ListTemp^.Next<>nil then
                           ListTemp^.Next^.Prev:=ListPrev;
                        ListTemp:=ListTemp^.Next;
                   end
                else
                    begin
                    Listprev:=ListTemp;
                    ListTemp:=ListTemp^.Next;
                    end
                end
             else
                 begin
                 ky:='Y';
                 if SkipUpdate then
                    begin
                    ky:='N';
                    if Flags.Verbose then writeln('update: skipping ',srclump);
                    end;
                 if Flags.Interact then
                    begin
                    write('update: update lump ',srclump,'? [ynasq]');
                    ky:=ReadKey;
                    case UpCase(ky) of
                      'A':Flags.Interact:=False;
                      'S':begin SkipUpdate:=True; if Flags.Verbose then writeln('update: skipping ',srclump);end;
                      'Q':halt(HALT_QUIT);
                      'Y':;
                      else ky:='n';
                      end;
                    writeln(ky);
                    end;
                 ListTemp^.Dir:=OldEntry^.Dir;
                 if (UpCase(ky)='Y') or (UpCase(ky)='A') then
                    if UpdateLump(pak,ListTemp,MstrStart) then
                       begin
                       ListPrev^.Next:=ListTemp^.Next;
                       Dispose(ListTemp);
                       ListTemp:=ListPrev^.Next;
                       if ListTemp<>nil then ListTemp^.Prev:=ListPrev;
                       end;
                 end;
             end;

       WriteDirectory(pak,MstrStart);
       Close(pak);
  end;


procedure RemovePAK(pakfile:string;filespec:PFilespecList);
  var
     pak:file;
     ListTemp:PMasterDir;
     MstrStart :PMasterDir;
     DirLen,DirPos: Longint;
     lumpname: string;
  begin
       SafetyPAK(pakfile);
       if not OpenPAK(pak,pakfile) then exit;
       MstrStart:=ReadDirectory(pak);
       if Filespec=nil then writeln('remove: no entries to process');

       CropDirectory(pak);

       ListTemp:=MstrStart;
       while ListTemp<>nil do
             begin
             SetStr(lumpname,ListTemp^.Dir.Lumpname);
             if Match(lumpname,Filespec) then
                begin
                if Flags.Verbose then writeln('remove: ',lumpname);
                RemoveLump(pak,ListTemp,MstrStart);
                end;
             ListTemp:=ListTemp^.Next;
             end;
       WriteDirectory(pak,MstrStart);
       Close(pak);
  end;


procedure RenamePAK(pakfile:string;filespec:PFilespecList);
  var
     MstrStart: PMasterDir;
     MstrTemp:PMasterDir;
     SpecTemp: PFileSPecList;
     lumpname,newname: string;
     pak: file;
  begin
       SafetyPAK(pakfile);
       if not OpenPAK(pak,pakfile) then exit;
       MstrStart:=ReadDirectory(pak);
       MstrTemp:=MstrStart;
       while MstrTemp<>nil do
             begin
             SetStr(lumpname,MstrTemp^.Dir.Lumpname);
             SpecTemp:=FileSpec;
             while SpecTemp<>nil do
                   begin
                   if SpecTemp^.Remapped then
                      if lumpname=SpecTemp^.Lumpname then
                         begin
                         newname:=SpecTemp^.Filespec;
                         cvForeslash(newname);Lower4(newname);
                         SetArr(MstrTemp^.Dir.Lumpname,newname);
                         if Flags.Verbose then
                            writeln('rename: ',lumpname,' to ',newname);
                         end;
                   SpecTemp:=SpecTemp^.Next;
                   end;
             MstrTemp:=MstrTemp^.Next;
             end;
       CropDirectory(pak);
       WriteDirectory(pak,MstrStart);
       Close(pak);
  end;


var
   pakfile:string;
   filespec:PFileSpecList;

begin
     DirectVideo:=False;
     Assign(Output,'');ReWrite(Output);
     Writeln('# XPak v0.4.0; 96/07/01. (c) Tom Wheeley; <splitbung>, tomw@tsys.demon.co.uk; '#13#10);
     Case CheckParams(pakfile,filespec) of
          List:    ListPAK(pakfile,filespec);
          Extract: ExtractPAK(pakfile,filespec);
          Add:     AddPAK(pakfile,filespec);
          Remove:  RemovePAK(pakfile,filespec);
          Rename:  RenamePAK(pakfile,filespec);
          else writeln('main: mode not yet implemented');
     end;
end.