{****************************************************************************
*                      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.