- Changed TWorldItem and TWorldBlock Change-tracking

- Reverted TStaticItem.UpdatePriorities
- Fixed vdtTiles' HintCanvas to use the desired font when drawing
- Fixed UpdateFilter to no longer call ForceUpdateCurrentTile
- Several code cleanups
This commit is contained in:
Andreas Schneider 2009-12-23 16:39:24 +01:00
parent 34b62f6cd0
commit cf4c155858
8 changed files with 4915 additions and 5013 deletions

View File

@ -6,12 +6,12 @@
<Flags>
<MainUnitHasUsesSectionForAllUnits Value="False"/>
<AlwaysBuild Value="False"/>
<LRSInOutputDirectory Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<TargetFileExt Value=".exe"/>
<Title Value="CentrED"/>
<LFMResourceType Value="res"/>
<Icon Value="0"/>
</General>
<LazDoc Paths="../doc"/>

View File

@ -5,7 +5,7 @@ object frmMain: TfrmMain
Width = 755
ActiveControl = oglGameWindow
Caption = 'UO CentrED'
ClientHeight = 556
ClientHeight = 559
ClientWidth = 755
Constraints.MinHeight = 500
Constraints.MinWidth = 750
@ -23,7 +23,7 @@ object frmMain: TfrmMain
object pnlBottom: TPanel
Left = 0
Height = 31
Top = 525
Top = 528
Width = 755
Align = alBottom
BevelOuter = bvNone
@ -34,7 +34,7 @@ object frmMain: TfrmMain
Left = 11
Height = 14
Top = 7
Width = 11
Width = 10
Caption = 'X:'
ParentColor = False
end
@ -42,7 +42,7 @@ object frmMain: TfrmMain
Left = 88
Height = 14
Top = 7
Width = 10
Width = 9
Caption = 'Y:'
ParentColor = False
end
@ -55,10 +55,10 @@ object frmMain: TfrmMain
ParentColor = False
end
object lblTip: TLabel
Left = 517
Left = 523
Height = 31
Top = 0
Width = 230
Width = 224
Align = alRight
Alignment = taRightJustify
BorderSpacing.Right = 8
@ -67,10 +67,10 @@ object frmMain: TfrmMain
ParentColor = False
end
object lblTipC: TLabel
Left = 487
Left = 500
Height = 31
Top = 0
Width = 30
Width = 23
Align = alRight
Caption = 'Tip: '
Font.Height = -11
@ -81,7 +81,7 @@ object frmMain: TfrmMain
end
object edX: TSpinEdit
Left = 24
Height = 19
Height = 21
Top = 3
Width = 55
MaxValue = 100000
@ -89,7 +89,7 @@ object frmMain: TfrmMain
end
object edY: TSpinEdit
Left = 104
Height = 19
Height = 21
Top = 3
Width = 52
MaxValue = 100000
@ -108,7 +108,7 @@ object frmMain: TfrmMain
end
object pcLeft: TPageControl
Left = 0
Height = 501
Height = 504
Top = 24
Width = 224
ActivePage = tsTiles
@ -117,13 +117,13 @@ object frmMain: TfrmMain
TabOrder = 1
object tsTiles: TTabSheet
Caption = 'Tiles'
ClientHeight = 468
ClientWidth = 218
ClientHeight = 478
ClientWidth = 216
object lblFilter: TLabel
AnchorSideLeft.Control = cbTerrain
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = cbTerrain
Left = 81
Left = 75
Height = 14
Top = 8
Width = 30
@ -140,10 +140,10 @@ object frmMain: TfrmMain
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = spTileList
Left = 4
Height = 218
Height = 234
Hint = '-'
Top = 56
Width = 210
Top = 50
Width = 208
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 4
BorderSpacing.Top = 4
@ -197,13 +197,13 @@ object frmMain: TfrmMain
AnchorSideBottom.Side = asrBottom
Left = 0
Height = 189
Top = 279
Width = 218
Top = 289
Width = 216
Align = alBottom
Anchors = [akTop, akLeft, akRight, akBottom]
Caption = 'Random pool'
ClientHeight = 175
ClientWidth = 216
ClientHeight = 171
ClientWidth = 212
TabOrder = 1
object btnAddRandom: TSpeedButton
AnchorSideLeft.Control = gbRandom
@ -363,10 +363,10 @@ object frmMain: TfrmMain
object btnRandomPresetSave: TSpeedButton
AnchorSideTop.Control = cbRandomPreset
AnchorSideRight.Control = btnRandomPresetDelete
Left = 164
Left = 160
Height = 22
Hint = 'Save Preset'
Top = 142
Top = 146
Width = 22
Anchors = [akTop, akRight]
BorderSpacing.Right = 4
@ -417,10 +417,10 @@ object frmMain: TfrmMain
AnchorSideTop.Control = btnRandomPresetSave
AnchorSideRight.Control = gbRandom
AnchorSideRight.Side = asrBottom
Left = 190
Left = 186
Height = 22
Hint = 'Delete Preset'
Top = 142
Top = 146
Width = 22
Anchors = [akTop, akRight]
BorderSpacing.Right = 4
@ -477,9 +477,9 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = cbRandomPreset
Cursor = 63
Left = 4
Height = 114
Height = 118
Top = 24
Width = 208
Width = 204
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 4
BorderSpacing.Top = 2
@ -525,14 +525,14 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = gbRandom
AnchorSideBottom.Side = asrBottom
Left = 4
Height = 29
Top = 142
Width = 156
Height = 21
Top = 146
Width = 152
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 4
BorderSpacing.Right = 4
BorderSpacing.Bottom = 4
ItemHeight = 0
ItemHeight = 13
OnChange = cbRandomPresetChange
Sorted = True
Style = csDropDownList
@ -546,8 +546,8 @@ object frmMain: TfrmMain
Cursor = crVSplit
Left = 0
Height = 5
Top = 274
Width = 218
Top = 284
Width = 216
Align = alNone
Anchors = [akLeft, akRight, akBottom]
ResizeAnchor = akBottom
@ -557,10 +557,10 @@ object frmMain: TfrmMain
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = vdtTiles
AnchorSideBottom.Side = asrBottom
Left = 110
Height = 19
Left = 108
Height = 21
Hint = 'Append S or T to restrict the search to Statics or Terrain.'
Top = 247
Top = 255
Width = 96
Anchors = [akRight, akBottom]
BorderSpacing.Right = 8
@ -579,10 +579,10 @@ object frmMain: TfrmMain
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = tsTiles
AnchorSideRight.Side = asrBottom
Left = 81
Height = 19
Left = 75
Height = 21
Top = 22
Width = 121
Width = 125
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Right = 16
OnEditingDone = edFilterEditingDone
@ -593,10 +593,10 @@ object frmMain: TfrmMain
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = cbTerrain
AnchorSideTop.Side = asrBottom
Left = 4
Height = 22
Top = 30
Width = 60
Left = 5
Height = 19
Top = 27
Width = 53
Caption = 'Statics'
Checked = True
OnChange = cbStaticsChange
@ -607,9 +607,9 @@ object frmMain: TfrmMain
AnchorSideLeft.Control = tsTiles
AnchorSideTop.Control = tsTiles
Left = 4
Height = 22
Height = 19
Top = 8
Width = 61
Width = 55
BorderSpacing.Left = 4
BorderSpacing.Top = 8
Caption = 'Terrain'
@ -621,26 +621,25 @@ object frmMain: TfrmMain
end
object tsClients: TTabSheet
Caption = 'Clients'
ClientHeight = 468
ClientWidth = 218
ClientHeight = 478
ClientWidth = 216
object lbClients: TListBox
Left = 0
Height = 468
Height = 478
Top = 0
Width = 218
Width = 216
Align = alClient
ItemHeight = 0
OnDblClick = mnuGoToClientClick
PopupMenu = pmClients
Sorted = True
TabOrder = 0
TopIndex = -1
end
end
object tsLocations: TTabSheet
Caption = 'Locations'
ClientHeight = 468
ClientWidth = 218
ClientHeight = 478
ClientWidth = 216
object btnClearLocations: TSpeedButton
AnchorSideLeft.Control = btnDeleteLocation
AnchorSideLeft.Side = asrBottom
@ -648,7 +647,7 @@ object frmMain: TfrmMain
Left = 125
Height = 22
Hint = 'Clear'
Top = 442
Top = 452
Width = 23
BorderSpacing.Left = 4
Color = clBtnFace
@ -701,7 +700,7 @@ object frmMain: TfrmMain
Left = 98
Height = 22
Hint = 'Delete'
Top = 442
Top = 452
Width = 23
Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 4
@ -753,7 +752,7 @@ object frmMain: TfrmMain
Left = 71
Height = 22
Hint = 'Add'
Top = 442
Top = 452
Width = 23
Anchors = [akTop, akRight]
BorderSpacing.Right = 4
@ -807,9 +806,9 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = btnDeleteLocation
Cursor = 63
Left = 4
Height = 434
Height = 444
Top = 4
Width = 210
Width = 208
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Around = 4
DefaultText = 'Node'
@ -823,7 +822,7 @@ object frmMain: TfrmMain
item
Position = 1
Text = 'Name'
Width = 135
Width = 133
end>
Header.DefaultHeight = 17
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible]
@ -1036,7 +1035,7 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = spChat
Left = 224
Height = 22
Top = 389
Top = 392
Width = 531
Anchors = [akLeft, akRight, akBottom]
BevelInner = bvRaised
@ -1049,7 +1048,7 @@ object frmMain: TfrmMain
Left = 10
Height = 18
Top = 2
Width = 104
Width = 101
Align = alLeft
BorderSpacing.Left = 8
Caption = 'Chat and Messages'
@ -1070,7 +1069,7 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = pnlBottom
Left = 224
Height = 109
Top = 416
Top = 419
Width = 531
Anchors = [akTop, akLeft, akRight, akBottom]
BevelOuter = bvNone
@ -1081,7 +1080,7 @@ object frmMain: TfrmMain
object vstChat: TVirtualStringTree
Cursor = 63
Left = 0
Height = 90
Height = 88
Top = 0
Width = 531
Align = alClient
@ -1119,8 +1118,8 @@ object frmMain: TfrmMain
end
object edChat: TEdit
Left = 0
Height = 19
Top = 90
Height = 21
Top = 88
Width = 531
Align = alBottom
OnKeyPress = edChatKeyPress
@ -1135,7 +1134,7 @@ object frmMain: TfrmMain
Cursor = crVSplit
Left = 224
Height = 5
Top = 411
Top = 414
Width = 531
Align = alNone
Anchors = [akLeft, akRight, akBottom]
@ -1152,7 +1151,7 @@ object frmMain: TfrmMain
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = pnlChatHeader
Left = 224
Height = 365
Height = 368
Top = 24
Width = 531
Anchors = [akTop, akLeft, akRight, akBottom]

View File

@ -1285,7 +1285,6 @@ procedure TfrmMain.edSearchIDExit(Sender: TObject);
begin
edSearchID.Visible := False;
edSearchID.Text := '';
//edSearchID.Font.Color := clWindowText;
end;
procedure TfrmMain.edSearchIDKeyPress(Sender: TObject; var Key: char);
@ -1316,7 +1315,6 @@ begin
tileID := 0;
if not TryStrToInt(enteredText, tileID) then
begin
//edSearchID.Font.Color := clRed;
MessageDlg('Error', 'The specified TileID is invalid.', mtError, [mbOK], 0);
vdtTiles.SetFocus;
Exit;
@ -1341,18 +1339,15 @@ begin
if node = nil then
begin
//edSearchID.Font.Color := clRed;
MessageDlg('Error', 'The tile with the specified ID could not be found.' +
LineEnding + 'Check for conflicting filter settings.', mtError, [mbOK], 0);
vdtTiles.SetFocus;
Exit;
end;
//edSearchID.Font.Color := clWindowText;
edSearchID.Visible := False;
end else if Key = #27 then
begin
edSearchID.Visible := False;
//edSearchID.Font.Color := clWindowText;
Key := #0;
end else if not (Key in ['$', '0'..'9', 'a'..'f', 'A'..'F', 's', 'S',
't', 'T', #8]) then
@ -1549,15 +1544,6 @@ end;
procedure TfrmMain.vdtTilesClick(Sender: TObject);
begin
{if vdtTiles.GetFirstSelected <> nil then
begin
if not tbDrawTile.Down then
begin
frmDrawSettings.rbTileList.Checked := True;
tbDrawTileClick(Sender);
end else
ProcessToolState;
end;}
if acDraw.Checked then
ProcessToolState;
end;
@ -1566,6 +1552,7 @@ procedure TfrmMain.vdtTilesDrawHint(Sender: TBaseVirtualTree;
HintCanvas: TCanvas; Node: PVirtualNode; const R: TRect; Column: TColumnIndex
);
begin
HintCanvas.Font.Assign(Sender.Font);
HintCanvas.Font.Style := [fsBold];
DrawText(HintCanvas.Handle, PChar(FTileHint.Name), Length(FTileHint.Name),
FTileHint.NameRect, 0);
@ -1941,9 +1928,13 @@ begin
lblTileInfo.Caption := Format('Terrain TileID: $%x, X: %d, Y: %d, Z: %d',
[FCurrentTile.TileID, FCurrentTile.X, FCurrentTile.Y, FCurrentTile.Z])
else if FCurrentTile is TStaticItem then
lblTileInfo.Caption := Format('Static TileID: $%x, X: %d, Y: %d, Z: %d, Hue: $%x',
{lblTileInfo.Caption := Format('Static TileID: $%x, X: %d, Y: %d, Z: %d, Hue: $%x',
[FCurrentTile.TileID, FCurrentTile.X, FCurrentTile.Y, FCurrentTile.Z,
TStaticItem(FCurrentTile).Hue]);
TStaticItem(FCurrentTile).Hue]);}
lblTileInfo.Caption := Format('Static TileID: $%x, X: %d, Y: %d, Z: %d, Hue: $%x, Priority: %d, Bonus: %d, Solver: %d',
[FCurrentTile.TileID, FCurrentTile.X, FCurrentTile.Y, FCurrentTile.Z,
TStaticItem(FCurrentTile).Hue, FCurrentTile.Priority, FCurrentTile.PriorityBonus,
FCurrentTile.PrioritySolver]);
end;
UpdateSelection;
@ -2446,7 +2437,8 @@ end;
procedure TfrmMain.OnMapChanged(AMapCell: TMapCell);
begin
PrepareMapCell(AMapCell);
InvalidateFilter;
ForceUpdateCurrentTile;
InvalidateFilter
end;
procedure TfrmMain.OnNewBlock(ABlock: TBlock);
@ -2457,9 +2449,9 @@ end;
procedure TfrmMain.OnStaticDeleted(AStaticItem: TStaticItem);
begin
FScreenBuffer.Delete(AStaticItem);
UpdateCurrentTile;
FRepaintNeeded := True;
ForceUpdateCurrentTile;
InvalidateFilter
end;
procedure TfrmMain.OnStaticElevated(AStaticItem: TStaticItem);
@ -2472,7 +2464,8 @@ begin
begin
PrepareScreenBlock(blockInfo);
Exclude(FScreenBufferState, sbsIndexed);
InvalidateFilter;
ForceUpdateCurrentTile;
InvalidateFilter
end;
end;
@ -2487,7 +2480,7 @@ begin
begin
PrepareScreenBlock(blockInfo);
FRepaintNeeded := True;
InvalidateFilter;
ForceUpdateCurrentTile;
Break;
end;
end;
@ -2503,7 +2496,8 @@ begin
AStaticItem.PrioritySolver := FScreenBuffer.GetSerial;
PrepareScreenBlock(FScreenBuffer.Insert(AStaticItem));
FRepaintNeeded := True;
InvalidateFilter;
ForceUpdateCurrentTile;
InvalidateFilter
end;
end;
@ -2743,8 +2737,6 @@ begin
end;
Include(FScreenBufferState, sbsFiltered);
ForceUpdateCurrentTile;
if (FLightManager.LightLevel > 0) and not acFlat.Checked then
FLightManager.UpdateLightMap(FX + FLowOffsetX, FRangeX + 1, FY + FLowOffsetY,
FRangeY + 1, FScreenBuffer);

View File

@ -97,7 +97,6 @@ type
FRadarMap: TRadarMap;
FBlockCache: TBlockCache;
FBlockSubscriptions: TBlockSubscriptions;
procedure OnBlockChanged(ABlock: TMulBlock);
procedure OnRemoveCachedObject(ABlock: TBlock);
function GetMapCell(AX, AY: Word): TMapCell;
function GetStaticList(AX, AY: Word): TStaticItemList;
@ -494,11 +493,6 @@ begin
Result := (west + east) div 2;
end;
procedure TLandscape.OnBlockChanged(ABlock: TMulBlock);
begin
// Do nothing for now
end;
procedure TLandscape.OnRemoveCachedObject(ABlock: TBlock);
begin
if ABlock <> nil then
@ -544,12 +538,10 @@ var
begin
FMap.Position := ((AX * FHeight) + AY) * 196;
map := TMapBlock.Create(FMap, AX, AY);
map.OnChanged := @OnBlockChanged;
FStaIdx.Position := ((AX * FHeight) + AY) * 12;
index := TGenericIndex.Create(FStaIdx);
statics := TSeperatedStaticBlock.Create(FStatics, index, AX, AY);
statics.OnChanged := @OnBlockChanged;
statics.TiledataProvider := FTiledataProvider;
index.Free;
@ -573,9 +565,7 @@ begin
begin
FMap.Position := ((AWorldBlock.X * FHeight) + AWorldBlock.Y) * 196;
AWorldBlock.Write(FMap);
for i := 0 to 63 do
TMapBlock(AWorldBlock).Cells[i].InitOriginalState;
AWorldBlock.CleanUp;
AWorldBlock.Changed := False;
end else if AWorldBlock is TStaticBlock then
begin
FStaIdx.Position := ((AWorldBlock.X * FHeight) + AWorldBlock.Y) * 12;
@ -597,10 +587,7 @@ begin
FStaIdx.Seek(-12, soFromCurrent);
index.Write(FStaIdx);
index.Free;
for i := 0 to 63 do
for j := 0 to TSeperatedStaticBlock(AWorldBlock).Cells[i].Count - 1 do
TStaticItem(TSeperatedStaticBlock(AWorldBlock).Cells[i].Items[j]).InitOriginalState;
AWorldBlock.CleanUp;
AWorldBlock.Changed := False;
end;
end;

View File

@ -4,6 +4,7 @@
<Version Value="7"/>
<General>
<Flags>
<MainUnitHasUsesSectionForAllUnits Value="False"/>
<LRSInOutputDirectory Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
@ -138,15 +139,14 @@
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<Optimizations>
<OptimizationLevel Value="3"/>
<OptimizationLevel Value="0"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<UseLineInfoUnit Value="False"/>
<StripSymbols Value="True"/>
<GenerateDebugInfo Value="True"/>
<UseHeaptrc Value="True"/>
</Debugging>
<LinkSmart Value="True"/>
</Linking>
<Other>
<CustomOptions Value="-FE../bin/

View File

@ -107,8 +107,6 @@ begin
end;
FIsGhost := False;
InitOriginalState;
end;
constructor TMapCell.Create(AOwner: TWorldBlock; AData: TStream);

View File

@ -42,11 +42,9 @@ type
protected
{ Members }
FHue: Word;
FOrgHue: Word;
{ Methods }
function HasChanged: Boolean; override;
procedure SetHue(AHue: Word);
procedure SetHue(AValue: Word);
public
{ Fields }
property Hue: Word read FHue write SetHue;
@ -54,7 +52,6 @@ type
{ Methods }
function Clone: TStaticItem; override;
function GetSize: Integer; override;
procedure InitOriginalState; override;
procedure UpdatePriorities(ATileData: TStaticTiledata; ASolver: Integer);
procedure Write(AData: TStream); override;
end;
@ -112,8 +109,6 @@ begin
FX := ABlockX * 8 + iX;
FY := ABlockY * 8 + iY;
end;
InitOriginalState;
end;
constructor TStaticItem.Create(AOwner: TWorldBlock; AData: TStream);
@ -121,14 +116,12 @@ begin
Create(AOwner, AData, 0, 0);
end;
function TStaticItem.HasChanged: Boolean;
procedure TStaticItem.SetHue(AValue: Word);
begin
Result := (FHue <> FOrgHue) or inherited HasChanged;
end;
if FHue = AValue then
Exit;
procedure TStaticItem.SetHue(AHue: Word);
begin
FHue := AHue;
FHue := AValue;
DoChanged;
end;
@ -147,17 +140,13 @@ begin
Result := 7;
end;
procedure TStaticItem.InitOriginalState;
begin
FOrgHue := FHue;
inherited InitOriginalState;
end;
procedure TStaticItem.UpdatePriorities(ATileData: TStaticTiledata;
ASolver: Integer);
begin
FPriorityBonus := 0;
if not (tdfBackground in ATileData.Flags) or (ATileData.Height > 0) then
if not (tdfBackground in ATileData.Flags) then
Inc(FPriorityBonus);
if ATileData.Height > 0 then
Inc(FPriorityBonus);
FPriority := Z + FPriorityBonus;
FPrioritySolver := ASolver;

View File

@ -40,33 +40,30 @@ type
TWorldItem = class(TMulBlock)
constructor Create(AOwner: TWorldBlock);
protected
FOwner, FOrgOwner: TWorldBlock;
FTileID, FOrgTileID: Word;
FX, FOrgX: Word;
FY, FOrgY: Word;
FZ, FOrgZ: ShortInt;
FOwner: TWorldBlock;
FTileID: Word;
FX: Word;
FY: Word;
FZ: ShortInt;
FSelected: Boolean;
FCanBeEdited: Boolean;
FLocked: Boolean;
FChanged: Boolean;
FPriority: Integer;
FPriorityBonus: ShortInt;
FPrioritySolver: Integer;
procedure DoChanged;
function GetTileID: Word; virtual;
function GetZ: ShortInt; virtual;
procedure SetTileID(ATileID: Word);
procedure SetX(AX: Word);
procedure SetY(AY: Word);
procedure SetZ(AZ: ShortInt);
procedure SetSelected(ASelected: Boolean);
procedure SetOwner(AOwner: TWorldBlock);
procedure SetLocked(ALocked: Boolean);
procedure DoChanged;
function HasChanged: Boolean; virtual;
procedure SetOwner(AOwner: TWorldBlock);
procedure SetSelected(ASelected: Boolean);
procedure SetTileID(AValue: Word);
procedure SetX(AValue: Word);
procedure SetY(AValue: Word);
procedure SetZ(AValue: ShortInt);
public
procedure UpdatePos(AX, AY: Word; AZ: ShortInt);
procedure Delete;
procedure InitOriginalState; virtual;
property Owner: TWorldBlock read FOwner write SetOwner;
property TileID: Word read GetTileID write SetTileID;
@ -76,7 +73,6 @@ type
property Selected: Boolean read FSelected write SetSelected;
property CanBeEdited: Boolean read FCanBeEdited write FCanBeEdited;
property Locked: Boolean read FLocked write SetLocked;
property Changed: Boolean read FChanged;
property Priority: Integer read FPriority write FPriority;
property PriorityBonus: ShortInt read FPriorityBonus write FPriorityBonus;
property PrioritySolver: Integer read FPrioritySolver write FPrioritySolver;
@ -95,18 +91,14 @@ type
FX: Word;
FY: Word;
FRefCount: Integer;
FChanges: Integer;
function GetChanged: Boolean;
procedure SetChanged(AChanged: Boolean);
procedure DoStateChanged;
FChanged: Boolean;
public
property X: Word read FX write FX;
property Y: Word read FY write FY;
property RefCount: Integer read FRefCount;
property Changed: Boolean read GetChanged write SetChanged;
property Changed: Boolean read FChanged write FChanged;
procedure AddRef;
procedure RemoveRef;
procedure CleanUp;
end;
TVirtualTile = class(TWorldItem);
@ -139,9 +131,6 @@ begin
Result := 1;
end;
if Result = 0 then
Result := AItem1.PriorityBonus - AItem2.PriorityBonus;
if Result = 0 then
Result := AItem1.PrioritySolver - AItem2.PrioritySolver;
end;
@ -153,10 +142,15 @@ begin
inherited Create;
FSelected := False;
FLocked := False;
FChanged := False;
FOwner := AOwner;
end;
procedure TWorldItem.DoChanged;
begin
if FOwner <> nil then
FOwner.Changed := True;
end;
function TWorldItem.GetTileID: Word;
begin
Result := FTileID;
@ -171,44 +165,6 @@ procedure TWorldItem.Delete;
begin
SetSelected(False);
SetLocked(False);
if (FOwner <> FOrgOwner) then
FOwner.Changed := False
else if Assigned(FOrgOwner) and (not FChanged) then
FOrgOwner.Changed := True;
end;
procedure TWorldItem.DoChanged;
var
blockChanged: Boolean;
begin
blockChanged := HasChanged;
if Assigned(FOwner) then
begin
if FChanged and (not blockChanged) then
FOwner.Changed := False
else if (not FChanged) and blockChanged then
FOwner.Changed := True;
end;
FChanged := blockChanged;
if Assigned(FOnChanged) then
FOnChanged(Self);
end;
function TWorldItem.HasChanged: Boolean;
begin
Result := (FX <> FOrgX) or (FY <> FOrgY) or (FZ <> FOrgZ) or
(FTileID <> FOrgTileID) or (FOrgOwner <> FOwner);
end;
procedure TWorldItem.InitOriginalState;
begin
{if Assigned(FOrgOwner) and (FOwner <> FOrgOwner) then
FOrgOwner.Changed := False;}
FOrgOwner := FOwner;
FOrgTileID := FTileID;
FOrgX := FX;
FOrgY := FY;
FOrgZ := FZ;
DoChanged;
end;
@ -217,7 +173,7 @@ begin
if FLocked <> ALocked then
begin
FLocked := ALocked;
if Assigned(FOwner) then
if FOwner <> nil then
if FLocked then
FOwner.AddRef
else
@ -229,22 +185,19 @@ procedure TWorldItem.SetOwner(AOwner: TWorldBlock);
begin
if FOwner <> AOwner then
begin
if Assigned(FOwner) then
if FOwner <> nil then
begin
if FOwner <> FOrgOwner then
FOwner.Changed := False;
FOwner.Changed := True;
if FLocked then FOwner.RemoveRef;
if FSelected then FOwner.RemoveRef;
end;
FOwner := AOwner;
if Assigned(FOwner) then
if FOwner <> nil then
begin
if FOwner <> FOrgOwner then
FOwner.Changed := True;
if FLocked then FOwner.AddRef;
if FSelected then FOwner.AddRef;
end;
DoChanged;
end;
end;
@ -258,27 +211,39 @@ begin
FSelected := ASelected;
end;
procedure TWorldItem.SetTileID(ATileID: Word);
procedure TWorldItem.SetTileID(AValue: Word);
begin
FTileID := ATileID;
if FTileID = AValue then
Exit;
FTileID := AValue;
DoChanged;
end;
procedure TWorldItem.SetX(AX: Word);
procedure TWorldItem.SetX(AValue: Word);
begin
FX := AX;
if FX = AValue then
Exit;
FX := AValue;
DoChanged;
end;
procedure TWorldItem.SetY(AY: Word);
procedure TWorldItem.SetY(AValue: Word);
begin
FY := AY;
DoChanged
if FY = AValue then
Exit;
FY := AValue;
DoChanged;
end;
procedure TWorldItem.SetZ(AZ: ShortInt);
procedure TWorldItem.SetZ(AValue: ShortInt);
begin
FZ := AZ;
if FZ = AValue then
Exit;
FZ := AValue;
DoChanged;
end;
@ -295,47 +260,19 @@ end;
procedure TWorldBlock.AddRef;
begin
Inc(FRefCount);
DoStateChanged;
end;
procedure TWorldBlock.CleanUp;
begin
FChanges := 0;
DoStateChanged;
end;
constructor TWorldBlock.Create;
begin
inherited Create;
FRefCount := 0;
FChanges := 0;
end;
procedure TWorldBlock.DoStateChanged;
begin
if Assigned(FOnChanged) then
FOnChanged(Self);
end;
function TWorldBlock.GetChanged: Boolean;
begin
Result := (FChanges <> 0);
FChanged := False;
end;
procedure TWorldBlock.RemoveRef;
begin
if FRefCount > 0 then
Dec(FRefCount);
DoStateChanged;
end;
procedure TWorldBlock.SetChanged(AChanged: Boolean);
begin
if AChanged then
Inc(FChanges)
else
Dec(FChanges);
DoStateChanged;
end;
end.