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

- Changed TWorldItem and TWorldBlock Change-tracking

Browse Source 
- 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
Download Patch File Download Diff File Expand all files Collapse all files

442
UOLib/UMap.pas
View File

@@ -1,222 +1,220 @@
(*
* 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 UMap;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes, fgl, UWorldItem;
const
MapCellSize = 3;
MapBlockSize = 4 + (64 * MapCellSize);
type
{ TMapCell }
TMapCell = class(TWorldItem)
constructor Create(AOwner: TWorldBlock; AData: TStream; AX, AY: Word); overload;
constructor Create(AOwner: TWorldBlock; AData: TStream); overload;
protected
FIsGhost: Boolean;
FGhostZ: ShortInt;
FGhostID: Word;
function GetTileID: Word; override;
function GetZ: ShortInt; override;
public
property Altitude: ShortInt read GetZ write SetZ;
property IsGhost: Boolean read FIsGhost write FIsGhost;
property GhostZ: ShortInt read FGhostZ write FGhostZ;
property GhostID: Word write FGhostID;
function Clone: TMapCell; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
end;
TMapCellList = specialize TFPGObjectList<TMapCell>;
{ TMapBlock }
TMapBlock = class(TWorldBlock)
constructor Create(AData: TStream; AX, AY: Word); overload;
constructor Create(AData: TStream); overload;
destructor Destroy; override;
protected
FHeader: LongInt;
public
Cells: array[0..63] of TMapCell;
property Header: LongInt read FHeader write FHeader;
function Clone: TMapBlock; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
end;
function GetMapCellOffset(ABlock: Integer): Integer;
implementation
function GetMapCellOffset(ABlock: Integer): Integer;
var
group, tile: Integer;
begin
group := ABlock div 64;
tile := ABlock mod 64;
Result := group * MapBlockSize + 4 + tile * MapCellSize;
end;
{ TMapCell }
constructor TMapCell.Create(AOwner: TWorldBlock; AData: TStream; AX, AY: Word);
begin
inherited Create(AOwner);
FX := AX;
FY := AY;
if AData <> nil then
begin
AData.Read(FTileID, SizeOf(Word));
AData.Read(FZ, SizeOf(ShortInt));
end;
FIsGhost := False;
InitOriginalState;
end;
constructor TMapCell.Create(AOwner: TWorldBlock; AData: TStream);
begin
Create(AOwner, AData, 0, 0);
end;
function TMapCell.GetTileID: Word;
begin
if FIsGhost then
Result := FGhostID
else
Result := FTileID;
end;
function TMapCell.GetZ: ShortInt;
begin
if FIsGhost then
Result := FGhostZ
else
Result := FZ;
end;
function TMapCell.Clone: TMapCell;
begin
Result := TMapCell.Create(nil, nil);
Result.FX := FX;
Result.FY := FY;
Result.FZ := FZ;
Result.FTileID := FTileID;
end;
procedure TMapCell.Write(AData: TStream);
begin
AData.Write(FTileID, SizeOf(Word));
AData.Write(FZ, SizeOf(ShortInt));
end;
function TMapCell.GetSize: Integer;
begin
Result := MapCellSize;
end;
{ TMapBlock }
constructor TMapBlock.Create(AData: TStream; AX, AY: Word);
var
iX, iY: Integer;
buffer: TMemoryStream;
begin
inherited Create;
FX := AX;
FY := AY;
try
buffer := nil;
if Assigned(AData) then
begin
buffer := TMemoryStream.Create;
buffer.CopyFrom(AData, 196);
buffer.Position := 0;
buffer.Read(FHeader, SizeOf(LongInt));
end;
for iY := 0 to 7 do
for iX := 0 to 7 do
Cells[iY * 8 + iX] := TMapCell.Create(Self, buffer, AX * 8 + iX, AY * 8 + iY);
finally
if Assigned(buffer) then FreeAndNil(buffer);
end;
end;
constructor TMapBlock.Create(AData: TStream);
begin
Create(AData, 0, 0);
end;
destructor TMapBlock.Destroy;
var
i: Integer;
begin
for i := 0 to 63 do
Cells[i].Free;
inherited;
end;
function TMapBlock.Clone: TMapBlock;
var
i: Integer;
begin
Result := TMapBlock.Create(nil);
Result.FX := FX;
Result.FY := FY;
for i := 0 to 63 do
Result.Cells[i] := Cells[i].Clone;
end;
procedure TMapBlock.Write(AData: TStream);
var
i: Integer;
begin
AData.Write(FHeader, SizeOf(LongInt));
for i := 0 to 63 do
Cells[i].Write(AData);
end;
function TMapBlock.GetSize: Integer;
begin
Result := MapBlockSize;
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 UMap;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes, fgl, UWorldItem;
const
MapCellSize = 3;
MapBlockSize = 4 + (64 * MapCellSize);
type
{ TMapCell }
TMapCell = class(TWorldItem)
constructor Create(AOwner: TWorldBlock; AData: TStream; AX, AY: Word); overload;
constructor Create(AOwner: TWorldBlock; AData: TStream); overload;
protected
FIsGhost: Boolean;
FGhostZ: ShortInt;
FGhostID: Word;
function GetTileID: Word; override;
function GetZ: ShortInt; override;
public
property Altitude: ShortInt read GetZ write SetZ;
property IsGhost: Boolean read FIsGhost write FIsGhost;
property GhostZ: ShortInt read FGhostZ write FGhostZ;
property GhostID: Word write FGhostID;
function Clone: TMapCell; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
end;
TMapCellList = specialize TFPGObjectList<TMapCell>;
{ TMapBlock }
TMapBlock = class(TWorldBlock)
constructor Create(AData: TStream; AX, AY: Word); overload;
constructor Create(AData: TStream); overload;
destructor Destroy; override;
protected
FHeader: LongInt;
public
Cells: array[0..63] of TMapCell;
property Header: LongInt read FHeader write FHeader;
function Clone: TMapBlock; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
end;
function GetMapCellOffset(ABlock: Integer): Integer;
implementation
function GetMapCellOffset(ABlock: Integer): Integer;
var
group, tile: Integer;
begin
group := ABlock div 64;
tile := ABlock mod 64;
Result := group * MapBlockSize + 4 + tile * MapCellSize;
end;
{ TMapCell }
constructor TMapCell.Create(AOwner: TWorldBlock; AData: TStream; AX, AY: Word);
begin
inherited Create(AOwner);
FX := AX;
FY := AY;
if AData <> nil then
begin
AData.Read(FTileID, SizeOf(Word));
AData.Read(FZ, SizeOf(ShortInt));
end;
FIsGhost := False;
end;
constructor TMapCell.Create(AOwner: TWorldBlock; AData: TStream);
begin
Create(AOwner, AData, 0, 0);
end;
function TMapCell.GetTileID: Word;
begin
if FIsGhost then
Result := FGhostID
else
Result := FTileID;
end;
function TMapCell.GetZ: ShortInt;
begin
if FIsGhost then
Result := FGhostZ
else
Result := FZ;
end;
function TMapCell.Clone: TMapCell;
begin
Result := TMapCell.Create(nil, nil);
Result.FX := FX;
Result.FY := FY;
Result.FZ := FZ;
Result.FTileID := FTileID;
end;
procedure TMapCell.Write(AData: TStream);
begin
AData.Write(FTileID, SizeOf(Word));
AData.Write(FZ, SizeOf(ShortInt));
end;
function TMapCell.GetSize: Integer;
begin
Result := MapCellSize;
end;
{ TMapBlock }
constructor TMapBlock.Create(AData: TStream; AX, AY: Word);
var
iX, iY: Integer;
buffer: TMemoryStream;
begin
inherited Create;
FX := AX;
FY := AY;
try
buffer := nil;
if Assigned(AData) then
begin
buffer := TMemoryStream.Create;
buffer.CopyFrom(AData, 196);
buffer.Position := 0;
buffer.Read(FHeader, SizeOf(LongInt));
end;
for iY := 0 to 7 do
for iX := 0 to 7 do
Cells[iY * 8 + iX] := TMapCell.Create(Self, buffer, AX * 8 + iX, AY * 8 + iY);
finally
if Assigned(buffer) then FreeAndNil(buffer);
end;
end;
constructor TMapBlock.Create(AData: TStream);
begin
Create(AData, 0, 0);
end;
destructor TMapBlock.Destroy;
var
i: Integer;
begin
for i := 0 to 63 do
Cells[i].Free;
inherited;
end;
function TMapBlock.Clone: TMapBlock;
var
i: Integer;
begin
Result := TMapBlock.Create(nil);
Result.FX := FX;
Result.FY := FY;
for i := 0 to 63 do
Result.Cells[i] := Cells[i].Clone;
end;
procedure TMapBlock.Write(AData: TStream);
var
i: Integer;
begin
AData.Write(FHeader, SizeOf(LongInt));
for i := 0 to 63 do
Cells[i].Write(AData);
end;
function TMapBlock.GetSize: Integer;
begin
Result := MapBlockSize;
end;
end.

493
UOLib/UStatics.pas
View File

@@ -1,252 +1,241 @@
(*
* 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 UStatics;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes, fgl, 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;
protected
{ Members }
FHue: Word;
FOrgHue: Word;
{ Methods }
function HasChanged: Boolean; override;
procedure SetHue(AHue: Word);
public
{ Fields }
property Hue: Word read FHue write SetHue;
{ Methods }
function Clone: TStaticItem; override;
function GetSize: Integer; override;
procedure InitOriginalState; override;
procedure UpdatePriorities(ATileData: TStaticTiledata; ASolver: Integer);
procedure Write(AData: TStream); override;
end;
TStaticItemList = specialize TFPGObjectList<TStaticItem>;
{ TStaticBlock}
TStaticBlock = class(TWorldBlock)
constructor Create(AData: TStream; AIndex: TGenericIndex; AX, AY: Word);
overload;
constructor Create(AData: TStream; AIndex: TGenericIndex); overload;
destructor Destroy; override;
protected
{ Members }
FItems: TStaticItemList;
public
{ Fields }
property Items: TStaticItemList 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;
function CompareStaticItems(const AStatic1, AStatic2: TStaticItem): Integer;
implementation
function CompareStaticItems(const AStatic1, AStatic2: TStaticItem): Integer;
begin
Result := CompareWorldItems(AStatic1, AStatic2);
end;
{ TStaticItem }
constructor TStaticItem.Create(AOwner: TWorldBlock; AData: TStream; ABlockX,
ABlockY: Word);
var
iX, iY: Byte;
begin
inherited Create(AOwner);
if AData <> nil then
begin
AData.Read(FTileID, SizeOf(SmallInt));
AData.Read(iX, SizeOf(Byte));
AData.Read(iY, SizeOf(Byte));
AData.Read(FZ, SizeOf(ShortInt));
AData.Read(FHue, SizeOf(SmallInt));
FX := ABlockX * 8 + iX;
FY := ABlockY * 8 + iY;
end;
InitOriginalState;
end;
constructor TStaticItem.Create(AOwner: TWorldBlock; AData: TStream);
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);
Result.FTileID := FTileID;
Result.FX := FX;
Result.FY := FY;
Result.FZ := FZ;
Result.FHue := FHue;
end;
function TStaticItem.GetSize: Integer;
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
Inc(FPriorityBonus);
FPriority := Z + FPriorityBonus;
FPrioritySolver := ASolver;
end;
procedure TStaticItem.Write(AData: TStream);
var
iX, iY: Byte;
begin
iX := FX mod 8;
iY := FY mod 8;
AData.Write(FTileID, SizeOf(SmallInt));
AData.Write(iX, SizeOf(Byte));
AData.Write(iY, SizeOf(Byte));
AData.Write(FZ, SizeOf(ShortInt));
AData.Write(FHue, SizeOf(SmallInt));
end;
{ TStaticBlock }
constructor TStaticBlock.Create(AData: TStream; AIndex: TGenericIndex;
AX, AY: Word);
var
i: Integer;
block: TMemoryStream;
begin
inherited Create;
FX := AX;
FY := AY;
FItems := TStaticItemList.Create(True);
if (AData <> nil) and (AIndex.Lookup > 0) and (AIndex.Size > 0) then
begin
AData.Position := AIndex.Lookup;
block := TMemoryStream.Create;
block.CopyFrom(AData, AIndex.Size);
block.Position := 0;
for i := 1 to (AIndex.Size div 7) do
FItems.Add(TStaticItem.Create(Self, block, AX, AY));
block.Free;
end;
end;
constructor TStaticBlock.Create(AData: TStream; AIndex: TGenericIndex);
begin
Create(AData, AIndex, 0, 0);
end;
destructor TStaticBlock.Destroy;
begin
FreeAndNil(FItems);
inherited;
end;
function TStaticBlock.Clone: TStaticBlock;
var
i: Integer;
begin
Result := TStaticBlock.Create(nil, nil, FX, FY);
for i := 0 to FItems.Count - 1 do
Result.FItems.Add(FItems.Items[i].Clone);
end;
function TStaticBlock.GetSize: Integer;
begin
Result := FItems.Count * 7;
end;
procedure TStaticBlock.ReverseWrite(AData: TStream);
var
i: Integer;
begin
for i := FItems.Count - 1 downto 0 do
FItems[i].Write(AData);
end;
procedure TStaticBlock.Sort;
begin
FItems.Sort(@CompareStaticItems);
end;
procedure TStaticBlock.Write(AData: TStream);
var
i: Integer;
begin
for i := 0 to FItems.Count - 1 do
FItems[i].Write(AData);
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 UStatics;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes, fgl, 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;
protected
{ Members }
FHue: Word;
{ Methods }
procedure SetHue(AValue: Word);
public
{ Fields }
property Hue: Word read FHue write SetHue;
{ Methods }
function Clone: TStaticItem; override;
function GetSize: Integer; override;
procedure UpdatePriorities(ATileData: TStaticTiledata; ASolver: Integer);
procedure Write(AData: TStream); override;
end;
TStaticItemList = specialize TFPGObjectList<TStaticItem>;
{ TStaticBlock}
TStaticBlock = class(TWorldBlock)
constructor Create(AData: TStream; AIndex: TGenericIndex; AX, AY: Word);
overload;
constructor Create(AData: TStream; AIndex: TGenericIndex); overload;
destructor Destroy; override;
protected
{ Members }
FItems: TStaticItemList;
public
{ Fields }
property Items: TStaticItemList 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;
function CompareStaticItems(const AStatic1, AStatic2: TStaticItem): Integer;
implementation
function CompareStaticItems(const AStatic1, AStatic2: TStaticItem): Integer;
begin
Result := CompareWorldItems(AStatic1, AStatic2);
end;
{ TStaticItem }
constructor TStaticItem.Create(AOwner: TWorldBlock; AData: TStream; ABlockX,
ABlockY: Word);
var
iX, iY: Byte;
begin
inherited Create(AOwner);
if AData <> nil then
begin
AData.Read(FTileID, SizeOf(SmallInt));
AData.Read(iX, SizeOf(Byte));
AData.Read(iY, SizeOf(Byte));
AData.Read(FZ, SizeOf(ShortInt));
AData.Read(FHue, SizeOf(SmallInt));
FX := ABlockX * 8 + iX;
FY := ABlockY * 8 + iY;
end;
end;
constructor TStaticItem.Create(AOwner: TWorldBlock; AData: TStream);
begin
Create(AOwner, AData, 0, 0);
end;
procedure TStaticItem.SetHue(AValue: Word);
begin
if FHue = AValue then
Exit;
FHue := AValue;
DoChanged;
end;
function TStaticItem.Clone: TStaticItem;
begin
Result := TStaticItem.Create(nil, nil);
Result.FTileID := FTileID;
Result.FX := FX;
Result.FY := FY;
Result.FZ := FZ;
Result.FHue := FHue;
end;
function TStaticItem.GetSize: Integer;
begin
Result := 7;
end;
procedure TStaticItem.UpdatePriorities(ATileData: TStaticTiledata;
ASolver: Integer);
begin
FPriorityBonus := 0;
if not (tdfBackground in ATileData.Flags) then
Inc(FPriorityBonus);
if ATileData.Height > 0 then
Inc(FPriorityBonus);
FPriority := Z + FPriorityBonus;
FPrioritySolver := ASolver;
end;
procedure TStaticItem.Write(AData: TStream);
var
iX, iY: Byte;
begin
iX := FX mod 8;
iY := FY mod 8;
AData.Write(FTileID, SizeOf(SmallInt));
AData.Write(iX, SizeOf(Byte));
AData.Write(iY, SizeOf(Byte));
AData.Write(FZ, SizeOf(ShortInt));
AData.Write(FHue, SizeOf(SmallInt));
end;
{ TStaticBlock }
constructor TStaticBlock.Create(AData: TStream; AIndex: TGenericIndex;
AX, AY: Word);
var
i: Integer;
block: TMemoryStream;
begin
inherited Create;
FX := AX;
FY := AY;
FItems := TStaticItemList.Create(True);
if (AData <> nil) and (AIndex.Lookup > 0) and (AIndex.Size > 0) then
begin
AData.Position := AIndex.Lookup;
block := TMemoryStream.Create;
block.CopyFrom(AData, AIndex.Size);
block.Position := 0;
for i := 1 to (AIndex.Size div 7) do
FItems.Add(TStaticItem.Create(Self, block, AX, AY));
block.Free;
end;
end;
constructor TStaticBlock.Create(AData: TStream; AIndex: TGenericIndex);
begin
Create(AData, AIndex, 0, 0);
end;
destructor TStaticBlock.Destroy;
begin
FreeAndNil(FItems);
inherited;
end;
function TStaticBlock.Clone: TStaticBlock;
var
i: Integer;
begin
Result := TStaticBlock.Create(nil, nil, FX, FY);
for i := 0 to FItems.Count - 1 do
Result.FItems.Add(FItems.Items[i].Clone);
end;
function TStaticBlock.GetSize: Integer;
begin
Result := FItems.Count * 7;
end;
procedure TStaticBlock.ReverseWrite(AData: TStream);
var
i: Integer;
begin
for i := FItems.Count - 1 downto 0 do
FItems[i].Write(AData);
end;
procedure TStaticBlock.Sort;
begin
FItems.Sort(@CompareStaticItems);
end;
procedure TStaticBlock.Write(AData: TStream);
var
i: Integer;
begin
for i := 0 to FItems.Count - 1 do
FItems[i].Write(AData);
end;
end.

161
UOLib/UWorldItem.pas
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;
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;
function GetTileID: Word; virtual;
function GetZ: ShortInt; virtual;
procedure SetLocked(ALocked: Boolean);
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;
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.