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

- Fixed/Removed some compiler warnings and hints 

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

20
Client/CentrED.lpi
View File

@ -40,7 +40,7 @@
<MinVersion Major="4" Minor="5" Release="1" Valid="True"/>
</Item4>
</RequiredPackages>
<Units Count="26">
<Units Count="29">
<Unit0>
<Filename Value="CentrED.lpr"/>
<IsPartOfProject Value="True"/>
@ -229,10 +229,25 @@
<IsPartOfProject Value="True"/>
<UnitName Value="UPackets"/>
</Unit25>
<Unit26>
<Filename Value="ULandscape.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ULandscape"/>
</Unit26>
<Unit27>
<Filename Value="UGameResources.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UGameResources"/>
</Unit27>
<Unit28>
<Filename Value="UAdminHandling.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UAdminHandling"/>
</Unit28>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<Version Value="8"/>
<Target>
<Filename Value="../bin/CentrED"/>
</Target>
@ -249,7 +264,6 @@
</Parsing>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<Generate Value="Faster"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>

2
Client/CentrED.lpr
View File

@ -39,7 +39,7 @@ uses
UfrmMoveSettings, UfrmAbout, UfrmHueSettings, UfrmRadar,
UfrmLargeScaleCommand, UfrmVirtualLayer, UfrmFilter, UfrmTileInfo,
UGUIPlatformUtils, UPlatformTypes, UfrmRegionControl, UPackets,
UPacketHandlers;
UPacketHandlers, UAdminHandling, UGameResources, ULandscape;
{$IFDEF Windows}
{$R *.res}

204
Client/UAdminHandling.pas
View File

@ -1,96 +1,108 @@
(*
* 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 UAdminHandling;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, UPacket, UPacketHandlers, UEnhancedMemoryStream, UEnums;
type
{ TFlushServerPacket }
TFlushServerPacket = class(TPacket)
constructor Create;
end;
{ TQuitServerPacket }
TQuitServerPacket = class(TPacket)
constructor Create(AReason: string);
end;
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream);
var
AdminPacketHandlers: array[0..$FF] of TPacketHandler;
implementation
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream);
var
packetHandler: TPacketHandler;
begin
packetHandler := AdminPacketHandlers[ABuffer.ReadByte];
if packetHandler <> nil then
packetHandler.Process(ABuffer);
end;
{ TFlushServerPacket }
constructor TFlushServerPacket.Create;
begin
inherited Create($03, 0);
FStream.WriteByte($01);
end;
{ TQuitServerPacket }
constructor TQuitServerPacket.Create(AReason: string);
begin
inherited Create($03, 0);
FStream.WriteByte($02);
FStream.WriteStringNull(AReason);
end;
{$WARNINGS OFF}
var
i: Integer;
initialization
for i := 0 to $FF do
AdminPacketHandlers[i] := nil;
finalization
for i := 0 to $FF do
if AdminPacketHandlers[i] <> nil then
AdminPacketHandlers[i].Free;
{$WARNINGS ON}
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 UAdminHandling;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, UPacket, UPacketHandlers, UEnhancedMemoryStream, UEnums;
type
TAdminHandlerAlreadyAssignedException = class(Exception);
{ TFlushServerPacket }
TFlushServerPacket = class(TPacket)
constructor Create;
end;
{ TQuitServerPacket }
TQuitServerPacket = class(TPacket)
constructor Create(AReason: string);
end;
procedure AssignAdminPacketHandler(APacketID: Byte; AHandler: TPacketHandler);
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream);
var
AdminPacketHandlers: array[0..$FF] of TPacketHandler;
implementation
procedure AssignAdminPacketHandler(APacketID: Byte; AHandler: TPacketHandler);
begin
if AdminPacketHandlers[APacketID] <> nil then
raise TAdminHandlerAlreadyAssignedException.CreateFmt(
'The AdminPacketHandler $%.2x is already assigned!', [APacketID]);
AdminPacketHandlers[APacketID] := AHandler;
end;
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream);
var
packetHandler: TPacketHandler;
begin
packetHandler := AdminPacketHandlers[ABuffer.ReadByte];
if packetHandler <> nil then
packetHandler.Process(ABuffer);
end;
{ TFlushServerPacket }
constructor TFlushServerPacket.Create;
begin
inherited Create($03, 0);
FStream.WriteByte($01);
end;
{ TQuitServerPacket }
constructor TQuitServerPacket.Create(AReason: string);
begin
inherited Create($03, 0);
FStream.WriteByte($02);
FStream.WriteStringNull(AReason);
end;
{$WARNINGS OFF}
var
i: Integer;
initialization
for i := 0 to $FF do
AdminPacketHandlers[i] := nil;
finalization
for i := 0 to $FF do
if AdminPacketHandlers[i] <> nil then
AdminPacketHandlers[i].Free;
{$WARNINGS ON}
end.

6
Client/UfrmAccountControl.pas
View File

@ -140,9 +140,9 @@ procedure TfrmAccountControl.FormCreate(Sender: TObject);
begin
vstAccounts.NodeDataSize := SizeOf(TAccountInfo);
AdminPacketHandlers[$05] := TPacketHandler.Create(0, @OnModifyUserResponse);
AdminPacketHandlers[$06] := TPacketHandler.Create(0, @OnDeleteUserResponse);
AdminPacketHandlers[$07] := TPacketHandler.Create(0, @OnListUsersPacket);
AssignAdminPacketHandler($05, TPacketHandler.Create(0, @OnModifyUserResponse));
AssignAdminPacketHandler($06, TPacketHandler.Create(0, @OnDeleteUserResponse));
AssignAdminPacketHandler($07, TPacketHandler.Create(0, @OnListUsersPacket));
end;
procedure TfrmAccountControl.FormClose(Sender: TObject;

60
Client/UfrmLargeScaleCommand.lfm
View File

@ -3,7 +3,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Height = 397
Top = 171
Width = 620
ActiveControl = vdtDeleteStaticsTiles
ActiveControl = vstActions
Caption = 'Large Scale Commands'
ClientHeight = 397
ClientWidth = 620
@ -27,12 +27,12 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
TabOrder = 0
object pgArea: TPage
Caption = 'pgArea'
ClientWidth = 468
ClientHeight = 360
ClientWidth = 464
ClientHeight = 335
ParentFont = True
object sbArea: TScrollBox
Height = 360
Width = 468
Height = 335
Width = 464
Align = alClient
TabOrder = 0
object pbArea: TPaintBox
@ -46,8 +46,8 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
end
object pgCopyMove: TPage
Caption = 'Copy/Move'
ClientWidth = 468
ClientHeight = 360
ClientWidth = 464
ClientHeight = 335
ParentFont = True
object rgCMAction: TRadioGroup
Left = 12
@ -64,8 +64,8 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 2
ClientHeight = 40
ClientWidth = 184
ClientHeight = 23
ClientWidth = 180
Columns = 2
ItemIndex = 0
Items.Strings = (
@ -132,8 +132,8 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
end
object pgModifyAltitude: TPage
Caption = 'Modify altitude'
ClientWidth = 468
ClientHeight = 360
ClientWidth = 464
ClientHeight = 335
ParentFont = True
object Label2: TLabel
Left = 28
@ -218,18 +218,18 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
end
object pgDrawTerrain: TPage
Caption = 'Draw Terrain'
ClientWidth = 468
ClientHeight = 360
ClientWidth = 464
ClientHeight = 335
ParentFont = True
object gbDrawTerrainTiles: TGroupBox
Left = 8
Height = 344
Height = 319
Top = 8
Width = 225
Align = alLeft
BorderSpacing.Around = 8
Caption = 'Tiles'
ClientHeight = 328
ClientHeight = 315
ClientWidth = 221
ParentFont = True
TabOrder = 0
@ -250,7 +250,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Tag = 1
Cursor = 63
Left = 4
Height = 236
Height = 223
Top = 62
Width = 213
Align = alClient
@ -288,7 +288,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
end
object pnlDrawTerrainTilesControls: TPanel
Height = 26
Top = 302
Top = 289
Width = 221
Align = alBottom
BevelOuter = bvNone
@ -408,13 +408,13 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Align = alLeft
BorderSpacing.Around = 8
Caption = 'Tiles'
ClientHeight = 327
ClientHeight = 329
ClientWidth = 221
ParentFont = True
TabOrder = 0
object lblDeleteStaticsTilesDesc: TLabel
Left = 4
Height = 73
Height = 78
Width = 213
Align = alTop
BorderSpacing.Left = 4
@ -429,8 +429,8 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Tag = 1
Cursor = 63
Left = 4
Height = 220
Top = 77
Height = 217
Top = 82
Width = 213
Align = alClient
BorderSpacing.Left = 4
@ -467,7 +467,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
end
object pnlDrawTerrainTilesControls2: TPanel
Height = 26
Top = 301
Top = 303
Width = 221
Align = alBottom
BevelOuter = bvNone
@ -579,13 +579,13 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Top = 8
Width = 185
Caption = 'Z Boundaries'
ClientHeight = 75
ClientHeight = 77
ClientWidth = 181
ParentFont = True
TabOrder = 1
object Label7: TLabel
Left = 4
Height = 28
Height = 30
Width = 173
Align = alTop
BorderSpacing.Left = 4
@ -598,7 +598,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
end
object Label8: TLabel
Left = 64
Height = 13
Height = 14
Top = 42
Width = 12
Caption = 'to'
@ -632,17 +632,17 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
object pgInsertStatics: TPage
Caption = 'Insert statics'
ClientWidth = 464
ClientHeight = 360
ClientHeight = 335
ParentFont = True
object gbInserStaticsTiles: TGroupBox
Left = 8
Height = 344
Height = 319
Top = 8
Width = 225
Align = alLeft
BorderSpacing.Around = 8
Caption = 'Tiles'
ClientHeight = 327
ClientHeight = 315
ClientWidth = 221
ParentFont = True
TabOrder = 0
@ -662,7 +662,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
object vdtInsertStaticsTiles: TVirtualDrawTree
Tag = 1
Left = 4
Height = 235
Height = 223
Top = 62
Width = 213
Align = alClient
@ -700,7 +700,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
end
object pnlDrawTerrainTilesControls1: TPanel
Height = 26
Top = 301
Top = 289
Width = 221
Align = alBottom
BevelOuter = bvNone

68
Client/UfrmMain.lfm
View File

@ -5,7 +5,7 @@ object frmMain: TfrmMain
Width = 766
ActiveControl = pcLeft
Caption = 'UO CentrED'
ClientHeight = 574
ClientHeight = 578
ClientWidth = 766
Constraints.MinHeight = 603
Constraints.MinWidth = 766
@ -21,7 +21,7 @@ object frmMain: TfrmMain
WindowState = wsMaximized
object pnlBottom: TPanel
Height = 31
Top = 543
Top = 547
Width = 766
Align = alBottom
BevelOuter = bvNone
@ -110,7 +110,7 @@ object frmMain: TfrmMain
end
end
object pcLeft: TPageControl
Height = 519
Height = 523
Top = 24
Width = 224
ActivePage = tsTiles
@ -120,7 +120,7 @@ object frmMain: TfrmMain
TabOrder = 1
object tsTiles: TTabSheet
Caption = 'Tiles'
ClientHeight = 488
ClientHeight = 494
ClientWidth = 220
ParentFont = True
object pnlTileListSettings: TPanel
@ -134,18 +134,18 @@ object frmMain: TfrmMain
TabOrder = 0
object lblFilter: TLabel
Left = 84
Height = 13
Height = 14
Top = 8
Width = 33
Width = 30
Caption = 'Filter:'
ParentColor = False
ParentFont = True
end
object cbTerrain: TCheckBox
Left = 4
Height = 20
Height = 21
Top = 8
Width = 66
Width = 60
Caption = 'Terrain'
Checked = True
OnChange = cbTerrainChange
@ -155,9 +155,9 @@ object frmMain: TfrmMain
end
object cbStatics: TCheckBox
Left = 4
Height = 20
Height = 21
Top = 32
Width = 64
Width = 59
Caption = 'Statics'
Checked = True
OnChange = cbStaticsChange
@ -177,7 +177,7 @@ object frmMain: TfrmMain
end
object vdtTiles: TVirtualDrawTree
Tag = 1
Height = 234
Height = 240
Top = 56
Width = 220
Align = alClient
@ -221,18 +221,18 @@ object frmMain: TfrmMain
end
object gbRandom: TGroupBox
Height = 193
Top = 295
Top = 301
Width = 220
Align = alBottom
Caption = 'Random pool'
ClientHeight = 176
ClientHeight = 178
ClientWidth = 216
ParentFont = True
TabOrder = 2
object vdtRandom: TVirtualDrawTree
Tag = 1
Cursor = 63
Height = 124
Height = 126
Top = 22
Width = 216
Align = alClient
@ -420,7 +420,7 @@ object frmMain: TfrmMain
object pnlRandomPreset: TPanel
Left = 4
Height = 22
Top = 150
Top = 152
Width = 208
Align = alBottom
BorderSpacing.Around = 4
@ -540,7 +540,7 @@ object frmMain: TfrmMain
object spTileList: TSplitter
Cursor = crVSplit
Height = 5
Top = 290
Top = 296
Width = 220
Align = alBottom
ResizeAnchor = akBottom
@ -563,12 +563,12 @@ object frmMain: TfrmMain
end
object tsClients: TTabSheet
Caption = 'Clients'
ClientHeight = 519
ClientWidth = 224
ClientHeight = 494
ClientWidth = 220
ParentFont = True
object lbClients: TListBox
Height = 519
Width = 224
Height = 494
Width = 220
Align = alClient
OnDblClick = mnuGoToClientClick
ParentFont = True
@ -580,15 +580,15 @@ object frmMain: TfrmMain
end
object tsLocations: TTabSheet
Caption = 'Locations'
ClientHeight = 519
ClientWidth = 224
ClientHeight = 494
ClientWidth = 220
ParentFont = True
object vstLocations: TVirtualStringTree
Cursor = 63
Left = 4
Height = 483
Height = 458
Top = 4
Width = 216
Width = 212
Align = alClient
BorderSpacing.Around = 4
BorderStyle = bsSingle
@ -614,20 +614,20 @@ object frmMain: TfrmMain
end
item
Position = 1
Width = 141
Width = 137
WideText = 'Name'
end>
end
object pnlLocationControls: TPanel
Left = 4
Height = 24
Top = 491
Width = 216
Top = 466
Width = 212
Align = alBottom
BorderSpacing.Around = 4
BevelOuter = bvNone
ClientHeight = 24
ClientWidth = 216
ClientWidth = 212
ParentFont = True
TabOrder = 1
object btnClearLocations: TSpeedButton
@ -951,17 +951,17 @@ object frmMain: TfrmMain
end
object pnlMain: TPanel
Left = 224
Height = 519
Height = 523
Top = 24
Width = 542
Align = alClient
BevelOuter = bvNone
ClientHeight = 519
ClientHeight = 523
ClientWidth = 542
ParentFont = True
TabOrder = 3
object oglGameWindow: TOpenGLControl
Height = 368
Height = 372
Width = 542
Align = alClient
OnDblClick = oglGameWindowDblClick
@ -975,7 +975,7 @@ object frmMain: TfrmMain
end
object pnlChatHeader: TPanel
Height = 24
Top = 368
Top = 372
Width = 542
Align = alBottom
BevelInner = bvRaised
@ -1003,7 +1003,7 @@ object frmMain: TfrmMain
end
object pnlChat: TPanel
Height = 122
Top = 397
Top = 401
Width = 542
Align = alBottom
BevelOuter = bvNone
@ -1059,7 +1059,7 @@ object frmMain: TfrmMain
object spChat: TSplitter
Cursor = crVSplit
Height = 5
Top = 392
Top = 396
Width = 542
Align = alBottom
AutoSnap = False

14
Client/UfrmMain.pas
View File

@ -32,9 +32,9 @@ interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Menus,
ComCtrls, OpenGLContext, GL, GLU, UGameResources, ULandscape, ExtCtrls,
StdCtrls, Spin, UEnums, VTHeaderPopup, VirtualTrees, Buttons, UMulBlock,
UWorldItem, math, LCLIntf, UOverlayUI, UStatics, UEnhancedMemoryStream,
ActnList, ImagingClasses, contnrs, dateutils, UPlatformTypes;
StdCtrls, Spin, UEnums, VirtualTrees, Buttons, UMulBlock, UWorldItem, math,
LCLIntf, UOverlayUI, UStatics, UEnhancedMemoryStream, ActnList,
ImagingClasses, dateutils, UPlatformTypes;
type
@ -1030,6 +1030,7 @@ begin
end else
Delete(enteredText, Length(enteredText), 1);
tileID := 0;
if not TryStrToInt(enteredText, tileID) then
begin
//edSearchID.Font.Color := clRed;
@ -1306,8 +1307,10 @@ end;
procedure TfrmMain.vdtTilesHotChange(Sender: TBaseVirtualTree; OldNode,
NewNode: PVirtualNode);
{$IFDEF Windows}
var
tileInfo: PTileInfo;
{$ENDIF Windows}
begin
{TODO : Fix mouse over on !Windows platforms}
{$IFDEF Windows}
@ -1440,6 +1443,7 @@ begin
locationInfo := Sender.GetNodeData(Node);
Stream.Read(locationInfo^.X, SizeOf(Word));
Stream.Read(locationInfo^.Y, SizeOf(Word));
stringLength := 0;
Stream.Read(stringLength, SizeOf(Integer));
SetLength(s, stringLength);
Stream.Read(s[1], stringLength);
@ -1570,7 +1574,7 @@ var
virtualTile: TVirtualTile;
staticsFilter: TStaticFilter;
procedure GetMapDrawOffset(x, y: Integer; var drawX, drawY: Single);
procedure GetMapDrawOffset(x, y: Integer; out drawX, drawY: Single);
begin
drawX := (oglGameWindow.Width div 2) + (x - y) * 22;
drawY := (oglGamewindow.Height div 2) + (x + y) * 22;
@ -1578,10 +1582,12 @@ var
begin
drawDistance := Trunc(Sqrt(oglGameWindow.Width * oglGameWindow.Width + oglGamewindow.Height * oglGamewindow.Height) / 44);
{$HINTS off}{$WARNINGS off}
if FX - drawDistance < 0 then lowOffX := -FX else lowOffX := -drawDistance;
if FY - drawDistance < 0 then lowOffY := -FY else lowOffY := -drawDistance;
if FX + drawDistance >= FLandscape.Width * 8 then highOffX := FLandscape.Width * 8 - FX - 1 else highOffX := drawDistance;
if FY + drawDistance >= FLandscape.Height * 8 then highOffY := FLandscape.Height * 8 - FY - 1 else highOffY := drawDistance;
{$HINTS on}{$WARNINGS on}
FLandscape.PrepareBlocks((FX + lowOffX) div 8, (FY + lowOffY) div 8, (FX + highOffX) div 8 + 1, (FY + highOffY) div 8 + 1);

11
Client/UfrmRegionControl.lfm
View File

@ -287,10 +287,8 @@ object frmRegionControl: TfrmRegionControl
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
TreeOptions.SelectionOptions = [toFullRowSelect]
OnChange = vstRegionsChange
OnEditing = vstRegionsOnEditing
OnFreeNode = vstRegionsFreeNode
OnGetText = vstRegionsGetText
OnNewText = vstRegionsNewText
Columns = <
item
Width = 158
@ -337,14 +335,14 @@ object frmRegionControl: TfrmRegionControl
ClientWidth = 612
ParentFont = True
TabOrder = 2
object btnExit: TButton
object btnClose: TButton
Left = 548
Height = 25
Width = 64
Align = alRight
Anchors = [akTop, akRight]
BorderSpacing.Left = 4
Caption = 'Exit'
Caption = 'Close'
OnClick = btnCloseClick
ParentFont = True
TabOrder = 0
@ -368,11 +366,12 @@ object frmRegionControl: TfrmRegionControl
top = 43
object mnuAddRegion: TMenuItem
Caption = 'Add'
OnClick = acAddGroup
OnClick = mnuAddRegionClick
end
object mnuRemoveRegion: TMenuItem
Caption = 'Remove'
OnClick = accRemoveGroup
Enabled = False
OnClick = mnuRemoveRegionClick
end
end
end

893
Client/UfrmRegionControl.pas
View File

@ -30,9 +30,9 @@ unit UfrmRegionControl;
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, CheckLst,
Classes, SysUtils, math, LResources, Forms, Controls, Graphics, Dialogs,
VirtualTrees, ExtCtrls, ImagingComponents, StdCtrls, Buttons, Spin, LCLIntf,
math, UPlatformTypes, UEnhancedMemoryStream, Menus, contnrs, URectList;
UEnhancedMemoryStream, Menus, URectList;
type
TAreaMoveType = (amLeft, amTop, amRight, amBottom);
@ -44,7 +44,7 @@ type
btnAddArea: TSpeedButton;
btnClearArea: TSpeedButton;
btnDeleteArea: TSpeedButton;
btnExit: TButton;
btnClose: TButton;
btnSave: TButton;
Label1: TLabel;
lblX: TLabel;
@ -64,8 +64,8 @@ type
seY2: TSpinEdit;
vstRegions: TVirtualStringTree;
vstArea: TVirtualStringTree;
procedure acAddGroup(Sender: TObject);
procedure accRemoveGroup(Sender: TObject);
procedure mnuAddRegionClick(Sender: TObject);
procedure mnuRemoveRegionClick(Sender: TObject);
procedure btnAddAreaClick(Sender: TObject);
procedure btnClearAreaClick(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
@ -87,14 +87,13 @@ type
procedure vstRegionsFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vstRegionsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
procedure vstRegionsNewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; const NewText: WideString);
procedure vstRegionsOnEditing(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; var Allowed: Boolean);
protected
FLastX: Integer;
FLastY: Integer;
FAreaMove: TAreaMove;
function FindRegion(AName: string): PVirtualNode;
procedure OnModifyRegionPacket(ABuffer: TEnhancedMemoryStream);
procedure OnDeleteRegionPacket(ABuffer: TEnhancedMemoryStream);
procedure OnListRegionsPacket(ABuffer: TEnhancedMemoryStream);
private
{ private declarations }
@ -108,33 +107,520 @@ var
implementation
uses
UGameResources, UfrmRadar, UfrmMain, UdmNetwork, UPacket, UPackets,
UGUIPlatformUtils, UAdminHandling, UPacketHandlers;
UGameResources, UfrmRadar, UfrmMain, UdmNetwork, UPacket, UGUIPlatformUtils,
UAdminHandling, UPacketHandlers;
type
{ TRequestRegionListPacket }
TRequestRegionListPacket = class(TPacket)
constructor Create;
end;
PRegionInfo = ^TRegionInfo;
TRegionInfo = record
Name: string;
Areas: TRectList;
end;
{ TModifyRegionPacket }
TModifyRegionPacket = class(TPacket)
constructor Create(ARegionInfo: TRegionInfo);
end;
{ TDeleteRegionPacket }
TDeleteRegionPacket = class(TPacket)
constructor Create(AName: string);
end;
{ TRequestRegionListPacket }
TRequestRegionListPacket = class(TPacket)
constructor Create;
end;
{ TModifyRegionPacket }
constructor TModifyRegionPacket.Create(ARegionInfo: TRegionInfo);
var
i: Integer;
count: Byte;
area: TRect;
begin
inherited Create($03, 0); //Admin Packet
FStream.WriteByte($08); //Admin PacketID
FStream.WriteStringNull(ARegionInfo.Name);
count := Min(ARegionInfo.Areas.Count, 256);
FStream.WriteByte(count);
for i := 0 to count - 1 do
begin
area := ARegionInfo.Areas.Rects[i];
FStream.WriteWord(area.Left);
FStream.WriteWord(area.Top);
FStream.WriteWord(area.Right);
FStream.WriteWord(area.Bottom);
end;
end;
{ TDeleteRegionPacket }
constructor TDeleteRegionPacket.Create(AName: string);
begin
inherited Create($03, 0); //Admin Packet
FStream.WriteByte($09); //Admin PacketID
FStream.WriteStringNull(AName);
end;
{ TRequestRegionListPacket }
constructor TRequestRegionListPacket.Create;
begin
inherited Create($03, 0);
FStream.WriteByte($0A);
inherited Create($03, 0); //Admin Packet
FStream.WriteByte($0A); //Admin PacketID
end;
{ TfrmRegionControl }
procedure TfrmRegionControl.FormCreate(Sender: TObject);
begin
pbArea.Width := frmRadarMap.Radar.Width;
pbArea.Height := frmRadarMap.Radar.Height;
seX1.MaxValue := ResMan.Landscape.CellWidth;
seX2.MaxValue := ResMan.Landscape.CellWidth;
seY1.MaxValue := ResMan.Landscape.CellHeight;
seY2.MaxValue := ResMan.Landscape.CellHeight;
vstArea.NodeDataSize := SizeOf(TRect);
vstRegions.NodeDataSize := SizeOf(TRegionInfo);
frmRadarMap.Dependencies.Add(pbArea);
AssignAdminPacketHandler($08, TPacketHandler.Create(0, @OnModifyRegionPacket));
AssignAdminPacketHandler($09, TPacketHandler.Create(0, @OnDeleteRegionPacket));
AssignAdminPacketHandler($0A, TPacketHandler.Create(0, @OnListRegionsPacket));
end;
procedure TfrmRegionControl.FormDestroy(Sender: TObject);
begin
frmRadarMap.Dependencies.Remove(pbArea);
if AdminPacketHandlers[$08] <> nil then FreeAndNil(AdminPacketHandlers[$08]);
if AdminPacketHandlers[$09] <> nil then FreeAndNil(AdminPacketHandlers[$09]);
if AdminPacketHandlers[$0A] <> nil then FreeAndNil(AdminPacketHandlers[$0A]);
end;
procedure TfrmRegionControl.FormShow(Sender: TObject);
begin
SetWindowParent(Handle, frmMain.Handle);
btnSave.Enabled := False; //no changes yet
dmNetwork.Send(TRequestRegionListPacket.Create);
end;
procedure TfrmRegionControl.btnSaveClick(Sender: TObject);
var
regionNode: PVirtualNode;
regionInfo: PRegionInfo;
areaNode: PVirtualNode;
areaInfo: PRect;
begin
btnSave.Enabled := False;
//Refresh the current region
regionNode := vstRegions.GetFirstSelected;
if regionNode <> nil then
begin
regionInfo := vstRegions.GetNodeData(regionNode);
regionInfo^.Areas.Clear;
areaNode := vstArea.GetFirst;
while areaNode <> nil do
begin
areaInfo := vstArea.GetNodeData(areaNode);
regionInfo^.Areas.Add(areaInfo^.Left, areaInfo^.Top, areaInfo^.Right,
areaInfo^.Bottom);
areaNode := vstArea.GetNext(areaNode);
end;
//Send the modified values
dmNetwork.Send(TModifyRegionPacket.Create(regionInfo^));
end;
//Clear the selection
vstRegions.ClearSelection;
end;
procedure TfrmRegionControl.mnuAddRegionClick(Sender: TObject);
var
regionName: string;
node: PVirtualNode;
regionInfo: PRegionInfo;
begin
regionName := '';
if InputQuery('New Region', 'Enter the name for the new region:', regionName) then
begin
if FindRegion(regionName) = nil then
begin
node := vstRegions.AddChild(nil);
regionInfo := vstRegions.GetNodeData(node);
regionInfo^.Name := regionName;
regionInfo^.Areas := TRectList.Create;
vstRegions.ClearSelection;
vstRegions.Selected[node] := True;
btnSave.Enabled := True;
end else
begin
MessageDlg('New Region', 'The region could not be added. A region with ' +
'that name already exists.', mtError, [mbOK], 0);
end;
end;
end;
procedure TfrmRegionControl.mnuRemoveRegionClick(Sender: TObject);
var
regionNode: PVirtualNode;
regionInfo: PRegionInfo;
begin
regionNode := vstRegions.GetFirstSelected;
if (regionNode <> nil) and (MessageDlg('Delete Region', 'Are you sure, you ' +
'want to delete the selected region?', mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
begin
regionInfo := vstRegions.GetNodeData(regionNode);
dmNetwork.Send(TDeleteRegionPacket.Create(regionInfo^.Name));
vstRegions.Selected[regionNode] := False;
end;
end;
procedure TfrmRegionControl.btnAddAreaClick(Sender: TObject);
var
node: PVirtualNode;
areaInfo: PRect;
begin
node := vstArea.AddChild(nil);
areaInfo := vstArea.GetNodeData(node);
areaInfo^.Left := 0;
areaInfo^.Top := 0;
areaInfo^.Right := 0;
areaInfo^.Bottom := 0;
vstArea.ClearSelection;
vstArea.Selected[node] := True;
vstArea.FocusedNode := node;
btnSave.Enabled := True; //possible change to be saved
end;
procedure TfrmRegionControl.btnClearAreaClick(Sender: TObject);
begin
vstArea.Clear;
vstAreaChange(vstArea, nil);
end;
procedure TfrmRegionControl.btnCloseClick(Sender: TObject);
begin
if btnSave.Enabled and (MessageDlg('Unsaved changes', 'There are unsaved ' +
'changes.' + #13#10+#13#10+ 'Do you want to save them now?',
mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
begin
btnSaveClick(Sender);
end;
Close;
end;
procedure TfrmRegionControl.btnDeleteAreaClick(Sender: TObject);
begin
vstArea.DeleteSelectedNodes;
vstAreaChange(vstArea, nil);
btnSave.Enabled := True; //possible change to be saved
end;
procedure TfrmRegionControl.pbAreaMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
areaNode, match: PVirtualNode;
areaInfo: PRect;
p: TPoint;
begin
FAreaMove := [];
p := Point(X * 8, Y * 8);
match := nil;
areaNode := vstArea.GetFirst;
while areaNode <> nil do //find the last matching area
begin
areaInfo := vstArea.GetNodeData(areaNode);
if PtInRect(areaInfo^, p) then
match := areaNode;
areaNode := vstArea.GetNext(areaNode);
end;
if match <> nil then
begin
areaInfo := vstArea.GetNodeData(match);
if p.x - areaInfo^.Left <= 64 then Include(FAreaMove, amLeft);
if p.y - areaInfo^.Top <= 64 then Include(FAreaMove, amTop);
if areaInfo^.Right - p.x <= 64 then Include(FAreaMove, amRight);
if areaInfo^.Bottom - p.y <= 64 then Include(FAreaMove, amBottom);
if FAreaMove = [] then
FAreaMove := [amLeft, amTop, amRight, amBottom];
end else
begin
match := vstArea.AddChild(nil);
areaInfo := vstArea.GetNodeData(match);
areaInfo^.Left := p.x;
areaInfo^.Top := p.y;
areaInfo^.Right := p.x;
areaInfo^.Bottom := p.y;
pbArea.Repaint;
FAreaMove := [amRight, amBottom];
end;
vstArea.ClearSelection;
vstArea.Selected[match] := True;
FLastX := X;
FLastY := Y;
end;
procedure TfrmRegionControl.pbAreaMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var
offsetX, offsetY: Integer;
begin
if (ssLeft in Shift) and (vstArea.GetFirstSelected <> nil) then
begin
offsetX := (X - FLastX) * 8;
offsetY := (Y - FLastY) * 8;
if amLeft in FAreaMove then seX1.Value := seX1.Value + offsetX;
if amRight in FAreaMove then seX2.Value := seX2.Value + offsetX;
if amTop in FAreaMove then seY1.Value := seY1.Value + offsetY;
if amBottom in FAreaMove then seY2.Value := seY2.Value + offsetY;
FLastX := X;
FLastY := Y;
seX1Change(nil);
end;
end;
procedure TfrmRegionControl.pbAreaPaint(Sender: TObject);
var
node: PVirtualNode;
areaInfo: PRect;
begin
DisplayImage(pbArea.Canvas, 0, 0, frmRadarMap.Radar);
pbArea.Canvas.Pen.Color := clRed;
pbArea.Canvas.Brush.Color := clMaroon;
pbArea.Canvas.Brush.Style := bsFDiagonal;
node := vstArea.GetFirst;
while node <> nil do
begin
if vstArea.Selected[node] then
begin
pbArea.Canvas.Pen.Width := 2;
pbArea.Canvas.Pen.Style := psSolid;
end else
begin
pbArea.Canvas.Pen.Width := 1;
pbArea.Canvas.Pen.Style := psDot;
end;
areaInfo := vstArea.GetNodeData(node);
pbArea.Canvas.Rectangle(areaInfo^.Left div 8, areaInfo^.Top div 8,
areaInfo^.Right div 8 + 1, areaInfo^.Bottom div 8 + 1);
node := vstArea.GetNext(node);
end;
end;
procedure TfrmRegionControl.seX1Change(Sender: TObject);
var
node: PVirtualNode;
areaInfo: PRect;
begin
node := vstArea.GetFirstSelected;
if node <> nil then
begin
areaInfo := vstArea.GetNodeData(node);
areaInfo^.Left := seX1.Value;
areaInfo^.Right := seX2.Value;
areaInfo^.Top := seY1.Value;
areaInfo^.Bottom := seY2.Value;
vstArea.InvalidateNode(node);
pbArea.Repaint;
btnSave.Enabled := True; //possible change to be saved
end;
end;
procedure TfrmRegionControl.vstAreaChange(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
areaInfo: PRect;
selected: Boolean;
begin
selected := (Node <> nil) and Sender.Selected[Node];
btnDeleteArea.Enabled := selected;
lblX.Enabled := selected;
lblY.Enabled := selected;
seX1.Enabled := selected;
seX2.Enabled := selected;
seY1.Enabled := selected;
seY2.Enabled := selected;
if selected then
begin
areaInfo := Sender.GetNodeData(Node);
seX1.Value := areaInfo^.Left;
seX2.Value := areaInfo^.Right;
seY1.Value := areaInfo^.Top;
seY2.Value := areaInfo^.Bottom;
end;
pbArea.Repaint;
end;
procedure TfrmRegionControl.vstAreaGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString);
var
areaInfo: PRect;
begin
areaInfo := Sender.GetNodeData(Node);
CellText := Format('(%d, %d), (%d, %d)', [areaInfo^.Left, areaInfo^.Top,
areaInfo^.Right, areaInfo^.Bottom]);
end;
procedure TfrmRegionControl.vstRegionsChange(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
i: Integer;
selected, areaNode: PVirtualNode;
regionInfo: PRegionInfo;
areaInfo: PRect;
begin
if btnSave.Enabled and (MessageDlg('Unsaved changes', 'There are unsaved ' +
'changes.' + #13#10+#13#10+ 'Do you want to save them now?',
mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
begin
btnSaveClick(Sender);
end;
vstArea.BeginUpdate;
vstArea.Clear;
selected := Sender.GetFirstSelected;
if selected <> nil then
begin
btnAddArea.Enabled := True;
btnClearArea.Enabled := True;
mnuRemoveRegion.Enabled := True;
regionInfo := Sender.GetNodeData(selected);
for i := 0 to regionInfo^.Areas.Count - 1 do
begin
areaNode := vstArea.AddChild(nil);
areaInfo := vstArea.GetNodeData(areaNode);
with regionInfo^.Areas.Rects[i] do
begin
areaInfo^.Left := Left;
areaInfo^.Top := Top;
areaInfo^.Right := Right;
areaInfo^.Bottom := Bottom;
end;
end;
end else
begin
btnAddArea.Enabled := False;
btnDeleteArea.Enabled := False;
btnClearArea.Enabled := False;
mnuRemoveRegion.Enabled := False;
end;
vstArea.EndUpdate;
pbArea.Repaint;
btnSave.Enabled := False; //no changes to be saved
end;
procedure TfrmRegionControl.vstRegionsFreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
regionInfo: PRegionInfo;
begin
regionInfo := Sender.GetNodeData(Node);
if regionInfo^.Areas <> nil then FreeAndNil(regionInfo^.Areas);
end;
procedure TfrmRegionControl.vstRegionsGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString);
var
regionInfo: PRegionInfo;
begin
regionInfo := Sender.GetNodeData(Node);
CellText := regionInfo^.Name;
end;
function TfrmRegionControl.FindRegion(AName: string): PVirtualNode;
var
regionInfo: PRegionInfo;
found: Boolean;
begin
found := False;
Result := vstRegions.GetFirst;
while (Result <> nil) and (not found) do
begin
regionInfo := vstRegions.GetNodeData(Result);
if regionInfo^.Name = AName then
found := True
else
Result := vstRegions.GetNext(Result);
end;
end;
procedure TfrmRegionControl.OnModifyRegionPacket(ABuffer: TEnhancedMemoryStream);
var
regionName: string;
regionNode: PVirtualNode;
regionInfo: PRegionInfo;
areaCount: Byte;
i: Integer;
x1, y1, x2, y2: Word;
begin
ABuffer.ReadByte; //status, not used yet
//TODO : Ask user how to proceed, if the added/modified packet conflicts with the currently edited region
regionName := ABuffer.ReadStringNull;
regionNode := FindRegion(regionName);
if regionNode = nil then
begin
regionNode := vstRegions.AddChild(nil);
regionInfo := vstRegions.GetNodeData(regionNode);
regionInfo^.Name := regionName;
regionInfo^.Areas := TRectList.Create;
end else
begin
regionInfo := vstRegions.GetNodeData(regionNode);
regionInfo^.Areas.Clear;
end;
areaCount := ABuffer.ReadByte;
for i := 0 to areaCount - 1 do
begin
x1 := ABuffer.ReadWord;
y1 := ABuffer.ReadWord;
x2 := ABuffer.ReadWord;
y2 := ABuffer.ReadWord;
regionInfo^.Areas.Add(x1, y1, x2, y2);
end;
if vstRegions.Selected[regionNode] then
begin
btnSave.Enabled := False;
vstRegionsChange(vstRegions, regionNode);
end;
end;
procedure TfrmRegionControl.OnDeleteRegionPacket(ABuffer: TEnhancedMemoryStream);
var
regionName: string;
regionNode: PVirtualNode;
begin
ABuffer.ReadByte; //status, not used yet
regionName := ABuffer.ReadStringNull;
regionNode := FindRegion(regionName);
//TODO : Ask user how to proceed, if the deleted packet conflicts with the currently edited region
if regionNode <> nil then
vstRegions.DeleteNode(regionNode);
end;
procedure TfrmRegionControl.OnListRegionsPacket(ABuffer: TEnhancedMemoryStream);
var
regionCount, areaCount: Byte;
@ -164,375 +650,6 @@ begin
vstRegions.EndUpdate;
end;
procedure TfrmRegionControl.FormCreate(Sender: TObject);
begin
pbArea.Width := frmRadarMap.Radar.Width;
pbArea.Height := frmRadarMap.Radar.Height;
seX1.MaxValue := ResMan.Landscape.CellWidth;
seX2.MaxValue := ResMan.Landscape.CellWidth;
seY1.MaxValue := ResMan.Landscape.CellHeight;
seY2.MaxValue := ResMan.Landscape.CellHeight;
vstArea.NodeDataSize := SizeOf(TRect);
vstRegions.NodeDataSize := SizeOf(TRegionInfo);
frmRadarMap.Dependencies.Add(pbArea);
AdminPacketHandlers[$0A] := TPacketHandler.Create(0, @OnListRegionsPacket);
end;
procedure TfrmRegionControl.btnDeleteAreaClick(Sender: TObject);
var
infoGroup: PRegionInfo;
i: Integer;
begin
if vstRegions.GetFirstSelected <> nil then
begin
infoGroup := vstRegions.GetNodeData(vstRegions.GetFirstSelected);
infoGroup^.Areas.Delete(vstArea.AbsoluteIndex(vstArea.GetFirstSelected));
vstRegionsChange(vstRegions, vstRegions.GetFirstSelected);
end;
end;
procedure TfrmRegionControl.btnSaveClick(Sender: TObject);
var
packet: TPacket;
stream: TEnhancedMemoryStream;
groupCount,areaCount: Byte;
i, j: Integer;
node: PVirtualNode;
groupInfo: PRegionInfo;
begin
packet := TPacket.Create($03, 0);
stream := packet.Stream;
stream.Position := stream.Size;
stream.WriteByte($09);
groupCount := Min(vstRegions.RootNodeCount, 255);
stream.WriteByte(groupCount);
if groupCount = 0 then Exit;
i := 0;
node := vstRegions.GetFirst;
while (node <> nil) and (i < groupCount) do
begin
groupInfo := vstRegions.GetNodeData(node);
stream.WriteStringNull(groupInfo^.Name);
areaCount:=Min(groupInfo^.Areas.Count,255);
stream.WriteByte(areaCount);
for j := 0 to areaCount-1 do
with groupInfo^.Areas.Rects[j] do
begin
stream.WriteWord(Min(Left, Right));
stream.WriteWord(Min(Top, Bottom));
stream.WriteWord(Max(Left, Right));
stream.WriteWord(Max(Top, Bottom));
end;
node := vstRegions.GetNext(node);
Inc(i);
end;
dmNetwork.Send(TCompressedPacket.Create(packet));
Close;
end;
procedure TfrmRegionControl.acAddGroup(Sender: TObject);
var
node : PVirtualNode;
infoGroup : PRegionInfo;
begin
node := vstRegions.AddChild(nil);
infoGroup := vstRegions.GetNodeData(node);
infoGroup^.Name := 'Unnamed';
infoGroup^.Areas := TRectList.Create;
end;
procedure TfrmRegionControl.accRemoveGroup(Sender: TObject);
begin
vstRegions.DeleteSelectedNodes;
vstRegionsChange(vstRegions, nil);
end;
procedure TfrmRegionControl.btnAddAreaClick(Sender: TObject);
var
node, selected: PVirtualNode;
areaInfo: ^TRect;
regionInfo: PRegionInfo;
begin
selected := vstRegions.GetFirstSelected;
if selected <> nil then
begin
regionInfo := vstRegions.GetNodeData(selected);
node := vstArea.AddChild(nil);
areaInfo := vstArea.GetNodeData(node);
areaInfo^.Left := 0;
areaInfo^.Top := 0;
areaInfo^.Right := 0;
areaInfo^.Bottom := 0;
regionInfo^.Areas.Add(0, 0, 0, 0);
vstArea.ClearSelection;
vstArea.Selected[node] := True;
vstArea.FocusedNode := node;
end;
end;
procedure TfrmRegionControl.btnClearAreaClick(Sender: TObject);
var
regionNode: PVirtualNode;
regionInfo: PRegionInfo;
i: Integer;
begin
regionNode := vstRegions.GetFirstSelected;
if regionNode <> nil then
begin
regionInfo := vstRegions.GetNodeData(regionNode);
regionInfo^.Areas.Clear;
vstRegionsChange(vstRegions, vstRegions.GetFirstSelected);
end;
end;
procedure TfrmRegionControl.btnCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmRegionControl.FormDestroy(Sender: TObject);
begin
frmRadarMap.Dependencies.Remove(pbArea);
if AdminPacketHandlers[$0A] <> nil then FreeAndNil(AdminPacketHandlers[$0A]);
end;
procedure TfrmRegionControl.FormShow(Sender: TObject);
begin
SetWindowParent(Handle, frmMain.Handle);
dmNetwork.Send(TRequestRegionListPacket.Create);
end;
procedure TfrmRegionControl.pbAreaMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
areaNode, regionNode, match: PVirtualNode;
areaInfo: ^TRect;
p: TPoint;
i: Integer;
regionInfo: PRegionInfo;
begin
FAreaMove := [];
p := Point(X * 8, Y * 8);
match := nil;
areaNode := vstArea.GetFirst;
while areaNode <> nil do //find the last matching area
begin
areaInfo := vstArea.GetNodeData(areaNode);
if PtInRect(areaInfo^, p) then
match := areaNode;
areaNode := vstArea.GetNext(areaNode);
end;
if match <> nil then
begin
areaInfo := vstArea.GetNodeData(match);
if p.x - areaInfo^.Left <= 64 then Include(FAreaMove, amLeft);
if p.y - areaInfo^.Top <= 64 then Include(FAreaMove, amTop);
if areaInfo^.Right - p.x <= 64 then Include(FAreaMove, amRight);
if areaInfo^.Bottom - p.y <= 64 then Include(FAreaMove, amBottom);
if FAreaMove = [] then
FAreaMove := [amLeft, amTop, amRight, amBottom];
end else
begin
regionNode := vstRegions.GetFirstSelected;
if regionNode <> nil then
begin
regionInfo := vstRegions.GetNodeData(regionNode);
match := vstArea.AddChild(nil);
areaInfo := vstArea.GetNodeData(match);
areaInfo^.Left := p.x;
areaInfo^.Top := p.y;
areaInfo^.Right := p.x;
areaInfo^.Bottom := p.y;
regionInfo^.Areas.Add(p.x, p.y, p.x, p.y);
pbArea.Repaint;
FAreaMove := [amRight, amBottom];
end;
end;
vstArea.ClearSelection;
vstArea.Selected[match] := True;
FLastX := X;
FLastY := Y;
end;
procedure TfrmRegionControl.pbAreaMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var
offsetX, offsetY: Integer;
begin
if (ssLeft in Shift) and (vstArea.GetFirstSelected <> nil) then
begin
offsetX := (X - FLastX) * 8;
offsetY := (Y - FLastY) * 8;
if amLeft in FAreaMove then seX1.Value := seX1.Value + offsetX;
if amRight in FAreaMove then seX2.Value := seX2.Value + offsetX;
if amTop in FAreaMove then seY1.Value := seY1.Value + offsetY;
if amBottom in FAreaMove then seY2.Value := seY2.Value + offsetY;
FLastX := X;
FLastY := Y;
seX1Change(nil);
end;
end;
procedure TfrmRegionControl.pbAreaPaint(Sender: TObject);
var
i: Integer;
node: PVirtualNode;
areaInfo: ^TRect;
begin
DisplayImage(pbArea.Canvas, 0, 0, frmRadarMap.Radar);
pbArea.Canvas.Pen.Color := clRed;
pbArea.Canvas.Brush.Color := clMaroon;
pbArea.Canvas.Brush.Style := bsFDiagonal;
node := vstArea.GetFirst;
while node <> nil do
begin
if vstArea.Selected[node] then
begin
pbArea.Canvas.Pen.Width := 2;
pbArea.Canvas.Pen.Style := psSolid;
end else
begin
pbArea.Canvas.Pen.Width := 1;
pbArea.Canvas.Pen.Style := psDot;
end;
areaInfo := vstArea.GetNodeData(node);
pbArea.Canvas.Rectangle(areaInfo^.Left div 8, areaInfo^.Top div 8,
areaInfo^.Right div 8 + 1, areaInfo^.Bottom div 8 + 1);
node := vstArea.GetNext(node);
end;
end;
procedure TfrmRegionControl.seX1Change(Sender: TObject);
var
node: PVirtualNode;
areaInfo: ^TRect;
regionInfo: PRegionInfo;
begin
node := vstArea.GetFirstSelected;
if node <> nil then
begin
areaInfo := vstArea.GetNodeData(node);
areaInfo^.Left := seX1.Value;
areaInfo^.Right := seX2.Value;
areaInfo^.Top := seY1.Value;
areaInfo^.Bottom := seY2.Value;
regionInfo:= vstRegions.GetNodeData(vstRegions.GetFirstSelected);
regionInfo^.Areas.Rects[vstArea.AbsoluteIndex(node)] := areaInfo^;
vstArea.InvalidateNode(node);
pbArea.Repaint;
end;
end;
procedure TfrmRegionControl.vstAreaChange(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
areaInfo: ^TRect;
selected: Boolean;
begin
selected := (Node <> nil) and Sender.Selected[Node];
btnDeleteArea.Enabled := selected;
lblX.Enabled := selected;
lblY.Enabled := selected;
seX1.Enabled := selected;
seX2.Enabled := selected;
seY1.Enabled := selected;
seY2.Enabled := selected;
if selected then
begin
areaInfo := Sender.GetNodeData(Node);
seX1.Value := areaInfo^.Left;
seX2.Value := areaInfo^.Right;
seY1.Value := areaInfo^.Top;
seY2.Value := areaInfo^.Bottom;
end;
pbArea.Repaint;
end;
procedure TfrmRegionControl.vstAreaGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString);
var
areaInfo: ^TRect;
begin
areaInfo := Sender.GetNodeData(Node);
CellText := Format('(%d, %d), (%d, %d)', [areaInfo^.Left, areaInfo^.Top,
areaInfo^.Right, areaInfo^.Bottom]);
end;
procedure TfrmRegionControl.vstRegionsChange(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
i: Integer;
areaNode: PVirtualNode;
regionInfo: PRegionInfo;
areaInfo: ^TRect;
begin
vstArea.BeginUpdate;
vstArea.Clear;
if Node <> nil then
begin
regionInfo := Sender.GetNodeData(Node);
for i := 0 to regionInfo^.Areas.Count - 1 do
begin
areaNode := vstArea.AddChild(nil);
areaInfo := vstArea.GetNodeData(areaNode);
with regionInfo^.Areas.Rects[i] do
begin
areaInfo^.Left := Left;
areaInfo^.Top := Top;
areaInfo^.Right := Right;
areaInfo^.Bottom := Bottom;
end;
end;
end;
vstArea.EndUpdate;
pbArea.Repaint;
end;
procedure TfrmRegionControl.vstRegionsFreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
regionInfo: PRegionInfo;
begin
regionInfo := Sender.GetNodeData(Node);
if regionInfo^.Areas <> nil then FreeAndNil(regionInfo^.Areas);
end;
procedure TfrmRegionControl.vstRegionsGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString);
var
regionInfo: PRegionInfo;
begin
regionInfo := Sender.GetNodeData(Node);
CellText := regionInfo^.Name;
end;
procedure TfrmRegionControl.vstRegionsNewText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; const NewText: WideString);
var
regionInfo: PRegionInfo;
begin
if (Node <> nil) then begin
regionInfo := Sender.GetNodeData(Node);
regionInfo^.Name := NewText;
end;
end;
procedure TfrmRegionControl.vstRegionsOnEditing(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
begin
Allowed := True;
end;
initialization
{$I UfrmRegionControl.lrs}

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>

5
UXmlHelper.pas
View File

@ -55,7 +55,7 @@ implementation
class function TXmlHelper.FindChild(AParent: TDOMElement; AName: string): TDOMElement;
var
i: Integer;
i: LongWord;
nodeList: TDOMNodeList;
begin
Result := nil;
@ -71,9 +71,6 @@ begin
end;
class function TXmlHelper.AssureElement(AParent: TDOMElement; AName: string): TDOMElement;
var
i: Integer;
nodeList: TDOMNodeList;
begin
Result := FindChild(AParent, AName);
if Result = nil then