diff --git a/Client/CentrED.lpi b/Client/CentrED.lpi
index ca7ca5c..1f264fd 100644
--- a/Client/CentrED.lpi
+++ b/Client/CentrED.lpi
@@ -40,7 +40,7 @@
-
+
@@ -229,10 +229,25 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
@@ -249,7 +264,6 @@
-
diff --git a/Client/CentrED.lpr b/Client/CentrED.lpr
index 3def0b4..ba4c799 100644
--- a/Client/CentrED.lpr
+++ b/Client/CentrED.lpr
@@ -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}
diff --git a/Client/UAdminHandling.pas b/Client/UAdminHandling.pas
index 95e98b5..3b41475 100644
--- a/Client/UAdminHandling.pas
+++ b/Client/UAdminHandling.pas
@@ -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.
+
diff --git a/Client/UfrmAccountControl.pas b/Client/UfrmAccountControl.pas
index c4da68b..bd3cf53 100644
--- a/Client/UfrmAccountControl.pas
+++ b/Client/UfrmAccountControl.pas
@@ -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;
diff --git a/Client/UfrmLargeScaleCommand.lfm b/Client/UfrmLargeScaleCommand.lfm
index 482b28b..1e8451c 100644
--- a/Client/UfrmLargeScaleCommand.lfm
+++ b/Client/UfrmLargeScaleCommand.lfm
@@ -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
diff --git a/Client/UfrmMain.lfm b/Client/UfrmMain.lfm
index 2e79066..d1cfa1a 100644
--- a/Client/UfrmMain.lfm
+++ b/Client/UfrmMain.lfm
@@ -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
diff --git a/Client/UfrmMain.pas b/Client/UfrmMain.pas
index 829becb..391993a 100644
--- a/Client/UfrmMain.pas
+++ b/Client/UfrmMain.pas
@@ -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);
diff --git a/Client/UfrmRegionControl.lfm b/Client/UfrmRegionControl.lfm
index 835fdf5..5eb4cfa 100644
--- a/Client/UfrmRegionControl.lfm
+++ b/Client/UfrmRegionControl.lfm
@@ -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
diff --git a/Client/UfrmRegionControl.pas b/Client/UfrmRegionControl.pas
index 579cbd9..a01fa08 100644
--- a/Client/UfrmRegionControl.pas
+++ b/Client/UfrmRegionControl.pas
@@ -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}
diff --git a/Server/UAccount.pas b/Server/UAccount.pas
index c4c60fe..b94c8f0 100644
--- a/Server/UAccount.pas
+++ b/Server/UAccount.pas
@@ -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;
diff --git a/Server/UAdminHandling.pas b/Server/UAdminHandling.pas
index f194acc..8624db4 100644
--- a/Server/UAdminHandling.pas
+++ b/Server/UAdminHandling.pas
@@ -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;
diff --git a/Server/UConfig.pas b/Server/UConfig.pas
index cdad211..bb47a58 100644
--- a/Server/UConfig.pas
+++ b/Server/UConfig.pas
@@ -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('');
diff --git a/Server/UConnectionHandling.pas b/Server/UConnectionHandling.pas
index 5845fb9..28a7f20 100644
--- a/Server/UConnectionHandling.pas
+++ b/Server/UConnectionHandling.pas
@@ -79,7 +79,6 @@ procedure OnLoginRequestPacket(ABuffer: TEnhancedMemoryStream;
var
username, passwordHash: string;
account: TAccount;
- pwHash: string;
netState: TNetState;
invalid: Boolean;
begin
diff --git a/Server/ULandscape.pas b/Server/ULandscape.pas
index 45f8d67..3a75f00 100644
--- a/Server/ULandscape.pas
+++ b/Server/ULandscape.pas
@@ -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;
diff --git a/Server/ULargeScaleOperations.pas b/Server/ULargeScaleOperations.pas
index 0083394..5f72ae7 100644
--- a/Server/ULargeScaleOperations.pas
+++ b/Server/ULargeScaleOperations.pas
@@ -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.
+
diff --git a/Server/UPacketHandlers.pas b/Server/UPacketHandlers.pas
index d4f800f..0c4fd84 100644
--- a/Server/UPacketHandlers.pas
+++ b/Server/UPacketHandlers.pas
@@ -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));
diff --git a/Server/URadarMap.pas b/Server/URadarMap.pas
index 99ea1fa..e772f05 100644
--- a/Server/URadarMap.pas
+++ b/Server/URadarMap.pas
@@ -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.
+
diff --git a/Server/URegions.pas b/Server/URegions.pas
index a91de5d..8bd56ea 100644
--- a/Server/URegions.pas
+++ b/Server/URegions.pas
@@ -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
diff --git a/Server/cedserver.lpi b/Server/cedserver.lpi
index 4bcba24..8c1dfad 100644
--- a/Server/cedserver.lpi
+++ b/Server/cedserver.lpi
@@ -102,7 +102,7 @@
-
+
@@ -114,7 +114,6 @@
-
diff --git a/UXmlHelper.pas b/UXmlHelper.pas
index fcbf13a..e23c408 100644
--- a/UXmlHelper.pas
+++ b/UXmlHelper.pas
@@ -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