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

2
Client/CentrED.lpr
View File

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

204
Client/UAdminHandling.pas
View File

@ -1,96 +1,108 @@
(* (*
* CDDL HEADER START * CDDL HEADER START
* *
* The contents of this file are subject to the terms of the * The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only * Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance * (the "License"). You may not use this file except in compliance
* with the License. * with the License.
* *
* You can obtain a copy of the license at * You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php. * http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions * See the License for the specific language governing permissions
* and limitations under the License. * and limitations under the License.
* *
* When distributing Covered Code, include this CDDL HEADER in each * When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at * file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable, * http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed * add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information: * by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner] * Portions Copyright [yyyy] [name of copyright owner]
* *
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2007 Andreas Schneider * Portions Copyright 2007 Andreas Schneider
*) *)
unit UAdminHandling; unit UAdminHandling;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, SysUtils, UPacket, UPacketHandlers, UEnhancedMemoryStream, UEnums; Classes, SysUtils, UPacket, UPacketHandlers, UEnhancedMemoryStream, UEnums;
type type
{ TFlushServerPacket } TAdminHandlerAlreadyAssignedException = class(Exception);
TFlushServerPacket = class(TPacket) { TFlushServerPacket }
constructor Create;
end; TFlushServerPacket = class(TPacket)
constructor Create;
{ TQuitServerPacket } end;
TQuitServerPacket = class(TPacket) { TQuitServerPacket }
constructor Create(AReason: string);
end; TQuitServerPacket = class(TPacket)
constructor Create(AReason: string);
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream); end;
var procedure AssignAdminPacketHandler(APacketID: Byte; AHandler: TPacketHandler);
AdminPacketHandlers: array[0..$FF] of TPacketHandler; procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream);
implementation var
AdminPacketHandlers: array[0..$FF] of TPacketHandler;
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream);
var implementation
packetHandler: TPacketHandler;
begin procedure AssignAdminPacketHandler(APacketID: Byte; AHandler: TPacketHandler);
packetHandler := AdminPacketHandlers[ABuffer.ReadByte]; begin
if packetHandler <> nil then if AdminPacketHandlers[APacketID] <> nil then
packetHandler.Process(ABuffer); raise TAdminHandlerAlreadyAssignedException.CreateFmt(
end; 'The AdminPacketHandler $%.2x is already assigned!', [APacketID]);
{ TFlushServerPacket } AdminPacketHandlers[APacketID] := AHandler;
end;
constructor TFlushServerPacket.Create;
begin procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream);
inherited Create($03, 0); var
FStream.WriteByte($01); packetHandler: TPacketHandler;
end; begin
packetHandler := AdminPacketHandlers[ABuffer.ReadByte];
{ TQuitServerPacket } if packetHandler <> nil then
packetHandler.Process(ABuffer);
constructor TQuitServerPacket.Create(AReason: string); end;
begin
inherited Create($03, 0); { TFlushServerPacket }
FStream.WriteByte($02);
FStream.WriteStringNull(AReason); constructor TFlushServerPacket.Create;
end; begin
inherited Create($03, 0);
{$WARNINGS OFF} FStream.WriteByte($01);
var end;
i: Integer;
{ TQuitServerPacket }
initialization
for i := 0 to $FF do constructor TQuitServerPacket.Create(AReason: string);
AdminPacketHandlers[i] := nil; begin
finalization inherited Create($03, 0);
for i := 0 to $FF do FStream.WriteByte($02);
if AdminPacketHandlers[i] <> nil then FStream.WriteStringNull(AReason);
AdminPacketHandlers[i].Free; end;
{$WARNINGS ON}
{$WARNINGS OFF}
end. 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 begin
vstAccounts.NodeDataSize := SizeOf(TAccountInfo); vstAccounts.NodeDataSize := SizeOf(TAccountInfo);
AdminPacketHandlers[$05] := TPacketHandler.Create(0, @OnModifyUserResponse); AssignAdminPacketHandler($05, TPacketHandler.Create(0, @OnModifyUserResponse));
AdminPacketHandlers[$06] := TPacketHandler.Create(0, @OnDeleteUserResponse); AssignAdminPacketHandler($06, TPacketHandler.Create(0, @OnDeleteUserResponse));
AdminPacketHandlers[$07] := TPacketHandler.Create(0, @OnListUsersPacket); AssignAdminPacketHandler($07, TPacketHandler.Create(0, @OnListUsersPacket));
end; end;
procedure TfrmAccountControl.FormClose(Sender: TObject; procedure TfrmAccountControl.FormClose(Sender: TObject;

60
Client/UfrmLargeScaleCommand.lfm
View File

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

68
Client/UfrmMain.lfm
View File

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

14
Client/UfrmMain.pas
View File

@ -32,9 +32,9 @@ interface
uses uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Menus, Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Menus,
ComCtrls, OpenGLContext, GL, GLU, UGameResources, ULandscape, ExtCtrls, ComCtrls, OpenGLContext, GL, GLU, UGameResources, ULandscape, ExtCtrls,
StdCtrls, Spin, UEnums, VTHeaderPopup, VirtualTrees, Buttons, UMulBlock, StdCtrls, Spin, UEnums, VirtualTrees, Buttons, UMulBlock, UWorldItem, math,
UWorldItem, math, LCLIntf, UOverlayUI, UStatics, UEnhancedMemoryStream, LCLIntf, UOverlayUI, UStatics, UEnhancedMemoryStream, ActnList,
ActnList, ImagingClasses, contnrs, dateutils, UPlatformTypes; ImagingClasses, dateutils, UPlatformTypes;
type type
@ -1030,6 +1030,7 @@ begin
end else end else
Delete(enteredText, Length(enteredText), 1); Delete(enteredText, Length(enteredText), 1);
tileID := 0;
if not TryStrToInt(enteredText, tileID) then if not TryStrToInt(enteredText, tileID) then
begin begin
//edSearchID.Font.Color := clRed; //edSearchID.Font.Color := clRed;
@ -1306,8 +1307,10 @@ end;
procedure TfrmMain.vdtTilesHotChange(Sender: TBaseVirtualTree; OldNode, procedure TfrmMain.vdtTilesHotChange(Sender: TBaseVirtualTree; OldNode,
NewNode: PVirtualNode); NewNode: PVirtualNode);
{$IFDEF Windows}
var var
tileInfo: PTileInfo; tileInfo: PTileInfo;
{$ENDIF Windows}
begin begin
{TODO : Fix mouse over on !Windows platforms} {TODO : Fix mouse over on !Windows platforms}
{$IFDEF Windows} {$IFDEF Windows}
@ -1440,6 +1443,7 @@ begin
locationInfo := Sender.GetNodeData(Node); locationInfo := Sender.GetNodeData(Node);
Stream.Read(locationInfo^.X, SizeOf(Word)); Stream.Read(locationInfo^.X, SizeOf(Word));
Stream.Read(locationInfo^.Y, SizeOf(Word)); Stream.Read(locationInfo^.Y, SizeOf(Word));
stringLength := 0;
Stream.Read(stringLength, SizeOf(Integer)); Stream.Read(stringLength, SizeOf(Integer));
SetLength(s, stringLength); SetLength(s, stringLength);
Stream.Read(s[1], stringLength); Stream.Read(s[1], stringLength);
@ -1570,7 +1574,7 @@ var
virtualTile: TVirtualTile; virtualTile: TVirtualTile;
staticsFilter: TStaticFilter; staticsFilter: TStaticFilter;
procedure GetMapDrawOffset(x, y: Integer; var drawX, drawY: Single); procedure GetMapDrawOffset(x, y: Integer; out drawX, drawY: Single);
begin begin
drawX := (oglGameWindow.Width div 2) + (x - y) * 22; drawX := (oglGameWindow.Width div 2) + (x - y) * 22;
drawY := (oglGamewindow.Height div 2) + (x + y) * 22; drawY := (oglGamewindow.Height div 2) + (x + y) * 22;
@ -1578,10 +1582,12 @@ var
begin begin
drawDistance := Trunc(Sqrt(oglGameWindow.Width * oglGameWindow.Width + oglGamewindow.Height * oglGamewindow.Height) / 44); 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 FX - drawDistance < 0 then lowOffX := -FX else lowOffX := -drawDistance;
if FY - drawDistance < 0 then lowOffY := -FY else lowOffY := -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 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; 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); 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.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
TreeOptions.SelectionOptions = [toFullRowSelect] TreeOptions.SelectionOptions = [toFullRowSelect]
OnChange = vstRegionsChange OnChange = vstRegionsChange
OnEditing = vstRegionsOnEditing
OnFreeNode = vstRegionsFreeNode OnFreeNode = vstRegionsFreeNode
OnGetText = vstRegionsGetText OnGetText = vstRegionsGetText
OnNewText = vstRegionsNewText
Columns = < Columns = <
item item
Width = 158 Width = 158
@ -337,14 +335,14 @@ object frmRegionControl: TfrmRegionControl
ClientWidth = 612 ClientWidth = 612
ParentFont = True ParentFont = True
TabOrder = 2 TabOrder = 2
object btnExit: TButton object btnClose: TButton
Left = 548 Left = 548
Height = 25 Height = 25
Width = 64 Width = 64
Align = alRight Align = alRight
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
BorderSpacing.Left = 4 BorderSpacing.Left = 4
Caption = 'Exit' Caption = 'Close'
OnClick = btnCloseClick OnClick = btnCloseClick
ParentFont = True ParentFont = True
TabOrder = 0 TabOrder = 0
@ -368,11 +366,12 @@ object frmRegionControl: TfrmRegionControl
top = 43 top = 43
object mnuAddRegion: TMenuItem object mnuAddRegion: TMenuItem
Caption = 'Add' Caption = 'Add'
OnClick = acAddGroup OnClick = mnuAddRegionClick
end end
object mnuRemoveRegion: TMenuItem object mnuRemoveRegion: TMenuItem
Caption = 'Remove' Caption = 'Remove'
OnClick = accRemoveGroup Enabled = False
OnClick = mnuRemoveRegionClick
end end
end end
end end

893
Client/UfrmRegionControl.pas
View File

@ -30,9 +30,9 @@ unit UfrmRegionControl;
interface interface
uses uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, CheckLst, Classes, SysUtils, math, LResources, Forms, Controls, Graphics, Dialogs,
VirtualTrees, ExtCtrls, ImagingComponents, StdCtrls, Buttons, Spin, LCLIntf, VirtualTrees, ExtCtrls, ImagingComponents, StdCtrls, Buttons, Spin, LCLIntf,
math, UPlatformTypes, UEnhancedMemoryStream, Menus, contnrs, URectList; UEnhancedMemoryStream, Menus, URectList;
type type
TAreaMoveType = (amLeft, amTop, amRight, amBottom); TAreaMoveType = (amLeft, amTop, amRight, amBottom);
@ -44,7 +44,7 @@ type
btnAddArea: TSpeedButton; btnAddArea: TSpeedButton;
btnClearArea: TSpeedButton; btnClearArea: TSpeedButton;
btnDeleteArea: TSpeedButton; btnDeleteArea: TSpeedButton;
btnExit: TButton; btnClose: TButton;
btnSave: TButton; btnSave: TButton;
Label1: TLabel; Label1: TLabel;
lblX: TLabel; lblX: TLabel;
@ -64,8 +64,8 @@ type
seY2: TSpinEdit; seY2: TSpinEdit;
vstRegions: TVirtualStringTree; vstRegions: TVirtualStringTree;
vstArea: TVirtualStringTree; vstArea: TVirtualStringTree;
procedure acAddGroup(Sender: TObject); procedure mnuAddRegionClick(Sender: TObject);
procedure accRemoveGroup(Sender: TObject); procedure mnuRemoveRegionClick(Sender: TObject);
procedure btnAddAreaClick(Sender: TObject); procedure btnAddAreaClick(Sender: TObject);
procedure btnClearAreaClick(Sender: TObject); procedure btnClearAreaClick(Sender: TObject);
procedure btnCloseClick(Sender: TObject); procedure btnCloseClick(Sender: TObject);
@ -87,14 +87,13 @@ type
procedure vstRegionsFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure vstRegionsFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vstRegionsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; procedure vstRegionsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString); 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 protected
FLastX: Integer; FLastX: Integer;
FLastY: Integer; FLastY: Integer;
FAreaMove: TAreaMove; FAreaMove: TAreaMove;
function FindRegion(AName: string): PVirtualNode;
procedure OnModifyRegionPacket(ABuffer: TEnhancedMemoryStream);
procedure OnDeleteRegionPacket(ABuffer: TEnhancedMemoryStream);
procedure OnListRegionsPacket(ABuffer: TEnhancedMemoryStream); procedure OnListRegionsPacket(ABuffer: TEnhancedMemoryStream);
private private
{ private declarations } { private declarations }
@ -108,33 +107,520 @@ var
implementation implementation
uses uses
UGameResources, UfrmRadar, UfrmMain, UdmNetwork, UPacket, UPackets, UGameResources, UfrmRadar, UfrmMain, UdmNetwork, UPacket, UGUIPlatformUtils,
UGUIPlatformUtils, UAdminHandling, UPacketHandlers; UAdminHandling, UPacketHandlers;
type type
{ TRequestRegionListPacket }
TRequestRegionListPacket = class(TPacket)
constructor Create;
end;
PRegionInfo = ^TRegionInfo; PRegionInfo = ^TRegionInfo;
TRegionInfo = record TRegionInfo = record
Name: string; Name: string;
Areas: TRectList; Areas: TRectList;
end; 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 } { TRequestRegionListPacket }
constructor TRequestRegionListPacket.Create; constructor TRequestRegionListPacket.Create;
begin begin
inherited Create($03, 0); inherited Create($03, 0); //Admin Packet
FStream.WriteByte($0A); FStream.WriteByte($0A); //Admin PacketID
end; end;
{ TfrmRegionControl } { 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); procedure TfrmRegionControl.OnListRegionsPacket(ABuffer: TEnhancedMemoryStream);
var var
regionCount, areaCount: Byte; regionCount, areaCount: Byte;
@ -164,375 +650,6 @@ begin
vstRegions.EndUpdate; vstRegions.EndUpdate;
end; 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 initialization
{$I UfrmRegionControl.lrs} {$I UfrmRegionControl.lrs}

5
Server/UAccount.pas
View File

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

21
Server/UAdminHandling.pas
View File

@ -90,6 +90,20 @@ implementation
uses uses
md5, UCEDServer, UPackets, UClientHandling; 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; procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState); ANetState: TNetState);
var var
@ -250,7 +264,9 @@ begin
Max(x1, x2), Max(y1, y2)); Max(x1, x2), Max(y1, y2));
end; end;
CEDServerInstance.SendPacket(ANetState, Config.Regions.Invalidate;
AdminBroadcast(alAdministrator,
TModifyRegionResponsePacket.Create(status, region)); TModifyRegionResponsePacket.Create(status, region));
end; end;
@ -271,12 +287,13 @@ begin
if TRegion(regions[i]).Name = regionName then if TRegion(regions[i]).Name = regionName then
begin begin
regions.Delete(i); regions.Delete(i);
regions.Invalidate;
status := drDeleted; status := drDeleted;
end else end else
inc(i); inc(i);
end; end;
CEDServerInstance.SendPacket(ANetState, AdminBroadcast(alAdministrator,
TDeleteRegionResponsePacket.Create(status, regionName)); TDeleteRegionResponsePacket.Create(status, regionName));
end; end;

2
Server/UConfig.pas
View File

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

1
Server/UConnectionHandling.pas
View File

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

15
Server/ULandscape.pas
View File

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

760
Server/ULargeScaleOperations.pas
View File

@ -1,380 +1,380 @@
(* (*
* CDDL HEADER START * CDDL HEADER START
* *
* The contents of this file are subject to the terms of the * The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only * Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance * (the "License"). You may not use this file except in compliance
* with the License. * with the License.
* *
* You can obtain a copy of the license at * You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php. * http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions * See the License for the specific language governing permissions
* and limitations under the License. * and limitations under the License.
* *
* When distributing Covered Code, include this CDDL HEADER in each * When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at * file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable, * http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed * add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information: * by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner] * Portions Copyright [yyyy] [name of copyright owner]
* *
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2007 Andreas Schneider * Portions Copyright 2007 Andreas Schneider
*) *)
unit ULargeScaleOperations; unit ULargeScaleOperations;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, SysUtils, UMap, UStatics, UEnhancedMemoryStream, math, Classes, SysUtils, UMap, UStatics, UEnhancedMemoryStream, math,
ULandscape; ULandscape;
type type
TCopyMoveType = (cmCopy = 0, cmMove = 1); TCopyMoveType = (cmCopy = 0, cmMove = 1);
TSetAltitudeType = (saTerrain = 1, saRelative = 2); TSetAltitudeType = (saTerrain = 1, saRelative = 2);
TStaticsPlacement = (spTerrain = 1, spTop = 2, spFix = 3); TStaticsPlacement = (spTerrain = 1, spTop = 2, spFix = 3);
{ TLargeScaleOperation } { TLargeScaleOperation }
TLargeScaleOperation = class(TObject) TLargeScaleOperation = class(TObject)
constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); virtual; constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); virtual;
protected protected
FLandscape: TLandscape; FLandscape: TLandscape;
public public
procedure Apply(AMapCell: TMapCell; AStatics: TList; procedure Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); virtual; abstract; AAdditionalAffectedBlocks: TBits); virtual; abstract;
end; end;
{ TLSCopyMove } { TLSCopyMove }
TLSCopyMove = class(TLargeScaleOperation) TLSCopyMove = class(TLargeScaleOperation)
constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); override; constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); override;
protected protected
FType: TCopyMoveType; FType: TCopyMoveType;
FOffsetX: Integer; FOffsetX: Integer;
FOffsetY: Integer; FOffsetY: Integer;
FErase: Boolean; FErase: Boolean;
public public
property OffsetX: Integer read FOffsetX; property OffsetX: Integer read FOffsetX;
property OffsetY: Integer read FOffsetY; property OffsetY: Integer read FOffsetY;
procedure Apply(AMapCell: TMapCell; AStatics: TList; procedure Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); override; AAdditionalAffectedBlocks: TBits); override;
end; end;
{ TLSSetAltitude } { TLSSetAltitude }
TLSSetAltitude = class(TLargeScaleOperation) TLSSetAltitude = class(TLargeScaleOperation)
constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); override; constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); override;
protected protected
FType: TSetAltitudeType; FType: TSetAltitudeType;
FMinZ: ShortInt; FMinZ: ShortInt;
FMaxZ: ShortInt; FMaxZ: ShortInt;
FRelativeZ: ShortInt; FRelativeZ: ShortInt;
public public
procedure Apply(AMapCell: TMapCell; AStatics: TList; procedure Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); override; AAdditionalAffectedBlocks: TBits); override;
end; end;
{ TLSDrawTerrain } { TLSDrawTerrain }
TLSDrawTerrain = class(TLargeScaleOperation) TLSDrawTerrain = class(TLargeScaleOperation)
constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); override; constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); override;
protected protected
FTileIDs: array of Word; FTileIDs: array of Word;
public public
procedure Apply(AMapCell: TMapCell; AStatics: TList; procedure Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); override; AAdditionalAffectedBlocks: TBits); override;
end; end;
{ TLSDeleteStatics } { TLSDeleteStatics }
TLSDeleteStatics = class(TLargeScaleOperation) TLSDeleteStatics = class(TLargeScaleOperation)
constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); override; constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); override;
protected protected
FTileIDs: array of Word; FTileIDs: array of Word;
FMinZ: ShortInt; FMinZ: ShortInt;
FMaxZ: ShortInt; FMaxZ: ShortInt;
public public
procedure Apply(AMapCell: TMapCell; AStatics: TList; procedure Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); override; AAdditionalAffectedBlocks: TBits); override;
end; end;
{ TLSInsertStatics } { TLSInsertStatics }
TLSInsertStatics = class(TLargeScaleOperation) TLSInsertStatics = class(TLargeScaleOperation)
constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); override; constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); override;
protected protected
FTileIDs: array of Word; FTileIDs: array of Word;
FProbability: Byte; FProbability: Byte;
FPlacementType: TStaticsPlacement; FPlacementType: TStaticsPlacement;
FFixZ: ShortInt; FFixZ: ShortInt;
public public
procedure Apply(AMapCell: TMapCell; AStatics: TList; procedure Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); override; AAdditionalAffectedBlocks: TBits); override;
end; end;
implementation implementation
uses uses
UCEDServer, UTiledata; UCEDServer;
{ TLargeScaleOperation } { TLargeScaleOperation }
constructor TLargeScaleOperation.Init(AData: TEnhancedMemoryStream; constructor TLargeScaleOperation.Init(AData: TEnhancedMemoryStream;
ALandscape: TLandscape); ALandscape: TLandscape);
begin begin
inherited Create; inherited Create;
FLandscape := ALandscape; FLandscape := ALandscape;
end; end;
{ TLSCopyMove } { TLSCopyMove }
constructor TLSCopyMove.Init(AData: TEnhancedMemoryStream; constructor TLSCopyMove.Init(AData: TEnhancedMemoryStream;
ALandscape: TLandscape); ALandscape: TLandscape);
begin begin
inherited Init(AData, ALandscape); inherited Init(AData, ALandscape);
FType := TCopyMoveType(AData.ReadByte); FType := TCopyMoveType(AData.ReadByte);
FOffsetX := AData.ReadInteger; FOffsetX := AData.ReadInteger;
FOffsetY := AData.ReadInteger; FOffsetY := AData.ReadInteger;
FErase := AData.ReadBoolean; FErase := AData.ReadBoolean;
end; end;
procedure TLSCopyMove.Apply(AMapCell: TMapCell; AStatics: TList; procedure TLSCopyMove.Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); AAdditionalAffectedBlocks: TBits);
var var
x, y: Word; x, y: Word;
targetCell: TMapCell; targetCell: TMapCell;
targetStatics: TList; targetStatics: TList;
targetStaticsBlock: TSeperatedStaticBlock; targetStaticsBlock: TSeperatedStaticBlock;
i: Integer; i: Integer;
staticItem: TStaticItem; staticItem: TStaticItem;
begin begin
x := EnsureRange(AMapCell.X + FOffsetX, 0, FLandscape.CellWidth - 1); x := EnsureRange(AMapCell.X + FOffsetX, 0, FLandscape.CellWidth - 1);
y := EnsureRange(AMapCell.Y + FOffsetY, 0, FLandscape.CellHeight - 1); y := EnsureRange(AMapCell.Y + FOffsetY, 0, FLandscape.CellHeight - 1);
//writeln('target: ', x, ',', y); //writeln('target: ', x, ',', y);
targetCell := FLandscape.MapCell[x, y]; targetCell := FLandscape.MapCell[x, y];
targetStaticsBlock := FLandscape.GetStaticBlock(x div 8, y div 8); targetStaticsBlock := FLandscape.GetStaticBlock(x div 8, y div 8);
targetStatics := targetStaticsBlock.Cells[(y mod 8) * 8 + (x mod 8)]; targetStatics := targetStaticsBlock.Cells[(y mod 8) * 8 + (x mod 8)];
if FErase then if FErase then
begin begin
for i := 0 to targetStatics.Count - 1 do for i := 0 to targetStatics.Count - 1 do
begin begin
TStaticItem(targetStatics.Items[i]).Delete; TStaticItem(targetStatics.Items[i]).Delete;
end; end;
targetStatics.Clear; targetStatics.Clear;
end; end;
targetCell.TileID := AMapCell.TileID; targetCell.TileID := AMapCell.TileID;
targetCell.Z := AMapCell.Z; targetCell.Z := AMapCell.Z;
if FType = cmCopy then if FType = cmCopy then
begin begin
for i := 0 to AStatics.Count - 1 do for i := 0 to AStatics.Count - 1 do
begin begin
staticItem := TStaticItem.Create(nil, nil, 0, 0); staticItem := TStaticItem.Create(nil, nil, 0, 0);
staticItem.X := x; staticItem.X := x;
staticItem.Y := y; staticItem.Y := y;
staticItem.Z := TStaticItem(AStatics.Items[i]).Z; staticItem.Z := TStaticItem(AStatics.Items[i]).Z;
staticItem.TileID := TStaticItem(AStatics.Items[i]).TileID; staticItem.TileID := TStaticItem(AStatics.Items[i]).TileID;
staticItem.Hue := TStaticItem(AStatics.Items[i]).Hue; staticItem.Hue := TStaticItem(AStatics.Items[i]).Hue;
staticItem.Owner := targetStaticsBlock; staticItem.Owner := targetStaticsBlock;
targetStatics.Add(staticItem); targetStatics.Add(staticItem);
end; end;
end else end else
begin begin
{for i := 0 to AStatics.Count - 1 do} {for i := 0 to AStatics.Count - 1 do}
while AStatics.Count > 0 do while AStatics.Count > 0 do
begin begin
targetStatics.Add(AStatics.Items[0]); targetStatics.Add(AStatics.Items[0]);
TStaticItem(AStatics.Items[0]).UpdatePos(x, y, TStaticItem(AStatics.Items[0]).Z); TStaticItem(AStatics.Items[0]).UpdatePos(x, y, TStaticItem(AStatics.Items[0]).Z);
TStaticItem(AStatics.Items[0]).Owner := targetStaticsBlock; TStaticItem(AStatics.Items[0]).Owner := targetStaticsBlock;
AStatics.Delete(0); AStatics.Delete(0);
end; end;
//AStatics.Clear; //AStatics.Clear;
end; end;
FLandscape.SortStaticsList(targetStatics); FLandscape.SortStaticsList(targetStatics);
AAdditionalAffectedBlocks.Bits[(x div 8) * FLandscape.Height + (y div 8)] := True; AAdditionalAffectedBlocks.Bits[(x div 8) * FLandscape.Height + (y div 8)] := True;
end; end;
{ TLSSetAltitude } { TLSSetAltitude }
constructor TLSSetAltitude.Init(AData: TEnhancedMemoryStream; constructor TLSSetAltitude.Init(AData: TEnhancedMemoryStream;
ALandscape: TLandscape); ALandscape: TLandscape);
begin begin
inherited Init(AData, ALandscape); inherited Init(AData, ALandscape);
FType := TSetAltitudeType(AData.ReadByte); FType := TSetAltitudeType(AData.ReadByte);
case FType of case FType of
saTerrain: saTerrain:
begin begin
FMinZ := AData.ReadShortInt; FMinZ := AData.ReadShortInt;
FMaxZ := AData.ReadShortInt; FMaxZ := AData.ReadShortInt;
end; end;
saRelative: saRelative:
begin begin
FRelativeZ := AData.ReadShortInt; FRelativeZ := AData.ReadShortInt;
end; end;
end; end;
end; end;
procedure TLSSetAltitude.Apply(AMapCell: TMapCell; AStatics: TList; procedure TLSSetAltitude.Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); AAdditionalAffectedBlocks: TBits);
var var
i: Integer; i: Integer;
newZ: ShortInt; newZ: ShortInt;
diff: ShortInt; diff: ShortInt;
static: TStaticItem; static: TStaticItem;
begin begin
if FType = saTerrain then if FType = saTerrain then
begin begin
newZ := FMinZ + Random(FMaxZ - FMinZ + 1); newZ := FMinZ + Random(FMaxZ - FMinZ + 1);
diff := newZ - AMapCell.Z; diff := newZ - AMapCell.Z;
AMapCell.Z := newZ; AMapCell.Z := newZ;
end else end else
begin begin
diff := FRelativeZ; diff := FRelativeZ;
AMapCell.Z := EnsureRange(AMapCell.Z + diff, -128, 127); AMapCell.Z := EnsureRange(AMapCell.Z + diff, -128, 127);
end; end;
for i := 0 to AStatics.Count - 1 do for i := 0 to AStatics.Count - 1 do
begin begin
static := TStaticItem(AStatics.Items[i]); static := TStaticItem(AStatics.Items[i]);
static.Z := EnsureRange(static.Z + diff, -128, 127); static.Z := EnsureRange(static.Z + diff, -128, 127);
end; end;
end; end;
{ TLSDrawTerrain } { TLSDrawTerrain }
constructor TLSDrawTerrain.Init(AData: TEnhancedMemoryStream; constructor TLSDrawTerrain.Init(AData: TEnhancedMemoryStream;
ALandscape: TLandscape); ALandscape: TLandscape);
var var
count: Word; count: Word;
begin begin
inherited Init(AData, ALandscape); inherited Init(AData, ALandscape);
count := AData.ReadWord; count := AData.ReadWord;
SetLength(FTileIDs, count); SetLength(FTileIDs, count);
AData.Read(FTileIDs[0], count * SizeOf(Word)); AData.Read(FTileIDs[0], count * SizeOf(Word));
end; end;
procedure TLSDrawTerrain.Apply(AMapCell: TMapCell; AStatics: TList; procedure TLSDrawTerrain.Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); AAdditionalAffectedBlocks: TBits);
begin begin
if Length(FTileIDs) > 0 then if Length(FTileIDs) > 0 then
AMapCell.TileID := FTileIDs[Random(Length(FTileIDs))]; AMapCell.TileID := FTileIDs[Random(Length(FTileIDs))];
end; end;
{ TLSDeleteStatics } { TLSDeleteStatics }
constructor TLSDeleteStatics.Init(AData: TEnhancedMemoryStream; constructor TLSDeleteStatics.Init(AData: TEnhancedMemoryStream;
ALandscape: TLandscape); ALandscape: TLandscape);
var var
count: Word; count: Word;
begin begin
inherited Init(AData, ALandscape); inherited Init(AData, ALandscape);
count := AData.ReadWord; count := AData.ReadWord;
SetLength(FTileIDs, count); SetLength(FTileIDs, count);
AData.Read(FTileIDs[0], count * SizeOf(Word)); AData.Read(FTileIDs[0], count * SizeOf(Word));
FMinZ := AData.ReadShortInt; FMinZ := AData.ReadShortInt;
FMaxZ := AData.ReadShortInt; FMaxZ := AData.ReadShortInt;
end; end;
procedure TLSDeleteStatics.Apply(AMapCell: TMapCell; AStatics: TList; procedure TLSDeleteStatics.Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); AAdditionalAffectedBlocks: TBits);
var var
i, j: Integer; i, j: Integer;
static: TStaticItem; static: TStaticItem;
begin begin
i := 0; i := 0;
while i < AStatics.Count do while i < AStatics.Count do
begin begin
static := TStaticItem(AStatics.Items[i]); static := TStaticItem(AStatics.Items[i]);
if InRange(static.Z, FMinZ, FMaxZ) then if InRange(static.Z, FMinZ, FMaxZ) then
begin begin
if Length(FTileIDs) > 0 then if Length(FTileIDs) > 0 then
begin begin
for j := Low(FTileIDs) to High(FTileIDs) do for j := Low(FTileIDs) to High(FTileIDs) do
begin begin
if static.TileID = FTileIDs[j] - $4000 then if static.TileID = FTileIDs[j] - $4000 then
begin begin
AStatics.Delete(i); AStatics.Delete(i);
static.Delete; static.Delete;
Dec(i); Dec(i);
Break; Break;
end; end;
end; end;
Inc(i); Inc(i);
end else end else
begin begin
AStatics.Delete(i); AStatics.Delete(i);
static.Delete; static.Delete;
end; end;
end else end else
Inc(i); Inc(i);
end; end;
end; end;
{ TLSInsertStatics } { TLSInsertStatics }
constructor TLSInsertStatics.Init(AData: TEnhancedMemoryStream; constructor TLSInsertStatics.Init(AData: TEnhancedMemoryStream;
ALandscape: TLandscape); ALandscape: TLandscape);
var var
count: Word; count: Word;
begin begin
inherited Init(AData, ALandscape); inherited Init(AData, ALandscape);
count := AData.ReadWord; count := AData.ReadWord;
SetLength(FTileIDs, count); SetLength(FTileIDs, count);
AData.Read(FTileIDs[0], count * SizeOf(Word)); AData.Read(FTileIDs[0], count * SizeOf(Word));
FProbability := AData.ReadByte; FProbability := AData.ReadByte;
FPlacementType := TStaticsPlacement(AData.ReadByte); FPlacementType := TStaticsPlacement(AData.ReadByte);
if FPlacementType = spFix then if FPlacementType = spFix then
FFixZ := AData.ReadShortInt; FFixZ := AData.ReadShortInt;
end; end;
procedure TLSInsertStatics.Apply(AMapCell: TMapCell; AStatics: TList; procedure TLSInsertStatics.Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); AAdditionalAffectedBlocks: TBits);
var var
staticItem, static: TStaticItem; staticItem, static: TStaticItem;
topZ, staticTop: ShortInt; topZ, staticTop: ShortInt;
i: Integer; i: Integer;
begin begin
if (Length(FTileIDs) = 0) or (Random(100) >= FProbability) then Exit; if (Length(FTileIDs) = 0) or (Random(100) >= FProbability) then Exit;
staticItem := TStaticItem.Create(nil, nil, 0, 0); staticItem := TStaticItem.Create(nil, nil, 0, 0);
staticItem.X := AMapCell.X; staticItem.X := AMapCell.X;
staticItem.Y := AMapCell.Y; staticItem.Y := AMapCell.Y;
staticItem.TileID := FTileIDs[Random(Length(FTileIDs))] - $4000; staticItem.TileID := FTileIDs[Random(Length(FTileIDs))] - $4000;
staticItem.Hue := 0; staticItem.Hue := 0;
case FPlacementType of case FPlacementType of
spTerrain: spTerrain:
begin begin
staticItem.Z := AMapCell.Z; staticItem.Z := AMapCell.Z;
end; end;
spTop: spTop:
begin begin
topZ := AMapCell.Z; topZ := AMapCell.Z;
for i := 0 to AStatics.Count - 1 do for i := 0 to AStatics.Count - 1 do
begin begin
static := TStaticItem(AStatics.Items[i]); static := TStaticItem(AStatics.Items[i]);
staticTop := EnsureRange(static.Z + CEDServerInstance.Landscape.TiledataProvider.StaticTiles[static.TileID].Height, -128, 127); staticTop := EnsureRange(static.Z + CEDServerInstance.Landscape.TiledataProvider.StaticTiles[static.TileID].Height, -128, 127);
if staticTop > topZ then topZ := staticTop; if staticTop > topZ then topZ := staticTop;
end; end;
end; end;
spFix: spFix:
begin begin
staticItem.Z := FFixZ; staticItem.Z := FFixZ;
end; end;
end; end;
AStatics.Add(staticItem); AStatics.Add(staticItem);
staticItem.Owner := CEDServerInstance.Landscape.GetStaticBlock(staticItem.X div 8, staticItem.Owner := CEDServerInstance.Landscape.GetStaticBlock(staticItem.X div 8,
staticItem.Y div 8); staticItem.Y div 8);
end; end;
end. end.

1
Server/UPacketHandlers.pas
View File

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

534
Server/URadarMap.pas
View File

@ -1,267 +1,267 @@
(* (*
* CDDL HEADER START * CDDL HEADER START
* *
* The contents of this file are subject to the terms of the * The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only * Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance * (the "License"). You may not use this file except in compliance
* with the License. * with the License.
* *
* You can obtain a copy of the license at * You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php. * http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions * See the License for the specific language governing permissions
* and limitations under the License. * and limitations under the License.
* *
* When distributing Covered Code, include this CDDL HEADER in each * When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at * file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable, * http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed * add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information: * by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner] * Portions Copyright [yyyy] [name of copyright owner]
* *
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2007 Andreas Schneider * Portions Copyright 2007 Andreas Schneider
*) *)
unit URadarMap; unit URadarMap;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, SysUtils, UConfig, UNetState, UEnhancedMemoryStream, UEnums; Classes, SysUtils, UConfig, UNetState, UEnhancedMemoryStream, UEnums;
type type
TRadarColorArray = array of Word; TRadarColorArray = array of Word;
{ TRadarMap } { TRadarMap }
TRadarMap = class(TObject) TRadarMap = class(TObject)
constructor Create(AMap, AStatics, AStaIdx: TStream; AWidth, AHeight: Word; constructor Create(AMap, AStatics, AStaIdx: TStream; AWidth, AHeight: Word;
ARadarCol: string); ARadarCol: string);
destructor Destroy; override; destructor Destroy; override;
protected protected
FWidth: Word; FWidth: Word;
FHeight: Word; FHeight: Word;
FRadarColors: TRadarColorArray; FRadarColors: TRadarColorArray;
FRadarMap: TRadarColorArray; FRadarMap: TRadarColorArray;
FPackets: TList; FPackets: TList;
FPacketSize: Cardinal; FPacketSize: Cardinal;
procedure OnRadarHandlingPacket(ABuffer: TEnhancedMemoryStream; procedure OnRadarHandlingPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState); ANetState: TNetState);
public public
procedure Update(AX, AY, ATileID: Word); procedure Update(AX, AY, ATileID: Word);
procedure BeginUpdate; procedure BeginUpdate;
procedure EndUpdate; procedure EndUpdate;
end; end;
implementation implementation
uses uses
UPacket, UPackets, UPacketHandlers, UCEDServer, crc; UPacket, UPackets, UPacketHandlers, UCEDServer, crc;
type type
TMulIndex = packed record TMulIndex = packed record
Position: Cardinal; Position: Cardinal;
Size: Cardinal; Size: Cardinal;
Userdata: Cardinal; Userdata: Cardinal;
end; end;
TMapCell = packed record TMapCell = packed record
TileID: Word; TileID: Word;
Altitude: ShortInt; Altitude: ShortInt;
end; end;
TStaticItem = packed record TStaticItem = packed record
TileID: Word; TileID: Word;
X, Y: Byte; X, Y: Byte;
Z: ShortInt; Z: ShortInt;
Hue: Word; Hue: Word;
end; end;
{ TRadarChecksumPacket } { TRadarChecksumPacket }
TRadarChecksumPacket = class(TPacket) TRadarChecksumPacket = class(TPacket)
constructor Create(ARadarMap: TRadarColorArray); constructor Create(ARadarMap: TRadarColorArray);
end; end;
{ TRadarMapPacket } { TRadarMapPacket }
TRadarMapPacket = class(TPacket) TRadarMapPacket = class(TPacket)
constructor Create(ARadarMap: TRadarColorArray); constructor Create(ARadarMap: TRadarColorArray);
end; end;
{ TUpdateRadarPacket } { TUpdateRadarPacket }
TUpdateRadarPacket = class(TPacket) TUpdateRadarPacket = class(TPacket)
constructor Create(AX, AY, AColor: Word); constructor Create(AX, AY, AColor: Word);
end; end;
{ TRadarChecksumPacket } { TRadarChecksumPacket }
constructor TRadarChecksumPacket.Create(ARadarMap: TRadarColorArray); constructor TRadarChecksumPacket.Create(ARadarMap: TRadarColorArray);
var var
checksum: Cardinal; checksum: Cardinal;
begin begin
inherited Create($0D, 0); inherited Create($0D, 0);
FStream.WriteByte($01); FStream.WriteByte($01);
checksum := crc32(0, nil, 0); checksum := crc32(0, nil, 0);
checksum := crc32(checksum, @ARadarMap[0], Length(ARadarMap) * SizeOf(Word)); checksum := crc32(checksum, @ARadarMap[0], Length(ARadarMap) * SizeOf(Word));
FStream.WriteCardinal(checksum); FStream.WriteCardinal(checksum);
end; end;
{ TRadarMapPacket } { TRadarMapPacket }
constructor TRadarMapPacket.Create(ARadarMap: TRadarColorArray); constructor TRadarMapPacket.Create(ARadarMap: TRadarColorArray);
begin begin
inherited Create($0D, 0); inherited Create($0D, 0);
FStream.WriteByte($02); FStream.WriteByte($02);
FStream.Write(ARadarMap[0], Length(ARadarMap) * SizeOf(Word)); FStream.Write(ARadarMap[0], Length(ARadarMap) * SizeOf(Word));
end; end;
{ TUpdateRadarPacket } { TUpdateRadarPacket }
constructor TUpdateRadarPacket.Create(AX, AY, AColor: Word); constructor TUpdateRadarPacket.Create(AX, AY, AColor: Word);
begin begin
inherited Create($0D, 0); inherited Create($0D, 0);
FStream.WriteByte($03); FStream.WriteByte($03);
FStream.WriteWord(AX); FStream.WriteWord(AX);
FStream.WriteWord(AY); FStream.WriteWord(AY);
FStream.WriteWord(AColor); FStream.WriteWord(AColor);
end; end;
{ TRadarMap } { TRadarMap }
constructor TRadarMap.Create(AMap, AStatics, AStaIdx: TStream; AWidth, constructor TRadarMap.Create(AMap, AStatics, AStaIdx: TStream; AWidth,
AHeight: Word; ARadarCol: string); AHeight: Word; ARadarCol: string);
var var
radarcol: TFileStream; radarcol: TFileStream;
count, i, item, highestZ: Integer; count, i, item, highestZ: Integer;
staticsItems: array of TStaticItem; staticsItems: array of TStaticItem;
mapCell: TMapCell; mapCell: TMapCell;
index: TMulIndex; index: TMulIndex;
begin begin
radarcol := TFileStream.Create(ARadarCol, fmOpenRead); radarcol := TFileStream.Create(ARadarCol, fmOpenRead);
SetLength(FRadarColors, radarcol.Size div SizeOf(Word)); SetLength(FRadarColors, radarcol.Size div SizeOf(Word));
radarcol.Read(FRadarColors[0], radarcol.Size); radarcol.Read(FRadarColors[0], radarcol.Size);
radarcol.Free; radarcol.Free;
FWidth := AWidth; FWidth := AWidth;
FHeight := AHeight; FHeight := AHeight;
count := AWidth * AHeight; count := AWidth * AHeight;
SetLength(FRadarMap, count); SetLength(FRadarMap, count);
AMap.Position := 4; AMap.Position := 4;
AStaIdx.Position := 0; AStaIdx.Position := 0;
for i := 0 to count - 1 do for i := 0 to count - 1 do
begin begin
AMap.Read(mapCell, SizeOf(TMapCell)); AMap.Read(mapCell, SizeOf(TMapCell));
AMap.Seek(193, soFromCurrent); AMap.Seek(193, soFromCurrent);
FRadarMap[i] := FRadarColors[mapCell.TileID]; FRadarMap[i] := FRadarColors[mapCell.TileID];
AStaIdx.Read(index, SizeOf(TMulIndex)); AStaIdx.Read(index, SizeOf(TMulIndex));
if (index.Position < $FFFFFFFF) and (index.Size > 0) then if (index.Position < $FFFFFFFF) and (index.Size > 0) then
begin begin
AStatics.Position := index.Position; AStatics.Position := index.Position;
SetLength(staticsItems, index.Size div 7); SetLength(staticsItems, index.Size div 7);
AStatics.Read(staticsItems[0], index.Size); AStatics.Read(staticsItems[0], index.Size);
highestZ := mapCell.Altitude; highestZ := mapCell.Altitude;
for item := Low(staticsItems) to High(staticsItems) do for item := Low(staticsItems) to High(staticsItems) do
begin begin
if (staticsItems[item].X = 0) and (staticsItems[item].Y = 0) and if (staticsItems[item].X = 0) and (staticsItems[item].Y = 0) and
(staticsItems[item].Z >= highestZ) then (staticsItems[item].Z >= highestZ) then
begin begin
highestZ := staticsItems[item].Z; highestZ := staticsItems[item].Z;
FRadarMap[i] := FRadarColors[staticsItems[item].TileID + $4000]; FRadarMap[i] := FRadarColors[staticsItems[item].TileID + $4000];
end; end;
end; end;
end; end;
end; end;
FPackets := nil; FPackets := nil;
RegisterPacketHandler($0D, TPacketHandler.Create(2, @OnRadarHandlingPacket)); RegisterPacketHandler($0D, TPacketHandler.Create(2, @OnRadarHandlingPacket));
inherited Create; inherited Create;
end; end;
destructor TRadarMap.Destroy; destructor TRadarMap.Destroy;
begin begin
RegisterPacketHandler($0D, nil); RegisterPacketHandler($0D, nil);
inherited Destroy; inherited Destroy;
end; end;
procedure TRadarMap.OnRadarHandlingPacket(ABuffer: TEnhancedMemoryStream; procedure TRadarMap.OnRadarHandlingPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState); ANetState: TNetState);
var var
subID: Byte; subID: Byte;
begin begin
if not ValidateAccess(ANetState, alView) then Exit; if not ValidateAccess(ANetState, alView) then Exit;
subID := ABuffer.ReadByte; subID := ABuffer.ReadByte;
case subID of case subID of
$01: //request checksum $01: //request checksum
begin begin
CEDServerInstance.SendPacket(ANetState, TRadarChecksumPacket.Create( CEDServerInstance.SendPacket(ANetState, TRadarChecksumPacket.Create(
FRadarMap)); FRadarMap));
end; end;
$02: //request radarmap $02: //request radarmap
begin begin
CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create( CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(
TRadarMapPacket.Create(FRadarMap))); TRadarMapPacket.Create(FRadarMap)));
end; end;
end; end;
end; end;
procedure TRadarMap.Update(AX, AY, ATileID: Word); procedure TRadarMap.Update(AX, AY, ATileID: Word);
var var
color: Word; color: Word;
block: Cardinal; block: Cardinal;
packet: TPacket; packet: TPacket;
begin begin
block := AX * FHeight + AY; block := AX * FHeight + AY;
color := FRadarColors[ATileID]; color := FRadarColors[ATileID];
if FRadarMap[block] <> color then if FRadarMap[block] <> color then
begin begin
FRadarMap[block] := color; FRadarMap[block] := color;
packet := TUpdateRadarPacket.Create(AX, AY, color); packet := TUpdateRadarPacket.Create(AX, AY, color);
if FPackets <> nil then if FPackets <> nil then
begin begin
FPackets.Add(packet); FPackets.Add(packet);
Inc(FPacketSize, packet.Stream.Size); Inc(FPacketSize, packet.Stream.Size);
end else end else
CEDServerInstance.SendPacket(nil, packet); CEDServerInstance.SendPacket(nil, packet);
end; end;
end; end;
procedure TRadarMap.BeginUpdate; procedure TRadarMap.BeginUpdate;
begin begin
if FPackets <> nil then Exit; if FPackets <> nil then Exit;
FPackets := TList.Create; FPackets := TList.Create;
FPacketSize := 0; FPacketSize := 0;
end; end;
procedure TRadarMap.EndUpdate; procedure TRadarMap.EndUpdate;
var var
completePacket: TPacket; completePacket: TPacket;
i: Integer; i: Integer;
begin begin
if FPackets = nil then Exit; if FPackets = nil then Exit;
completePacket := TCompressedPacket.Create(TRadarMapPacket.Create(FRadarMap)); completePacket := TCompressedPacket.Create(TRadarMapPacket.Create(FRadarMap));
if completePacket.Stream.Size <= (FPacketSize div 4) * 5 then if completePacket.Stream.Size <= (FPacketSize div 4) * 5 then
begin begin
CEDServerInstance.SendPacket(nil, completePacket); CEDServerInstance.SendPacket(nil, completePacket);
for i := 0 to FPackets.Count - 1 do for i := 0 to FPackets.Count - 1 do
TPacket(FPackets.Items[i]).Free; TPacket(FPackets.Items[i]).Free;
end else end else
begin begin
for i := 0 to FPackets.Count - 1 do for i := 0 to FPackets.Count - 1 do
CEDServerInstance.SendPacket(nil, TPacket(FPackets.Items[i])); CEDServerInstance.SendPacket(nil, TPacket(FPackets.Items[i]));
completePacket.Free; completePacket.Free;
end; end;
FreeAndNil(FPackets); FreeAndNil(FPackets);
end; end;
end. end.

6
Server/URegions.pas
View File

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

3
Server/cedserver.lpi
View File

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

5
UXmlHelper.pas
View File

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