home *** CD-ROM | disk | FTP | other *** search
/ Deathday Collection / dday.bin / edit / dfe / wad.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-26  |  8KB  |  325 lines
  1. {****************************************************************************
  2. *                      The DOOM Hacker's Tool Kit                           *
  3. *****************************************************************************
  4. * Unit:       WAD                                                              *
  5. * Purpose: Loading WAD File directory and much more                         *
  6. * Date:    4/28/94                                                          *
  7. * Author:  Joshua Jackson        Internet: joshjackson@delphi.com           *
  8. ****************************************************************************}
  9.  
  10. {$O+,F+}
  11. unit wad;
  12.  
  13. interface
  14.  
  15. uses WadDecl;
  16.  
  17. type    PWadDirectory=^TWadDirectory;
  18.         TWadDirectory=object
  19.             WadName        :array[1..9] of char;
  20.             WadFile        :file;
  21.             WadID            :array[1..4] of char;
  22.             DirEntries    :longint;
  23.             DirStart        :longint;
  24.             DirEntry     :PWADDirList;
  25.             Constructor Init(WadFileName:String);
  26.             Procedure DisplayWadDir;
  27.             Function FindObject(ObjName:ObjNameStr):word;
  28.             Procedure SetWadPalette(PlayPalNum:integer);
  29.             Procedure RestorePalette;
  30.             Destructor Done;
  31.         end;
  32.  
  33. Function WadResultMsg(ErrNum:byte):string;
  34.  
  35. Const TerminateOnWadError:boolean=True;
  36.         WadResult        :Integer = 0;
  37.         wrOk                = 00;
  38.         wrInvalidFile    = 01;
  39.         wrMaxEntries    = 02;
  40.         wrNoObject        = 03;
  41.         wrNoSound        = 04;
  42.         wrBadImageSize = 05;
  43.         wrNoPicture        = 06;
  44.         wrNoPalette        = 07;
  45.         wrNoFile            = 08;
  46.         ShowInit            :boolean=False;
  47.         WadPaletteIsSet:Boolean=false;
  48.  
  49. implementation
  50.  
  51. uses crt,windos,dos;
  52.  
  53. var    OldPalette:array[1..768] of byte;
  54.  
  55. Function TWadDirectory.FindObject(ObjName:ObjNameStr):word;
  56.  
  57.     var    t,x:integer;
  58.             TempName:ObjNameStr;
  59.  
  60.     begin
  61.         for t:=8 downto 1 do begin
  62.             if ObjName[t] = ' ' then
  63.                 ObjName[t]:= #0;
  64.             ObjName[t]:=Upcase(ObjName[t]);
  65.         end;
  66.         for t:=1 to DirEntries do begin
  67.             for x:=1 to 8 do
  68.                 if ObjName[x]='?' then
  69.                     TempName[x]:=DirEntry^[t].ObjName[x]
  70.                 else
  71.                     TempName[x]:=ObjName[x];
  72.             if DirEntry^[t].ObjName = TempName then begin
  73.                 FindObject:=t;
  74.                 exit;
  75.             end;
  76.         end;
  77.         FindObject:=0;
  78.     end;
  79.  
  80. {Procedure ReadSound(Dir:PWadDir;SoundName:ObjNameStr;var SBuff:PSoundBuff);
  81.  
  82.     var     l:word;
  83.             TempPtr:PSoundBuff;
  84.  
  85.     begin
  86.         l:=FindObject(Dir,SoundName);
  87.         if l=0 then begin
  88.             if TerminateOnWadError then begin
  89.                 TextMode(co80);
  90.                 writeln('ReadSound: Could not locate sound ID: ',SoundName);
  91.                 halt(1);
  92.              end
  93.             else begin
  94.                 WadResult:=wrNoSound;
  95.                 exit;
  96.             end;
  97.         end;
  98.         seek(Dir^.WadFile,Dir^.DirEntry^[l].ObjStart);
  99.         New(TempPtr);}                                    {Allocate New Sound Descriptor}
  100. {        BlockRead(Dir^.WadFile,Dir^.ObjBuffer^[0],Dir^.DirEntry^[l].ObjLength);
  101.         Move(Dir^.ObjBuffer^[2],TempPtr^.SampleRate,4);
  102.         GetMem(TempPtr^.Sound,TempPtr^.Samples);
  103.         Move(Dir^.ObjBuffer^[6],TempPtr^.Sound^,TempPtr^.Samples);
  104.         writeln('Sound Size: ',TempPtr^.Samples);
  105.         SBuff:=TempPtr;
  106.         WadResult:=wrOk;
  107.     end;}
  108.  
  109. Procedure TWadDirectory.SetWadPalette(PlayPalNum:integer);
  110.  
  111.     var     Regs:Registers;
  112.             PalEnt:word;
  113.             PBuff:array[1..768] of byte;
  114.  
  115.     Procedure SaveColor(ColorNum:word);
  116.  
  117.         begin
  118.             move(OldPalette[ColorNum * 3],PBuff[ColorNum  * 3],3);
  119.         end;
  120.  
  121.     begin
  122.         if Not WadPaletteIsSet then begin
  123.             with regs do begin
  124.                 Regs.ax:=$1017;
  125.                 Regs.es:=Seg(OldPalette);
  126.                 Regs.dx:=ofs(OldPalette);
  127.                 Regs.bx:=0;
  128.                 Regs.cx:=256;
  129.                 Intr($10,Regs);
  130.             end;
  131.         end;
  132.         PalEnt:=FindObject('PLAYPAL ');
  133.         if PalEnt=0 then begin
  134.             if TerminateOnWadError then begin
  135.                 TextMode(CO80);
  136.                 writeln('SetWadPalette: Could not locate PLAYPAL');
  137.                 halt(1);
  138.              end
  139.             else begin
  140.                 WadResult:=wrNoPalette;
  141.                 exit;
  142.             end;
  143.         end;
  144.         Seek(WadFile,DirEntry^[PalEnt].ObjStart + (768 * PlayPalNum));
  145.         Blockread(WadFile,Pbuff,768);
  146.         for PalEnt:=1 to 768 do
  147.             Pbuff[PalEnt]:=Pbuff[PalEnt] div 4;
  148. {        SaveColor(7);
  149.         SaveColor(1);
  150.         SaveColor(2);
  151.         SaveColor(3);
  152.         SaveColor(15);
  153.         SaveColor(8);}
  154.         with regs do begin
  155.             ax:=$1012;
  156.             bx:=0;
  157.             cx:=256;
  158.             es:=seg(PBuff);
  159.             dx:=ofs(PBuff);
  160.             Intr($10,Regs);
  161.         end;
  162.         WadResult:=wrOk;
  163.         WadPaletteIsSet:=True;
  164.     end;
  165.  
  166. Procedure TWadDirectory.RestorePalette;
  167.  
  168.     var    Regs:Registers;
  169.  
  170.     begin
  171.         if WadPaletteIsSet then begin
  172.             with regs do begin
  173.                 ax:=$1012;
  174.                 bx:=0;
  175.                 cx:=256;
  176.                 es:=seg(OldPalette);
  177.                 dx:=ofs(OldPalette);
  178.                 Intr($10,Regs);
  179.             end;
  180.         end;
  181.         WadPaletteIsSet:=False;
  182.     end;
  183.  
  184. {$I-}
  185. Constructor TWadDirectory.Init(WadFileName:String);
  186.  
  187.     var    DirSize:longint;
  188.  
  189.     begin
  190.         if ShowInit then
  191.             writeln('W_Init: Initializing WAD file');
  192.         assign(WadFile,WadFileName);
  193.         reset(WadFile,1);
  194.         if IOResult<>0 then begin
  195.             if TerminateOnWadError then begin
  196.                 TextMode(CO80);
  197.                 writeln('WadDirectory_Init: Error Reading WAD FILE: ',WadFileName);
  198.                 halt(1);
  199.              end
  200.             else begin
  201.                 WadResult:=wrNoFile;
  202.                 exit;
  203.             end;
  204.         end;
  205.         WadFileName:=WadFileName+#0;
  206.         FillChar(WadName,8,#0);
  207.         filesplit(@WadFileName,NIL,@WadName,NIL);
  208.         blockread(WadFile,WadID,12);
  209.         if (WadID<>'IWAD') and (WadID<>'PWAD') then begin
  210.             if TerminateOnWadError then begin
  211.                 TextMode(CO80);
  212.                 Close(WadFile);
  213.                 writeln('W_Init: ',WadFileName,' is not a valid WAD file');
  214.                 halt(1);
  215.              end
  216.             else begin
  217.                 WadResult:=wrInvalidFile;
  218.                 exit;
  219.             end;
  220.         end;
  221.         if DirEntries > MaxEntries then begin
  222.             if TerminateOnWadError then begin
  223.                 TextMode(CO80);
  224.                 Close(WadFile);
  225.                 write('   W_Init_Alloc: Can not allocate for more than ',MaxEntries);
  226.                 writeln(' Directory Entries');
  227.                 halt(1);
  228.              end
  229.             else begin
  230.                 WadResult:=wrMaxEntries;
  231.                 exit;
  232.             end;
  233.         end;
  234.         DirSize:=DirEntries * 16;
  235.         GetMem(DirEntry, DirSize);
  236.         FillChar(DirEntry^,DirSize,#00);
  237.         if ShowInit then
  238.             writeln('   W_Init_Alloc: ',DirSize,' Allocated for directory');
  239.         seek(WadFile, DirStart);
  240.         BlockRead(WadFile, DirEntry^, DirSize);
  241.         WadResult:=wrOk;
  242.     end;
  243.  
  244. Procedure TWadDirectory.DisplayWadDir;
  245.  
  246.     var    x:word;
  247.  
  248.     begin
  249.         writeln('Directory of WAD: ',WadName);
  250.         for x:=1 to DirEntries do begin
  251.             with DirEntry^[x] do begin
  252.                 writeln(ObjName,'         ',ObjStart,'          ',ObjLength);
  253.             end;
  254.         end;
  255.     end;
  256.  
  257. Destructor TWadDirectory.Done;
  258.  
  259.     var    DirSize:word;
  260.  
  261.     begin
  262.         close(WadFile);
  263.         DirSize:=DirEntries * 16;
  264.         FreeMem(DirEntry, DirSize);
  265.     end;
  266.  
  267. Function WadResultMsg(ErrNum:byte):string;
  268.  
  269.     begin
  270.         case ErrNum of
  271.             wrOk:WadResultMsg:='';
  272.             wrInvalidFile:WadResultMsg:='Invalid WAD file Format';
  273.             wrMaxEntries:WadResultMsg:='Too many WAD directory Entries';
  274.             wrNoObject:WadResultMsg:='Specified WAD Object Not Found';
  275.             wrNoSound:WadResultMsg:='Specified WAD Sound Not Found';
  276.             wrBadImageSize:WadResultMsg:='Invalid WAD Image Size';
  277.             wrNoPicture:WadResultMsg:='Specified Picture ID Not Found';
  278.             wrNoPalette:WadResultMsg:='PLAYPAL Entry Not Found';
  279.             wrNoFile:WadResultMsg:='Error Accessing WAD File';
  280.         else
  281.             WadResultMsg:='Unknown WAD file Error'
  282.         end;
  283.     end;
  284.  
  285. begin
  286. {$IFDEF DFE}
  287.     TextAttr:=7;
  288.     ClrScr;
  289.     TextAttr:=31;
  290.     write('                          The DOOM Hacker''s Tool Kit                            ');
  291.     TextAttr:=7;
  292.     writeln('Sys_Init: Examining System');
  293.     case Test8086 of
  294.         00:begin
  295.                 writeln('   CPU_Check: 8088 or 8086');
  296.                 writeln('                 This Program requires at least an 80386.');
  297.                 halt(1);
  298.             end;
  299.         01:begin
  300.                 writeln('   CPU_Check: 80286');
  301.                 writeln('                 This Program requires at least an 80386.');
  302.                 halt(1);
  303.                 end;
  304.         02:begin
  305.                 writeln('   CPU_Check: 80386 or better');
  306.             end;
  307.     end;
  308.     delay(450);
  309.     writeln('SysMem_Init: Initializing Memory Allocation Deamon...');
  310.     writeln('   SysMem_Init: ',Hex_String(MaxAvail),'  ');
  311.     if MaxAvail < 300000 then begin
  312.         writeln('   SysMem_Init: Insufficient System Memory!');
  313.         halt(1);
  314.     end;
  315.     delay(500);
  316. {$ELSE}
  317.     writeln;
  318.    writeln('The DOOM Hacker''s Tool Kit v1.00');
  319.    writeln;
  320.    writeln('by: Jackson Software');
  321.    writeln('author: Joshua Jackson      internet: joshjackson@delphi.com');
  322.     delay(1000);
  323. {$ENDIF}
  324. end.
  325.