- Added iterator to TCacheManager
- Added access (CanBeWritten) tracking to TStaticItem - Moved TLandscape.UpdateStaticsPriorities to TStaticItem.UpdatePriorities - Moved ULandscape.CompareWorldItems to UWorldItem - Renamed TSeperatedStaticBlock.RefreshList to RebuildList - Changed TStaticBlock.Sort to use CompareWorldItems and TList.Sort - Some code style changes
This commit is contained in:
parent
f3888db49c
commit
b70f03ba2a
@ -88,11 +88,15 @@ type
|
||||
constructor Create(AMap: TMapBlock; AStatics: TStaticBlock);
|
||||
destructor Destroy; override;
|
||||
protected
|
||||
{ Fields }
|
||||
FMapBlock: TMapBlock;
|
||||
FStaticBlock: TStaticBlock;
|
||||
public
|
||||
{ Fields }
|
||||
property Map: TMapBlock read FMapBlock;
|
||||
property Static: TStaticBlock read FStaticBlock;
|
||||
{ Methods }
|
||||
procedure UpdateBlockAcess;
|
||||
end;
|
||||
|
||||
TLandscapeChangeEvent = procedure of object;
|
||||
@ -148,8 +152,7 @@ type
|
||||
procedure GetNormals(AX, AY: Word; var ANormals: TNormals);
|
||||
procedure MoveStatic(AStatic: TStaticItem; AX, AY: Word);
|
||||
procedure PrepareBlocks(AX1, AY1, AX2, AY2: Word);
|
||||
procedure UpdateStaticsPriority(AStaticItem: TStaticItem;
|
||||
APrioritySolver: Integer);
|
||||
procedure UpdateBlockAccess;
|
||||
end;
|
||||
|
||||
TScreenState = (ssNormal, ssFiltered, ssGhost);
|
||||
@ -185,8 +188,8 @@ type
|
||||
procedure Delete(AItem: TWorldItem);
|
||||
function Find(AScreenPosition: TPoint): PBlockInfo;
|
||||
function GetSerial: Cardinal;
|
||||
function Iterate(var ABlockInfo: PBlockInfo): Boolean;
|
||||
function Insert(AItem: TWorldItem): PBlockInfo;
|
||||
function Iterate(var ABlockInfo: PBlockInfo): Boolean;
|
||||
procedure Sort;
|
||||
procedure UpdateShortcuts;
|
||||
{ Events }
|
||||
@ -215,30 +218,6 @@ begin
|
||||
Result := ((AX and $7FFF) shl 15) or (AY and $7FFF);
|
||||
end;
|
||||
|
||||
function CompareWorldItems(AItem1, AItem2: Pointer): Integer;
|
||||
begin
|
||||
if TWorldItem(AItem1).X <> TWorldItem(AItem2).X then
|
||||
Exit(TWorldItem(AItem1).X - TWorldItem(AItem2).X);
|
||||
|
||||
if TWorldItem(AItem1).Y <> TWorldItem(AItem2).Y then
|
||||
Exit(TWorldItem(AItem1).Y - TWorldItem(AItem2).Y);
|
||||
|
||||
Result := TWorldItem(AItem1).Priority - TWorldItem(AItem2).Priority;
|
||||
if Result = 0 then
|
||||
begin
|
||||
if (TObject(AItem1) is TMapCell) and (TObject(AItem2) is TStaticItem) then
|
||||
Result := -1
|
||||
else if (TObject(AItem1) is TStaticItem) and (TObject(AItem2) is TMapCell) then
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
if Result = 0 then
|
||||
Result := TWorldItem(AItem1).PriorityBonus - TWorldItem(AItem2).PriorityBonus;
|
||||
|
||||
if Result = 0 then
|
||||
Result := TWorldItem(AItem1).PrioritySolver - TWorldItem(AItem2).PrioritySolver;
|
||||
end;
|
||||
|
||||
{ TLandTextureManager }
|
||||
|
||||
constructor TLandTextureManager.Create;
|
||||
@ -342,6 +321,7 @@ begin
|
||||
inherited Create;
|
||||
FMapBlock := AMap;
|
||||
FStaticBlock := AStatics;
|
||||
UpdateBlockAcess;
|
||||
end;
|
||||
|
||||
destructor TBlock.Destroy;
|
||||
@ -351,6 +331,28 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TBlock.UpdateBlockAcess;
|
||||
var
|
||||
staticItem: TStaticItem;
|
||||
i: Integer;
|
||||
begin
|
||||
for i := Low(FMapBlock.Cells) to High(FMapBlock.Cells) do
|
||||
begin
|
||||
FMapBlock.Cells[i].CanBeEdited := dmNetwork.CanWrite(
|
||||
FMapBlock.Cells[i].X, FMapBlock.Cells[i].Y);
|
||||
end;
|
||||
|
||||
if FStaticBlock is TSeperatedStaticBlock then
|
||||
TSeperatedStaticBlock(FStaticBlock).RebuildList; //fill items
|
||||
|
||||
for i := 0 to FStaticBlock.Items.Count - 1 do
|
||||
begin
|
||||
staticItem := TStaticItem(FStaticBlock.Items[i]);
|
||||
staticItem.CanBeEdited := dmNetwork.CanWrite(
|
||||
staticItem.X, staticItem.Y);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TLandscape }
|
||||
|
||||
constructor TLandscape.Create(AWidth, AHeight: Word);
|
||||
@ -533,7 +535,7 @@ begin
|
||||
targetStaticList := block.Cells[(y mod 8) * 8 + x mod 8];
|
||||
targetStaticList.Add(staticItem);
|
||||
for i := 0 to targetStaticList.Count - 1 do
|
||||
UpdateStaticsPriority(TStaticItem(targetStaticList.Items[i]), i);
|
||||
TStaticItem(targetStaticList.Items[i]).UpdatePriorities(i);
|
||||
targetStaticList.Sort(@CompareWorldItems);
|
||||
staticItem.Owner := block;
|
||||
if Assigned(FOnChange) then FOnChange;
|
||||
@ -591,7 +593,7 @@ begin
|
||||
begin
|
||||
staticItem.Z := ABuffer.ReadShortInt;
|
||||
for j := 0 to statics.Count - 1 do
|
||||
UpdateStaticsPriority(TStaticItem(statics.Items[j]), j);
|
||||
TStaticItem(statics.Items[j]).UpdatePriorities(j);
|
||||
statics.Sort(@CompareWorldItems);
|
||||
if Assigned(FOnChange) then FOnChange;
|
||||
Break;
|
||||
@ -650,7 +652,7 @@ begin
|
||||
statics := targetBlock.Cells[(newY mod 8) * 8 + newX mod 8];
|
||||
statics.Add(staticItem);
|
||||
for i := 0 to statics.Count - 1 do
|
||||
UpdateStaticsPriority(TStaticItem(statics.Items[i]), i);
|
||||
TStaticItem(statics.Items[i]).UpdatePriorities(i);
|
||||
statics.Sort(@CompareWorldItems);
|
||||
staticItem.Owner := targetBlock;
|
||||
end;
|
||||
@ -724,7 +726,7 @@ begin
|
||||
(TStaticItem(drawStatics[i]).Z <= AMaxZ) and
|
||||
((AStaticsFilter = nil) or AStaticsFilter(TStaticItem(drawStatics[i]))) then
|
||||
begin
|
||||
UpdateStaticsPriority(TStaticItem(drawStatics[i]), ADrawList.GetSerial);
|
||||
TStaticItem(drawStatics[i]).UpdatePriorities(ADrawList.GetSerial);
|
||||
ADrawList.Add(TWorldItem(drawStatics[i]));
|
||||
end;
|
||||
end;
|
||||
@ -857,7 +859,7 @@ begin
|
||||
targetStaticList := targetBlock.Cells[(AY mod 8) * 8 + AX mod 8];
|
||||
targetStaticList.Add(AStatic);
|
||||
for i := 0 to targetStaticList.Count - 1 do
|
||||
UpdateStaticsPriority(TStaticItem(targetStaticList.Items[i]), i);
|
||||
TStaticItem(targetStaticList.Items[i]).UpdatePriorities(i);
|
||||
targetStaticList.Sort(@CompareWorldItems);
|
||||
AStatic.UpdatePos(AX, AY, AStatic.Z);
|
||||
AStatic.Owner := targetBlock;
|
||||
@ -896,19 +898,13 @@ begin
|
||||
dmNetwork.Send(TRequestBlocksPacket.Create(coords));
|
||||
end;
|
||||
|
||||
procedure TLandscape.UpdateStaticsPriority(AStaticItem: TStaticItem;
|
||||
APrioritySolver: Integer);
|
||||
procedure TLandscape.UpdateBlockAccess;
|
||||
var
|
||||
staticTileData: TStaticTileData;
|
||||
cacheEntry: PCacheEntry;
|
||||
begin
|
||||
staticTileData := ResMan.Tiledata.StaticTiles[AStaticItem.TileID];
|
||||
AStaticItem.PriorityBonus := 0;
|
||||
if not ((staticTileData.Flags and tdfBackground) = tdfBackground) then
|
||||
AStaticItem.PriorityBonus := AStaticItem.PriorityBonus + 1;
|
||||
if staticTileData.Height > 0 then
|
||||
AStaticItem.PriorityBonus := AStaticItem.PriorityBonus + 1;
|
||||
AStaticItem.Priority := AStaticItem.Z + AStaticItem.PriorityBonus;
|
||||
AStaticItem.PrioritySolver := APrioritySolver;
|
||||
cacheEntry := nil;
|
||||
while FBlockCache.Iterate(cacheEntry) do
|
||||
TBlock(cacheEntry^.Obj).UpdateBlockAcess;
|
||||
end;
|
||||
|
||||
{ TMaterial }
|
||||
@ -1087,15 +1083,6 @@ begin
|
||||
Inc(FSerial);
|
||||
end;
|
||||
|
||||
function TScreenBuffer.Iterate(var ABlockInfo: PBlockInfo): Boolean;
|
||||
begin
|
||||
if ABlockInfo = nil then
|
||||
ABlockInfo := FShortCuts[0]
|
||||
else
|
||||
ABlockInfo := ABlockInfo^.Next;
|
||||
Result := ABlockInfo <> nil;
|
||||
end;
|
||||
|
||||
function TScreenBuffer.Insert(AItem: TWorldItem): PBlockInfo;
|
||||
var
|
||||
current: PBlockInfo;
|
||||
@ -1145,6 +1132,15 @@ begin
|
||||
Inc(FCount);
|
||||
end;
|
||||
|
||||
function TScreenBuffer.Iterate(var ABlockInfo: PBlockInfo): Boolean;
|
||||
begin
|
||||
if ABlockInfo = nil then
|
||||
ABlockInfo := FShortCuts[0]
|
||||
else
|
||||
ABlockInfo := ABlockInfo^.Next;
|
||||
Result := ABlockInfo <> nil;
|
||||
end;
|
||||
|
||||
//Mergesort
|
||||
procedure TScreenBuffer.Sort;
|
||||
|
||||
|
||||
@ -1,24 +1,28 @@
|
||||
object dmNetwork: TdmNetwork
|
||||
OnCreate = DataModuleCreate
|
||||
OnDestroy = DataModuleDestroy
|
||||
Height = 300
|
||||
HorizontalOffset = 290
|
||||
VerticalOffset = 171
|
||||
Width = 400
|
||||
object TCPClient: TLTCPComponent
|
||||
OnReceive = TCPClientReceive
|
||||
OnError = TCPClientError
|
||||
OnDisconnect = TCPClientDisconnect
|
||||
OnConnect = TCPClientConnect
|
||||
left = 40
|
||||
top = 24
|
||||
end
|
||||
object tmNoOp: TTimer
|
||||
Enabled = False
|
||||
Interval = 30000
|
||||
OnTimer = tmNoOpTimer
|
||||
OnStartTimer = tmNoOpStartTimer
|
||||
left = 72
|
||||
top = 24
|
||||
end
|
||||
end
|
||||
object dmNetwork: TdmNetwork
|
||||
OnCreate = DataModuleCreate
|
||||
OnDestroy = DataModuleDestroy
|
||||
OldCreateOrder = False
|
||||
Height = 300
|
||||
HorizontalOffset = 290
|
||||
VerticalOffset = 171
|
||||
Width = 400
|
||||
object TCPClient: TLTCPComponent
|
||||
Port = 0
|
||||
OnReceive = TCPClientReceive
|
||||
OnError = TCPClientError
|
||||
OnDisconnect = TCPClientDisconnect
|
||||
OnConnect = TCPClientConnect
|
||||
Timeout = 0
|
||||
ReuseAddress = False
|
||||
left = 40
|
||||
top = 24
|
||||
end
|
||||
object tmNoOp: TTimer
|
||||
Enabled = False
|
||||
Interval = 30000
|
||||
OnTimer = tmNoOpTimer
|
||||
OnStartTimer = tmNoOpStartTimer
|
||||
left = 72
|
||||
top = 24
|
||||
end
|
||||
end
|
||||
|
||||
@ -345,14 +345,16 @@ var
|
||||
i: Integer;
|
||||
pt: TPoint;
|
||||
begin
|
||||
if FWriteMap.Count = 0 then Exit(True); //TODO : still too slow
|
||||
if FWriteMap.Count > 0 then
|
||||
begin
|
||||
pt := Point(AX, AY);
|
||||
for i := 0 to FWriteMap.Count - 1 do
|
||||
if PtInRect(FWriteMap.Rects[i], pt) then
|
||||
Exit(True);
|
||||
|
||||
pt := Point(AX, AY);
|
||||
for i := 0 to FWriteMap.Count - 1 do
|
||||
if PtInRect(FWriteMap.Rects[i], pt) then
|
||||
Exit(True);
|
||||
|
||||
Result := False;
|
||||
Result := False;
|
||||
end else
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.Send(APacket: TPacket);
|
||||
|
||||
@ -3,6 +3,7 @@ object frmMain: TfrmMain
|
||||
Height = 603
|
||||
Top = 126
|
||||
Width = 766
|
||||
ActiveControl = oglGameWindow
|
||||
Caption = 'UO CentrED'
|
||||
ClientHeight = 580
|
||||
ClientWidth = 766
|
||||
@ -540,7 +541,7 @@ object frmMain: TfrmMain
|
||||
Top = 306
|
||||
Width = 218
|
||||
Align = alNone
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
Anchors = [akLeft, akRight, akBottom]
|
||||
ResizeAnchor = akBottom
|
||||
end
|
||||
object edSearchID: TEdit
|
||||
@ -1110,7 +1111,7 @@ object frmMain: TfrmMain
|
||||
Top = 435
|
||||
Width = 542
|
||||
Align = alNone
|
||||
Anchors = [akLeft, akRight]
|
||||
Anchors = [akLeft, akRight, akBottom]
|
||||
AutoSnap = False
|
||||
ResizeAnchor = akBottom
|
||||
Visible = False
|
||||
|
||||
@ -1662,7 +1662,6 @@ var
|
||||
tileRect: TRect;
|
||||
virtualTile: TVirtualTile;
|
||||
staticsFilter: TStaticFilter;
|
||||
editing: Boolean;
|
||||
intensity: GLfloat;
|
||||
blockInfo: PBlockInfo;
|
||||
item: TWorldItem;
|
||||
@ -1688,19 +1687,17 @@ begin
|
||||
//TODO : implement CanBeEdited handling (dmNetwork.CanWrite.....)
|
||||
if acSelect.Checked or item.CanBeEdited then
|
||||
begin
|
||||
editing := True;
|
||||
intensity := 1.0;
|
||||
SetNormalLights;
|
||||
end else
|
||||
begin
|
||||
editing := False;
|
||||
intensity := 0.5;
|
||||
SetDarkLights;
|
||||
end;
|
||||
|
||||
glColor4f(intensity, intensity, intensity, 1.0);
|
||||
|
||||
highlight := item.CanBeEdited and blockInfo^.Highlighted;
|
||||
highlight := blockInfo^.Highlighted and item.CanBeEdited;
|
||||
|
||||
if highlight then
|
||||
begin
|
||||
@ -2357,7 +2354,8 @@ begin
|
||||
$07: //access changed
|
||||
begin
|
||||
accessLevel := TAccessLevel(ABuffer.ReadByte);
|
||||
dmNetwork.UpdateWriteMap(ABuffer);
|
||||
dmNetwork.UpdateWriteMap(ABuffer); //TODO : movie writemap to landscape
|
||||
FLandscape.UpdateBlockAccess; //TODO : could be handled by updatewritemap
|
||||
|
||||
if accessLevel <> dmNetwork.AccessLevel then
|
||||
begin
|
||||
|
||||
@ -1,230 +1,243 @@
|
||||
(*
|
||||
* CDDL HEADER START
|
||||
*
|
||||
* The contents of this file are subject to the terms of the
|
||||
* Common Development and Distribution License, Version 1.0 only
|
||||
* (the "License"). You may not use this file except in compliance
|
||||
* with the License.
|
||||
*
|
||||
* You can obtain a copy of the license at
|
||||
* http://www.opensource.org/licenses/cddl1.php.
|
||||
* See the License for the specific language governing permissions
|
||||
* and limitations under the License.
|
||||
*
|
||||
* When distributing Covered Code, include this CDDL HEADER in each
|
||||
* file and include the License file at
|
||||
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||
* add the following below this CDDL HEADER, with the fields enclosed
|
||||
* by brackets "[]" replaced with your own identifying * information:
|
||||
* Portions Copyright [yyyy] [name of copyright owner]
|
||||
*
|
||||
* CDDL HEADER END
|
||||
*
|
||||
*
|
||||
* Portions Copyright 2007 Andreas Schneider
|
||||
*)
|
||||
unit UCacheManager;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes;
|
||||
|
||||
type
|
||||
TRemoveObjectEvent = procedure(AObject: TObject) of object;
|
||||
|
||||
PCacheEntry = ^TCacheEntry;
|
||||
TCacheEntry = record
|
||||
ID: Integer;
|
||||
Obj: TObject;
|
||||
Next: PCacheEntry;
|
||||
end;
|
||||
|
||||
{ TCacheManager }
|
||||
|
||||
TCacheManager = class(TObject)
|
||||
constructor Create(ASize: Integer);
|
||||
destructor Destroy; override;
|
||||
protected
|
||||
FSize: Integer;
|
||||
FFirst: PCacheEntry;
|
||||
FLast: PCacheEntry;
|
||||
FOnRemoveObject: TRemoveObjectEvent;
|
||||
public
|
||||
function QueryID(const AID: Integer; out AObj: TObject): Boolean;
|
||||
procedure StoreID(AID: Integer; AObj: TObject);
|
||||
procedure DiscardID(AID: Integer);
|
||||
procedure DiscardObj(AObj: TObject);
|
||||
procedure RemoveID(AID: Integer);
|
||||
procedure Clear;
|
||||
property OnRemoveObject: TRemoveObjectEvent read FOnRemoveObject write FOnRemoveObject;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TCacheManager }
|
||||
|
||||
constructor TCacheManager.Create(ASize: Integer);
|
||||
var
|
||||
i: Integer;
|
||||
current: PCacheEntry;
|
||||
begin
|
||||
FOnRemoveObject := nil;
|
||||
FSize := ASize;
|
||||
if FSize > 0 then
|
||||
begin
|
||||
New(FFirst);
|
||||
current := FFirst;
|
||||
current^.ID := LongInt($FFFFFFFF);
|
||||
current^.Obj := nil;
|
||||
for i := 2 to FSize do
|
||||
begin
|
||||
New(current^.Next);
|
||||
FLast := current;
|
||||
current := current^.Next;
|
||||
current^.ID := LongInt($FFFFFFFF);
|
||||
current^.Obj := nil;
|
||||
end;
|
||||
current^.Next := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TCacheManager.Destroy;
|
||||
var
|
||||
i: Integer;
|
||||
current, last: PCacheEntry;
|
||||
begin
|
||||
current := FFirst;
|
||||
for i := 1 to FSize do
|
||||
begin
|
||||
if current^.Obj <> nil then
|
||||
begin
|
||||
if Assigned(FOnRemoveObject) then FOnRemoveObject(current^.Obj);
|
||||
FreeAndNil(current^.Obj);
|
||||
end;
|
||||
last := current;
|
||||
current := current^.Next;
|
||||
Dispose(last);
|
||||
end;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TCacheManager.DiscardID(AID: Integer);
|
||||
var
|
||||
current: PCacheEntry;
|
||||
begin
|
||||
current := FFirst;
|
||||
while (current <> nil) do
|
||||
begin
|
||||
if (current^.ID = AID) then
|
||||
begin
|
||||
current^.ID := LongInt($FFFFFFFF);
|
||||
current^.Obj := nil;
|
||||
current := nil;
|
||||
end else
|
||||
current := current^.Next;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCacheManager.DiscardObj(AObj: TObject);
|
||||
var
|
||||
current: PCacheEntry;
|
||||
begin
|
||||
current := FFirst;
|
||||
while (current <> nil) do
|
||||
begin
|
||||
if (current^.Obj = AObj) then
|
||||
begin
|
||||
current^.ID := LongInt($FFFFFFFF);
|
||||
current^.Obj := nil;
|
||||
current := nil;
|
||||
end else
|
||||
current := current^.Next;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCacheManager.RemoveID(AID: Integer);
|
||||
var
|
||||
current: PCacheEntry;
|
||||
begin
|
||||
current := FFirst;
|
||||
FLast := current;
|
||||
while (current <> nil) do
|
||||
begin
|
||||
if (current^.ID = AID) then
|
||||
begin
|
||||
current^.ID := LongInt($FFFFFFFF);
|
||||
if current^.Obj <> nil then
|
||||
FreeAndNil(current^.Obj);
|
||||
end;
|
||||
if (current^.Next <> nil) then
|
||||
FLast := current;
|
||||
current := current^.Next;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCacheManager.Clear;
|
||||
var
|
||||
current: PCacheEntry;
|
||||
begin
|
||||
current := FFirst;
|
||||
while current <> nil do
|
||||
begin
|
||||
if current^.Obj <> nil then
|
||||
begin
|
||||
current^.ID := LongInt($FFFFFFFF);
|
||||
if Assigned(FOnRemoveObject) then FOnRemoveObject(current^.Obj);
|
||||
FreeAndNil(current^.Obj);
|
||||
end;
|
||||
current := current^.Next;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCacheManager.QueryID(const AID: Integer;
|
||||
out AObj: TObject): Boolean;
|
||||
var
|
||||
current: PCacheEntry;
|
||||
begin
|
||||
current := FFirst;
|
||||
FLast := current;
|
||||
Result := False;
|
||||
while (current <> nil) and (not Result) do
|
||||
begin
|
||||
if (current^.ID = AID) then
|
||||
begin
|
||||
Result := True;
|
||||
AObj := current^.Obj;
|
||||
if current <> FFirst then
|
||||
begin
|
||||
FLast^.Next := current^.Next;
|
||||
current^.Next := FFirst;
|
||||
FFirst := current;
|
||||
end;
|
||||
end;
|
||||
if (current^.Next <> nil) then
|
||||
FLast := current;
|
||||
current := current^.Next;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCacheManager.StoreID(AID: Integer; AObj: TObject);
|
||||
var
|
||||
current: PCacheEntry;
|
||||
begin
|
||||
current := FLast^.Next; //well, FLast is not really the last, but the one before the last ;)
|
||||
FLast^.Next := nil;
|
||||
current^.Next := FFirst;
|
||||
FFirst := current;
|
||||
FFirst^.ID := AID;
|
||||
if FFirst^.Obj <> nil then //if the last cache entry did contain an object, remove it now
|
||||
begin
|
||||
if Assigned(FOnRemoveObject) then FOnRemoveObject(FFirst^.Obj);
|
||||
FreeAndNil(FFirst^.Obj);
|
||||
end;
|
||||
FFirst^.Obj := AObj;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
(*
|
||||
* CDDL HEADER START
|
||||
*
|
||||
* The contents of this file are subject to the terms of the
|
||||
* Common Development and Distribution License, Version 1.0 only
|
||||
* (the "License"). You may not use this file except in compliance
|
||||
* with the License.
|
||||
*
|
||||
* You can obtain a copy of the license at
|
||||
* http://www.opensource.org/licenses/cddl1.php.
|
||||
* See the License for the specific language governing permissions
|
||||
* and limitations under the License.
|
||||
*
|
||||
* When distributing Covered Code, include this CDDL HEADER in each
|
||||
* file and include the License file at
|
||||
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||
* add the following below this CDDL HEADER, with the fields enclosed
|
||||
* by brackets "[]" replaced with your own identifying * information:
|
||||
* Portions Copyright [yyyy] [name of copyright owner]
|
||||
*
|
||||
* CDDL HEADER END
|
||||
*
|
||||
*
|
||||
* Portions Copyright 2009 Andreas Schneider
|
||||
*)
|
||||
unit UCacheManager;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes;
|
||||
|
||||
type
|
||||
TRemoveObjectEvent = procedure(AObject: TObject) of object;
|
||||
|
||||
PCacheEntry = ^TCacheEntry;
|
||||
TCacheEntry = record
|
||||
ID: Integer;
|
||||
Obj: TObject;
|
||||
Next: PCacheEntry;
|
||||
end;
|
||||
|
||||
{ TCacheManager }
|
||||
|
||||
TCacheManager = class(TObject)
|
||||
constructor Create(ASize: Integer);
|
||||
destructor Destroy; override;
|
||||
protected
|
||||
{ Members }
|
||||
FSize: Integer;
|
||||
FFirst: PCacheEntry;
|
||||
FLast: PCacheEntry;
|
||||
FOnRemoveObject: TRemoveObjectEvent;
|
||||
public
|
||||
{ Fields }
|
||||
property OnRemoveObject: TRemoveObjectEvent read FOnRemoveObject write FOnRemoveObject;
|
||||
{ Methods }
|
||||
function QueryID(const AID: Integer; out AObj: TObject): Boolean;
|
||||
procedure StoreID(AID: Integer; AObj: TObject);
|
||||
procedure DiscardID(AID: Integer);
|
||||
procedure DiscardObj(AObj: TObject);
|
||||
procedure RemoveID(AID: Integer);
|
||||
procedure Clear;
|
||||
function Iterate(var ACacheEntry: PCacheEntry): Boolean;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TCacheManager }
|
||||
|
||||
constructor TCacheManager.Create(ASize: Integer);
|
||||
var
|
||||
i: Integer;
|
||||
current: PCacheEntry;
|
||||
begin
|
||||
FOnRemoveObject := nil;
|
||||
FSize := ASize;
|
||||
if FSize > 0 then
|
||||
begin
|
||||
New(FFirst);
|
||||
current := FFirst;
|
||||
current^.ID := LongInt($FFFFFFFF);
|
||||
current^.Obj := nil;
|
||||
for i := 2 to FSize do
|
||||
begin
|
||||
New(current^.Next);
|
||||
FLast := current;
|
||||
current := current^.Next;
|
||||
current^.ID := LongInt($FFFFFFFF);
|
||||
current^.Obj := nil;
|
||||
end;
|
||||
current^.Next := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TCacheManager.Destroy;
|
||||
var
|
||||
i: Integer;
|
||||
current, last: PCacheEntry;
|
||||
begin
|
||||
current := FFirst;
|
||||
for i := 1 to FSize do
|
||||
begin
|
||||
if current^.Obj <> nil then
|
||||
begin
|
||||
if Assigned(FOnRemoveObject) then FOnRemoveObject(current^.Obj);
|
||||
FreeAndNil(current^.Obj);
|
||||
end;
|
||||
last := current;
|
||||
current := current^.Next;
|
||||
Dispose(last);
|
||||
end;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TCacheManager.DiscardID(AID: Integer);
|
||||
var
|
||||
current: PCacheEntry;
|
||||
begin
|
||||
current := FFirst;
|
||||
while (current <> nil) do
|
||||
begin
|
||||
if (current^.ID = AID) then
|
||||
begin
|
||||
current^.ID := LongInt($FFFFFFFF);
|
||||
current^.Obj := nil;
|
||||
current := nil;
|
||||
end else
|
||||
current := current^.Next;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCacheManager.DiscardObj(AObj: TObject);
|
||||
var
|
||||
current: PCacheEntry;
|
||||
begin
|
||||
current := FFirst;
|
||||
while (current <> nil) do
|
||||
begin
|
||||
if (current^.Obj = AObj) then
|
||||
begin
|
||||
current^.ID := LongInt($FFFFFFFF);
|
||||
current^.Obj := nil;
|
||||
current := nil;
|
||||
end else
|
||||
current := current^.Next;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCacheManager.RemoveID(AID: Integer);
|
||||
var
|
||||
current: PCacheEntry;
|
||||
begin
|
||||
current := FFirst;
|
||||
FLast := current;
|
||||
while (current <> nil) do
|
||||
begin
|
||||
if (current^.ID = AID) then
|
||||
begin
|
||||
current^.ID := LongInt($FFFFFFFF);
|
||||
if current^.Obj <> nil then
|
||||
FreeAndNil(current^.Obj);
|
||||
end;
|
||||
if (current^.Next <> nil) then
|
||||
FLast := current;
|
||||
current := current^.Next;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCacheManager.Clear;
|
||||
var
|
||||
current: PCacheEntry;
|
||||
begin
|
||||
current := FFirst;
|
||||
while current <> nil do
|
||||
begin
|
||||
if current^.Obj <> nil then
|
||||
begin
|
||||
current^.ID := LongInt($FFFFFFFF);
|
||||
if Assigned(FOnRemoveObject) then FOnRemoveObject(current^.Obj);
|
||||
FreeAndNil(current^.Obj);
|
||||
end;
|
||||
current := current^.Next;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCacheManager.Iterate(var ACacheEntry: PCacheEntry): Boolean;
|
||||
begin
|
||||
if ACacheEntry = nil then
|
||||
ACacheEntry := FFirst
|
||||
else
|
||||
ACacheEntry := ACacheEntry^.Next;
|
||||
Result := ACacheEntry <> nil;
|
||||
end;
|
||||
|
||||
function TCacheManager.QueryID(const AID: Integer;
|
||||
out AObj: TObject): Boolean;
|
||||
var
|
||||
current: PCacheEntry;
|
||||
begin
|
||||
current := FFirst;
|
||||
FLast := current;
|
||||
Result := False;
|
||||
while (current <> nil) and (not Result) do
|
||||
begin
|
||||
if (current^.ID = AID) then
|
||||
begin
|
||||
Result := True;
|
||||
AObj := current^.Obj;
|
||||
if current <> FFirst then
|
||||
begin
|
||||
FLast^.Next := current^.Next;
|
||||
current^.Next := FFirst;
|
||||
FFirst := current;
|
||||
end;
|
||||
end;
|
||||
if (current^.Next <> nil) then
|
||||
FLast := current;
|
||||
current := current^.Next;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCacheManager.StoreID(AID: Integer; AObj: TObject);
|
||||
var
|
||||
current: PCacheEntry;
|
||||
begin
|
||||
current := FLast^.Next; //well, FLast is not really the last, but the one before the last ;)
|
||||
FLast^.Next := nil;
|
||||
current^.Next := FFirst;
|
||||
FFirst := current;
|
||||
FFirst^.ID := AID;
|
||||
if FFirst^.Obj <> nil then //if the last cache entry did contain an object, remove it now
|
||||
begin
|
||||
if Assigned(FOnRemoveObject) then FOnRemoveObject(FFirst^.Obj);
|
||||
FreeAndNil(FFirst^.Obj);
|
||||
end;
|
||||
FFirst^.Obj := AObj;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -21,7 +21,7 @@
|
||||
* CDDL HEADER END
|
||||
*
|
||||
*
|
||||
* Portions Copyright 2007 Andreas Schneider
|
||||
* Portions Copyright 2009 Andreas Schneider
|
||||
*)
|
||||
unit UStatics;
|
||||
|
||||
@ -30,52 +30,71 @@ unit UStatics;
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, UMulBlock, UGenericIndex, UTiledata, UWorldItem;
|
||||
SysUtils, Classes, UGenericIndex, UWorldItem, UTiledata;
|
||||
|
||||
type
|
||||
{ TStaticItem }
|
||||
|
||||
TStaticItem = class(TWorldItem)
|
||||
constructor Create(AOwner: TWorldBlock; AData: TStream; ABlockX, ABlockY: Word); overload;
|
||||
constructor Create(AOwner: TWorldBlock; AData: TStream); overload;
|
||||
function Clone: TStaticItem; override;
|
||||
function GetIdentifier: Integer;
|
||||
function GetSize: Integer; override;
|
||||
procedure Write(AData: TStream); override;
|
||||
protected
|
||||
FHue, FOrgHue: Word;
|
||||
procedure SetHue(AHue: Word);
|
||||
{ Members }
|
||||
FHue: Word;
|
||||
FOrgHue: Word;
|
||||
{ Methods }
|
||||
function HasChanged: Boolean; override;
|
||||
procedure SetHue(AHue: Word);
|
||||
public
|
||||
procedure InitOriginalState; override;
|
||||
{ Fields }
|
||||
property Hue: Word read FHue write SetHue;
|
||||
{ Methods }
|
||||
function Clone: TStaticItem; override;
|
||||
function GetSize: Integer; override;
|
||||
procedure InitOriginalState; override;
|
||||
procedure UpdatePriorities(ASolver: Integer);
|
||||
procedure Write(AData: TStream); override;
|
||||
end;
|
||||
|
||||
{ TStaticBlock}
|
||||
|
||||
TStaticBlock = class(TWorldBlock)
|
||||
constructor Create(AData: TStream; AIndex: TGenericIndex; AX, AY: Word); overload;
|
||||
constructor Create(AData: TStream; AIndex: TGenericIndex); overload;
|
||||
destructor Destroy; override;
|
||||
function Clone: TStaticBlock; override;
|
||||
function GetSize: Integer; override;
|
||||
procedure Write(AData: TStream); override;
|
||||
procedure ReverseWrite(AData: TStream);
|
||||
procedure Sort;
|
||||
protected
|
||||
{ Members }
|
||||
FItems: TList;
|
||||
public
|
||||
{ Fields }
|
||||
property Items: TList read FItems write FItems;
|
||||
{ Methods }
|
||||
function Clone: TStaticBlock; override;
|
||||
function GetSize: Integer; override;
|
||||
procedure ReverseWrite(AData: TStream);
|
||||
procedure Sort;
|
||||
procedure Write(AData: TStream); override;
|
||||
end;
|
||||
|
||||
{ TSeperatedStaticBlock }
|
||||
|
||||
TSeperatedStaticBlock = class(TStaticBlock)
|
||||
constructor Create(AData: TStream; AIndex: TGenericIndex; AX, AY: Word); overload;
|
||||
constructor Create(AData: TStream; AIndex: TGenericIndex); overload;
|
||||
destructor Destroy; override;
|
||||
function Clone: TSeperatedStaticBlock; override;
|
||||
function GetSize: Integer; override;
|
||||
protected
|
||||
procedure RefreshList;
|
||||
public
|
||||
Cells: array[0..63] of TList;
|
||||
{ Methods }
|
||||
function Clone: TSeperatedStaticBlock; override;
|
||||
function GetSize: Integer; override;
|
||||
procedure RebuildList;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
UGameResources; //Used for priority calculation
|
||||
|
||||
{ TStaticItem }
|
||||
|
||||
constructor TStaticItem.Create(AOwner: TWorldBlock; AData: TStream; ABlockX, ABlockY: Word);
|
||||
@ -102,6 +121,17 @@ begin
|
||||
Create(AOwner, AData, 0, 0);
|
||||
end;
|
||||
|
||||
function TStaticItem.HasChanged: Boolean;
|
||||
begin
|
||||
Result := (FHue <> FOrgHue) or inherited HasChanged;
|
||||
end;
|
||||
|
||||
procedure TStaticItem.SetHue(AHue: Word);
|
||||
begin
|
||||
FHue := AHue;
|
||||
DoChanged;
|
||||
end;
|
||||
|
||||
function TStaticItem.Clone: TStaticItem;
|
||||
begin
|
||||
Result := TStaticItem.Create(nil, nil);
|
||||
@ -112,9 +142,29 @@ begin
|
||||
Result.FHue := FHue;
|
||||
end;
|
||||
|
||||
function TStaticItem.GetIdentifier: Integer;
|
||||
function TStaticItem.GetSize: Integer;
|
||||
begin
|
||||
Result := 0 or (((FX mod 8) shl 28) and $F0000000) or (((FY mod 8) shl 24) and $0F000000) or ((Byte(FZ) shl 16) and $00FF0000) or (Word(FTileID) and $0000FFFF);
|
||||
Result := 7;
|
||||
end;
|
||||
|
||||
procedure TStaticItem.InitOriginalState;
|
||||
begin
|
||||
FOrgHue := FHue;
|
||||
inherited InitOriginalState;
|
||||
end;
|
||||
|
||||
procedure TStaticItem.UpdatePriorities(ASolver: Integer);
|
||||
var
|
||||
staticTileData: TStaticTileData;
|
||||
begin
|
||||
staticTileData := ResMan.Tiledata.StaticTiles[FTileID];
|
||||
FPriorityBonus := 0;
|
||||
if not ((staticTileData.Flags and tdfBackground) = tdfBackground) then
|
||||
Inc(FPriorityBonus);
|
||||
if staticTileData.Height > 0 then
|
||||
Inc(FPriorityBonus);
|
||||
FPriority := Z + FPriorityBonus;
|
||||
FPrioritySolver := ASolver;
|
||||
end;
|
||||
|
||||
procedure TStaticItem.Write(AData: TStream);
|
||||
@ -131,28 +181,6 @@ begin
|
||||
AData.Write(FHue, SizeOf(SmallInt));
|
||||
end;
|
||||
|
||||
function TStaticItem.GetSize: Integer;
|
||||
begin
|
||||
Result := 7;
|
||||
end;
|
||||
|
||||
function TStaticItem.HasChanged: Boolean;
|
||||
begin
|
||||
Result := (FHue <> FOrgHue) or inherited HasChanged;
|
||||
end;
|
||||
|
||||
procedure TStaticItem.InitOriginalState;
|
||||
begin
|
||||
FOrgHue := FHue;
|
||||
inherited InitOriginalState;
|
||||
end;
|
||||
|
||||
procedure TStaticItem.SetHue(AHue: Word);
|
||||
begin
|
||||
FHue := AHue;
|
||||
DoChanged;
|
||||
end;
|
||||
|
||||
{ TStaticBlock }
|
||||
|
||||
constructor TStaticBlock.Create(AData: TStream; AIndex: TGenericIndex; AX, AY: Word);
|
||||
@ -214,14 +242,6 @@ begin
|
||||
Result := FItems.Count * 7;
|
||||
end;
|
||||
|
||||
procedure TStaticBlock.Write(AData: TStream);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to FItems.Count - 1 do
|
||||
TStaticItem(FItems[i]).Write(AData);
|
||||
end;
|
||||
|
||||
procedure TStaticBlock.ReverseWrite(AData: TStream);
|
||||
var
|
||||
i: Integer;
|
||||
@ -233,49 +253,16 @@ begin
|
||||
end;
|
||||
|
||||
procedure TStaticBlock.Sort;
|
||||
var
|
||||
iMin, iMax: Integer;
|
||||
|
||||
procedure sift;
|
||||
var
|
||||
i, j: integer;
|
||||
begin
|
||||
i := iMin;
|
||||
j := 2 * i;
|
||||
FItems[0] := FItems[i];
|
||||
while j <= iMax do
|
||||
begin
|
||||
if j < iMax then
|
||||
if TStaticItem(FItems[j]).GetIdentifier < TStaticItem(FItems[j + 1]).GetIdentifier then inc(j);
|
||||
if TStaticItem(FItems[0]).GetIdentifier >= TStaticItem(FItems[j]).GetIdentifier then break;
|
||||
FItems[i] := FItems[j];
|
||||
i := j;
|
||||
j := 2 * i;
|
||||
end;
|
||||
FItems[i] := FItems[0];
|
||||
end;
|
||||
|
||||
begin
|
||||
if FItems.Count > 0 then
|
||||
begin
|
||||
iMax := FItems.Count;
|
||||
iMin := iMax div 2 + 1;
|
||||
FItems.Insert(0, nil);
|
||||
while iMin > 1 do
|
||||
begin
|
||||
dec(iMin);
|
||||
sift;
|
||||
end;
|
||||
while iMax > 1 do
|
||||
begin
|
||||
FItems[0] := FItems[iMin];
|
||||
FItems[iMin] := FItems[iMax];
|
||||
FItems[iMax] := FItems[0];
|
||||
dec(iMax);
|
||||
sift;
|
||||
end;
|
||||
FItems.Delete(0);
|
||||
end;
|
||||
FItems.Sort(@CompareWorldItems);
|
||||
end;
|
||||
|
||||
procedure TStaticBlock.Write(AData: TStream);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to FItems.Count - 1 do
|
||||
TStaticItem(FItems[i]).Write(AData);
|
||||
end;
|
||||
|
||||
{ TSeperatedStaticBlock }
|
||||
@ -339,6 +326,27 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TSeperatedStaticBlock.RebuildList;
|
||||
var
|
||||
i, j, solver: Integer;
|
||||
begin
|
||||
FItems.Clear;
|
||||
solver := 0;
|
||||
for i := 0 to 63 do
|
||||
begin
|
||||
if Cells[i] <> nil then
|
||||
begin
|
||||
for j := 0 to Cells[i].Count - 1 do
|
||||
begin
|
||||
FItems.Add(Cells[i].Items[j]);
|
||||
TStaticItem(Cells[i].Items[j]).UpdatePriorities(solver);
|
||||
Inc(solver);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
Sort;
|
||||
end;
|
||||
|
||||
function TSeperatedStaticBlock.Clone: TSeperatedStaticBlock;
|
||||
var
|
||||
i, j: Integer;
|
||||
@ -352,26 +360,9 @@ end;
|
||||
|
||||
function TSeperatedStaticBlock.GetSize: Integer;
|
||||
begin
|
||||
RefreshList;
|
||||
RebuildList;
|
||||
Result := inherited GetSize;
|
||||
end;
|
||||
|
||||
procedure TSeperatedStaticBlock.RefreshList;
|
||||
var
|
||||
i, j: Integer;
|
||||
begin
|
||||
FItems.Clear;
|
||||
for i := 0 to 63 do
|
||||
begin
|
||||
if Cells[i] <> nil then
|
||||
begin
|
||||
for j := 0 to Cells[i].Count - 1 do
|
||||
if Cells[i].Items[j] <> nil then
|
||||
FItems.Add(Cells[i].Items[j]);
|
||||
end;
|
||||
end;
|
||||
Sort;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -34,6 +34,9 @@ uses
|
||||
|
||||
type
|
||||
TWorldBlock = class;
|
||||
|
||||
{ TWorldItem }
|
||||
|
||||
TWorldItem = class(TMulBlock)
|
||||
constructor Create(AOwner: TWorldBlock);
|
||||
protected
|
||||
@ -75,6 +78,9 @@ type
|
||||
property PriorityBonus: ShortInt read FPriorityBonus write FPriorityBonus;
|
||||
property PrioritySolver: Integer read FPrioritySolver write FPrioritySolver;
|
||||
end;
|
||||
|
||||
{ TWorldBlock }
|
||||
|
||||
TWorldBlock = class(TMulBlock)
|
||||
constructor Create;
|
||||
protected
|
||||
@ -95,8 +101,37 @@ type
|
||||
procedure CleanUp;
|
||||
end;
|
||||
|
||||
function CompareWorldItems(AItem1, AItem2: Pointer): Integer;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
UMap, UStatics;
|
||||
|
||||
function CompareWorldItems(AItem1, AItem2: Pointer): Integer;
|
||||
begin
|
||||
if TWorldItem(AItem1).X <> TWorldItem(AItem2).X then
|
||||
Exit(TWorldItem(AItem1).X - TWorldItem(AItem2).X);
|
||||
|
||||
if TWorldItem(AItem1).Y <> TWorldItem(AItem2).Y then
|
||||
Exit(TWorldItem(AItem1).Y - TWorldItem(AItem2).Y);
|
||||
|
||||
Result := TWorldItem(AItem1).Priority - TWorldItem(AItem2).Priority;
|
||||
if Result = 0 then
|
||||
begin
|
||||
if (TObject(AItem1) is TMapCell) and (TObject(AItem2) is TStaticItem) then
|
||||
Result := -1
|
||||
else if (TObject(AItem1) is TStaticItem) and (TObject(AItem2) is TMapCell) then
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
if Result = 0 then
|
||||
Result := TWorldItem(AItem1).PriorityBonus - TWorldItem(AItem2).PriorityBonus;
|
||||
|
||||
if Result = 0 then
|
||||
Result := TWorldItem(AItem1).PrioritySolver - TWorldItem(AItem2).PrioritySolver;
|
||||
end;
|
||||
|
||||
{ TWorldItem }
|
||||
|
||||
constructor TWorldItem.Create(AOwner: TWorldBlock);
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user