program DirPWad;

{
        09/09/1994 v1.01 Added support for Doom ][
                         Added support for multiple files and wildcards
                         Layout changed

}

uses Dos;


procedure help;
begin
 writeln;
 writeln('DirPWad v1.01 (c)1994 R.Nijlunsing csg465@wing.rug.nl');
 writeln;
 writeln('Syntax:');
 writeln(' DIRPWAD <PWAD file(s)> [<PWAD file(s)> ..]');
 writeln('Wildcards are allowed');
 writeln;
 writeln('Example:');
 writeln(' I:\GREAT\GAMES\ID\DOOM1\1.666> dirpwad MyWad.wad');
 writeln('could produce:');
 writeln;
 writeln('MYWAD.WAD :');
 writeln('  E2M4 : 12      3');
 writeln('  E2M5 : 1234    0');
 writeln;
 writeln('which means:');
 writeln('''The file MyWad.WAD is a DOOM wad file which contains 2 levels:');
 writeln(' episode 2 mission 4 which can be played by 2 persons in coop mode');
 writeln(' and by a maximum of 3 persons in deathmatch. The other level,');
 writeln(' episode 2 mission 5, can be played in coop by 4 persons but');
 writeln(' not in deathmatch mode as there are no deathmatch-starts.''');
 writeln;
 halt(1);
end;

function Cstring(cs:string):string;
{ Converts <cs> (ASCIIZ) to a Pascal string }
var
 s:string;
 i:integer;
begin
 s:='';
 i:=0;
 while cs[i]<>#0 do begin
  s:=s+cs[i];
  inc(i);
 end;
 Cstring:=s;
end;

function exist(filename:string):boolean;
{ Returns TRUE if file <filename> exists, otherwise FALSE }
var f:file of byte;
begin
 assign(f,filename);
 {$I-}
 reset(f);
 {$I+}
 if IOResult<>0 then  exist:=false
 else                 exist:=true;
end;

function Up(s:string):string;
{ Returns string <s> in uppercase }
var p:integer; result:string;
begin
 result:=s;
 for p:=1 to length(s) do
  result[p]:=upcase(result[p]);
 up:=result;
end;

procedure error(e:string; c:integer);
begin
 writeln;
 writeln(' Fatal error: ',e);
 halt(c);
end;

procedure process_file(f:string);
{ Processes file with filename <f> }
type
 Tsig = array[0..3] of char; { WAD signature {PWAD or IWAD) }
 Tthingentry = record  { A 'thing' map entry : }
  x, y: integer;        { Coordinates: (x,y) }
  angle: integer;       { Orientation }
  typenr: integer;      { Type (1=player 1 start etc.) }
  attr: word;           { Attribute }
 end;
 Tresname = array[0..7] of char; { Type of resource name, ASCIIZ }
 Tdirentry = record  { Type of directory entry (=resource) in WAD file }
  resstart: longint;  { Offset begin resource }
  ressize: longint;   { Size of resource in bytes }
  resname: Tresname;  { Name of resource }
 end;
const
 maxthingentries = 65000 div sizeof(Tthingentry);
 maxdirentries   = 65000 div sizeof(Tdirentry);
 good_sig_PWAD: Tsig = 'PWAD'; { A good signature }
 good_sig_IWAD: Tsig = 'IWAD'; { The other possibility }
type
 Tdir = array[0..maxdirentries-1] of Tdirentry; { Type of resource dir }
 Tthing = array[0..maxthingentries-1] of Tthingentry; { Type of things dir }
var
 fn_input: string;   { Filenames }
 fh_input: file;     { Filehandles }
 header: record      { Header of WAD file }
  sig: Tsig;          { PWAD /IWAD signature }
  direntries: longint;{ # of entries in directory }
  dirstart: longint;  { Offset begin directory }
 end;
 dirptr: ^Tdir;      { Pointer to directory }
 dirsize: word;      { Length of directory in bytes }
 thingptr: ^Tthing;  { Pointer to thing directory }
 i,j:integer;        { Index }
 playerstart:array[1..4] of boolean; { TRUE if playerstart[player] exists }
 dmstarts:integer;   { # of deathmatch starts in a level }
begin
 fn_input:=f;
 { Open file }
 assign(fh_input,fn_input);
 reset(fh_input,1);
 { Read WAD info }
 blockread(fh_input,header,sizeof(header));
 writeln(fn_input,' :');
 if (header.sig <> good_sig_PWAD) and
    (header.sig <> good_sig_IWAD) then begin
  close(fh_input);
  writeln('  Error: Invalid signature in file !');
  exit;
 end;
 if (header.direntries > maxdirentries) then begin
  writeln(' Warning: resource directory >64Kb; truncated');
  header.direntries:=maxdirentries;
 end;
 { Read directory }
 dirsize:=sizeof(Tdirentry)*header.direntries;
 if MaxAvail < dirsize then error('Out of memory',4);
 getmem(dirptr,dirsize);
 seek(fh_input,header.dirstart);
 blockread(fh_input,dirptr^,dirsize);
 { Scan for start new episode/mission }
 i:=0;
 while i<header.direntries do begin
  with dirptr^[i] do begin
   if ((resname[0]='E') and (resname[2]='M') and (resname[4]=#0)) or   {ExMy}
      ((resname[0]='M') and (resname[1]='A') and (resname[2]='P') and  {MAPxx}
       (resname[5]=#0)) then begin
    write('   ',Cstring(resname),' : ');
   end else
    if (resname='THINGS'#0#0) then begin
     { Now load the thing directory }
     seek(fh_input,resstart);
     if MaxAvail < ressize then begin
      writeln('Too many things; truncating');
      ressize:=(MaxAvail div 10)*10;
     end;
     getmem(thingptr,ressize);
     blockread(fh_input,thingptr^,ressize);
     dmstarts:=0;
     for j:=1 to 4 do
      playerstart[j]:=false;
     for j:=0 to (ressize div 10)-1 do
      case thingptr^[j].typenr of
        1: playerstart[1]:=true;         { Player 1 start .. }
        2: playerstart[2]:=true;         { Player 2 start .. }
        3: playerstart[3]:=true;         { Player 3 start .. }
        4: playerstart[4]:=true;         { Player 4 start .. }
       11: inc(dmstarts);      { Deathmatch start }
      end;
     for j:=1 to 4 do
      if playerstart[j] then write(j:1) else write(' ');
     write(' ');
     writeln(dmstarts:4);
     freemem(thingptr,ressize);
    end;
  end;
  inc(i);       { Next resource }
 end;
 { Dispose directory }
 freemem(dirptr,dirsize);
 { Close file }
 close(fh_input);
end;


{ Main program }

var
 i:integer;             { Parameters index }
 f:string;
 DirInfo:SearchRec;
 Dir:DirStr;
 Dummy1:NameStr;
 Dummy2:ExtStr;
begin
 if (paramcount=0) then help;
 for i:=1 to paramcount do begin
  f:=up(paramstr(i));
  if exist(f+'.WAD') then
   process_file(f+'.WAD')
  else begin
   FindFirst(f,$2f, DirInfo);  { Find all files }
   if (DosError<>0) then
    writeln('Warning: ''',f,''' not found')
   else begin
    Fsplit(f,Dir,dummy1,dummy2);
    while (DosError=0) do begin
     process_file(Dir+DirInfo.Name);
     FindNext(DirInfo);
    end;
   end;
  end;
 end;
end.