diff --git a/Client/ULandscape.pas b/Client/ULandscape.pas index 13f21dc..25c6585 100644 --- a/Client/ULandscape.pas +++ b/Client/ULandscape.pas @@ -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; diff --git a/Client/UdmNetwork.lfm b/Client/UdmNetwork.lfm index 95651be..fd42dc9 100644 --- a/Client/UdmNetwork.lfm +++ b/Client/UdmNetwork.lfm @@ -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 diff --git a/Client/UdmNetwork.pas b/Client/UdmNetwork.pas index fdfe951..9995477 100644 --- a/Client/UdmNetwork.pas +++ b/Client/UdmNetwork.pas @@ -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); diff --git a/Client/UfrmMain.lfm b/Client/UfrmMain.lfm index 0c06a15..a634d80 100644 --- a/Client/UfrmMain.lfm +++ b/Client/UfrmMain.lfm @@ -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 diff --git a/Client/UfrmMain.pas b/Client/UfrmMain.pas index 8f6ac21..e33ff23 100644 --- a/Client/UfrmMain.pas +++ b/Client/UfrmMain.pas @@ -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 diff --git a/UCacheManager.pas b/UCacheManager.pas index 48b83a4..41e97d1 100644 --- a/UCacheManager.pas +++ b/UCacheManager.pas @@ -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. + diff --git a/UOLib/UStatics.pas b/UOLib/UStatics.pas index f243ab5..1c10e5e 100644 --- a/UOLib/UStatics.pas +++ b/UOLib/UStatics.pas @@ -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. diff --git a/UOLib/UWorldItem.pas b/UOLib/UWorldItem.pas index 5cdd412..4e4fea3 100644 --- a/UOLib/UWorldItem.pas +++ b/UOLib/UWorldItem.pas @@ -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);