home *** CD-ROM | disk | FTP | other *** search
/ Deathday Collection / dday.bin / edit / dfe / objcache.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-26  |  4KB  |  161 lines
  1. {****************************************************************************
  2. *                      The DOOM Hacker's Tool Kit                           *
  3. *****************************************************************************
  4. * Unit   : OBJCACHE                                                         *
  5. * Purpose: Object Cache Memory Allocation Deamon                                   *
  6. * Date:    4/28/94                                                          *
  7. * Author:  Joshua Jackson        Internet: joshjackson@delphi.com           *
  8. ****************************************************************************}
  9.  
  10. unit ObjCache;
  11.  
  12. interface
  13.  
  14. uses Wad,WadDecl,Crt;
  15.  
  16. const    MaxLumps=5;
  17.         MaxLumpSize=64000;
  18.  
  19. type  PCacheLump=^TCacheLump;
  20.         TCacheLump=record
  21.             Size        :word;
  22.             Data        :BAP;
  23.         end;
  24.         PObjectCache=^TObjectCache;
  25.         TObjectCache=Object
  26.             Constructor Init(WDir:PWadDirectory;ObjNum:word);
  27.             Procedure SetPos(NewPos:longint);
  28.             Function CurPos:Longint;
  29.             Procedure IncPos(IncVal:longint);
  30.             Procedure CacheRead(var Dest;Count:word);
  31.             Function Size:Longint;
  32.             Destructor Done;
  33.          private
  34.             NumLumps:byte;
  35.             Lump:array[1..MaxLumps] of PCacheLump;
  36.             CachePos:longint;
  37.             LumpPos:word;
  38.             CurLump:byte;
  39.         end;
  40.  
  41. implementation
  42.  
  43. Constructor TObjectCache.Init(WDir:PWadDirectory;ObjNum:word);
  44.  
  45.     var    t:integer;
  46.  
  47.     begin
  48.         if WDir^.DirEntry^[ObjNum].ObjLength > MaxAvail then begin
  49.             TextMode(CO80);
  50.             writeln('ObjectCache_Init: Insufficient Memory to Allocate Cache');
  51.             halt(1);
  52.         end;
  53.         NumLumps:=WDir^.DirEntry^[ObjNum].ObjLength div MaxLumpSize;
  54.         if NumLumps > MaxLumps then begin
  55.             TextMode(CO80);
  56.             writeln('ObjectCache_Init: NumLumps > MaxLumps');
  57.             halt(1);
  58.         end;
  59.         for t:=1 to NumLumps do begin
  60.             New(Lump[t]);
  61.             Lump[t]^.Size:=MaxLumpSize;
  62.             GetMem(Lump[t]^.Data,MaxLumpSize);
  63.         end;
  64.         if (WDir^.DirEntry^[ObjNum].ObjLength Mod MaxLumpSize) > 0 then begin
  65.             Inc(NumLumps);
  66.             new(Lump[NumLumps]);
  67.             Lump[NumLumps]^.Size:=WDir^.DirEntry^[ObjNum].ObjLength Mod MaxLumpSize;
  68.             GetMem(Lump[NumLumps]^.Data,Lump[NumLumps]^.Size);
  69.         end;
  70.         Seek(WDir^.WadFile,WDir^.DirEntry^[ObjNum].ObjStart);
  71.         for t:=1 to NumLumps do
  72.             BlockRead(WDir^.WadFile,Lump[t]^.Data^,Lump[t]^.Size);
  73.         SetPos(0);
  74.     end;
  75.  
  76. Procedure TObjectCache.SetPos(NewPos:longint);
  77.  
  78.     begin
  79.         if NewPos > Size then begin
  80.             TextMode(CO80);
  81.             writeln('ObjectCache_SetPos: Attempted to set pointer past end of cache.');
  82.             Halt;
  83.         end;
  84.         CurLump:=(NewPos div MaxLumpSize) + 1;
  85.         LumpPos:=NewPos mod MaxLumpSize;
  86.     end;
  87.  
  88. Function TObjectCache.CurPos:Longint;
  89.  
  90.     var     t:integer;
  91.             TempPos:Longint;
  92.  
  93.     begin
  94.         TempPos:=LumpPos;
  95.         for t:=(CurLump - 1) Downto 1 do
  96.             TempPos:=TempPos+Lump[t]^.Size;
  97.         CurPos:=TempPos;
  98.     end;
  99.  
  100. Procedure TObjectCache.IncPos(IncVal:longint);
  101.  
  102.     begin
  103.         SetPos(CurPos + IncVal);
  104.     end;
  105.  
  106. Procedure TObjectCache.CacheRead(var Dest;Count:word);
  107.  
  108.     var    DestPtr:pointer;
  109.             Remaining,ReadSize:word;
  110.  
  111.     begin
  112.         DestPtr:=@Dest;
  113.         ReadSize:=Count;
  114.         Remaining:=Count;
  115.         repeat
  116.             if CurPos+Count > Size then begin
  117.                 TextMode(CO80);
  118.                 writeln('ObjectCache_CacheRead: Attempted to read past end of cache.');
  119.                 halt(1);
  120.             end;
  121.             if (LumpPos+Count) > MaxLumpSize then
  122.                 ReadSize:=MaxLumpSize-LumpPos;
  123.             Remaining:=Remaining-ReadSize;
  124.             move(Lump[CurLump]^.Data^[LumpPos],DestPtr^,ReadSize);
  125.             if Remaining > 0 then begin
  126.                 DestPtr:=Ptr(Seg(DestPtr^), Ofs(DestPtr^)+ReadSize);
  127.             end;
  128.             SetPos(CurPos + ReadSize);
  129.         until remaining = 0;
  130.     end;
  131.  
  132. Function TObjectCache.Size:longint;
  133.  
  134.     var     t:integer;
  135.             TempSize:longint;
  136.  
  137.     begin
  138.         TempSize:=0;
  139.         for t:=1 to NumLumps do
  140.             TempSize:=TempSize+Lump[t]^.Size;
  141.         Size:=TempSize;
  142.     end;
  143.  
  144. Destructor TObjectCache.Done;
  145.  
  146.     var t:integer;
  147.  
  148.     begin
  149.         for t:=1 to NumLumps do begin
  150.             FreeMem(Lump[t]^.Data,Lump[t]^.Size);
  151.             dispose(Lump[t]);
  152.         end;
  153.     end;
  154.  
  155. begin
  156. {$IFDEF DFE}
  157.     writeln('SysObjectCache_Init: Initializing Object Cache Memory Allocation Deamon...');
  158.     writeln('   SysObjectCache_Init: Max Lump Size = ',MaxLumpSize);
  159.     writeln('   SysObjectCache_Init: Max Cache Lumps = ',MaxLumps);
  160. {$ENDIF}
  161. end.