home *** CD-ROM | disk | FTP | other *** search
/ Tricks of the DOOM Programming Gurus / Tricks_of_the_Doom_Programming_Gurus.iso / bonus / utils / dirpwad / dirpwad.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-09-09  |  6.3 KB  |  220 lines
  1. program DirPWad;
  2.  
  3. {
  4.         09/09/1994 v1.01 Added support for Doom ][
  5.                          Added support for multiple files and wildcards
  6.                          Layout changed
  7.  
  8. }
  9.  
  10. uses Dos;
  11.  
  12.  
  13. procedure help;
  14. begin
  15.  writeln;
  16.  writeln('DirPWad v1.01 (c)1994 R.Nijlunsing csg465@wing.rug.nl');
  17.  writeln;
  18.  writeln('Syntax:');
  19.  writeln(' DIRPWAD <PWAD file(s)> [<PWAD file(s)> ..]');
  20.  writeln('Wildcards are allowed');
  21.  writeln;
  22.  writeln('Example:');
  23.  writeln(' I:\GREAT\GAMES\ID\DOOM1\1.666> dirpwad MyWad.wad');
  24.  writeln('could produce:');
  25.  writeln;
  26.  writeln('MYWAD.WAD :');
  27.  writeln('  E2M4 : 12      3');
  28.  writeln('  E2M5 : 1234    0');
  29.  writeln;
  30.  writeln('which means:');
  31.  writeln('''The file MyWad.WAD is a DOOM wad file which contains 2 levels:');
  32.  writeln(' episode 2 mission 4 which can be played by 2 persons in coop mode');
  33.  writeln(' and by a maximum of 3 persons in deathmatch. The other level,');
  34.  writeln(' episode 2 mission 5, can be played in coop by 4 persons but');
  35.  writeln(' not in deathmatch mode as there are no deathmatch-starts.''');
  36.  writeln;
  37.  halt(1);
  38. end;
  39.  
  40. function Cstring(cs:string):string;
  41. { Converts <cs> (ASCIIZ) to a Pascal string }
  42. var
  43.  s:string;
  44.  i:integer;
  45. begin
  46.  s:='';
  47.  i:=0;
  48.  while cs[i]<>#0 do begin
  49.   s:=s+cs[i];
  50.   inc(i);
  51.  end;
  52.  Cstring:=s;
  53. end;
  54.  
  55. function exist(filename:string):boolean;
  56. { Returns TRUE if file <filename> exists, otherwise FALSE }
  57. var f:file of byte;
  58. begin
  59.  assign(f,filename);
  60.  {$I-}
  61.  reset(f);
  62.  {$I+}
  63.  if IOResult<>0 then  exist:=false
  64.  else                 exist:=true;
  65. end;
  66.  
  67. function Up(s:string):string;
  68. { Returns string <s> in uppercase }
  69. var p:integer; result:string;
  70. begin
  71.  result:=s;
  72.  for p:=1 to length(s) do
  73.   result[p]:=upcase(result[p]);
  74.  up:=result;
  75. end;
  76.  
  77. procedure error(e:string; c:integer);
  78. begin
  79.  writeln;
  80.  writeln(' Fatal error: ',e);
  81.  halt(c);
  82. end;
  83.  
  84. procedure process_file(f:string);
  85. { Processes file with filename <f> }
  86. type
  87.  Tsig = array[0..3] of char; { WAD signature {PWAD or IWAD) }
  88.  Tthingentry = record  { A 'thing' map entry : }
  89.   x, y: integer;        { Coordinates: (x,y) }
  90.   angle: integer;       { Orientation }
  91.   typenr: integer;      { Type (1=player 1 start etc.) }
  92.   attr: word;           { Attribute }
  93.  end;
  94.  Tresname = array[0..7] of char; { Type of resource name, ASCIIZ }
  95.  Tdirentry = record  { Type of directory entry (=resource) in WAD file }
  96.   resstart: longint;  { Offset begin resource }
  97.   ressize: longint;   { Size of resource in bytes }
  98.   resname: Tresname;  { Name of resource }
  99.  end;
  100. const
  101.  maxthingentries = 65000 div sizeof(Tthingentry);
  102.  maxdirentries   = 65000 div sizeof(Tdirentry);
  103.  good_sig_PWAD: Tsig = 'PWAD'; { A good signature }
  104.  good_sig_IWAD: Tsig = 'IWAD'; { The other possibility }
  105. type
  106.  Tdir = array[0..maxdirentries-1] of Tdirentry; { Type of resource dir }
  107.  Tthing = array[0..maxthingentries-1] of Tthingentry; { Type of things dir }
  108. var
  109.  fn_input: string;   { Filenames }
  110.  fh_input: file;     { Filehandles }
  111.  header: record      { Header of WAD file }
  112.   sig: Tsig;          { PWAD /IWAD signature }
  113.   direntries: longint;{ # of entries in directory }
  114.   dirstart: longint;  { Offset begin directory }
  115.  end;
  116.  dirptr: ^Tdir;      { Pointer to directory }
  117.  dirsize: word;      { Length of directory in bytes }
  118.  thingptr: ^Tthing;  { Pointer to thing directory }
  119.  i,j:integer;        { Index }
  120.  playerstart:array[1..4] of boolean; { TRUE if playerstart[player] exists }
  121.  dmstarts:integer;   { # of deathmatch starts in a level }
  122. begin
  123.  fn_input:=f;
  124.  { Open file }
  125.  assign(fh_input,fn_input);
  126.  reset(fh_input,1);
  127.  { Read WAD info }
  128.  blockread(fh_input,header,sizeof(header));
  129.  writeln(fn_input,' :');
  130.  if (header.sig <> good_sig_PWAD) and
  131.     (header.sig <> good_sig_IWAD) then begin
  132.   close(fh_input);
  133.   writeln('  Error: Invalid signature in file !');
  134.   exit;
  135.  end;
  136.  if (header.direntries > maxdirentries) then begin
  137.   writeln(' Warning: resource directory >64Kb; truncated');
  138.   header.direntries:=maxdirentries;
  139.  end;
  140.  { Read directory }
  141.  dirsize:=sizeof(Tdirentry)*header.direntries;
  142.  if MaxAvail < dirsize then error('Out of memory',4);
  143.  getmem(dirptr,dirsize);
  144.  seek(fh_input,header.dirstart);
  145.  blockread(fh_input,dirptr^,dirsize);
  146.  { Scan for start new episode/mission }
  147.  i:=0;
  148.  while i<header.direntries do begin
  149.   with dirptr^[i] do begin
  150.    if ((resname[0]='E') and (resname[2]='M') and (resname[4]=#0)) or   {ExMy}
  151.       ((resname[0]='M') and (resname[1]='A') and (resname[2]='P') and  {MAPxx}
  152.        (resname[5]=#0)) then begin
  153.     write('   ',Cstring(resname),' : ');
  154.    end else
  155.     if (resname='THINGS'#0#0) then begin
  156.      { Now load the thing directory }
  157.      seek(fh_input,resstart);
  158.      if MaxAvail < ressize then begin
  159.       writeln('Too many things; truncating');
  160.       ressize:=(MaxAvail div 10)*10;
  161.      end;
  162.      getmem(thingptr,ressize);
  163.      blockread(fh_input,thingptr^,ressize);
  164.      dmstarts:=0;
  165.      for j:=1 to 4 do
  166.       playerstart[j]:=false;
  167.      for j:=0 to (ressize div 10)-1 do
  168.       case thingptr^[j].typenr of
  169.         1: playerstart[1]:=true;         { Player 1 start .. }
  170.         2: playerstart[2]:=true;         { Player 2 start .. }
  171.         3: playerstart[3]:=true;         { Player 3 start .. }
  172.         4: playerstart[4]:=true;         { Player 4 start .. }
  173.        11: inc(dmstarts);      { Deathmatch start }
  174.       end;
  175.      for j:=1 to 4 do
  176.       if playerstart[j] then write(j:1) else write(' ');
  177.      write(' ');
  178.      writeln(dmstarts:4);
  179.      freemem(thingptr,ressize);
  180.     end;
  181.   end;
  182.   inc(i);       { Next resource }
  183.  end;
  184.  { Dispose directory }
  185.  freemem(dirptr,dirsize);
  186.  { Close file }
  187.  close(fh_input);
  188. end;
  189.  
  190.  
  191. { Main program }
  192.  
  193. var
  194.  i:integer;             { Parameters index }
  195.  f:string;
  196.  DirInfo:SearchRec;
  197.  Dir:DirStr;
  198.  Dummy1:NameStr;
  199.  Dummy2:ExtStr;
  200. begin
  201.  if (paramcount=0) then help;
  202.  for i:=1 to paramcount do begin
  203.   f:=up(paramstr(i));
  204.   if exist(f+'.WAD') then
  205.    process_file(f+'.WAD')
  206.   else begin
  207.    FindFirst(f,$2f, DirInfo);  { Find all files }
  208.    if (DosError<>0) then
  209.     writeln('Warning: ''',f,''' not found')
  210.    else begin
  211.     Fsplit(f,Dir,dummy1,dummy2);
  212.     while (DosError=0) do begin
  213.      process_file(Dir+DirInfo.Name);
  214.      FindNext(DirInfo);
  215.     end;
  216.    end;
  217.   end;
  218.  end;
  219. end.
  220.