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

- Fixed/Removed some compiler warnings and hints

Browse Source 
- Some more syntactic changes to UfrmRegionControl.pas
- Implemented region modification and deletion
- Changed the server side region handling to broadcast the changes
- Added safer admin packet registration
- Added some more units to the project files
This commit is contained in:
Andreas Schneider
2008-08-23 23:09:20 +02:00
parent 49e095a83f
commit 85cc0c0066
20 changed files with 1394 additions and 1237 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
Server/UAccount.pas
View File

@@ -30,8 +30,7 @@ unit UAccount;
interface
uses
Classes, SysUtils, md5, contnrs, math, DOM, UXmlHelper, UInterfaces,
UEnums, URegions;
Classes, SysUtils, contnrs, math, DOM, UXmlHelper, UInterfaces, UEnums;
type
@@ -86,8 +85,6 @@ uses
constructor TAccount.Create(AOwner: IInvalidate; AName, APasswordHash: string;
AAccessLevel: TAccessLevel; ARegions: TStringList);
var
i : Integer;
begin
inherited Create;
FOwner := AOwner;

21
Server/UAdminHandling.pas
View File

@@ -90,6 +90,20 @@ implementation
uses
md5, UCEDServer, UPackets, UClientHandling;
procedure AdminBroadcast(AAccessLevel: TAccessLevel; APacket: TPacket);
var
netState: TNetState;
begin
CEDServerInstance.TCPServer.IterReset;
while CEDServerInstance.TCPServer.IterNext do
begin
netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData);
if (netState <> nil) and (netState.Account.AccessLevel >= AAccessLevel) then
CEDServerInstance.SendPacket(netState, APacket, False);
end;
APacket.Free;
end;
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
@@ -250,7 +264,9 @@ begin
Max(x1, x2), Max(y1, y2));
end;
CEDServerInstance.SendPacket(ANetState,
Config.Regions.Invalidate;
AdminBroadcast(alAdministrator,
TModifyRegionResponsePacket.Create(status, region));
end;
@@ -271,12 +287,13 @@ begin
if TRegion(regions[i]).Name = regionName then
begin
regions.Delete(i);
regions.Invalidate;
status := drDeleted;
end else
inc(i);
end;
CEDServerInstance.SendPacket(ANetState,
AdminBroadcast(alAdministrator,
TDeleteRegionResponsePacket.Create(status, regionName));
end;

2
Server/UConfig.pas
View File

@@ -201,6 +201,7 @@ begin
inherited Create;
FFilename := AFilename;
ReadXMLFile(xmlDoc, AFilename);
version := 0;
if not ((xmlDoc.DocumentElement.NodeName = 'CEDConfig') and
TryStrToInt(xmlDoc.DocumentElement.AttribStrings['Version'], version) and
(version = CONFIGVERSION)) then
@@ -247,6 +248,7 @@ begin
Writeln('===================');
Write ('Port [2597]: ');
Readln (stringValue);
intValue := 0;
if not TryStrToInt(stringValue, intValue) then intValue := 2597;
FPort := intValue;
Writeln('');

1
Server/UConnectionHandling.pas
View File

@@ -79,7 +79,6 @@ procedure OnLoginRequestPacket(ABuffer: TEnhancedMemoryStream;
var
username, passwordHash: string;
account: TAccount;
pwHash: string;
netState: TNetState;
invalid: Boolean;
begin

15
Server/ULandscape.pas
View File

@@ -30,8 +30,8 @@ unit ULandscape;
interface
uses
SysUtils, Classes, contnrs, UGenericIndex, UMap, UStatics, UTiledata,
UWorldItem, UMulBlock, math,
SysUtils, Classes, math, UGenericIndex, UMap, UStatics, UTiledata,
UWorldItem, UMulBlock,
UTileDataProvider, URadarMap,
UListSort, UCacheManager, ULinkedList, UBufferedStreams,
UEnhancedMemoryStream, UPacketHandlers, UPackets, UNetState, UEnums;
@@ -148,10 +148,6 @@ implementation
uses
UCEDServer, UConnectionHandling, UConfig, ULargeScaleOperations;
const
mMap = 0;
mStatics = 1;
function GetID(AX, AY: Word): Integer;
begin
Result := ((AX and $7FFF) shl 15) or (AY and $7FFF);
@@ -201,7 +197,7 @@ end;
constructor TLandscape.Create(AMap, AStatics, AStaIdx, ATiledata: TStream;
ARadarCol: string; AWidth, AHeight: Word; var AValid: Boolean);
var
blockID, blockType: Integer;
blockID: Integer;
begin
inherited Create;
FWidth := AWidth;
@@ -568,7 +564,6 @@ var
block: TSeperatedStaticBlock;
staticItem: TStaticItem;
targetStaticList: TList;
i: Integer;
subscriptions: TLinkedList;
item: PLinkedItem;
packet: TInsertStaticPacket;
@@ -653,7 +648,7 @@ procedure TLandscape.OnElevateStaticPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
block: TSeperatedStaticBlock;
i, j: Integer;
i: Integer;
statics: TList;
staticInfo: TStaticInfo;
staticItem: TStaticItem;
@@ -800,7 +795,7 @@ procedure TLandscape.OnHueStaticPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
block: TSeperatedStaticBlock;
i, j: Integer;
i: Integer;
statics: TList;
staticInfo: TStaticInfo;
staticItem: TStaticItem;

760
Server/ULargeScaleOperations.pas
View File

@@ -1,380 +1,380 @@
(*
* 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 ULargeScaleOperations;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, UMap, UStatics, UEnhancedMemoryStream, math,
ULandscape;
type
TCopyMoveType = (cmCopy = 0, cmMove = 1);
TSetAltitudeType = (saTerrain = 1, saRelative = 2);
TStaticsPlacement = (spTerrain = 1, spTop = 2, spFix = 3);
{ TLargeScaleOperation }
TLargeScaleOperation = class(TObject)
constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); virtual;
protected
FLandscape: TLandscape;
public
procedure Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); virtual; abstract;
end;
{ TLSCopyMove }
TLSCopyMove = class(TLargeScaleOperation)
constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); override;
protected
FType: TCopyMoveType;
FOffsetX: Integer;
FOffsetY: Integer;
FErase: Boolean;
public
property OffsetX: Integer read FOffsetX;
property OffsetY: Integer read FOffsetY;
procedure Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); override;
end;
{ TLSSetAltitude }
TLSSetAltitude = class(TLargeScaleOperation)
constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); override;
protected
FType: TSetAltitudeType;
FMinZ: ShortInt;
FMaxZ: ShortInt;
FRelativeZ: ShortInt;
public
procedure Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); override;
end;
{ TLSDrawTerrain }
TLSDrawTerrain = class(TLargeScaleOperation)
constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); override;
protected
FTileIDs: array of Word;
public
procedure Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); override;
end;
{ TLSDeleteStatics }
TLSDeleteStatics = class(TLargeScaleOperation)
constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); override;
protected
FTileIDs: array of Word;
FMinZ: ShortInt;
FMaxZ: ShortInt;
public
procedure Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); override;
end;
{ TLSInsertStatics }
TLSInsertStatics = class(TLargeScaleOperation)
constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); override;
protected
FTileIDs: array of Word;
FProbability: Byte;
FPlacementType: TStaticsPlacement;
FFixZ: ShortInt;
public
procedure Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); override;
end;
implementation
uses
UCEDServer, UTiledata;
{ TLargeScaleOperation }
constructor TLargeScaleOperation.Init(AData: TEnhancedMemoryStream;
ALandscape: TLandscape);
begin
inherited Create;
FLandscape := ALandscape;
end;
{ TLSCopyMove }
constructor TLSCopyMove.Init(AData: TEnhancedMemoryStream;
ALandscape: TLandscape);
begin
inherited Init(AData, ALandscape);
FType := TCopyMoveType(AData.ReadByte);
FOffsetX := AData.ReadInteger;
FOffsetY := AData.ReadInteger;
FErase := AData.ReadBoolean;
end;
procedure TLSCopyMove.Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits);
var
x, y: Word;
targetCell: TMapCell;
targetStatics: TList;
targetStaticsBlock: TSeperatedStaticBlock;
i: Integer;
staticItem: TStaticItem;
begin
x := EnsureRange(AMapCell.X + FOffsetX, 0, FLandscape.CellWidth - 1);
y := EnsureRange(AMapCell.Y + FOffsetY, 0, FLandscape.CellHeight - 1);
//writeln('target: ', x, ',', y);
targetCell := FLandscape.MapCell[x, y];
targetStaticsBlock := FLandscape.GetStaticBlock(x div 8, y div 8);
targetStatics := targetStaticsBlock.Cells[(y mod 8) * 8 + (x mod 8)];
if FErase then
begin
for i := 0 to targetStatics.Count - 1 do
begin
TStaticItem(targetStatics.Items[i]).Delete;
end;
targetStatics.Clear;
end;
targetCell.TileID := AMapCell.TileID;
targetCell.Z := AMapCell.Z;
if FType = cmCopy then
begin
for i := 0 to AStatics.Count - 1 do
begin
staticItem := TStaticItem.Create(nil, nil, 0, 0);
staticItem.X := x;
staticItem.Y := y;
staticItem.Z := TStaticItem(AStatics.Items[i]).Z;
staticItem.TileID := TStaticItem(AStatics.Items[i]).TileID;
staticItem.Hue := TStaticItem(AStatics.Items[i]).Hue;
staticItem.Owner := targetStaticsBlock;
targetStatics.Add(staticItem);
end;
end else
begin
{for i := 0 to AStatics.Count - 1 do}
while AStatics.Count > 0 do
begin
targetStatics.Add(AStatics.Items[0]);
TStaticItem(AStatics.Items[0]).UpdatePos(x, y, TStaticItem(AStatics.Items[0]).Z);
TStaticItem(AStatics.Items[0]).Owner := targetStaticsBlock;
AStatics.Delete(0);
end;
//AStatics.Clear;
end;
FLandscape.SortStaticsList(targetStatics);
AAdditionalAffectedBlocks.Bits[(x div 8) * FLandscape.Height + (y div 8)] := True;
end;
{ TLSSetAltitude }
constructor TLSSetAltitude.Init(AData: TEnhancedMemoryStream;
ALandscape: TLandscape);
begin
inherited Init(AData, ALandscape);
FType := TSetAltitudeType(AData.ReadByte);
case FType of
saTerrain:
begin
FMinZ := AData.ReadShortInt;
FMaxZ := AData.ReadShortInt;
end;
saRelative:
begin
FRelativeZ := AData.ReadShortInt;
end;
end;
end;
procedure TLSSetAltitude.Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits);
var
i: Integer;
newZ: ShortInt;
diff: ShortInt;
static: TStaticItem;
begin
if FType = saTerrain then
begin
newZ := FMinZ + Random(FMaxZ - FMinZ + 1);
diff := newZ - AMapCell.Z;
AMapCell.Z := newZ;
end else
begin
diff := FRelativeZ;
AMapCell.Z := EnsureRange(AMapCell.Z + diff, -128, 127);
end;
for i := 0 to AStatics.Count - 1 do
begin
static := TStaticItem(AStatics.Items[i]);
static.Z := EnsureRange(static.Z + diff, -128, 127);
end;
end;
{ TLSDrawTerrain }
constructor TLSDrawTerrain.Init(AData: TEnhancedMemoryStream;
ALandscape: TLandscape);
var
count: Word;
begin
inherited Init(AData, ALandscape);
count := AData.ReadWord;
SetLength(FTileIDs, count);
AData.Read(FTileIDs[0], count * SizeOf(Word));
end;
procedure TLSDrawTerrain.Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits);
begin
if Length(FTileIDs) > 0 then
AMapCell.TileID := FTileIDs[Random(Length(FTileIDs))];
end;
{ TLSDeleteStatics }
constructor TLSDeleteStatics.Init(AData: TEnhancedMemoryStream;
ALandscape: TLandscape);
var
count: Word;
begin
inherited Init(AData, ALandscape);
count := AData.ReadWord;
SetLength(FTileIDs, count);
AData.Read(FTileIDs[0], count * SizeOf(Word));
FMinZ := AData.ReadShortInt;
FMaxZ := AData.ReadShortInt;
end;
procedure TLSDeleteStatics.Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits);
var
i, j: Integer;
static: TStaticItem;
begin
i := 0;
while i < AStatics.Count do
begin
static := TStaticItem(AStatics.Items[i]);
if InRange(static.Z, FMinZ, FMaxZ) then
begin
if Length(FTileIDs) > 0 then
begin
for j := Low(FTileIDs) to High(FTileIDs) do
begin
if static.TileID = FTileIDs[j] - $4000 then
begin
AStatics.Delete(i);
static.Delete;
Dec(i);
Break;
end;
end;
Inc(i);
end else
begin
AStatics.Delete(i);
static.Delete;
end;
end else
Inc(i);
end;
end;
{ TLSInsertStatics }
constructor TLSInsertStatics.Init(AData: TEnhancedMemoryStream;
ALandscape: TLandscape);
var
count: Word;
begin
inherited Init(AData, ALandscape);
count := AData.ReadWord;
SetLength(FTileIDs, count);
AData.Read(FTileIDs[0], count * SizeOf(Word));
FProbability := AData.ReadByte;
FPlacementType := TStaticsPlacement(AData.ReadByte);
if FPlacementType = spFix then
FFixZ := AData.ReadShortInt;
end;
procedure TLSInsertStatics.Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits);
var
staticItem, static: TStaticItem;
topZ, staticTop: ShortInt;
i: Integer;
begin
if (Length(FTileIDs) = 0) or (Random(100) >= FProbability) then Exit;
staticItem := TStaticItem.Create(nil, nil, 0, 0);
staticItem.X := AMapCell.X;
staticItem.Y := AMapCell.Y;
staticItem.TileID := FTileIDs[Random(Length(FTileIDs))] - $4000;
staticItem.Hue := 0;
case FPlacementType of
spTerrain:
begin
staticItem.Z := AMapCell.Z;
end;
spTop:
begin
topZ := AMapCell.Z;
for i := 0 to AStatics.Count - 1 do
begin
static := TStaticItem(AStatics.Items[i]);
staticTop := EnsureRange(static.Z + CEDServerInstance.Landscape.TiledataProvider.StaticTiles[static.TileID].Height, -128, 127);
if staticTop > topZ then topZ := staticTop;
end;
end;
spFix:
begin
staticItem.Z := FFixZ;
end;
end;
AStatics.Add(staticItem);
staticItem.Owner := CEDServerInstance.Landscape.GetStaticBlock(staticItem.X div 8,
staticItem.Y div 8);
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 2007 Andreas Schneider
*)
unit ULargeScaleOperations;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, UMap, UStatics, UEnhancedMemoryStream, math,
ULandscape;
type
TCopyMoveType = (cmCopy = 0, cmMove = 1);
TSetAltitudeType = (saTerrain = 1, saRelative = 2);
TStaticsPlacement = (spTerrain = 1, spTop = 2, spFix = 3);
{ TLargeScaleOperation }
TLargeScaleOperation = class(TObject)
constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); virtual;
protected
FLandscape: TLandscape;
public
procedure Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); virtual; abstract;
end;
{ TLSCopyMove }
TLSCopyMove = class(TLargeScaleOperation)
constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); override;
protected
FType: TCopyMoveType;
FOffsetX: Integer;
FOffsetY: Integer;
FErase: Boolean;
public
property OffsetX: Integer read FOffsetX;
property OffsetY: Integer read FOffsetY;
procedure Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); override;
end;
{ TLSSetAltitude }
TLSSetAltitude = class(TLargeScaleOperation)
constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); override;
protected
FType: TSetAltitudeType;
FMinZ: ShortInt;
FMaxZ: ShortInt;
FRelativeZ: ShortInt;
public
procedure Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); override;
end;
{ TLSDrawTerrain }
TLSDrawTerrain = class(TLargeScaleOperation)
constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); override;
protected
FTileIDs: array of Word;
public
procedure Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); override;
end;
{ TLSDeleteStatics }
TLSDeleteStatics = class(TLargeScaleOperation)
constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); override;
protected
FTileIDs: array of Word;
FMinZ: ShortInt;
FMaxZ: ShortInt;
public
procedure Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); override;
end;
{ TLSInsertStatics }
TLSInsertStatics = class(TLargeScaleOperation)
constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); override;
protected
FTileIDs: array of Word;
FProbability: Byte;
FPlacementType: TStaticsPlacement;
FFixZ: ShortInt;
public
procedure Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); override;
end;
implementation
uses
UCEDServer;
{ TLargeScaleOperation }
constructor TLargeScaleOperation.Init(AData: TEnhancedMemoryStream;
ALandscape: TLandscape);
begin
inherited Create;
FLandscape := ALandscape;
end;
{ TLSCopyMove }
constructor TLSCopyMove.Init(AData: TEnhancedMemoryStream;
ALandscape: TLandscape);
begin
inherited Init(AData, ALandscape);
FType := TCopyMoveType(AData.ReadByte);
FOffsetX := AData.ReadInteger;
FOffsetY := AData.ReadInteger;
FErase := AData.ReadBoolean;
end;
procedure TLSCopyMove.Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits);
var
x, y: Word;
targetCell: TMapCell;
targetStatics: TList;
targetStaticsBlock: TSeperatedStaticBlock;
i: Integer;
staticItem: TStaticItem;
begin
x := EnsureRange(AMapCell.X + FOffsetX, 0, FLandscape.CellWidth - 1);
y := EnsureRange(AMapCell.Y + FOffsetY, 0, FLandscape.CellHeight - 1);
//writeln('target: ', x, ',', y);
targetCell := FLandscape.MapCell[x, y];
targetStaticsBlock := FLandscape.GetStaticBlock(x div 8, y div 8);
targetStatics := targetStaticsBlock.Cells[(y mod 8) * 8 + (x mod 8)];
if FErase then
begin
for i := 0 to targetStatics.Count - 1 do
begin
TStaticItem(targetStatics.Items[i]).Delete;
end;
targetStatics.Clear;
end;
targetCell.TileID := AMapCell.TileID;
targetCell.Z := AMapCell.Z;
if FType = cmCopy then
begin
for i := 0 to AStatics.Count - 1 do
begin
staticItem := TStaticItem.Create(nil, nil, 0, 0);
staticItem.X := x;
staticItem.Y := y;
staticItem.Z := TStaticItem(AStatics.Items[i]).Z;
staticItem.TileID := TStaticItem(AStatics.Items[i]).TileID;
staticItem.Hue := TStaticItem(AStatics.Items[i]).Hue;
staticItem.Owner := targetStaticsBlock;
targetStatics.Add(staticItem);
end;
end else
begin
{for i := 0 to AStatics.Count - 1 do}
while AStatics.Count > 0 do
begin
targetStatics.Add(AStatics.Items[0]);
TStaticItem(AStatics.Items[0]).UpdatePos(x, y, TStaticItem(AStatics.Items[0]).Z);
TStaticItem(AStatics.Items[0]).Owner := targetStaticsBlock;
AStatics.Delete(0);
end;
//AStatics.Clear;
end;
FLandscape.SortStaticsList(targetStatics);
AAdditionalAffectedBlocks.Bits[(x div 8) * FLandscape.Height + (y div 8)] := True;
end;
{ TLSSetAltitude }
constructor TLSSetAltitude.Init(AData: TEnhancedMemoryStream;
ALandscape: TLandscape);
begin
inherited Init(AData, ALandscape);
FType := TSetAltitudeType(AData.ReadByte);
case FType of
saTerrain:
begin
FMinZ := AData.ReadShortInt;
FMaxZ := AData.ReadShortInt;
end;
saRelative:
begin
FRelativeZ := AData.ReadShortInt;
end;
end;
end;
procedure TLSSetAltitude.Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits);
var
i: Integer;
newZ: ShortInt;
diff: ShortInt;
static: TStaticItem;
begin
if FType = saTerrain then
begin
newZ := FMinZ + Random(FMaxZ - FMinZ + 1);
diff := newZ - AMapCell.Z;
AMapCell.Z := newZ;
end else
begin
diff := FRelativeZ;
AMapCell.Z := EnsureRange(AMapCell.Z + diff, -128, 127);
end;
for i := 0 to AStatics.Count - 1 do
begin
static := TStaticItem(AStatics.Items[i]);
static.Z := EnsureRange(static.Z + diff, -128, 127);
end;
end;
{ TLSDrawTerrain }
constructor TLSDrawTerrain.Init(AData: TEnhancedMemoryStream;
ALandscape: TLandscape);
var
count: Word;
begin
inherited Init(AData, ALandscape);
count := AData.ReadWord;
SetLength(FTileIDs, count);
AData.Read(FTileIDs[0], count * SizeOf(Word));
end;
procedure TLSDrawTerrain.Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits);
begin
if Length(FTileIDs) > 0 then
AMapCell.TileID := FTileIDs[Random(Length(FTileIDs))];
end;
{ TLSDeleteStatics }
constructor TLSDeleteStatics.Init(AData: TEnhancedMemoryStream;
ALandscape: TLandscape);
var
count: Word;
begin
inherited Init(AData, ALandscape);
count := AData.ReadWord;
SetLength(FTileIDs, count);
AData.Read(FTileIDs[0], count * SizeOf(Word));
FMinZ := AData.ReadShortInt;
FMaxZ := AData.ReadShortInt;
end;
procedure TLSDeleteStatics.Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits);
var
i, j: Integer;
static: TStaticItem;
begin
i := 0;
while i < AStatics.Count do
begin
static := TStaticItem(AStatics.Items[i]);
if InRange(static.Z, FMinZ, FMaxZ) then
begin
if Length(FTileIDs) > 0 then
begin
for j := Low(FTileIDs) to High(FTileIDs) do
begin
if static.TileID = FTileIDs[j] - $4000 then
begin
AStatics.Delete(i);
static.Delete;
Dec(i);
Break;
end;
end;
Inc(i);
end else
begin
AStatics.Delete(i);
static.Delete;
end;
end else
Inc(i);
end;
end;
{ TLSInsertStatics }
constructor TLSInsertStatics.Init(AData: TEnhancedMemoryStream;
ALandscape: TLandscape);
var
count: Word;
begin
inherited Init(AData, ALandscape);
count := AData.ReadWord;
SetLength(FTileIDs, count);
AData.Read(FTileIDs[0], count * SizeOf(Word));
FProbability := AData.ReadByte;
FPlacementType := TStaticsPlacement(AData.ReadByte);
if FPlacementType = spFix then
FFixZ := AData.ReadShortInt;
end;
procedure TLSInsertStatics.Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits);
var
staticItem, static: TStaticItem;
topZ, staticTop: ShortInt;
i: Integer;
begin
if (Length(FTileIDs) = 0) or (Random(100) >= FProbability) then Exit;
staticItem := TStaticItem.Create(nil, nil, 0, 0);
staticItem.X := AMapCell.X;
staticItem.Y := AMapCell.Y;
staticItem.TileID := FTileIDs[Random(Length(FTileIDs))] - $4000;
staticItem.Hue := 0;
case FPlacementType of
spTerrain:
begin
staticItem.Z := AMapCell.Z;
end;
spTop:
begin
topZ := AMapCell.Z;
for i := 0 to AStatics.Count - 1 do
begin
static := TStaticItem(AStatics.Items[i]);
staticTop := EnsureRange(static.Z + CEDServerInstance.Landscape.TiledataProvider.StaticTiles[static.TileID].Height, -128, 127);
if staticTop > topZ then topZ := staticTop;
end;
end;
spFix:
begin
staticItem.Z := FFixZ;
end;
end;
AStatics.Add(staticItem);
staticItem.Owner := CEDServerInstance.Landscape.GetStaticBlock(staticItem.X div 8,
staticItem.Y div 8);
end;
end.

1
Server/UPacketHandlers.pas
View File

@@ -162,7 +162,6 @@ end;
procedure OnRequestBlocksPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
coords: TBlockCoordsArray;
i: Integer;
begin
if not ValidateAccess(ANetState, alView) then Exit;
SetLength(coords, (ABuffer.Size - ABuffer.Position) div SizeOf(TBlockCoords));

534
Server/URadarMap.pas
View File

@@ -1,267 +1,267 @@
(*
* 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 URadarMap;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, UConfig, UNetState, UEnhancedMemoryStream, UEnums;
type
TRadarColorArray = array of Word;
{ TRadarMap }
TRadarMap = class(TObject)
constructor Create(AMap, AStatics, AStaIdx: TStream; AWidth, AHeight: Word;
ARadarCol: string);
destructor Destroy; override;
protected
FWidth: Word;
FHeight: Word;
FRadarColors: TRadarColorArray;
FRadarMap: TRadarColorArray;
FPackets: TList;
FPacketSize: Cardinal;
procedure OnRadarHandlingPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
public
procedure Update(AX, AY, ATileID: Word);
procedure BeginUpdate;
procedure EndUpdate;
end;
implementation
uses
UPacket, UPackets, UPacketHandlers, UCEDServer, crc;
type
TMulIndex = packed record
Position: Cardinal;
Size: Cardinal;
Userdata: Cardinal;
end;
TMapCell = packed record
TileID: Word;
Altitude: ShortInt;
end;
TStaticItem = packed record
TileID: Word;
X, Y: Byte;
Z: ShortInt;
Hue: Word;
end;
{ TRadarChecksumPacket }
TRadarChecksumPacket = class(TPacket)
constructor Create(ARadarMap: TRadarColorArray);
end;
{ TRadarMapPacket }
TRadarMapPacket = class(TPacket)
constructor Create(ARadarMap: TRadarColorArray);
end;
{ TUpdateRadarPacket }
TUpdateRadarPacket = class(TPacket)
constructor Create(AX, AY, AColor: Word);
end;
{ TRadarChecksumPacket }
constructor TRadarChecksumPacket.Create(ARadarMap: TRadarColorArray);
var
checksum: Cardinal;
begin
inherited Create($0D, 0);
FStream.WriteByte($01);
checksum := crc32(0, nil, 0);
checksum := crc32(checksum, @ARadarMap[0], Length(ARadarMap) * SizeOf(Word));
FStream.WriteCardinal(checksum);
end;
{ TRadarMapPacket }
constructor TRadarMapPacket.Create(ARadarMap: TRadarColorArray);
begin
inherited Create($0D, 0);
FStream.WriteByte($02);
FStream.Write(ARadarMap[0], Length(ARadarMap) * SizeOf(Word));
end;
{ TUpdateRadarPacket }
constructor TUpdateRadarPacket.Create(AX, AY, AColor: Word);
begin
inherited Create($0D, 0);
FStream.WriteByte($03);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
FStream.WriteWord(AColor);
end;
{ TRadarMap }
constructor TRadarMap.Create(AMap, AStatics, AStaIdx: TStream; AWidth,
AHeight: Word; ARadarCol: string);
var
radarcol: TFileStream;
count, i, item, highestZ: Integer;
staticsItems: array of TStaticItem;
mapCell: TMapCell;
index: TMulIndex;
begin
radarcol := TFileStream.Create(ARadarCol, fmOpenRead);
SetLength(FRadarColors, radarcol.Size div SizeOf(Word));
radarcol.Read(FRadarColors[0], radarcol.Size);
radarcol.Free;
FWidth := AWidth;
FHeight := AHeight;
count := AWidth * AHeight;
SetLength(FRadarMap, count);
AMap.Position := 4;
AStaIdx.Position := 0;
for i := 0 to count - 1 do
begin
AMap.Read(mapCell, SizeOf(TMapCell));
AMap.Seek(193, soFromCurrent);
FRadarMap[i] := FRadarColors[mapCell.TileID];
AStaIdx.Read(index, SizeOf(TMulIndex));
if (index.Position < $FFFFFFFF) and (index.Size > 0) then
begin
AStatics.Position := index.Position;
SetLength(staticsItems, index.Size div 7);
AStatics.Read(staticsItems[0], index.Size);
highestZ := mapCell.Altitude;
for item := Low(staticsItems) to High(staticsItems) do
begin
if (staticsItems[item].X = 0) and (staticsItems[item].Y = 0) and
(staticsItems[item].Z >= highestZ) then
begin
highestZ := staticsItems[item].Z;
FRadarMap[i] := FRadarColors[staticsItems[item].TileID + $4000];
end;
end;
end;
end;
FPackets := nil;
RegisterPacketHandler($0D, TPacketHandler.Create(2, @OnRadarHandlingPacket));
inherited Create;
end;
destructor TRadarMap.Destroy;
begin
RegisterPacketHandler($0D, nil);
inherited Destroy;
end;
procedure TRadarMap.OnRadarHandlingPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
subID: Byte;
begin
if not ValidateAccess(ANetState, alView) then Exit;
subID := ABuffer.ReadByte;
case subID of
$01: //request checksum
begin
CEDServerInstance.SendPacket(ANetState, TRadarChecksumPacket.Create(
FRadarMap));
end;
$02: //request radarmap
begin
CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(
TRadarMapPacket.Create(FRadarMap)));
end;
end;
end;
procedure TRadarMap.Update(AX, AY, ATileID: Word);
var
color: Word;
block: Cardinal;
packet: TPacket;
begin
block := AX * FHeight + AY;
color := FRadarColors[ATileID];
if FRadarMap[block] <> color then
begin
FRadarMap[block] := color;
packet := TUpdateRadarPacket.Create(AX, AY, color);
if FPackets <> nil then
begin
FPackets.Add(packet);
Inc(FPacketSize, packet.Stream.Size);
end else
CEDServerInstance.SendPacket(nil, packet);
end;
end;
procedure TRadarMap.BeginUpdate;
begin
if FPackets <> nil then Exit;
FPackets := TList.Create;
FPacketSize := 0;
end;
procedure TRadarMap.EndUpdate;
var
completePacket: TPacket;
i: Integer;
begin
if FPackets = nil then Exit;
completePacket := TCompressedPacket.Create(TRadarMapPacket.Create(FRadarMap));
if completePacket.Stream.Size <= (FPacketSize div 4) * 5 then
begin
CEDServerInstance.SendPacket(nil, completePacket);
for i := 0 to FPackets.Count - 1 do
TPacket(FPackets.Items[i]).Free;
end else
begin
for i := 0 to FPackets.Count - 1 do
CEDServerInstance.SendPacket(nil, TPacket(FPackets.Items[i]));
completePacket.Free;
end;
FreeAndNil(FPackets);
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 2007 Andreas Schneider
*)
unit URadarMap;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, UConfig, UNetState, UEnhancedMemoryStream, UEnums;
type
TRadarColorArray = array of Word;
{ TRadarMap }
TRadarMap = class(TObject)
constructor Create(AMap, AStatics, AStaIdx: TStream; AWidth, AHeight: Word;
ARadarCol: string);
destructor Destroy; override;
protected
FWidth: Word;
FHeight: Word;
FRadarColors: TRadarColorArray;
FRadarMap: TRadarColorArray;
FPackets: TList;
FPacketSize: Cardinal;
procedure OnRadarHandlingPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
public
procedure Update(AX, AY, ATileID: Word);
procedure BeginUpdate;
procedure EndUpdate;
end;
implementation
uses
UPacket, UPackets, UPacketHandlers, UCEDServer, crc;
type
TMulIndex = packed record
Position: Cardinal;
Size: Cardinal;
Userdata: Cardinal;
end;
TMapCell = packed record
TileID: Word;
Altitude: ShortInt;
end;
TStaticItem = packed record
TileID: Word;
X, Y: Byte;
Z: ShortInt;
Hue: Word;
end;
{ TRadarChecksumPacket }
TRadarChecksumPacket = class(TPacket)
constructor Create(ARadarMap: TRadarColorArray);
end;
{ TRadarMapPacket }
TRadarMapPacket = class(TPacket)
constructor Create(ARadarMap: TRadarColorArray);
end;
{ TUpdateRadarPacket }
TUpdateRadarPacket = class(TPacket)
constructor Create(AX, AY, AColor: Word);
end;
{ TRadarChecksumPacket }
constructor TRadarChecksumPacket.Create(ARadarMap: TRadarColorArray);
var
checksum: Cardinal;
begin
inherited Create($0D, 0);
FStream.WriteByte($01);
checksum := crc32(0, nil, 0);
checksum := crc32(checksum, @ARadarMap[0], Length(ARadarMap) * SizeOf(Word));
FStream.WriteCardinal(checksum);
end;
{ TRadarMapPacket }
constructor TRadarMapPacket.Create(ARadarMap: TRadarColorArray);
begin
inherited Create($0D, 0);
FStream.WriteByte($02);
FStream.Write(ARadarMap[0], Length(ARadarMap) * SizeOf(Word));
end;
{ TUpdateRadarPacket }
constructor TUpdateRadarPacket.Create(AX, AY, AColor: Word);
begin
inherited Create($0D, 0);
FStream.WriteByte($03);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
FStream.WriteWord(AColor);
end;
{ TRadarMap }
constructor TRadarMap.Create(AMap, AStatics, AStaIdx: TStream; AWidth,
AHeight: Word; ARadarCol: string);
var
radarcol: TFileStream;
count, i, item, highestZ: Integer;
staticsItems: array of TStaticItem;
mapCell: TMapCell;
index: TMulIndex;
begin
radarcol := TFileStream.Create(ARadarCol, fmOpenRead);
SetLength(FRadarColors, radarcol.Size div SizeOf(Word));
radarcol.Read(FRadarColors[0], radarcol.Size);
radarcol.Free;
FWidth := AWidth;
FHeight := AHeight;
count := AWidth * AHeight;
SetLength(FRadarMap, count);
AMap.Position := 4;
AStaIdx.Position := 0;
for i := 0 to count - 1 do
begin
AMap.Read(mapCell, SizeOf(TMapCell));
AMap.Seek(193, soFromCurrent);
FRadarMap[i] := FRadarColors[mapCell.TileID];
AStaIdx.Read(index, SizeOf(TMulIndex));
if (index.Position < $FFFFFFFF) and (index.Size > 0) then
begin
AStatics.Position := index.Position;
SetLength(staticsItems, index.Size div 7);
AStatics.Read(staticsItems[0], index.Size);
highestZ := mapCell.Altitude;
for item := Low(staticsItems) to High(staticsItems) do
begin
if (staticsItems[item].X = 0) and (staticsItems[item].Y = 0) and
(staticsItems[item].Z >= highestZ) then
begin
highestZ := staticsItems[item].Z;
FRadarMap[i] := FRadarColors[staticsItems[item].TileID + $4000];
end;
end;
end;
end;
FPackets := nil;
RegisterPacketHandler($0D, TPacketHandler.Create(2, @OnRadarHandlingPacket));
inherited Create;
end;
destructor TRadarMap.Destroy;
begin
RegisterPacketHandler($0D, nil);
inherited Destroy;
end;
procedure TRadarMap.OnRadarHandlingPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
subID: Byte;
begin
if not ValidateAccess(ANetState, alView) then Exit;
subID := ABuffer.ReadByte;
case subID of
$01: //request checksum
begin
CEDServerInstance.SendPacket(ANetState, TRadarChecksumPacket.Create(
FRadarMap));
end;
$02: //request radarmap
begin
CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(
TRadarMapPacket.Create(FRadarMap)));
end;
end;
end;
procedure TRadarMap.Update(AX, AY, ATileID: Word);
var
color: Word;
block: Cardinal;
packet: TPacket;
begin
block := AX * FHeight + AY;
color := FRadarColors[ATileID];
if FRadarMap[block] <> color then
begin
FRadarMap[block] := color;
packet := TUpdateRadarPacket.Create(AX, AY, color);
if FPackets <> nil then
begin
FPackets.Add(packet);
Inc(FPacketSize, packet.Stream.Size);
end else
CEDServerInstance.SendPacket(nil, packet);
end;
end;
procedure TRadarMap.BeginUpdate;
begin
if FPackets <> nil then Exit;
FPackets := TList.Create;
FPacketSize := 0;
end;
procedure TRadarMap.EndUpdate;
var
completePacket: TPacket;
i: Integer;
begin
if FPackets = nil then Exit;
completePacket := TCompressedPacket.Create(TRadarMapPacket.Create(FRadarMap));
if completePacket.Stream.Size <= (FPacketSize div 4) * 5 then
begin
CEDServerInstance.SendPacket(nil, completePacket);
for i := 0 to FPackets.Count - 1 do
TPacket(FPackets.Items[i]).Free;
end else
begin
for i := 0 to FPackets.Count - 1 do
CEDServerInstance.SendPacket(nil, TPacket(FPackets.Items[i]));
completePacket.Free;
end;
FreeAndNil(FPackets);
end;
end.

6
Server/URegions.pas
View File

@@ -30,7 +30,7 @@ unit URegions;
interface
uses
Classes, SysUtils, contnrs, DOM, UXmlHelper, UInterfaces, UEnums, URectList;
Classes, SysUtils, contnrs, DOM, UXmlHelper, UInterfaces, URectList;
type
@@ -101,6 +101,10 @@ begin
if nodeList.Item[i].NodeName = 'Rect' then
begin
xmlArea := TDOMElement(nodeList.Item[i]);
x1 := 0;
y1 := 0;
x2 := 0;
y2 := 0;
if TryStrToInt(xmlArea.AttribStrings['x1'], x1) and
TryStrToInt(xmlArea.AttribStrings['y1'], y1) and
TryStrToInt(xmlArea.AttribStrings['x2'], x2) and

3
Server/cedserver.lpi
View File

@@ -102,7 +102,7 @@
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<Version Value="8"/>
<Target>
<Filename Value="../bin/cedserver"/>
</Target>
@@ -114,7 +114,6 @@
</SearchPaths>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<Generate Value="Faster"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>