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 

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

1
Client/CentrED.lpi
View File

@ -281,6 +281,7 @@
<Linking> <Linking>
<Debugging> <Debugging>
<GenerateDebugInfo Value="True"/> <GenerateDebugInfo Value="True"/>
<UseHeaptrc Value="True"/>
</Debugging> </Debugging>
<LinkSmart Value="True"/> <LinkSmart Value="True"/>
<Options> <Options>

87
Client/ULandscape.pas
View File

@ -90,7 +90,7 @@ type
constructor Create(AData: TStream; AIndex: TGenericIndex); overload; constructor Create(AData: TStream; AIndex: TGenericIndex); overload;
destructor Destroy; override; destructor Destroy; override;
public public
Cells: array[0..63] of TList; Cells: array[0..63] of TStaticItemList;
{ Methods } { Methods }
function Clone: TSeperatedStaticBlock; override; function Clone: TSeperatedStaticBlock; override;
function GetSize: Integer; override; function GetSize: Integer; override;
@ -149,7 +149,7 @@ type
function GetMapCell(AX, AY: Word): TMapCell; function GetMapCell(AX, AY: Word): TMapCell;
function GetNormals(AX, AY: Word): TNormals; function GetNormals(AX, AY: Word): TNormals;
function GetStaticBlock(AX, AY: Word): TSeperatedStaticBlock; function GetStaticBlock(AX, AY: Word): TSeperatedStaticBlock;
function GetStaticList(AX, AY: Word): TList; function GetStaticList(AX, AY: Word): TStaticItemList;
{ Events } { Events }
procedure OnRemoveCachedObject(AObject: TObject); procedure OnRemoveCachedObject(AObject: TObject);
procedure OnBlocksPacket(ABuffer: TEnhancedMemoryStream); procedure OnBlocksPacket(ABuffer: TEnhancedMemoryStream);
@ -166,7 +166,7 @@ type
property CellWidth: Word read FCellWidth; property CellWidth: Word read FCellWidth;
property CellHeight: Word read FCellHeight; property CellHeight: Word read FCellHeight;
property MapCell[X, Y: Word]: TMapCell read GetMapCell; property MapCell[X, Y: Word]: TMapCell read GetMapCell;
property StaticList[X, Y: Word]: TList read GetStaticList; property StaticList[X, Y: Word]: TStaticItemList read GetStaticList;
property Normals[X, Y: Word]: TNormals read GetNormals; property Normals[X, Y: Word]: TNormals read GetNormals;
property OnChange: TLandscapeChangeEvent read FOnChange write FOnChange; property OnChange: TLandscapeChangeEvent read FOnChange write FOnChange;
property OnMapChanged: TMapChangedEvent read FOnMapChanged write FOnMapChanged; property OnMapChanged: TMapChangedEvent read FOnMapChanged write FOnMapChanged;
@ -183,7 +183,7 @@ type
function CanWrite(AX, AY: Word): Boolean; function CanWrite(AX, AY: Word): Boolean;
procedure FillDrawList(ADrawList: TScreenBuffer; AX, AY, AWidth, procedure FillDrawList(ADrawList: TScreenBuffer; AX, AY, AWidth,
AHeight: Word; AMap, AStatics: Boolean; ANoDraw: Boolean; AHeight: Word; AMap, AStatics: Boolean; ANoDraw: Boolean;
AAdditionalTiles: TList = nil); AAdditionalTiles: TWorldItemList = nil);
function GetEffectiveAltitude(ATile: TMapCell): ShortInt; function GetEffectiveAltitude(ATile: TMapCell): ShortInt;
function GetLandAlt(AX, AY: Word; ADefault: ShortInt): ShortInt; function GetLandAlt(AX, AY: Word; ADefault: ShortInt): ShortInt;
procedure GetNormals(AX, AY: Word; var ANormals: TNormals); procedure GetNormals(AX, AY: Word; var ANormals: TNormals);
@ -362,13 +362,13 @@ var
block: TMemoryStream; block: TMemoryStream;
begin begin
inherited Create; inherited Create;
FItems := TList.Create; FItems := TStaticItemList.Create(False);
FX := AX; FX := AX;
FY := AY; FY := AY;
for i := 0 to 63 do for i := 0 to 63 do
Cells[i] := TList.Create; Cells[i] := TStaticItemList.Create;
if (AData <> nil) and (AIndex.Lookup > 0) and (AIndex.Size > 0) then if (AData <> nil) and (AIndex.Lookup > 0) and (AIndex.Size > 0) then
begin begin
@ -399,18 +399,7 @@ begin
for i := 0 to 63 do for i := 0 to 63 do
begin begin
if Cells[i] <> nil then if Cells[i] <> nil then
begin FreeAndNil(Cells[i]);
for j := 0 to Cells[i].Count - 1 do
begin
if Cells[i][j] <> nil then
begin
TStaticItem(Cells[i][j]).Free;
Cells[i][j] := nil;
end;
end;
Cells[i].Free;
Cells[i] := nil;
end;
end; end;
inherited Destroy; inherited Destroy;
@ -588,7 +577,7 @@ begin
end; end;
end; end;
function TLandscape.GetStaticList(AX, AY: Word): TList; function TLandscape.GetStaticList(AX, AY: Word): TStaticItemList;
var var
block: TSeperatedStaticBlock; block: TSeperatedStaticBlock;
begin begin
@ -668,7 +657,7 @@ var
x, y: Word; x, y: Word;
block: TSeperatedStaticBlock; block: TSeperatedStaticBlock;
staticItem: TStaticItem; staticItem: TStaticItem;
targetStaticList: TList; targetStaticList: TStaticItemList;
i: Integer; i: Integer;
begin begin
x := ABuffer.ReadWord; x := ABuffer.ReadWord;
@ -685,10 +674,10 @@ 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
TStaticItem(targetStaticList.Items[i]).UpdatePriorities( targetStaticList.Items[i].UpdatePriorities(
ResMan.Tiledata.StaticTiles[TStaticItem(targetStaticList.Items[i]).TileID], ResMan.Tiledata.StaticTiles[targetStaticList.Items[i].TileID],
i); i);
targetStaticList.Sort(@CompareWorldItems); targetStaticList.Sort(@CompareStaticItems);
staticItem.Owner := block; staticItem.Owner := block;
staticItem.CanBeEdited := CanWrite(x, y); staticItem.CanBeEdited := CanWrite(x, y);
@ -700,7 +689,7 @@ procedure TLandscape.OnDeleteStaticPacket(ABuffer: TEnhancedMemoryStream);
var var
block: TSeperatedStaticBlock; block: TSeperatedStaticBlock;
i: Integer; i: Integer;
statics: TList; statics: TStaticItemList;
staticInfo: TStaticInfo; staticInfo: TStaticInfo;
staticItem: TStaticItem; staticItem: TStaticItem;
begin begin
@ -711,7 +700,7 @@ begin
statics := block.Cells[(staticInfo.Y mod 8) * 8 + staticInfo.X mod 8]; statics := block.Cells[(staticInfo.Y mod 8) * 8 + staticInfo.X mod 8];
for i := 0 to statics.Count - 1 do for i := 0 to statics.Count - 1 do
begin begin
staticItem := TStaticItem(statics.Items[i]); staticItem := statics.Items[i];
if (staticItem.Z = staticInfo.Z) and if (staticItem.Z = staticInfo.Z) and
(staticItem.TileID = staticInfo.TileID) and (staticItem.TileID = staticInfo.TileID) and
(staticItem.Hue = staticInfo.Hue) then (staticItem.Hue = staticInfo.Hue) then
@ -730,7 +719,7 @@ procedure TLandscape.OnElevateStaticPacket(ABuffer: TEnhancedMemoryStream);
var var
block: TSeperatedStaticBlock; block: TSeperatedStaticBlock;
i,j : Integer; i,j : Integer;
statics: TList; statics: TStaticItemList;
staticInfo: TStaticInfo; staticInfo: TStaticInfo;
staticItem: TStaticItem; staticItem: TStaticItem;
begin begin
@ -741,17 +730,17 @@ begin
statics := block.Cells[(staticInfo.Y mod 8) * 8 + staticInfo.X mod 8]; statics := block.Cells[(staticInfo.Y mod 8) * 8 + staticInfo.X mod 8];
for i := 0 to statics.Count - 1 do for i := 0 to statics.Count - 1 do
begin begin
staticItem := TStaticItem(statics.Items[i]); staticItem := statics.Items[i];
if (staticItem.Z = staticInfo.Z) and if (staticItem.Z = staticInfo.Z) and
(staticItem.TileID = staticInfo.TileID) and (staticItem.TileID = staticInfo.TileID) and
(staticItem.Hue = staticInfo.Hue) then (staticItem.Hue = staticInfo.Hue) then
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
TStaticItem(statics.Items[j]).UpdatePriorities( statics.Items[j].UpdatePriorities(
ResMan.Tiledata.StaticTiles[TStaticItem(statics.Items[j]).TileID], ResMan.Tiledata.StaticTiles[statics.Items[j].TileID],
j); j);
statics.Sort(@CompareWorldItems); statics.Sort(@CompareStaticItems);
if Assigned(FOnStaticElevated) then FOnStaticElevated(staticItem); if Assigned(FOnStaticElevated) then FOnStaticElevated(staticItem);
@ -765,7 +754,7 @@ procedure TLandscape.OnMoveStaticPacket(ABuffer: TEnhancedMemoryStream);
var var
sourceBlock, targetBlock: TSeperatedStaticBlock; sourceBlock, targetBlock: TSeperatedStaticBlock;
i: Integer; i: Integer;
statics: TList; statics: TStaticItemList;
staticInfo: TStaticInfo; staticInfo: TStaticInfo;
staticItem: TStaticItem; staticItem: TStaticItem;
newX, newY: Word; newX, newY: Word;
@ -783,7 +772,7 @@ begin
i := 0; i := 0;
while (i < statics.Count) and (staticItem = nil) do while (i < statics.Count) and (staticItem = nil) do
begin begin
staticItem := TStaticItem(statics.Items[i]); staticItem := statics.Items[i];
if (staticItem.Z <> staticInfo.Z) or if (staticItem.Z <> staticInfo.Z) or
(staticItem.TileID <> staticInfo.TileID) or (staticItem.TileID <> staticInfo.TileID) or
(staticItem.Hue <> staticInfo.Hue) then (staticItem.Hue <> staticInfo.Hue) then
@ -815,7 +804,7 @@ begin
TStaticItem(statics.Items[i]).UpdatePriorities( TStaticItem(statics.Items[i]).UpdatePriorities(
ResMan.Tiledata.StaticTiles[TStaticItem(statics.Items[i]).TileID], ResMan.Tiledata.StaticTiles[TStaticItem(statics.Items[i]).TileID],
i); i);
statics.Sort(@CompareWorldItems); statics.Sort(@CompareStaticItems);
staticItem.Owner := targetBlock; staticItem.Owner := targetBlock;
staticItem.CanBeEdited := CanWrite(newX, newY); staticItem.CanBeEdited := CanWrite(newX, newY);
@ -827,7 +816,7 @@ procedure TLandscape.OnHueStaticPacket(ABuffer: TEnhancedMemoryStream);
var var
block: TSeperatedStaticBlock; block: TSeperatedStaticBlock;
i : Integer; i : Integer;
statics: TList; statics: TStaticItemList;
staticInfo: TStaticInfo; staticInfo: TStaticInfo;
staticItem: TStaticItem; staticItem: TStaticItem;
begin begin
@ -838,7 +827,7 @@ begin
statics := block.Cells[(staticInfo.Y mod 8) * 8 + staticInfo.X mod 8]; statics := block.Cells[(staticInfo.Y mod 8) * 8 + staticInfo.X mod 8];
for i := 0 to statics.Count - 1 do for i := 0 to statics.Count - 1 do
begin begin
staticItem := TStaticItem(statics.Items[i]); staticItem := statics.Items[i];
if (staticItem.Z = staticInfo.Z) and if (staticItem.Z = staticInfo.Z) and
(staticItem.TileID = staticInfo.TileID) and (staticItem.TileID = staticInfo.TileID) and
(staticItem.Hue = staticInfo.Hue) then (staticItem.Hue = staticInfo.Hue) then
@ -858,15 +847,15 @@ end;
procedure TLandscape.FillDrawList(ADrawList: TScreenBuffer; AX, AY, AWidth, procedure TLandscape.FillDrawList(ADrawList: TScreenBuffer; AX, AY, AWidth,
AHeight: Word; AMap, AStatics: Boolean; ANoDraw: Boolean; AHeight: Word; AMap, AStatics: Boolean; ANoDraw: Boolean;
AAdditionalTiles: TList = nil); AAdditionalTiles: TWorldItemList = nil);
var var
drawMapCell: TMapCell; drawMapCell: TMapCell;
drawStatics: TList; drawStatics: TStaticItemList;
i, x, y: Integer; i, x, y: Integer;
tempDrawList: TList; tempDrawList: TWorldItemList;
begin begin
ADrawList.Clear; ADrawList.Clear;
tempDrawList := TList.Create; tempDrawList := TWorldItemList.Create(False);;
for x := AX to AX + AWidth do for x := AX to AX + AWidth do
begin begin
for y := AY to AY + AWidth do for y := AY to AY + AWidth do
@ -889,8 +878,8 @@ begin
if drawStatics <> nil then if drawStatics <> nil then
for i := 0 to drawStatics.Count - 1 do for i := 0 to drawStatics.Count - 1 do
begin begin
TStaticItem(drawStatics[i]).UpdatePriorities( drawStatics[i].UpdatePriorities(
ResMan.Tiledata.StaticTiles[TStaticItem(drawStatics[i]).TileID], ResMan.Tiledata.StaticTiles[drawStatics[i].TileID],
ADrawList.GetSerial); ADrawList.GetSerial);
tempDrawList.Add(drawStatics[i]); tempDrawList.Add(drawStatics[i]);
end; end;
@ -898,8 +887,8 @@ begin
end; end;
end; end;
if AAdditionalTiles <> nil then for i := 0 to AAdditionalTiles.Count - 1 do
tempDrawList.AddList(AAdditionalTiles); tempDrawList.Add(AAdditionalTiles[i]);
tempDrawList.Sort(@CompareWorldItems); tempDrawList.Sort(@CompareWorldItems);
for i := 0 to tempDrawList.Count - 1 do for i := 0 to tempDrawList.Count - 1 do
@ -1018,7 +1007,7 @@ end;
procedure TLandscape.MoveStatic(AStatic: TStaticItem; AX, AY: Word); procedure TLandscape.MoveStatic(AStatic: TStaticItem; AX, AY: Word);
var var
sourceBlock, targetBlock: TSeperatedStaticBlock; sourceBlock, targetBlock: TSeperatedStaticBlock;
targetStaticList: TList; targetStaticList: TStaticItemList;
i: Integer; i: Integer;
begin begin
if (AX >= 0) and (AX <= FCellWidth) and (AY >= 0) and (AY <= FCellHeight) then if (AX >= 0) and (AX <= FCellWidth) and (AY >= 0) and (AY <= FCellHeight) then
@ -1031,10 +1020,10 @@ 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
TStaticItem(targetStaticList.Items[i]).UpdatePriorities( targetStaticList.Items[i].UpdatePriorities(
ResMan.Tiledata.StaticTiles[TStaticItem(targetStaticList.Items[i]).TileID], ResMan.Tiledata.StaticTiles[targetStaticList.Items[i].TileID],
i); i);
targetStaticList.Sort(@CompareWorldItems); targetStaticList.Sort(@CompareStaticItems);
AStatic.UpdatePos(AX, AY, AStatic.Z); AStatic.UpdatePos(AX, AY, AStatic.Z);
AStatic.Owner := targetBlock; AStatic.Owner := targetBlock;
end; end;
@ -1309,7 +1298,7 @@ begin
Result^.State := ssNormal; Result^.State := ssNormal;
Result^.Highlighted := False; Result^.Highlighted := False;
if (FShortCuts[0] = nil) or (CompareWorldItems(AItem, FShortCuts[0]) < 0) then if (FShortCuts[0] = nil) or (CompareWorldItems(AItem, FShortCuts[0]^.Item) < 0) then
begin begin
if FShortCuts[0] = nil then if FShortCuts[0] = nil then
FShortCuts[-1] := Result; //Update last item FShortCuts[-1] := Result; //Update last item
@ -1321,7 +1310,7 @@ begin
//find best entry point //find best entry point
shortcut := 0; shortcut := 0;
while (shortcut <= 10) and (FShortCuts[shortcut] <> nil) and while (shortcut <= 10) and (FShortCuts[shortcut] <> nil) and
(CompareWorldItems(AItem, FShortCuts[shortcut]) >= 0) do (CompareWorldItems(AItem, FShortCuts[shortcut]^.Item) >= 0) do
begin begin
current := FShortCuts[shortcut]; current := FShortCuts[shortcut];
Inc(shortcut); Inc(shortcut);

4
Client/UfrmMain.pas
View File

@ -278,7 +278,7 @@ type
FCurrentTile: TWorldItem; FCurrentTile: TWorldItem;
FSelectedTile: TWorldItem; FSelectedTile: TWorldItem;
FGhostTile: TWorldItem; FGhostTile: TWorldItem;
FVirtualTiles: TObjectList; FVirtualTiles: TWorldItemList;
FVLayerMaterial: TMaterial; FVLayerMaterial: TMaterial;
FOverlayUI: TOverlayUI; FOverlayUI: TOverlayUI;
FLocationsFile: string; FLocationsFile: string;
@ -776,7 +776,7 @@ begin
virtualLayerGraphic); virtualLayerGraphic);
virtualLayerGraphic.Free; virtualLayerGraphic.Free;
FVirtualTiles := TObjectList.Create(True); FVirtualTiles := TWorldItemList.Create(True);
FRandomPresetLocation := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) + 'RandomPresets' + PathDelim; FRandomPresetLocation := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) + 'RandomPresets' + PathDelim;
if not DirectoryExists(FRandomPresetLocation) then CreateDir(FRandomPresetLocation); if not DirectoryExists(FRandomPresetLocation) then CreateDir(FRandomPresetLocation);

372
UOLib/UMap.pas
View File

@ -1,180 +1,192 @@
(* (*
* 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 UMap; unit UMap;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
SysUtils, Classes, UMulBlock, UWorldItem; SysUtils, Classes, fgl, UMulBlock, UWorldItem;
const const
MapCellSize = 3; MapCellSize = 3;
MapBlockSize = 4 + (64 * MapCellSize); MapBlockSize = 4 + (64 * MapCellSize);
type type
TMapCell = class(TWorldItem)
constructor Create(AOwner: TWorldBlock; AData: TStream; AX, AY: Word); overload; { TMapCell }
constructor Create(AOwner: TWorldBlock; AData: TStream); overload;
function Clone: TMapCell; override; TMapCell = class(TWorldItem)
function GetSize: Integer; override; constructor Create(AOwner: TWorldBlock; AData: TStream; AX, AY: Word); overload;
procedure Write(AData: TStream); override; constructor Create(AOwner: TWorldBlock; AData: TStream); overload;
public function Clone: TMapCell; override;
property Altitude: ShortInt read FZ write FZ; function GetSize: Integer; override;
end; procedure Write(AData: TStream); override;
TMapBlock = class(TWorldBlock) public
constructor Create(AData: TStream; AX, AY: Word); overload; property Altitude: ShortInt read FZ write FZ;
constructor Create(AData: TStream); overload; end;
destructor Destroy; override;
function Clone: TMapBlock; override; TMapCellList = specialize TFPGObjectList<TMapCell>;
function GetSize: Integer; override;
procedure Write(AData: TStream); override; { TMapBlock }
protected
FHeader: LongInt; TMapBlock = class(TWorldBlock)
public constructor Create(AData: TStream; AX, AY: Word); overload;
Cells: array[0..63] of TMapCell; constructor Create(AData: TStream); overload;
property Header: LongInt read FHeader write FHeader; destructor Destroy; override;
end; function Clone: TMapBlock; override;
function GetSize: Integer; override;
function GetMapCellOffset(ABlock: Integer): Integer; procedure Write(AData: TStream); override;
protected
implementation FHeader: LongInt;
public
function GetMapCellOffset(ABlock: Integer): Integer; Cells: array[0..63] of TMapCell;
var property Header: LongInt read FHeader write FHeader;
group, tile: Integer; end;
begin
group := ABlock div 64; function GetMapCellOffset(ABlock: Integer): Integer;
tile := ABlock mod 64;
implementation
Result := group * MapBlockSize + 4 + tile * MapCellSize;
end; function GetMapCellOffset(ABlock: Integer): Integer;
var
constructor TMapCell.Create(AOwner: TWorldBlock; AData: TStream; AX, AY: Word); group, tile: Integer;
begin begin
inherited Create(AOwner); group := ABlock div 64;
FX := AX; tile := ABlock mod 64;
FY := AY;
if assigned(AData) then Result := group * MapBlockSize + 4 + tile * MapCellSize;
begin end;
AData.Read(FTileID, SizeOf(Word));
AData.Read(FZ, SizeOf(ShortInt)); { TMapCell }
end;
InitOriginalState; constructor TMapCell.Create(AOwner: TWorldBlock; AData: TStream; AX, AY: Word);
end; begin
inherited Create(AOwner);
constructor TMapCell.Create(AOwner: TWorldBlock; AData: TStream); FX := AX;
begin FY := AY;
Create(AOwner, AData, 0, 0); if assigned(AData) then
end; begin
AData.Read(FTileID, SizeOf(Word));
function TMapCell.Clone: TMapCell; AData.Read(FZ, SizeOf(ShortInt));
begin end;
Result := TMapCell.Create(nil, nil); InitOriginalState;
Result.FX := FX; end;
Result.FY := FY;
Result.FZ := FZ; constructor TMapCell.Create(AOwner: TWorldBlock; AData: TStream);
Result.FTileID := FTileID; begin
end; Create(AOwner, AData, 0, 0);
end;
procedure TMapCell.Write(AData: TStream);
begin function TMapCell.Clone: TMapCell;
AData.Write(FTileID, SizeOf(Word)); begin
AData.Write(FZ, SizeOf(ShortInt)); Result := TMapCell.Create(nil, nil);
end; Result.FX := FX;
Result.FY := FY;
function TMapCell.GetSize: Integer; Result.FZ := FZ;
begin Result.FTileID := FTileID;
Result := MapCellSize; end;
end;
procedure TMapCell.Write(AData: TStream);
constructor TMapBlock.Create(AData: TStream; AX, AY: Word); begin
var AData.Write(FTileID, SizeOf(Word));
iX, iY: Integer; AData.Write(FZ, SizeOf(ShortInt));
buffer: TMemoryStream; end;
begin
inherited Create; function TMapCell.GetSize: Integer;
FX := AX; begin
FY := AY; Result := MapCellSize;
try end;
buffer := nil;
if Assigned(AData) then { TMapBlock }
begin
buffer := TMemoryStream.Create; constructor TMapBlock.Create(AData: TStream; AX, AY: Word);
buffer.CopyFrom(AData, 196); var
buffer.Position := 0; iX, iY: Integer;
buffer.Read(FHeader, SizeOf(LongInt)); buffer: TMemoryStream;
end; begin
for iY := 0 to 7 do inherited Create;
for iX := 0 to 7 do FX := AX;
Cells[iY * 8 + iX] := TMapCell.Create(Self, buffer, AX * 8 + iX, AY * 8 + iY); FY := AY;
finally try
if Assigned(buffer) then FreeAndNil(buffer); buffer := nil;
end; if Assigned(AData) then
end; begin
buffer := TMemoryStream.Create;
constructor TMapBlock.Create(AData: TStream); buffer.CopyFrom(AData, 196);
begin buffer.Position := 0;
Create(AData, 0, 0); buffer.Read(FHeader, SizeOf(LongInt));
end; end;
for iY := 0 to 7 do
destructor TMapBlock.Destroy; for iX := 0 to 7 do
var Cells[iY * 8 + iX] := TMapCell.Create(Self, buffer, AX * 8 + iX, AY * 8 + iY);
i: Integer; finally
begin if Assigned(buffer) then FreeAndNil(buffer);
for i := 0 to 63 do end;
Cells[i].Free; end;
inherited;
end; constructor TMapBlock.Create(AData: TStream);
begin
function TMapBlock.Clone: TMapBlock; Create(AData, 0, 0);
var end;
i: Integer;
begin destructor TMapBlock.Destroy;
Result := TMapBlock.Create(nil); var
Result.FX := FX; i: Integer;
Result.FY := FY; begin
for i := 0 to 63 do for i := 0 to 63 do
Result.Cells[i] := Cells[i].Clone; Cells[i].Free;
end; inherited;
end;
procedure TMapBlock.Write(AData: TStream);
var function TMapBlock.Clone: TMapBlock;
i: Integer; var
begin i: Integer;
AData.Write(FHeader, SizeOf(LongInt)); begin
for i := 0 to 63 do Result := TMapBlock.Create(nil);
Cells[i].Write(AData); Result.FX := FX;
end; Result.FY := FY;
for i := 0 to 63 do
function TMapBlock.GetSize: Integer; Result.Cells[i] := Cells[i].Clone;
begin end;
Result := MapBlockSize;
end; procedure TMapBlock.Write(AData: TStream);
var
end. 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 interface
uses uses
SysUtils, Classes, UGenericIndex, UWorldItem, UTiledata; SysUtils, Classes, fgl, UGenericIndex, UWorldItem, UTiledata;
type type
{ TStaticItem } { TStaticItem }
@ -58,6 +58,8 @@ type
procedure Write(AData: TStream); override; procedure Write(AData: TStream); override;
end; end;
TStaticItemList = specialize TFPGObjectList<TStaticItem>;
{ TStaticBlock} { TStaticBlock}
TStaticBlock = class(TWorldBlock) TStaticBlock = class(TWorldBlock)
@ -66,10 +68,10 @@ type
destructor Destroy; override; destructor Destroy; override;
protected protected
{ Members } { Members }
FItems: TList; FItems: TStaticItemList;
public public
{ Fields } { Fields }
property Items: TList read FItems write FItems; property Items: TStaticItemList read FItems write FItems;
{ Methods } { Methods }
function Clone: TStaticBlock; override; function Clone: TStaticBlock; override;
@ -79,8 +81,15 @@ type
procedure Write(AData: TStream); override; procedure Write(AData: TStream); override;
end; end;
function CompareStaticItems(const AStatic1, AStatic2: TStaticItem): Integer;
implementation implementation
function CompareStaticItems(const AStatic1, AStatic2: TStaticItem): Integer;
begin
Result := CompareWorldItems(AStatic1, AStatic2);
end;
{ TStaticItem } { TStaticItem }
constructor TStaticItem.Create(AOwner: TWorldBlock; AData: TStream; ABlockX, ABlockY: Word); constructor TStaticItem.Create(AOwner: TWorldBlock; AData: TStream; ABlockX, ABlockY: Word);
@ -176,8 +185,8 @@ begin
FX := AX; FX := AX;
FY := AY; FY := AY;
FItems := TList.Create; FItems := TStaticItemList.Create(True);
if assigned(AData) and (AIndex.Lookup > 0) and (AIndex.Size > 0) then if (AData <> nil) and (AIndex.Lookup > 0) and (AIndex.Size > 0) then
begin begin
AData.Position := AIndex.Lookup; AData.Position := AIndex.Lookup;
block := TMemoryStream.Create; block := TMemoryStream.Create;
@ -198,17 +207,7 @@ destructor TStaticBlock.Destroy;
var var
i: Integer; i: Integer;
begin begin
if Assigned(FItems) then FreeAndNil(FItems);
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;
inherited; inherited;
end; end;
@ -218,7 +217,7 @@ var
begin begin
Result := TStaticBlock.Create(nil, nil, FX, FY); Result := TStaticBlock.Create(nil, nil, FX, FY);
for i := 0 to FItems.Count - 1 do for i := 0 to FItems.Count - 1 do
Result.FItems.Add(TStaticItem(FItems.Items[i]).Clone); Result.FItems.Add(FItems.Items[i].Clone);
end; end;
function TStaticBlock.GetSize: Integer; function TStaticBlock.GetSize: Integer;
@ -231,14 +230,12 @@ var
i: Integer; i: Integer;
begin begin
for i := FItems.Count - 1 downto 0 do for i := FItems.Count - 1 downto 0 do
begin FItems[i].Write(AData);
TStaticItem(FItems[i]).Write(AData);
end;
end; end;
procedure TStaticBlock.Sort; procedure TStaticBlock.Sort;
begin begin
FItems.Sort(@CompareWorldItems); FItems.Sort(@CompareStaticItems);
end; end;
procedure TStaticBlock.Write(AData: TStream); procedure TStaticBlock.Write(AData: TStream);
@ -246,7 +243,7 @@ var
i: Integer; i: Integer;
begin begin
for i := 0 to FItems.Count - 1 do for i := 0 to FItems.Count - 1 do
TStaticItem(FItems[i]).Write(AData); FItems[i].Write(AData);
end; end;
end. end.

32
UOLib/UWorldItem.pas
View File

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