home *** CD-ROM | disk | FTP | other *** search
/ MegaDoom Add-On 3 / MEGADOOM3.iso / other / dirpwad / dirpwad.pas < prev   
Pascal/Delphi Source File  |  1994-04-18  |  4KB  |  139 lines
  1. program DirPWad;
  2.  
  3. procedure help;
  4. begin
  5.  writeln;
  6.  writeln('DirPWad v1.00 (c)1994 R.Nijlunsing');
  7.  writeln;
  8.  writeln('Syntax:');
  9.  writeln(' DIRPWAD <PWAD file>');
  10.  writeln;
  11.  writeln;
  12.  halt(1);
  13. end;
  14.  
  15. function exist(filename:string):boolean;
  16. { Levert TRUE als file <filename> bestaat, anders FALSE }
  17. var f:file of byte;
  18. begin
  19.  assign(f,filename);
  20.  {$I-}
  21.  reset(f);
  22.  {$I+}
  23.  if IOResult<>0 then  exist:=false
  24.  else                 exist:=true;
  25. end;
  26.  
  27. function Up(s:string):string;
  28. { Levert de string S in hoofdletters op }
  29. var p:integer; result:string;
  30. begin
  31.  result:=s;
  32.  for p:=1 to length(s) do
  33.   result[p]:=upcase(result[p]);
  34.  up:=result;
  35. end;
  36.  
  37. procedure error(e:string; c:integer);
  38. begin
  39.  writeln;
  40.  writeln(' Fatal error: ',e);
  41.  halt(c);
  42. end;
  43.  
  44. type
  45.  Tsig = array[0..3] of char; { Type van de WAD signature }
  46.  Tthingentry = record  { Een 'ding' entry }
  47.   x, y: integer;        { Plaats op map is (x,y) }
  48.   angle: integer;       { Orientatie van ding }
  49.   typenr: integer;      { Ding nummer }
  50.   attr: word;           { Attribuut }
  51.  end;
  52.  Tresname = array[0..7] of char; { Naam van een resource, ASCIIZ }
  53.  Tdirentry = record  { Type van directory entry (=resource) in WAD file }
  54.   resstart: longint;  { Offset begin resource }
  55.   ressize: longint;   { Size van resource in bytes }
  56.   resname: Tresname;  { Naam van de resource }
  57.  end;
  58. const
  59.  maxthingentries = 65000 div sizeof(Tthingentry);
  60.  maxdirentries   = 65000 div sizeof(Tdirentry);
  61.  good_sig_PWAD: Tsig = 'PWAD'; { Een goede sig }
  62.  good_sig_IWAD: Tsig = 'IWAD'; { En de andere }
  63. type
  64.  Tdir = array[0..maxdirentries-1] of Tdirentry; { Type of resource dir }
  65.  Tthing = array[0..maxthingentries-1] of Tthingentry; { Type of things dir }
  66. var
  67.  fn_input: string;   { Filenames }
  68.  fh_input: file;     { Filehandles }
  69.  header: record      { Header van WAD file }
  70.   sig: Tsig;          { PWAD /IWAD signature }
  71.   direntries: longint;{ Aantal entries in directory }
  72.   dirstart: longint;  { Offset begin directory }
  73.  end;
  74.  dirptr: ^Tdir;      { Pointer naar de directory }
  75.  dirsize: word;      { Lengte van directory in bytes }
  76.  thingptr: ^Tthing;  { Pointer naar thing directory }
  77.  i,j:integer;        { Index }
  78. begin
  79.  if (paramcount<>1) then help;
  80.  fn_input:=up(paramstr(1));
  81.  if (not exist(fn_input)) and exist(fn_input+'.WAD') then
  82.   fn_input:=fn_input+'.WAD';
  83.  { Open file }
  84.  if not exist(fn_input) then error('Input file doesn''t exist !',2);
  85.  assign(fh_input,fn_input);
  86.  reset(fh_input,1);
  87.  { Read WAD info }
  88.  blockread(fh_input,header,sizeof(header));
  89.  write(fn_input,' :');
  90.  if (header.sig <> good_sig_PWAD) and
  91.     (header.sig <> good_sig_IWAD) then
  92.      error('Invalid signature in WAD file !',3);
  93.  if (header.direntries > maxdirentries) then begin
  94.   writeln(' Warning: resource directory >64Kb; truncated');
  95.   header.direntries:=maxdirentries;
  96.  end;
  97.  { Read directory }
  98.  dirsize:=sizeof(Tdirentry)*header.direntries;
  99.  if MaxAvail < dirsize then error('Out of memory',4);
  100.  getmem(dirptr,dirsize);
  101.  seek(fh_input,header.dirstart);
  102.  blockread(fh_input,dirptr^,dirsize);
  103.  { Scan for start new episode/mission }
  104.  i:=0;
  105.  while i<header.direntries do begin
  106.   with dirptr^[i] do begin
  107.    if (resname[0]='E') and (resname[2]='M') and (resname[4]=#0) then begin
  108.     writeln;
  109.     write(' E',resname[1],'M',resname[3],' : ');
  110.    end else
  111.     if (resname='THINGS'#0#0) then begin
  112.      { Laden van thing directory }
  113.      seek(fh_input,resstart);
  114.      if MaxAvail < ressize then begin
  115.       writeln('Too many things; truncating');
  116.       ressize:=(MaxAvail div 10)*10;
  117.      end;
  118.      getmem(thingptr,ressize);
  119.      blockread(fh_input,thingptr^,ressize);
  120.      for j:=0 to (ressize div 10)-1 do
  121.       case thingptr^[j].typenr of
  122.         1: write('1');         { Player 1 start .. }
  123.         2: write('2');
  124.         3: write('3');
  125.         4: write('4');
  126.        11: write('D');         { Deathmatch start }
  127.       end;
  128.      freemem(thingptr,ressize);
  129.     end;
  130.   end;
  131.   inc(i);       { Volgende resource }
  132.  end;
  133.  writeln;
  134.  { Dispose directory }
  135.  freemem(dirptr,dirsize);
  136.  { Close file }
  137.  close(fh_input);
  138. end.
  139.