home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FMI Superhry 1
/
Superhry-I.bin
/
bonus
/
doom
/
programs
/
dhtk100
/
objcache.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-05-26
|
4KB
|
161 lines
{****************************************************************************
* The DOOM Hacker's Tool Kit *
*****************************************************************************
* Unit : OBJCACHE *
* Purpose: Object Cache Memory Allocation Deamon *
* Date: 4/28/94 *
* Author: Joshua Jackson Internet: joshjackson@delphi.com *
****************************************************************************}
unit ObjCache;
interface
uses Wad,WadDecl,Crt;
const MaxLumps=5;
MaxLumpSize=64000;
type PCacheLump=^TCacheLump;
TCacheLump=record
Size :word;
Data :BAP;
end;
PObjectCache=^TObjectCache;
TObjectCache=Object
Constructor Init(WDir:PWadDirectory;ObjNum:word);
Procedure SetPos(NewPos:longint);
Function CurPos:Longint;
Procedure IncPos(IncVal:longint);
Procedure CacheRead(var Dest;Count:word);
Function Size:Longint;
Destructor Done;
private
NumLumps:byte;
Lump:array[1..MaxLumps] of PCacheLump;
CachePos:longint;
LumpPos:word;
CurLump:byte;
end;
implementation
Constructor TObjectCache.Init(WDir:PWadDirectory;ObjNum:word);
var t:integer;
begin
if WDir^.DirEntry^[ObjNum].ObjLength > MaxAvail then begin
TextMode(CO80);
writeln('ObjectCache_Init: Insufficient Memory to Allocate Cache');
halt(1);
end;
NumLumps:=WDir^.DirEntry^[ObjNum].ObjLength div MaxLumpSize;
if NumLumps > MaxLumps then begin
TextMode(CO80);
writeln('ObjectCache_Init: NumLumps > MaxLumps');
halt(1);
end;
for t:=1 to NumLumps do begin
New(Lump[t]);
Lump[t]^.Size:=MaxLumpSize;
GetMem(Lump[t]^.Data,MaxLumpSize);
end;
if (WDir^.DirEntry^[ObjNum].ObjLength Mod MaxLumpSize) > 0 then begin
Inc(NumLumps);
new(Lump[NumLumps]);
Lump[NumLumps]^.Size:=WDir^.DirEntry^[ObjNum].ObjLength Mod MaxLumpSize;
GetMem(Lump[NumLumps]^.Data,Lump[NumLumps]^.Size);
end;
Seek(WDir^.WadFile,WDir^.DirEntry^[ObjNum].ObjStart);
for t:=1 to NumLumps do
BlockRead(WDir^.WadFile,Lump[t]^.Data^,Lump[t]^.Size);
SetPos(0);
end;
Procedure TObjectCache.SetPos(NewPos:longint);
begin
if NewPos > Size then begin
TextMode(CO80);
writeln('ObjectCache_SetPos: Attempted to set pointer past end of cache.');
Halt;
end;
CurLump:=(NewPos div MaxLumpSize) + 1;
LumpPos:=NewPos mod MaxLumpSize;
end;
Function TObjectCache.CurPos:Longint;
var t:integer;
TempPos:Longint;
begin
TempPos:=LumpPos;
for t:=(CurLump - 1) Downto 1 do
TempPos:=TempPos+Lump[t]^.Size;
CurPos:=TempPos;
end;
Procedure TObjectCache.IncPos(IncVal:longint);
begin
SetPos(CurPos + IncVal);
end;
Procedure TObjectCache.CacheRead(var Dest;Count:word);
var DestPtr:pointer;
Remaining,ReadSize:word;
begin
DestPtr:=@Dest;
ReadSize:=Count;
Remaining:=Count;
repeat
if CurPos+Count > Size then begin
TextMode(CO80);
writeln('ObjectCache_CacheRead: Attempted to read past end of cache.');
halt(1);
end;
if (LumpPos+Count) > MaxLumpSize then
ReadSize:=MaxLumpSize-LumpPos;
Remaining:=Remaining-ReadSize;
move(Lump[CurLump]^.Data^[LumpPos],DestPtr^,ReadSize);
if Remaining > 0 then begin
DestPtr:=Ptr(Seg(DestPtr^), Ofs(DestPtr^)+ReadSize);
end;
SetPos(CurPos + ReadSize);
until remaining = 0;
end;
Function TObjectCache.Size:longint;
var t:integer;
TempSize:longint;
begin
TempSize:=0;
for t:=1 to NumLumps do
TempSize:=TempSize+Lump[t]^.Size;
Size:=TempSize;
end;
Destructor TObjectCache.Done;
var t:integer;
begin
for t:=1 to NumLumps do begin
FreeMem(Lump[t]^.Data,Lump[t]^.Size);
dispose(Lump[t]);
end;
end;
begin
{$IFDEF DFE}
writeln('SysObjectCache_Init: Initializing Object Cache Memory Allocation Deamon...');
writeln(' SysObjectCache_Init: Max Lump Size = ',MaxLumpSize);
writeln(' SysObjectCache_Init: Max Cache Lumps = ',MaxLumps);
{$ENDIF}
end.