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

- 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:
Andreas Schneider 2009-08-02 13:45:26 +02:00
parent f3888db49c
commit b70f03ba2a
8 changed files with 470 additions and 430 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

100
Client/ULandscape.pas
View File

@ -88,11 +88,15 @@ type
constructor Create(AMap: TMapBlock; AStatics: TStaticBlock); constructor Create(AMap: TMapBlock; AStatics: TStaticBlock);
destructor Destroy; override; destructor Destroy; override;
protected protected
{ Fields }
FMapBlock: TMapBlock; FMapBlock: TMapBlock;
FStaticBlock: TStaticBlock; FStaticBlock: TStaticBlock;
public public
{ Fields }
property Map: TMapBlock read FMapBlock; property Map: TMapBlock read FMapBlock;
property Static: TStaticBlock read FStaticBlock; property Static: TStaticBlock read FStaticBlock;
{ Methods }
procedure UpdateBlockAcess;
end; end;
TLandscapeChangeEvent = procedure of object; TLandscapeChangeEvent = procedure of object;
@ -148,8 +152,7 @@ type
procedure GetNormals(AX, AY: Word; var ANormals: TNormals); procedure GetNormals(AX, AY: Word; var ANormals: TNormals);
procedure MoveStatic(AStatic: TStaticItem; AX, AY: Word); procedure MoveStatic(AStatic: TStaticItem; AX, AY: Word);
procedure PrepareBlocks(AX1, AY1, AX2, AY2: Word); procedure PrepareBlocks(AX1, AY1, AX2, AY2: Word);
procedure UpdateStaticsPriority(AStaticItem: TStaticItem; procedure UpdateBlockAccess;
APrioritySolver: Integer);
end; end;
TScreenState = (ssNormal, ssFiltered, ssGhost); TScreenState = (ssNormal, ssFiltered, ssGhost);
@ -185,8 +188,8 @@ type
procedure Delete(AItem: TWorldItem); procedure Delete(AItem: TWorldItem);
function Find(AScreenPosition: TPoint): PBlockInfo; function Find(AScreenPosition: TPoint): PBlockInfo;
function GetSerial: Cardinal; function GetSerial: Cardinal;
function Iterate(var ABlockInfo: PBlockInfo): Boolean;
function Insert(AItem: TWorldItem): PBlockInfo; function Insert(AItem: TWorldItem): PBlockInfo;
function Iterate(var ABlockInfo: PBlockInfo): Boolean;
procedure Sort; procedure Sort;
procedure UpdateShortcuts; procedure UpdateShortcuts;
{ Events } { Events }
@ -215,30 +218,6 @@ begin
Result := ((AX and $7FFF) shl 15) or (AY and $7FFF); Result := ((AX and $7FFF) shl 15) or (AY and $7FFF);
end; 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 } { TLandTextureManager }
constructor TLandTextureManager.Create; constructor TLandTextureManager.Create;
@ -342,6 +321,7 @@ begin
inherited Create; inherited Create;
FMapBlock := AMap; FMapBlock := AMap;
FStaticBlock := AStatics; FStaticBlock := AStatics;
UpdateBlockAcess;
end; end;
destructor TBlock.Destroy; destructor TBlock.Destroy;
@ -351,6 +331,28 @@ begin
inherited Destroy; inherited Destroy;
end; 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 } { TLandscape }
constructor TLandscape.Create(AWidth, AHeight: Word); constructor TLandscape.Create(AWidth, AHeight: Word);
@ -533,7 +535,7 @@ begin
targetStaticList := block.Cells[(y mod 8) * 8 + x mod 8]; targetStaticList := block.Cells[(y mod 8) * 8 + x mod 8];
targetStaticList.Add(staticItem); targetStaticList.Add(staticItem);
for i := 0 to targetStaticList.Count - 1 do for i := 0 to targetStaticList.Count - 1 do
UpdateStaticsPriority(TStaticItem(targetStaticList.Items[i]), i); TStaticItem(targetStaticList.Items[i]).UpdatePriorities(i);
targetStaticList.Sort(@CompareWorldItems); targetStaticList.Sort(@CompareWorldItems);
staticItem.Owner := block; staticItem.Owner := block;
if Assigned(FOnChange) then FOnChange; if Assigned(FOnChange) then FOnChange;
@ -591,7 +593,7 @@ begin
begin begin
staticItem.Z := ABuffer.ReadShortInt; staticItem.Z := ABuffer.ReadShortInt;
for j := 0 to statics.Count - 1 do for j := 0 to statics.Count - 1 do
UpdateStaticsPriority(TStaticItem(statics.Items[j]), j); TStaticItem(statics.Items[j]).UpdatePriorities(j);
statics.Sort(@CompareWorldItems); statics.Sort(@CompareWorldItems);
if Assigned(FOnChange) then FOnChange; if Assigned(FOnChange) then FOnChange;
Break; Break;
@ -650,7 +652,7 @@ begin
statics := targetBlock.Cells[(newY mod 8) * 8 + newX mod 8]; statics := targetBlock.Cells[(newY mod 8) * 8 + newX mod 8];
statics.Add(staticItem); statics.Add(staticItem);
for i := 0 to statics.Count - 1 do for i := 0 to statics.Count - 1 do
UpdateStaticsPriority(TStaticItem(statics.Items[i]), i); TStaticItem(statics.Items[i]).UpdatePriorities(i);
statics.Sort(@CompareWorldItems); statics.Sort(@CompareWorldItems);
staticItem.Owner := targetBlock; staticItem.Owner := targetBlock;
end; end;
@ -724,7 +726,7 @@ begin
(TStaticItem(drawStatics[i]).Z <= AMaxZ) and (TStaticItem(drawStatics[i]).Z <= AMaxZ) and
((AStaticsFilter = nil) or AStaticsFilter(TStaticItem(drawStatics[i]))) then ((AStaticsFilter = nil) or AStaticsFilter(TStaticItem(drawStatics[i]))) then
begin begin
UpdateStaticsPriority(TStaticItem(drawStatics[i]), ADrawList.GetSerial); TStaticItem(drawStatics[i]).UpdatePriorities(ADrawList.GetSerial);
ADrawList.Add(TWorldItem(drawStatics[i])); ADrawList.Add(TWorldItem(drawStatics[i]));
end; end;
end; end;
@ -857,7 +859,7 @@ begin
targetStaticList := targetBlock.Cells[(AY mod 8) * 8 + AX mod 8]; targetStaticList := targetBlock.Cells[(AY mod 8) * 8 + AX mod 8];
targetStaticList.Add(AStatic); targetStaticList.Add(AStatic);
for i := 0 to targetStaticList.Count - 1 do for i := 0 to targetStaticList.Count - 1 do
UpdateStaticsPriority(TStaticItem(targetStaticList.Items[i]), i); TStaticItem(targetStaticList.Items[i]).UpdatePriorities(i);
targetStaticList.Sort(@CompareWorldItems); targetStaticList.Sort(@CompareWorldItems);
AStatic.UpdatePos(AX, AY, AStatic.Z); AStatic.UpdatePos(AX, AY, AStatic.Z);
AStatic.Owner := targetBlock; AStatic.Owner := targetBlock;
@ -896,19 +898,13 @@ begin
dmNetwork.Send(TRequestBlocksPacket.Create(coords)); dmNetwork.Send(TRequestBlocksPacket.Create(coords));
end; end;
procedure TLandscape.UpdateStaticsPriority(AStaticItem: TStaticItem; procedure TLandscape.UpdateBlockAccess;
APrioritySolver: Integer);
var var
staticTileData: TStaticTileData; cacheEntry: PCacheEntry;
begin begin
staticTileData := ResMan.Tiledata.StaticTiles[AStaticItem.TileID]; cacheEntry := nil;
AStaticItem.PriorityBonus := 0; while FBlockCache.Iterate(cacheEntry) do
if not ((staticTileData.Flags and tdfBackground) = tdfBackground) then TBlock(cacheEntry^.Obj).UpdateBlockAcess;
AStaticItem.PriorityBonus := AStaticItem.PriorityBonus + 1;
if staticTileData.Height > 0 then
AStaticItem.PriorityBonus := AStaticItem.PriorityBonus + 1;
AStaticItem.Priority := AStaticItem.Z + AStaticItem.PriorityBonus;
AStaticItem.PrioritySolver := APrioritySolver;
end; end;
{ TMaterial } { TMaterial }
@ -1087,15 +1083,6 @@ begin
Inc(FSerial); Inc(FSerial);
end; 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; function TScreenBuffer.Insert(AItem: TWorldItem): PBlockInfo;
var var
current: PBlockInfo; current: PBlockInfo;
@ -1145,6 +1132,15 @@ begin
Inc(FCount); Inc(FCount);
end; 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 //Mergesort
procedure TScreenBuffer.Sort; procedure TScreenBuffer.Sort;

52
Client/UdmNetwork.lfm
View File

@ -1,24 +1,28 @@
object dmNetwork: TdmNetwork object dmNetwork: TdmNetwork
OnCreate = DataModuleCreate OnCreate = DataModuleCreate
OnDestroy = DataModuleDestroy OnDestroy = DataModuleDestroy
Height = 300 OldCreateOrder = False
HorizontalOffset = 290 Height = 300
VerticalOffset = 171 HorizontalOffset = 290
Width = 400 VerticalOffset = 171
object TCPClient: TLTCPComponent Width = 400
OnReceive = TCPClientReceive object TCPClient: TLTCPComponent
OnError = TCPClientError Port = 0
OnDisconnect = TCPClientDisconnect OnReceive = TCPClientReceive
OnConnect = TCPClientConnect OnError = TCPClientError
left = 40 OnDisconnect = TCPClientDisconnect
top = 24 OnConnect = TCPClientConnect
end Timeout = 0
object tmNoOp: TTimer ReuseAddress = False
Enabled = False left = 40
Interval = 30000 top = 24
OnTimer = tmNoOpTimer end
OnStartTimer = tmNoOpStartTimer object tmNoOp: TTimer
left = 72 Enabled = False
top = 24 Interval = 30000
end OnTimer = tmNoOpTimer
end OnStartTimer = tmNoOpStartTimer
left = 72
top = 24
end
end

16
Client/UdmNetwork.pas
View File

@ -345,14 +345,16 @@ var
i: Integer; i: Integer;
pt: TPoint; pt: TPoint;
begin 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); Result := False;
for i := 0 to FWriteMap.Count - 1 do end else
if PtInRect(FWriteMap.Rects[i], pt) then Result := True;
Exit(True);
Result := False;
end; end;
procedure TdmNetwork.Send(APacket: TPacket); procedure TdmNetwork.Send(APacket: TPacket);

5
Client/UfrmMain.lfm
View File

@ -3,6 +3,7 @@ object frmMain: TfrmMain
Height = 603 Height = 603
Top = 126 Top = 126
Width = 766 Width = 766
ActiveControl = oglGameWindow
Caption = 'UO CentrED' Caption = 'UO CentrED'
ClientHeight = 580 ClientHeight = 580
ClientWidth = 766 ClientWidth = 766
@ -540,7 +541,7 @@ object frmMain: TfrmMain
Top = 306 Top = 306
Width = 218 Width = 218
Align = alNone Align = alNone
Anchors = [akTop, akLeft, akRight] Anchors = [akLeft, akRight, akBottom]
ResizeAnchor = akBottom ResizeAnchor = akBottom
end end
object edSearchID: TEdit object edSearchID: TEdit
@ -1110,7 +1111,7 @@ object frmMain: TfrmMain
Top = 435 Top = 435
Width = 542 Width = 542
Align = alNone Align = alNone
Anchors = [akLeft, akRight] Anchors = [akLeft, akRight, akBottom]
AutoSnap = False AutoSnap = False
ResizeAnchor = akBottom ResizeAnchor = akBottom
Visible = False Visible = False

8
Client/UfrmMain.pas
View File

@ -1662,7 +1662,6 @@ var
tileRect: TRect; tileRect: TRect;
virtualTile: TVirtualTile; virtualTile: TVirtualTile;
staticsFilter: TStaticFilter; staticsFilter: TStaticFilter;
editing: Boolean;
intensity: GLfloat; intensity: GLfloat;
blockInfo: PBlockInfo; blockInfo: PBlockInfo;
item: TWorldItem; item: TWorldItem;
@ -1688,19 +1687,17 @@ begin
//TODO : implement CanBeEdited handling (dmNetwork.CanWrite.....) //TODO : implement CanBeEdited handling (dmNetwork.CanWrite.....)
if acSelect.Checked or item.CanBeEdited then if acSelect.Checked or item.CanBeEdited then
begin begin
editing := True;
intensity := 1.0; intensity := 1.0;
SetNormalLights; SetNormalLights;
end else end else
begin begin
editing := False;
intensity := 0.5; intensity := 0.5;
SetDarkLights; SetDarkLights;
end; end;
glColor4f(intensity, intensity, intensity, 1.0); glColor4f(intensity, intensity, intensity, 1.0);
highlight := item.CanBeEdited and blockInfo^.Highlighted; highlight := blockInfo^.Highlighted and item.CanBeEdited;
if highlight then if highlight then
begin begin
@ -2357,7 +2354,8 @@ begin
$07: //access changed $07: //access changed
begin begin
accessLevel := TAccessLevel(ABuffer.ReadByte); 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 if accessLevel <> dmNetwork.AccessLevel then
begin begin

473
UCacheManager.pas
View File

@ -1,230 +1,243 @@
(* (*
* CDDL HEADER START * CDDL HEADER START
* *
* The contents of this file are subject to the terms of the * The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only * Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance * (the "License"). You may not use this file except in compliance
* with the License. * with the License.
* *
* You can obtain a copy of the license at * You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php. * http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions * See the License for the specific language governing permissions
* and limitations under the License. * and limitations under the License.
* *
* When distributing Covered Code, include this CDDL HEADER in each * When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at * file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable, * http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed * add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information: * by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner] * Portions Copyright [yyyy] [name of copyright owner]
* *
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2007 Andreas Schneider * Portions Copyright 2009 Andreas Schneider
*) *)
unit UCacheManager; unit UCacheManager;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
SysUtils, Classes; SysUtils, Classes;
type type
TRemoveObjectEvent = procedure(AObject: TObject) of object; TRemoveObjectEvent = procedure(AObject: TObject) of object;
PCacheEntry = ^TCacheEntry; PCacheEntry = ^TCacheEntry;
TCacheEntry = record TCacheEntry = record
ID: Integer; ID: Integer;
Obj: TObject; Obj: TObject;
Next: PCacheEntry; Next: PCacheEntry;
end; end;
{ TCacheManager } { TCacheManager }
TCacheManager = class(TObject) TCacheManager = class(TObject)
constructor Create(ASize: Integer); constructor Create(ASize: Integer);
destructor Destroy; override; destructor Destroy; override;
protected protected
FSize: Integer; { Members }
FFirst: PCacheEntry; FSize: Integer;
FLast: PCacheEntry; FFirst: PCacheEntry;
FOnRemoveObject: TRemoveObjectEvent; FLast: PCacheEntry;
public FOnRemoveObject: TRemoveObjectEvent;
function QueryID(const AID: Integer; out AObj: TObject): Boolean; public
procedure StoreID(AID: Integer; AObj: TObject); { Fields }
procedure DiscardID(AID: Integer); property OnRemoveObject: TRemoveObjectEvent read FOnRemoveObject write FOnRemoveObject;
procedure DiscardObj(AObj: TObject); { Methods }
procedure RemoveID(AID: Integer); function QueryID(const AID: Integer; out AObj: TObject): Boolean;
procedure Clear; procedure StoreID(AID: Integer; AObj: TObject);
property OnRemoveObject: TRemoveObjectEvent read FOnRemoveObject write FOnRemoveObject; procedure DiscardID(AID: Integer);
end; procedure DiscardObj(AObj: TObject);
procedure RemoveID(AID: Integer);
implementation procedure Clear;
function Iterate(var ACacheEntry: PCacheEntry): Boolean;
{ TCacheManager } end;
constructor TCacheManager.Create(ASize: Integer); implementation
var
i: Integer; { TCacheManager }
current: PCacheEntry;
begin constructor TCacheManager.Create(ASize: Integer);
FOnRemoveObject := nil; var
FSize := ASize; i: Integer;
if FSize > 0 then current: PCacheEntry;
begin begin
New(FFirst); FOnRemoveObject := nil;
current := FFirst; FSize := ASize;
current^.ID := LongInt($FFFFFFFF); if FSize > 0 then
current^.Obj := nil; begin
for i := 2 to FSize do New(FFirst);
begin current := FFirst;
New(current^.Next); current^.ID := LongInt($FFFFFFFF);
FLast := current; current^.Obj := nil;
current := current^.Next; for i := 2 to FSize do
current^.ID := LongInt($FFFFFFFF); begin
current^.Obj := nil; New(current^.Next);
end; FLast := current;
current^.Next := nil; current := current^.Next;
end; current^.ID := LongInt($FFFFFFFF);
end; current^.Obj := nil;
end;
destructor TCacheManager.Destroy; current^.Next := nil;
var end;
i: Integer; end;
current, last: PCacheEntry;
begin destructor TCacheManager.Destroy;
current := FFirst; var
for i := 1 to FSize do i: Integer;
begin current, last: PCacheEntry;
if current^.Obj <> nil then begin
begin current := FFirst;
if Assigned(FOnRemoveObject) then FOnRemoveObject(current^.Obj); for i := 1 to FSize do
FreeAndNil(current^.Obj); begin
end; if current^.Obj <> nil then
last := current; begin
current := current^.Next; if Assigned(FOnRemoveObject) then FOnRemoveObject(current^.Obj);
Dispose(last); FreeAndNil(current^.Obj);
end; end;
inherited; last := current;
end; current := current^.Next;
Dispose(last);
procedure TCacheManager.DiscardID(AID: Integer); end;
var inherited;
current: PCacheEntry; end;
begin
current := FFirst; procedure TCacheManager.DiscardID(AID: Integer);
while (current <> nil) do var
begin current: PCacheEntry;
if (current^.ID = AID) then begin
begin current := FFirst;
current^.ID := LongInt($FFFFFFFF); while (current <> nil) do
current^.Obj := nil; begin
current := nil; if (current^.ID = AID) then
end else begin
current := current^.Next; current^.ID := LongInt($FFFFFFFF);
end; current^.Obj := nil;
end; current := nil;
end else
procedure TCacheManager.DiscardObj(AObj: TObject); current := current^.Next;
var end;
current: PCacheEntry; end;
begin
current := FFirst; procedure TCacheManager.DiscardObj(AObj: TObject);
while (current <> nil) do var
begin current: PCacheEntry;
if (current^.Obj = AObj) then begin
begin current := FFirst;
current^.ID := LongInt($FFFFFFFF); while (current <> nil) do
current^.Obj := nil; begin
current := nil; if (current^.Obj = AObj) then
end else begin
current := current^.Next; current^.ID := LongInt($FFFFFFFF);
end; current^.Obj := nil;
end; current := nil;
end else
procedure TCacheManager.RemoveID(AID: Integer); current := current^.Next;
var end;
current: PCacheEntry; end;
begin
current := FFirst; procedure TCacheManager.RemoveID(AID: Integer);
FLast := current; var
while (current <> nil) do current: PCacheEntry;
begin begin
if (current^.ID = AID) then current := FFirst;
begin FLast := current;
current^.ID := LongInt($FFFFFFFF); while (current <> nil) do
if current^.Obj <> nil then begin
FreeAndNil(current^.Obj); if (current^.ID = AID) then
end; begin
if (current^.Next <> nil) then current^.ID := LongInt($FFFFFFFF);
FLast := current; if current^.Obj <> nil then
current := current^.Next; FreeAndNil(current^.Obj);
end; end;
end; if (current^.Next <> nil) then
FLast := current;
procedure TCacheManager.Clear; current := current^.Next;
var end;
current: PCacheEntry; end;
begin
current := FFirst; procedure TCacheManager.Clear;
while current <> nil do var
begin current: PCacheEntry;
if current^.Obj <> nil then begin
begin current := FFirst;
current^.ID := LongInt($FFFFFFFF); while current <> nil do
if Assigned(FOnRemoveObject) then FOnRemoveObject(current^.Obj); begin
FreeAndNil(current^.Obj); if current^.Obj <> nil then
end; begin
current := current^.Next; current^.ID := LongInt($FFFFFFFF);
end; if Assigned(FOnRemoveObject) then FOnRemoveObject(current^.Obj);
end; FreeAndNil(current^.Obj);
end;
function TCacheManager.QueryID(const AID: Integer; current := current^.Next;
out AObj: TObject): Boolean; end;
var end;
current: PCacheEntry;
begin function TCacheManager.Iterate(var ACacheEntry: PCacheEntry): Boolean;
current := FFirst; begin
FLast := current; if ACacheEntry = nil then
Result := False; ACacheEntry := FFirst
while (current <> nil) and (not Result) do else
begin ACacheEntry := ACacheEntry^.Next;
if (current^.ID = AID) then Result := ACacheEntry <> nil;
begin end;
Result := True;
AObj := current^.Obj; function TCacheManager.QueryID(const AID: Integer;
if current <> FFirst then out AObj: TObject): Boolean;
begin var
FLast^.Next := current^.Next; current: PCacheEntry;
current^.Next := FFirst; begin
FFirst := current; current := FFirst;
end; FLast := current;
end; Result := False;
if (current^.Next <> nil) then while (current <> nil) and (not Result) do
FLast := current; begin
current := current^.Next; if (current^.ID = AID) then
end; begin
end; Result := True;
AObj := current^.Obj;
procedure TCacheManager.StoreID(AID: Integer; AObj: TObject); if current <> FFirst then
var begin
current: PCacheEntry; FLast^.Next := current^.Next;
begin current^.Next := FFirst;
current := FLast^.Next; //well, FLast is not really the last, but the one before the last ;) FFirst := current;
FLast^.Next := nil; end;
current^.Next := FFirst; end;
FFirst := current; if (current^.Next <> nil) then
FFirst^.ID := AID; FLast := current;
if FFirst^.Obj <> nil then //if the last cache entry did contain an object, remove it now current := current^.Next;
begin end;
if Assigned(FOnRemoveObject) then FOnRemoveObject(FFirst^.Obj); end;
FreeAndNil(FFirst^.Obj);
end; procedure TCacheManager.StoreID(AID: Integer; AObj: TObject);
FFirst^.Obj := AObj; var
end; current: PCacheEntry;
begin
end. 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.

211
UOLib/UStatics.pas
View File

@ -21,7 +21,7 @@
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2007 Andreas Schneider * Portions Copyright 2009 Andreas Schneider
*) *)
unit UStatics; unit UStatics;
@ -30,52 +30,71 @@ unit UStatics;
interface interface
uses uses
SysUtils, Classes, UMulBlock, UGenericIndex, UTiledata, UWorldItem; SysUtils, Classes, UGenericIndex, UWorldItem, UTiledata;
type type
{ TStaticItem }
TStaticItem = class(TWorldItem) TStaticItem = class(TWorldItem)
constructor Create(AOwner: TWorldBlock; AData: TStream; ABlockX, ABlockY: Word); overload; constructor Create(AOwner: TWorldBlock; AData: TStream; ABlockX, ABlockY: Word); overload;
constructor Create(AOwner: TWorldBlock; AData: TStream); 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 protected
FHue, FOrgHue: Word; { Members }
procedure SetHue(AHue: Word); FHue: Word;
FOrgHue: Word;
{ Methods }
function HasChanged: Boolean; override; function HasChanged: Boolean; override;
procedure SetHue(AHue: Word);
public public
procedure InitOriginalState; override; { Fields }
property Hue: Word read FHue write SetHue; 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; end;
{ TStaticBlock}
TStaticBlock = class(TWorldBlock) TStaticBlock = class(TWorldBlock)
constructor Create(AData: TStream; AIndex: TGenericIndex; AX, AY: Word); overload; constructor Create(AData: TStream; AIndex: TGenericIndex; AX, AY: Word); overload;
constructor Create(AData: TStream; AIndex: TGenericIndex); overload; constructor Create(AData: TStream; AIndex: TGenericIndex); overload;
destructor Destroy; override; destructor Destroy; override;
function Clone: TStaticBlock; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
procedure ReverseWrite(AData: TStream);
procedure Sort;
protected protected
{ Members }
FItems: TList; FItems: TList;
public public
{ Fields }
property Items: TList read FItems write FItems; 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; end;
{ TSeperatedStaticBlock }
TSeperatedStaticBlock = class(TStaticBlock) TSeperatedStaticBlock = class(TStaticBlock)
constructor Create(AData: TStream; AIndex: TGenericIndex; AX, AY: Word); overload; constructor Create(AData: TStream; AIndex: TGenericIndex; AX, AY: Word); overload;
constructor Create(AData: TStream; AIndex: TGenericIndex); overload; constructor Create(AData: TStream; AIndex: TGenericIndex); overload;
destructor Destroy; override; destructor Destroy; override;
function Clone: TSeperatedStaticBlock; override;
function GetSize: Integer; override;
protected
procedure RefreshList;
public public
Cells: array[0..63] of TList; Cells: array[0..63] of TList;
{ Methods }
function Clone: TSeperatedStaticBlock; override;
function GetSize: Integer; override;
procedure RebuildList;
end; end;
implementation implementation
uses
UGameResources; //Used for priority calculation
{ TStaticItem } { TStaticItem }
constructor TStaticItem.Create(AOwner: TWorldBlock; AData: TStream; ABlockX, ABlockY: Word); constructor TStaticItem.Create(AOwner: TWorldBlock; AData: TStream; ABlockX, ABlockY: Word);
@ -102,6 +121,17 @@ begin
Create(AOwner, AData, 0, 0); Create(AOwner, AData, 0, 0);
end; 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; function TStaticItem.Clone: TStaticItem;
begin begin
Result := TStaticItem.Create(nil, nil); Result := TStaticItem.Create(nil, nil);
@ -112,9 +142,29 @@ begin
Result.FHue := FHue; Result.FHue := FHue;
end; end;
function TStaticItem.GetIdentifier: Integer; function TStaticItem.GetSize: Integer;
begin 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; end;
procedure TStaticItem.Write(AData: TStream); procedure TStaticItem.Write(AData: TStream);
@ -131,28 +181,6 @@ begin
AData.Write(FHue, SizeOf(SmallInt)); AData.Write(FHue, SizeOf(SmallInt));
end; 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 } { TStaticBlock }
constructor TStaticBlock.Create(AData: TStream; AIndex: TGenericIndex; AX, AY: Word); constructor TStaticBlock.Create(AData: TStream; AIndex: TGenericIndex; AX, AY: Word);
@ -214,14 +242,6 @@ begin
Result := FItems.Count * 7; Result := FItems.Count * 7;
end; 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); procedure TStaticBlock.ReverseWrite(AData: TStream);
var var
i: Integer; i: Integer;
@ -233,49 +253,16 @@ begin
end; end;
procedure TStaticBlock.Sort; 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 begin
if FItems.Count > 0 then FItems.Sort(@CompareWorldItems);
begin end;
iMax := FItems.Count;
iMin := iMax div 2 + 1; procedure TStaticBlock.Write(AData: TStream);
FItems.Insert(0, nil); var
while iMin > 1 do i: Integer;
begin begin
dec(iMin); for i := 0 to FItems.Count - 1 do
sift; TStaticItem(FItems[i]).Write(AData);
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;
end; end;
{ TSeperatedStaticBlock } { TSeperatedStaticBlock }
@ -339,6 +326,27 @@ begin
inherited Destroy; inherited Destroy;
end; 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; function TSeperatedStaticBlock.Clone: TSeperatedStaticBlock;
var var
i, j: Integer; i, j: Integer;
@ -352,26 +360,9 @@ end;
function TSeperatedStaticBlock.GetSize: Integer; function TSeperatedStaticBlock.GetSize: Integer;
begin begin
RefreshList; RebuildList;
Result := inherited GetSize; Result := inherited GetSize;
end; 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. end.

35
UOLib/UWorldItem.pas
View File

@ -34,6 +34,9 @@ uses
type type
TWorldBlock = class; TWorldBlock = class;
{ TWorldItem }
TWorldItem = class(TMulBlock) TWorldItem = class(TMulBlock)
constructor Create(AOwner: TWorldBlock); constructor Create(AOwner: TWorldBlock);
protected protected
@ -75,6 +78,9 @@ type
property PriorityBonus: ShortInt read FPriorityBonus write FPriorityBonus; property PriorityBonus: ShortInt read FPriorityBonus write FPriorityBonus;
property PrioritySolver: Integer read FPrioritySolver write FPrioritySolver; property PrioritySolver: Integer read FPrioritySolver write FPrioritySolver;
end; end;
{ TWorldBlock }
TWorldBlock = class(TMulBlock) TWorldBlock = class(TMulBlock)
constructor Create; constructor Create;
protected protected
@ -95,8 +101,37 @@ type
procedure CleanUp; procedure CleanUp;
end; end;
function CompareWorldItems(AItem1, AItem2: Pointer): Integer;
implementation 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 } { TWorldItem }
constructor TWorldItem.Create(AOwner: TWorldBlock); constructor TWorldItem.Create(AOwner: TWorldBlock);