aksdb
/
CentrED
1
0
Fork 0
Code Issues 2 Pull Requests Releases Wiki Activity

- Generalized TCacheManager (for more type-safety and cleaner code)

This commit is contained in:
Andreas Schneider 2009-12-08 15:12:09 +01:00
parent c0b5051b00
commit dde886b051
2 changed files with 56 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
Client/ULandscape.pas
View File

@ -67,15 +67,17 @@ type
procedure UpdateTexture; procedure UpdateTexture;
end; end;
TMaterialCache = specialize TCacheManager<TMaterial>;
{ TLandTextureManager } { TLandTextureManager }
TLandTextureManager = class TLandTextureManager = class
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
protected protected
FArtCache: TCacheManager; FArtCache: TMaterialCache;
FFlatLandArtCache: TCacheManager; FFlatLandArtCache: TMaterialCache;
FTexCache: TCacheManager; FTexCache: TMaterialCache;
public public
function GetArtMaterial(ATileID: Word): TMaterial; overload; function GetArtMaterial(ATileID: Word): TMaterial; overload;
function GetArtMaterial(ATileID: Word; AHue: THue; function GetArtMaterial(ATileID: Word; AHue: THue;
@ -125,6 +127,7 @@ type
TStaticChangedEvent = procedure(AStaticItem: TStaticItem) of object; TStaticChangedEvent = procedure(AStaticItem: TStaticItem) of object;
TScreenBuffer = class; TScreenBuffer = class;
TBlockCache = specialize TCacheManager<TBlock>;
{ TLandscape } { TLandscape }
@ -137,7 +140,7 @@ type
FHeight: Word; FHeight: Word;
FCellWidth: Word; FCellWidth: Word;
FCellHeight: Word; FCellHeight: Word;
FBlockCache: TCacheManager; FBlockCache: TBlockCache;
FOnChange: TLandscapeChangeEvent; FOnChange: TLandscapeChangeEvent;
FOnMapChanged: TMapChangedEvent; FOnMapChanged: TMapChangedEvent;
FOnNewBlock: TNewBlockEvent; FOnNewBlock: TNewBlockEvent;
@ -154,7 +157,7 @@ type
function GetStaticBlock(AX, AY: Word): TSeperatedStaticBlock; function GetStaticBlock(AX, AY: Word): TSeperatedStaticBlock;
function GetStaticList(AX, AY: Word): TStaticItemList; function GetStaticList(AX, AY: Word): TStaticItemList;
{ Events } { Events }
procedure OnRemoveCachedObject(AObject: TObject); procedure OnRemoveCachedObject(ABlock: TBlock);
procedure OnBlocksPacket(ABuffer: TEnhancedMemoryStream); procedure OnBlocksPacket(ABuffer: TEnhancedMemoryStream);
procedure OnDrawMapPacket(ABuffer: TEnhancedMemoryStream); procedure OnDrawMapPacket(ABuffer: TEnhancedMemoryStream);
procedure OnInsertStaticPacket(ABuffer: TEnhancedMemoryStream); procedure OnInsertStaticPacket(ABuffer: TEnhancedMemoryStream);
@ -278,16 +281,16 @@ end;
constructor TLandTextureManager.Create; constructor TLandTextureManager.Create;
begin begin
inherited Create; inherited Create;
FArtCache := TCacheManager.Create(1024); FArtCache := TMaterialCache.Create(1024);
FFlatLandArtCache := TCacheManager.Create(128); FFlatLandArtCache := TMaterialCache.Create(128);
FTexCache := TCacheManager.Create(128); FTexCache := TMaterialCache.Create(128);
end; end;
destructor TLandTextureManager.Destroy; destructor TLandTextureManager.Destroy;
begin begin
if FArtCache <> nil then FreeAndNil(FArtCache); FreeAndNil(FArtCache);
if FFlatLandArtCache <> nil then FreeAndNil(FFlatLandArtCache); FreeAndNil(FFlatLandArtCache);
if FTexCache <> nil then FreeAndNil(FTexCache); FreeAndNil(FTexCache);
inherited Destroy; inherited Destroy;
end; end;
@ -295,7 +298,7 @@ function TLandTextureManager.GetArtMaterial(ATileID: Word): TMaterial;
var var
artEntry: TArt; artEntry: TArt;
begin begin
if not FArtCache.QueryID(ATileID, TObject(Result)) then if not FArtCache.QueryID(ATileID, Result) then
begin begin
artEntry := TArt(ResMan.Art.Block[ATileID]); artEntry := TArt(ResMan.Art.Block[ATileID]);
@ -319,7 +322,7 @@ begin
end else end else
begin begin
id := ATileID or ((AHue.ID and $3FFF) shl 15) or (Byte(APartialHue) shl 29); id := ATileID or ((AHue.ID and $3FFF) shl 15) or (Byte(APartialHue) shl 29);
if not FArtCache.QueryID(id, TObject(Result)) then if not FArtCache.QueryID(id, Result) then
begin begin
artEntry := ResMan.Art.GetArt(ATileID, 0, AHue, APartialHue); artEntry := ResMan.Art.GetArt(ATileID, 0, AHue, APartialHue);
@ -336,7 +339,7 @@ function TLandTextureManager.GetFlatLandMaterial(ATileID: Word): TMaterial;
var var
artEntry: TArt; artEntry: TArt;
begin begin
if not FFlatLandArtCache.QueryID(ATileID, TObject(Result)) then if not FFlatLandArtCache.QueryID(ATileID, Result) then
begin begin
artEntry := ResMan.Art.GetFlatLand(ATileID); artEntry := ResMan.Art.GetFlatLand(ATileID);
@ -372,7 +375,7 @@ var
texEntry: TTexture; texEntry: TTexture;
texID: Integer; texID: Integer;
begin begin
if not FTexCache.QueryID(ATileID, TObject(Result)) then if not FTexCache.QueryID(ATileID, Result) then
begin begin
texID := ResMan.Tiledata.LandTiles[ATileID].TextureID; texID := ResMan.Tiledata.LandTiles[ATileID].TextureID;
if texID > 0 then if texID > 0 then
@ -525,7 +528,7 @@ begin
FHeight := AHeight; FHeight := AHeight;
FCellWidth := FWidth * 8; FCellWidth := FWidth * 8;
FCellHeight := FHeight * 8; FCellHeight := FHeight * 8;
FBlockCache := TCacheManager.Create(256); FBlockCache := TBlockCache.Create(256);
FBlockCache.OnRemoveObject := @OnRemoveCachedObject; FBlockCache.OnRemoveObject := @OnRemoveCachedObject;
FOnChange := nil; FOnChange := nil;
@ -579,7 +582,7 @@ begin
Result := nil; Result := nil;
if (AX >= 0) and (AX < FWidth) and (AY >= 0) and (AY < FHeight) then if (AX >= 0) and (AX < FWidth) and (AY >= 0) and (AY < FHeight) then
begin begin
if FBlockCache.QueryID(GetID(AX, AY), TObject(block)) then if FBlockCache.QueryID(GetID(AX, AY), block) then
Result := block.Map; Result := block.Map;
end; end;
end; end;
@ -609,7 +612,7 @@ begin
Result := nil; Result := nil;
if (AX >= 0) and (AX < FWidth) and (AY >= 0) and (AY < FHeight) then if (AX >= 0) and (AX < FWidth) and (AY >= 0) and (AY < FHeight) then
begin begin
if FBlockCache.QueryID(GetID(AX, AY), TObject(block)) then if FBlockCache.QueryID(GetID(AX, AY), block) then
Result := TSeperatedStaticBlock(block.Static); Result := TSeperatedStaticBlock(block.Static);
end; end;
end; end;
@ -627,13 +630,10 @@ begin
end; end;
end; end;
procedure TLandscape.OnRemoveCachedObject(AObject: TObject); procedure TLandscape.OnRemoveCachedObject(ABlock: TBlock);
var
block: TBlock;
begin begin
block := AObject as TBlock; if ABlock <> nil then
if block <> nil then dmNetwork.Send(TFreeBlockPacket.Create(ABlock.Map.X, ABlock.Map.Y));
dmNetwork.Send(TFreeBlockPacket.Create(block.Map.X, block.Map.Y));
end; end;
procedure TLandscape.OnBlocksPacket(ABuffer: TEnhancedMemoryStream); procedure TLandscape.OnBlocksPacket(ABuffer: TEnhancedMemoryStream);
@ -1071,7 +1071,7 @@ procedure TLandscape.PrepareBlocks(AX1, AY1, AX2, AY2: Word);
var var
x, y, i: Integer; x, y, i: Integer;
coords: TBlockCoordsArray; coords: TBlockCoordsArray;
obj: TObject; block: TBlock;
begin begin
AX1 := EnsureRange(AX1, 0, FWidth - 1); AX1 := EnsureRange(AX1, 0, FWidth - 1);
AY1 := EnsureRange(AY1, 0, FHeight - 1); AY1 := EnsureRange(AY1, 0, FHeight - 1);
@ -1084,7 +1084,7 @@ begin
for y := AY1 to AY2 do for y := AY1 to AY2 do
begin begin
if (not FOpenRequests[y * FWidth + x]) and if (not FOpenRequests[y * FWidth + x]) and
(not FBlockCache.QueryID(GetID(x, y), obj)) then (not FBlockCache.QueryID(GetID(x, y), block)) then
begin begin
SetLength(coords, Length(coords) + 1); SetLength(coords, Length(coords) + 1);
i := High(coords); i := High(coords);
@ -1100,12 +1100,12 @@ end;
procedure TLandscape.UpdateBlockAccess; procedure TLandscape.UpdateBlockAccess;
var var
cacheEntry: PCacheEntry; cacheEntry: TBlockCache.PCacheEntry;
begin begin
cacheEntry := nil; cacheEntry := nil;
while FBlockCache.Iterate(cacheEntry) do while FBlockCache.Iterate(cacheEntry) do
if cacheEntry^.Obj <> nil then if cacheEntry^.Obj <> nil then
TBlock(cacheEntry^.Obj).UpdateBlockAcess(Self); cacheEntry^.Obj.UpdateBlockAcess(Self);
end; end;
procedure TLandscape.UpdateWriteMap(AStream: TEnhancedMemoryStream); procedure TLandscape.UpdateWriteMap(AStream: TEnhancedMemoryStream);

45
UCacheManager.pas
View File

@ -33,34 +33,39 @@ uses
SysUtils, Classes; SysUtils, Classes;
type type
TRemoveObjectEvent = procedure(AObject: TObject) of object;
{ TCacheManager }
generic TCacheManager<T> = class
type public
{ Types }
TRemoveObjectEvent = procedure(AObject: T) of object;
PCacheEntry = ^TCacheEntry; PCacheEntry = ^TCacheEntry;
TCacheEntry = record TCacheEntry = record
ID: Integer; ID: Integer;
Obj: TObject; Obj: T;
Next: PCacheEntry; Next: PCacheEntry;
end; end;
var protected
{ TCacheManager }
TCacheManager = class(TObject)
constructor Create(ASize: Integer);
destructor Destroy; override;
protected
{ Members } { Members }
FSize: Integer; FSize: Integer;
FFirst: PCacheEntry; FFirst: PCacheEntry;
FLast: PCacheEntry; FLast: PCacheEntry;
FOnRemoveObject: TRemoveObjectEvent; FOnRemoveObject: TRemoveObjectEvent;
public public
constructor Create(ASize: Integer);
destructor Destroy; override;
{ Fields } { Fields }
property OnRemoveObject: TRemoveObjectEvent read FOnRemoveObject write FOnRemoveObject; property OnRemoveObject: TRemoveObjectEvent read FOnRemoveObject
write FOnRemoveObject;
{ Methods } { Methods }
function QueryID(const AID: Integer; out AObj: TObject): Boolean; function QueryID(const AID: Integer; out AObj: T): Boolean;
procedure StoreID(AID: Integer; AObj: TObject); procedure StoreID(AID: Integer; AObj: T);
procedure DiscardID(AID: Integer); procedure DiscardID(AID: Integer);
procedure DiscardObj(AObj: TObject); procedure DiscardObj(AObj: T);
procedure RemoveID(AID: Integer); procedure RemoveID(AID: Integer);
procedure Clear; procedure Clear;
function Iterate(var ACacheEntry: PCacheEntry): Boolean; function Iterate(var ACacheEntry: PCacheEntry): Boolean;
@ -103,7 +108,7 @@ begin
current := FFirst; current := FFirst;
for i := 1 to FSize do for i := 1 to FSize do
begin begin
if current^.Obj <> nil then if Pointer(current^.Obj) <> nil then
begin begin
if Assigned(FOnRemoveObject) then FOnRemoveObject(current^.Obj); if Assigned(FOnRemoveObject) then FOnRemoveObject(current^.Obj);
FreeAndNil(current^.Obj); FreeAndNil(current^.Obj);
@ -132,7 +137,7 @@ begin
end; end;
end; end;
procedure TCacheManager.DiscardObj(AObj: TObject); procedure TCacheManager.DiscardObj(AObj: T);
var var
current: PCacheEntry; current: PCacheEntry;
begin begin
@ -160,7 +165,7 @@ begin
if (current^.ID = AID) then if (current^.ID = AID) then
begin begin
current^.ID := LongInt($FFFFFFFF); current^.ID := LongInt($FFFFFFFF);
if current^.Obj <> nil then if Pointer(current^.Obj) <> nil then
FreeAndNil(current^.Obj); FreeAndNil(current^.Obj);
end; end;
if (current^.Next <> nil) then if (current^.Next <> nil) then
@ -176,7 +181,7 @@ begin
current := FFirst; current := FFirst;
while current <> nil do while current <> nil do
begin begin
if current^.Obj <> nil then if Pointer(current^.Obj) <> nil then
begin begin
current^.ID := LongInt($FFFFFFFF); current^.ID := LongInt($FFFFFFFF);
if Assigned(FOnRemoveObject) then FOnRemoveObject(current^.Obj); if Assigned(FOnRemoveObject) then FOnRemoveObject(current^.Obj);
@ -196,7 +201,7 @@ begin
end; end;
function TCacheManager.QueryID(const AID: Integer; function TCacheManager.QueryID(const AID: Integer;
out AObj: TObject): Boolean; out AObj: T): Boolean;
var var
current: PCacheEntry; current: PCacheEntry;
begin begin
@ -222,7 +227,7 @@ begin
end; end;
end; end;
procedure TCacheManager.StoreID(AID: Integer; AObj: TObject); procedure TCacheManager.StoreID(AID: Integer; AObj: T);
var var
current: PCacheEntry; current: PCacheEntry;
begin begin
@ -231,7 +236,7 @@ begin
current^.Next := FFirst; current^.Next := FFirst;
FFirst := current; FFirst := current;
FFirst^.ID := AID; FFirst^.ID := AID;
if FFirst^.Obj <> nil then //if the last cache entry did contain an object, remove it now if Pointer(FFirst^.Obj) <> nil then //if the last cache entry did contain an object, remove it now
begin begin
if Assigned(FOnRemoveObject) then FOnRemoveObject(FFirst^.Obj); if Assigned(FOnRemoveObject) then FOnRemoveObject(FFirst^.Obj);
FreeAndNil(FFirst^.Obj); FreeAndNil(FFirst^.Obj);