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

- Added generic lists for world items, static items and map items

Browse Source 
- Added appropriate compare functions
- Some local cleanups
This commit is contained in:
Andreas Schneider
2009-12-02 19:14:00 +01:00
parent 8df2313b4d
commit 01e7b98a12
6 changed files with 269 additions and 268 deletions
Download Patch File Download Diff File Expand all files Collapse all files

372
UOLib/UMap.pas
View File

@@ -1,180 +1,192 @@
(*
* 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 UMap;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes, UMulBlock, UWorldItem;
const
MapCellSize = 3;
MapBlockSize = 4 + (64 * MapCellSize);
type
TMapCell = class(TWorldItem)
constructor Create(AOwner: TWorldBlock; AData: TStream; AX, AY: Word); overload;
constructor Create(AOwner: TWorldBlock; AData: TStream); overload;
function Clone: TMapCell; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
public
property Altitude: ShortInt read FZ write FZ;
end;
TMapBlock = class(TWorldBlock)
constructor Create(AData: TStream; AX, AY: Word); overload;
constructor Create(AData: TStream); overload;
destructor Destroy; override;
function Clone: TMapBlock; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
protected
FHeader: LongInt;
public
Cells: array[0..63] of TMapCell;
property Header: LongInt read FHeader write FHeader;
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;
constructor TMapCell.Create(AOwner: TWorldBlock; AData: TStream; AX, AY: Word);
begin
inherited Create(AOwner);
FX := AX;
FY := AY;
if assigned(AData) then
begin
AData.Read(FTileID, SizeOf(Word));
AData.Read(FZ, SizeOf(ShortInt));
end;
InitOriginalState;
end;
constructor TMapCell.Create(AOwner: TWorldBlock; AData: TStream);
begin
Create(AOwner, AData, 0, 0);
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;
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, UMulBlock, 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;
function Clone: TMapCell; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
public
property Altitude: ShortInt read FZ write FZ;
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;
function Clone: TMapBlock; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
protected
FHeader: LongInt;
public
Cells: array[0..63] of TMapCell;
property Header: LongInt read FHeader write FHeader;
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 assigned(AData) then
begin
AData.Read(FTileID, SizeOf(Word));
AData.Read(FZ, SizeOf(ShortInt));
end;
InitOriginalState;
end;
constructor TMapCell.Create(AOwner: TWorldBlock; AData: TStream);
begin
Create(AOwner, AData, 0, 0);
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.

41
UOLib/UStatics.pas
View File

@@ -30,7 +30,7 @@ unit UStatics;
interface
uses
SysUtils, Classes, UGenericIndex, UWorldItem, UTiledata;
SysUtils, Classes, fgl, UGenericIndex, UWorldItem, UTiledata;
type
{ TStaticItem }
@@ -58,6 +58,8 @@ type
procedure Write(AData: TStream); override;
end;
TStaticItemList = specialize TFPGObjectList<TStaticItem>;
{ TStaticBlock}
TStaticBlock = class(TWorldBlock)
@@ -66,10 +68,10 @@ type
destructor Destroy; override;
protected
{ Members }
FItems: TList;
FItems: TStaticItemList;
public
{ Fields }
property Items: TList read FItems write FItems;
property Items: TStaticItemList read FItems write FItems;
{ Methods }
function Clone: TStaticBlock; override;
@@ -79,8 +81,15 @@ type
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);
@@ -176,8 +185,8 @@ begin
FX := AX;
FY := AY;
FItems := TList.Create;
if assigned(AData) and (AIndex.Lookup > 0) and (AIndex.Size > 0) then
FItems := TStaticItemList.Create(True);
if (AData <> nil) and (AIndex.Lookup > 0) and (AIndex.Size > 0) then
begin
AData.Position := AIndex.Lookup;
block := TMemoryStream.Create;
@@ -198,17 +207,7 @@ destructor TStaticBlock.Destroy;
var
i: Integer;
begin
if Assigned(FItems) then
begin
for i := 0 to FItems.Count - 1 do
if Assigned(FItems[i]) then
begin
TStaticItem(FItems[i]).Free;
FItems[i] := nil;
end;
FItems.Free;
FItems := nil;
end;
FreeAndNil(FItems);
inherited;
end;
@@ -218,7 +217,7 @@ var
begin
Result := TStaticBlock.Create(nil, nil, FX, FY);
for i := 0 to FItems.Count - 1 do
Result.FItems.Add(TStaticItem(FItems.Items[i]).Clone);
Result.FItems.Add(FItems.Items[i].Clone);
end;
function TStaticBlock.GetSize: Integer;
@@ -231,14 +230,12 @@ var
i: Integer;
begin
for i := FItems.Count - 1 downto 0 do
begin
TStaticItem(FItems[i]).Write(AData);
end;
FItems[i].Write(AData);
end;
procedure TStaticBlock.Sort;
begin
FItems.Sort(@CompareWorldItems);
FItems.Sort(@CompareStaticItems);
end;
procedure TStaticBlock.Write(AData: TStream);
@@ -246,7 +243,7 @@ var
i: Integer;
begin
for i := 0 to FItems.Count - 1 do
TStaticItem(FItems[i]).Write(AData);
FItems[i].Write(AData);
end;
end.

32
UOLib/UWorldItem.pas
View File

@@ -21,7 +21,7 @@
* CDDL HEADER END
*
*
* Portions Copyright 2007 Andreas Schneider
* Portions Copyright 2009 Andreas Schneider
*)
unit UWorldItem;
@@ -30,7 +30,7 @@ unit UWorldItem;
interface
uses
Classes, UMulBlock;
Classes, fgl, UMulBlock;
type
TWorldBlock = class;
@@ -79,6 +79,8 @@ type
property PrioritySolver: Integer read FPrioritySolver write FPrioritySolver;
end;
TWorldItemList = specialize TFPGObjectList<TWorldItem>;
{ TWorldBlock }
TWorldBlock = class(TMulBlock)
@@ -103,39 +105,39 @@ type
TVirtualTile = class(TWorldItem);
function CompareWorldItems(AItem1, AItem2: Pointer): Integer;
function CompareWorldItems(const AItem1, AItem2: TWorldItem): Integer;
implementation
uses
UMap, UStatics;
function CompareWorldItems(AItem1, AItem2: Pointer): Integer;
function CompareWorldItems(const AItem1, AItem2: TWorldItem): Integer;
begin
if TWorldItem(AItem1).X <> TWorldItem(AItem2).X then
Exit(TWorldItem(AItem1).X - TWorldItem(AItem2).X);
if AItem1.X <> AItem2.X then
Exit(AItem1.X - AItem2.X);
if TWorldItem(AItem1).Y <> TWorldItem(AItem2).Y then
Exit(TWorldItem(AItem1).Y - TWorldItem(AItem2).Y);
if AItem1.Y <> AItem2.Y then
Exit(AItem1.Y - AItem2.Y);
Result := TWorldItem(AItem1).Priority - TWorldItem(AItem2).Priority;
Result := AItem1.Priority - AItem2.Priority;
if Result = 0 then
begin
if (TObject(AItem1) is TMapCell) and (TObject(AItem2) is TStaticItem) then
if (AItem1 is TMapCell) and (AItem2 is TStaticItem) then
Result := -1
else if (TObject(AItem1) is TStaticItem) and (TObject(AItem2) is TMapCell) then
else if (AItem1 is TStaticItem) and (AItem2 is TMapCell) then
Result := 1
else if (TObject(AItem1) is TMapCell) and (TObject(AItem2) is TVirtualTile) then
else if (AItem1 is TMapCell) and (AItem2 is TVirtualTile) then
Result := -1
else if (TObject(AItem1) is TVirtualTile) and (TObject(AItem2) is TMapCell) then
else if (AItem1 is TVirtualTile) and (AItem2 is TMapCell) then
Result := 1;
end;
if Result = 0 then
Result := TWorldItem(AItem1).PriorityBonus - TWorldItem(AItem2).PriorityBonus;
Result := AItem1.PriorityBonus - AItem2.PriorityBonus;
if Result = 0 then
Result := TWorldItem(AItem1).PrioritySolver - TWorldItem(AItem2).PrioritySolver;
Result := AItem1.PrioritySolver - AItem2.PrioritySolver;
end;
{ TWorldItem }