home *** CD-ROM | disk | FTP | other *** search
/ Crazy Collection 12 / CC-12_1.iso / update / doompack / data.a00 / SW.ZIP / SW.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1994-06-19  |  3.8 KB  |  127 lines
  1. PROGRAM SHOW;
  2. { This program shows the levels in a DOOM wad file }
  3. { Paul Robinson 6/17/94 -- Email: PAUL@TDR.COM }
  4.  
  5. {                                                 }
  6. { (C) Copyright 1994, Tansin A. Darcos & Company, }
  7. { Commercial Rights Reserved                      }
  8. { Country of Origin: United States of America     }
  9. {                                                 }
  10.  
  11. TYPE
  12.  
  13.     HeaderType = RECORD
  14.                 Wadtype:        array[0..3] of char;  {"IWAD" or "PWAD"}
  15.                 NumEntries,                 {Number of Directory entries}
  16.                 dirpointer:     longint;    {Start of Directory}
  17.              END;
  18.  
  19.     DirectoryEntryType = RECORD
  20.                 StartPointer,            {Pointer to start of Resource}
  21.                 EntryLength:    longint; {Length of Resource}
  22.                 ResourceName:   array[1..8] of char;
  23.              END;
  24.  
  25. VAR
  26.       Wad:  file;
  27.       Header:headertype;
  28.       DirectoryEntry:DirectoryEntryType;
  29.       RSNAME:string[8];
  30.       name:string[64];
  31.  
  32.  
  33. PROCEDURE OpenWad;
  34. VAR I,J,K:INTEGER;
  35.     L:LONGINT;
  36.  
  37. BEGIN
  38.    assign(wad,name);
  39.    {$I-} Reset(wad,1); {$I+}
  40.    if IOResult <> 0 then
  41.      begin
  42.        assign(wad,name+'.WAD');  {Assume the .WAD was forgotten }
  43.        {$I-} Reset(wad,1); {$I+}
  44.        if IOResult <> 0 then
  45.          begin
  46.             writeln('File ',name,' cannot be opened.');
  47.             halt(2);
  48.          end;
  49.      end;
  50.    blockread(Wad,Header,sizeof(Header));
  51.    if (header.wadtype <> 'IWAD') and (header.wadtype<>'PWAD') then
  52.      begin
  53.        writeln('File ',name,' is not in wad format.');
  54.        halt(2);
  55.      end;
  56.    seek(Wad,Header.DirPointer);
  57.    J:=0; K:=0;
  58.    For L := 1 to Header.NUMENTRIES do
  59.          BEGIN
  60.             blockread(Wad,DirectoryEntry,sizeof(DirectoryEntry));
  61.             RsName := DirectoryEntry.ResourceName;
  62.             For I := 8 downto 1 do
  63.               if rsname[I] = #0 then
  64.                   rsname[0] := chr(i-1);
  65.             if (upcase(rsname[1])='E') and
  66.                (upcase(rsname[3])='M') and
  67.                (rsname[2] in ['1'..'3']) and
  68.                (rsname[4] in ['1'..'9']) and
  69.                (length(rsname)=4) then
  70.              begin
  71.                 if j<1 then
  72.                    begin
  73.                    writeln('The following level(s) were found in this ',
  74.                            header.wadtype,' wad:');
  75.                    write('    ');
  76.                    end;
  77.                 if K > 8 then
  78.                   begin
  79.                      writeln;
  80.                      write('    ');
  81.                      K := 0;
  82.                   end;
  83.                 write(rsname,' ');
  84.                 inc(j);
  85.                 inc(k);
  86.              end;
  87.  
  88.         END;
  89.              if K<>0 then
  90.                writeln;
  91.         if J = 0 then
  92.           writeln('This wad contains no level data.');
  93. END;
  94.  
  95.  
  96.  
  97. begin
  98.        if paramcount = 0 then
  99.         begin
  100.            write('Wad file Name?');
  101.            readln(name);
  102.         end
  103.        else
  104.         name := paramstr(1);
  105.         if name='/?' then
  106.           begin
  107.              write('SW-Wad level finder  ');
  108.              writeln('(C) Copyright Tansin A. Darcos & Company 1994');
  109.              writeln('Commercial Rights Reserved.');
  110.              writeln;
  111.              writeln('This program reads a WAD file and lists out all of');
  112.              writeln('the levels stored in that wad.');
  113.              writeln;
  114.              writeln('Usage:');
  115.              writeln;
  116.              writeln('SW [wadname[.WAD]]');
  117.              writeln;
  118.              writeln('If the name isn''t stated on the command line, SW');
  119.              writeln('will ask for it.  The extension .WAD is assumed if');
  120.              writeln('not stated.');
  121.              halt(1);
  122.           end;
  123.         if name = '' then halt(1);
  124.         OpenWad;
  125.         close(Wad);
  126. end.
  127.