program DirPWad;

procedure help;
begin
 writeln;
 writeln('DirPWad v1.00 (c)1994 R.Nijlunsing');
 writeln;
 writeln('Syntax:');
 writeln(' DIRPWAD <PWAD file>');
 writeln;
 writeln;
 halt(1);
end;

function exist(filename:string):boolean;
{ Levert TRUE als file <filename> bestaat, anders 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;
{ Levert de string S in hoofdletters op }
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;

type
 Tsig = array[0..3] of char; { Type van de WAD signature }
 Tthingentry = record  { Een 'ding' entry }
  x, y: integer;        { Plaats op map is (x,y) }
  angle: integer;       { Orientatie van ding }
  typenr: integer;      { Ding nummer }
  attr: word;           { Attribuut }
 end;
 Tresname = array[0..7] of char; { Naam van een resource, ASCIIZ }
 Tdirentry = record  { Type van directory entry (=resource) in WAD file }
  resstart: longint;  { Offset begin resource }
  ressize: longint;   { Size van resource in bytes }
  resname: Tresname;  { Naam van de resource }
 end;
const
 maxthingentries = 65000 div sizeof(Tthingentry);
 maxdirentries   = 65000 div sizeof(Tdirentry);
 good_sig_PWAD: Tsig = 'PWAD'; { Een goede sig }
 good_sig_IWAD: Tsig = 'IWAD'; { En de andere }
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 van WAD file }
  sig: Tsig;          { PWAD /IWAD signature }
  direntries: longint;{ Aantal entries in directory }
  dirstart: longint;  { Offset begin directory }
 end;
 dirptr: ^Tdir;      { Pointer naar de directory }
 dirsize: word;      { Lengte van directory in bytes }
 thingptr: ^Tthing;  { Pointer naar thing directory }
 i,j:integer;        { Index }
begin
 if (paramcount<>1) then help;
 fn_input:=up(paramstr(1));
 if (not exist(fn_input)) and exist(fn_input+'.WAD') then
  fn_input:=fn_input+'.WAD';
 { Open file }
 if not exist(fn_input) then error('Input file doesn''t exist !',2);
 assign(fh_input,fn_input);
 reset(fh_input,1);
 { Read WAD info }
 blockread(fh_input,header,sizeof(header));
 write(fn_input,' :');
 if (header.sig <> good_sig_PWAD) and
    (header.sig <> good_sig_IWAD) then
     error('Invalid signature in WAD file !',3);
 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) then begin
    writeln;
    write(' E',resname[1],'M',resname[3],' : ');
   end else
    if (resname='THINGS'#0#0) then begin
     { Laden van 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);
     for j:=0 to (ressize div 10)-1 do
      case thingptr^[j].typenr of
        1: write('1');         { Player 1 start .. }
        2: write('2');
        3: write('3');
        4: write('4');
       11: write('D');         { Deathmatch start }
      end;
     freemem(thingptr,ressize);
    end;
  end;
  inc(i);       { Volgende resource }
 end;
 writeln;
 { Dispose directory }
 freemem(dirptr,dirsize);
 { Close file }
 close(fh_input);
end.