diff --git a/Client/CentrED.lpi b/Client/CentrED.lpi
index d9f91e0..daef122 100644
--- a/Client/CentrED.lpi
+++ b/Client/CentrED.lpi
@@ -18,7 +18,7 @@
-
+
@@ -316,7 +316,7 @@
-
+
@@ -422,6 +422,7 @@
+
@@ -563,6 +564,10 @@
+
+
+
+
@@ -597,6 +602,7 @@
+
diff --git a/Client/Tools/UfrmBoundaries.lfm b/Client/Tools/UfrmBoundaries.lfm
index 9913d5b..5fb1fb4 100644
--- a/Client/Tools/UfrmBoundaries.lfm
+++ b/Client/Tools/UfrmBoundaries.lfm
@@ -1,7 +1,7 @@
inherited frmBoundaries: TfrmBoundaries
- Left = 1831
+ Left = 445
Height = 164
- Top = 239
+ Top = 332
Width = 402
Caption = 'Boundaries'
ClientHeight = 164
@@ -17,7 +17,7 @@ inherited frmBoundaries: TfrmBoundaries
BorderSpacing.Left = 4
BorderSpacing.Top = 4
Caption = 'Restrict Height'
- ClientHeight = 141
+ ClientHeight = 139
ClientWidth = 192
TabOrder = 0
object lblMinZ: TLabel
@@ -25,9 +25,9 @@ inherited frmBoundaries: TfrmBoundaries
AnchorSideTop.Control = seMinZ
AnchorSideTop.Side = asrCenter
Left = 4
- Height = 13
- Top = 8
- Width = 68
+ Height = 15
+ Top = 10
+ Width = 77
Caption = 'Minimum Z:'
Layout = tlCenter
ParentColor = False
@@ -37,7 +37,7 @@ inherited frmBoundaries: TfrmBoundaries
AnchorSideRight.Control = gbZRestriction
AnchorSideRight.Side = asrBottom
Left = 136
- Height = 21
+ Height = 27
Top = 4
Width = 52
Anchors = [akTop, akRight]
@@ -56,8 +56,8 @@ inherited frmBoundaries: TfrmBoundaries
AnchorSideRight.Control = gbZRestriction
AnchorSideRight.Side = asrBottom
Left = 4
- Height = 36
- Top = 29
+ Height = 37
+ Top = 35
Width = 184
Frequency = 10
Max = 127
@@ -74,9 +74,9 @@ inherited frmBoundaries: TfrmBoundaries
AnchorSideTop.Control = seMaxZ
AnchorSideTop.Side = asrCenter
Left = 4
- Height = 13
- Top = 73
- Width = 71
+ Height = 15
+ Top = 82
+ Width = 81
Caption = 'Maximum Z:'
Layout = tlCenter
ParentColor = False
@@ -87,8 +87,8 @@ inherited frmBoundaries: TfrmBoundaries
AnchorSideRight.Control = seMinZ
AnchorSideRight.Side = asrBottom
Left = 136
- Height = 21
- Top = 69
+ Height = 27
+ Top = 76
Width = 52
Anchors = [akTop, akRight]
MaxValue = 127
@@ -104,8 +104,8 @@ inherited frmBoundaries: TfrmBoundaries
AnchorSideRight.Control = gbZRestriction
AnchorSideRight.Side = asrBottom
Left = 4
- Height = 36
- Top = 94
+ Height = 37
+ Top = 107
Width = 184
Frequency = 10
Max = 127
@@ -133,15 +133,15 @@ inherited frmBoundaries: TfrmBoundaries
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Around = 4
Caption = 'Restrict View Range'
- ClientHeight = 141
+ ClientHeight = 139
ClientWidth = 190
TabOrder = 1
object seMinX: TSpinEdit
AnchorSideLeft.Control = lblX
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = seMaxX
- Left = 19
- Height = 21
+ Left = 20
+ Height = 27
Top = 4
Width = 74
BorderSpacing.Left = 4
@@ -153,7 +153,7 @@ inherited frmBoundaries: TfrmBoundaries
AnchorSideRight.Control = gbViewRestriction
AnchorSideRight.Side = asrBottom
Left = 112
- Height = 21
+ Height = 27
Top = 4
Width = 74
Anchors = [akTop, akRight]
@@ -168,9 +168,9 @@ inherited frmBoundaries: TfrmBoundaries
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = seMinX
AnchorSideRight.Side = asrBottom
- Left = 19
- Height = 21
- Top = 33
+ Left = 20
+ Height = 27
+ Top = 39
Width = 74
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 8
@@ -183,8 +183,8 @@ inherited frmBoundaries: TfrmBoundaries
AnchorSideRight.Control = seMaxX
AnchorSideRight.Side = asrBottom
Left = 112
- Height = 21
- Top = 33
+ Height = 27
+ Top = 39
Width = 74
Anchors = [akTop, akLeft, akRight]
OnChange = seMaxYChange
@@ -195,9 +195,9 @@ inherited frmBoundaries: TfrmBoundaries
AnchorSideTop.Control = seMinX
AnchorSideTop.Side = asrCenter
Left = 4
- Height = 13
- Top = 8
- Width = 11
+ Height = 15
+ Top = 10
+ Width = 12
BorderSpacing.Left = 4
Caption = 'X:'
ParentColor = False
@@ -207,9 +207,9 @@ inherited frmBoundaries: TfrmBoundaries
AnchorSideTop.Control = seMinY
AnchorSideTop.Side = asrCenter
Left = 4
- Height = 13
- Top = 37
- Width = 10
+ Height = 15
+ Top = 45
+ Width = 9
Caption = 'Y:'
ParentColor = False
end
@@ -218,10 +218,10 @@ inherited frmBoundaries: TfrmBoundaries
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = seMaxX
AnchorSideTop.Side = asrCenter
- Left = 97
- Height = 13
- Top = 8
- Width = 11
+ Left = 98
+ Height = 15
+ Top = 10
+ Width = 13
BorderSpacing.Left = 4
Caption = '—'
ParentColor = False
@@ -230,13 +230,31 @@ inherited frmBoundaries: TfrmBoundaries
AnchorSideLeft.Control = lblXSep
AnchorSideTop.Control = seMinY
AnchorSideTop.Side = asrCenter
- Left = 97
- Height = 13
- Top = 37
- Width = 11
+ Left = 98
+ Height = 15
+ Top = 45
+ Width = 13
Caption = '—'
ParentColor = False
end
+ object btnSelectArea: TButton
+ Left = 74
+ Height = 25
+ Top = 76
+ Width = 112
+ Caption = 'Select Area'
+ OnClick = btnSelectAreaClick
+ TabOrder = 4
+ end
+ object btnClear: TButton
+ Left = 111
+ Height = 25
+ Top = 107
+ Width = 75
+ Caption = 'Clear'
+ OnClick = btnClearClick
+ TabOrder = 5
+ end
end
inherited tmClose: TTimer[2]
end
diff --git a/Client/Tools/UfrmBoundaries.pas b/Client/Tools/UfrmBoundaries.pas
index ecf7ea5..65752b4 100644
--- a/Client/Tools/UfrmBoundaries.pas
+++ b/Client/Tools/UfrmBoundaries.pas
@@ -32,13 +32,15 @@ interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
- ComCtrls, Spin, ExtCtrls, UfrmToolWindow;
+ ComCtrls, Spin, ExtCtrls, UfrmToolWindow, USelectionHelper;
type
{ TfrmBoundaries }
TfrmBoundaries = class(TfrmToolWindow)
+ btnSelectArea: TButton;
+ btnClear: TButton;
gbZRestriction: TGroupBox;
gbViewRestriction: TGroupBox;
lblYSep: TLabel;
@@ -55,6 +57,8 @@ type
seMaxY: TSpinEdit;
tbMaxZ: TTrackBar;
tbMinZ: TTrackBar;
+ procedure btnSelectAreaClick(Sender: TObject);
+ procedure btnClearClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure seMaxXChange(Sender: TObject);
procedure seMaxYChange(Sender: TObject);
@@ -64,6 +68,8 @@ type
procedure seMinZChange(Sender: TObject);
procedure tbMaxZChange(Sender: TObject);
procedure tbMinZChange(Sender: TObject);
+ protected
+ procedure RangeSelected(AX1, AY1, AX2, AY2: Word);
public
{ public declarations }
end;
@@ -89,6 +95,20 @@ begin
seMaxY.Value := seMaxX.MaxValue;
end;
+procedure TfrmBoundaries.btnSelectAreaClick(Sender: TObject);
+begin
+ SelectRange(@RangeSelected);
+end;
+
+procedure TfrmBoundaries.btnClearClick(Sender: TObject);
+begin
+ seMinX.Value := 0;
+ seMinY.Value := 0;
+ seMaxX.Value := seMaxX.MaxValue;
+ seMaxY.Value := seMaxY.MaxValue;
+ frmMain.InvalidateFilter;
+end;
+
procedure TfrmBoundaries.seMaxXChange(Sender: TObject);
begin
frmMain.InvalidateFilter;
@@ -133,6 +153,15 @@ begin
frmMain.InvalidateFilter;
end;
+procedure TfrmBoundaries.RangeSelected(AX1, AY1, AX2, AY2: Word);
+begin
+ seMinX.Value := AX1;
+ seMinY.Value := AY1;
+ seMaxX.Value := AX2;
+ seMaxY.Value := AY2;
+ frmBoundaries.Show;
+end;
+
initialization
{$I UfrmBoundaries.lrs}
diff --git a/Client/USelectionHelper.pas b/Client/USelectionHelper.pas
new file mode 100644
index 0000000..5b81ee1
--- /dev/null
+++ b/Client/USelectionHelper.pas
@@ -0,0 +1,113 @@
+(*
+ * 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 2015 Andreas Schneider
+ *)
+unit USelectionHelper;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils;
+
+type
+ TSelectedRangeCallback = procedure(AX1, AY1, AX2, AY2: Word) of object;
+
+procedure SelectRange(ACallback: TSelectedRangeCallback);
+
+implementation
+
+uses
+ UfrmMain, UWorldItem, math;
+
+type
+
+ { TRangeSelectionHelper }
+
+ TRangeSelectionHelper = class
+ constructor Create(ACallback: TSelectedRangeCallback);
+ protected
+ FCallback: TSelectedRangeCallback;
+ FItem1: TWorldItem;
+ FItem2: TWorldItem;
+ procedure TileSelected(AWorldItem: TWorldItem);
+ procedure Finish;
+ public
+ procedure Run;
+ end;
+
+procedure SelectRange(ACallback: TSelectedRangeCallback);
+var
+ helper: TRangeSelectionHelper;
+begin
+ helper := TRangeSelectionHelper.Create(ACallback);
+ helper.Run;
+ //Cleanup will follow asynchroneously
+end;
+
+{ TRangeSelectionHelper }
+
+constructor TRangeSelectionHelper.Create(ACallback: TSelectedRangeCallback);
+begin
+ FCallback := ACallback;
+ FItem1 := nil;
+ FItem2 := nil;
+end;
+
+procedure TRangeSelectionHelper.TileSelected(AWorldItem: TWorldItem);
+begin
+ if FItem1 = nil then
+ FItem1 := AWorldItem
+ else if FItem2 = nil then
+ begin
+ FItem2 := AWorldItem;
+ Finish;
+ end;
+end;
+
+procedure TRangeSelectionHelper.Finish;
+var
+ minX, minY: Word;
+ maxX, maxY: Word;
+begin
+ frmMain.UnregisterSelectionListener(@TileSelected);
+ minX := Min(FItem1.X, FItem2.X);
+ minY := Min(FItem1.Y, FItem2.Y);
+ maxX := Max(FItem1.X, FItem2.X);
+ maxY := Max(FItem1.Y, FItem2.Y);
+ FCallback(minX, minY, maxX, maxY);
+ Free; //We use this class only once, so it can cleanup after itself
+end;
+
+procedure TRangeSelectionHelper.Run;
+begin
+ //TODO show indicator and option to cancel
+ //TODO keep track of instance (global variable maybe?)
+ frmMain.RegisterSelectionListener(@TileSelected);
+ frmMain.SwitchToSelection;
+end;
+
+end.
+
diff --git a/Client/UfrmMain.lfm b/Client/UfrmMain.lfm
index 2198c11..daf4206 100644
--- a/Client/UfrmMain.lfm
+++ b/Client/UfrmMain.lfm
@@ -81,7 +81,7 @@ object frmMain: TfrmMain
end
object edX: TSpinEdit
Left = 24
- Height = 21
+ Height = 25
Top = 3
Width = 55
MaxValue = 100000
@@ -89,7 +89,7 @@ object frmMain: TfrmMain
end
object edY: TSpinEdit
Left = 104
- Height = 21
+ Height = 25
Top = 3
Width = 52
MaxValue = 100000
@@ -118,12 +118,12 @@ object frmMain: TfrmMain
object tsTiles: TTabSheet
Caption = 'Tiles'
ClientHeight = 476
- ClientWidth = 220
+ ClientWidth = 214
object lblFilter: TLabel
AnchorSideLeft.Control = cbTerrain
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = cbTerrain
- Left = 85
+ Left = 91
Height = 13
Top = 8
Width = 31
@@ -140,10 +140,10 @@ object frmMain: TfrmMain
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = spTileList
Left = 4
- Height = 228
+ Height = 224
Hint = '-'
- Top = 60
- Width = 212
+ Top = 64
+ Width = 206
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 4
BorderSpacing.Top = 4
@@ -201,11 +201,11 @@ object frmMain: TfrmMain
Left = 0
Height = 183
Top = 293
- Width = 220
+ Width = 214
Anchors = [akTop, akLeft, akRight, akBottom]
Caption = 'Random pool'
ClientHeight = 168
- ClientWidth = 216
+ ClientWidth = 210
TabOrder = 1
object btnAddRandom: TSpeedButton
AnchorSideLeft.Control = gbRandom
@@ -359,10 +359,10 @@ object frmMain: TfrmMain
object btnRandomPresetSave: TSpeedButton
AnchorSideTop.Control = cbRandomPreset
AnchorSideRight.Control = btnRandomPresetDelete
- Left = 164
+ Left = 158
Height = 22
Hint = 'Save Preset'
- Top = 139
+ Top = 137
Width = 22
Anchors = [akTop, akRight]
BorderSpacing.Right = 4
@@ -411,10 +411,10 @@ object frmMain: TfrmMain
AnchorSideTop.Control = btnRandomPresetSave
AnchorSideRight.Control = gbRandom
AnchorSideRight.Side = asrBottom
- Left = 190
+ Left = 184
Height = 22
Hint = 'Delete Preset'
- Top = 139
+ Top = 137
Width = 22
Anchors = [akTop, akRight]
BorderSpacing.Right = 4
@@ -469,9 +469,9 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = cbRandomPreset
Cursor = 63
Left = 4
- Height = 111
+ Height = 109
Top = 24
- Width = 208
+ Width = 202
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 4
BorderSpacing.Top = 2
@@ -517,9 +517,9 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = gbRandom
AnchorSideBottom.Side = asrBottom
Left = 4
- Height = 25
- Top = 139
- Width = 156
+ Height = 27
+ Top = 137
+ Width = 150
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 4
BorderSpacing.Right = 4
@@ -539,7 +539,7 @@ object frmMain: TfrmMain
Left = 0
Height = 5
Top = 288
- Width = 220
+ Width = 214
Align = alNone
Anchors = [akLeft, akRight, akBottom]
ResizeAnchor = akBottom
@@ -549,7 +549,7 @@ object frmMain: TfrmMain
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = vdtTiles
AnchorSideBottom.Side = asrBottom
- Left = 112
+ Left = 106
Height = 23
Hint = 'Append S or T to restrict the search to Statics or Terrain.'
Top = 257
@@ -571,10 +571,10 @@ object frmMain: TfrmMain
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = tsTiles
AnchorSideRight.Side = asrBottom
- Left = 85
+ Left = 91
Height = 23
Top = 21
- Width = 119
+ Width = 107
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Right = 16
OnEditingDone = edFilterEditingDone
@@ -585,10 +585,10 @@ object frmMain: TfrmMain
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = cbTerrain
AnchorSideTop.Side = asrBottom
- Left = 4
- Height = 24
- Top = 32
- Width = 65
+ Left = 3
+ Height = 26
+ Top = 34
+ Width = 73
Caption = 'Statics'
Checked = True
OnChange = cbStaticsChange
@@ -599,9 +599,9 @@ object frmMain: TfrmMain
AnchorSideLeft.Control = tsTiles
AnchorSideTop.Control = tsTiles
Left = 4
- Height = 24
+ Height = 26
Top = 8
- Width = 65
+ Width = 71
BorderSpacing.Left = 4
BorderSpacing.Top = 8
Caption = 'Terrain'
@@ -614,7 +614,7 @@ object frmMain: TfrmMain
object tsClients: TTabSheet
Caption = 'Clients'
ClientHeight = 476
- ClientWidth = 220
+ ClientWidth = 214
object lbClients: TListBox
Left = 0
Height = 478
@@ -633,7 +633,7 @@ object frmMain: TfrmMain
object tsLocations: TTabSheet
Caption = 'Locations'
ClientHeight = 476
- ClientWidth = 220
+ ClientWidth = 214
object btnClearLocations: TSpeedButton
AnchorSideLeft.Control = btnDeleteLocation
AnchorSideLeft.Side = asrBottom
diff --git a/Client/UfrmMain.pas b/Client/UfrmMain.pas
index d4b4515..85c7b20 100644
--- a/Client/UfrmMain.pas
+++ b/Client/UfrmMain.pas
@@ -36,8 +36,7 @@ uses
StdCtrls, Spin, UEnums, VirtualTrees, Buttons, UMulBlock, UWorldItem, math,
LCLIntf, UOverlayUI, UStatics, UEnhancedMemoryStream, ActnList,
XMLPropStorage, ImagingClasses, dateutils, UPlatformTypes, UMap, UPacket,
- UGLFont, DOM, XMLRead, XMLWrite, strutils, ULightManager, heContnrs,
- UContnrExt, UTiledata, Types;
+ UGLFont, DOM, XMLRead, XMLWrite, strutils, ULightManager, fgl, UTiledata;
type
TAccessChangedListener = procedure(AAccessLevel: TAccessLevel) of object;
@@ -45,12 +44,12 @@ type
TScreenBufferState = (sbsValid, sbsIndexed, sbsFiltered);
TScreenBufferStates = set of TScreenBufferState;
- TBlockInfoList = specialize TheVector;
+ TBlockInfoList = specialize TFPGList;
TGhostTile = class(TStaticItem);
- TPacketList = specialize TheObjectVector;
- TAccessChangedListeners = specialize TPointerVectorSet;
- TSelectionListeners = specialize TPointerVectorSet;
+ TPacketList = specialize TFPGObjectList;
+ TAccessChangedListeners = specialize TFPGList;
+ TSelectionListeners = specialize TFPGList;
TTileHintInfo = record
Name: String;
@@ -713,8 +712,10 @@ begin
mnuGrabTileIDClick(nil);
end;
- for selectionListener in FSelectionListeners.Reversed do
+ for selectionListener in FSelectionListeners do
+ begin
selectionListener(CurrentTile);
+ end;
end;
if (not acSelect.Checked) and (targetTile <> nil) and (SelectedTile <> nil) then
@@ -1178,14 +1179,14 @@ end;
procedure TfrmMain.acUndoExecute(Sender: TObject);
var
- packet: TPacket;
+ i: Integer;
begin
//Send each reversed action in reverse order.
- for packet in FUndoList.Reversed do
- dmNetwork.Send(packet);
+ for i := FUndoList.Count - 1 downto 0 do
+ dmNetwork.Send(FUndoList[i]);
//Cleanup without freeing the objects (this was already done by dmNetwork.Send)
- FUndoList.Wipe;
+ FUndoList.Clear;
//No Undo packets, nothing to undo.
acUndo.Enabled := False;
@@ -1969,23 +1970,23 @@ end;
procedure TfrmMain.RegisterAccessChangedListener(
AListener: TAccessChangedListener);
begin
- FAccessChangedListeners.Include(AListener);
+ FAccessChangedListeners.Add(AListener);
end;
procedure TfrmMain.RegisterSelectionListener(AListener: TSelectionListener);
begin
- FSelectionListeners.Include(AListener);
+ FSelectionListeners.Add(AListener);
end;
procedure TfrmMain.UnregisterAccessChangedListener(
AListener: TAccessChangedListener);
begin
- FAccessChangedListeners.Exclude(AListener);
+ FAccessChangedListeners.Remove(AListener);
end;
procedure TfrmMain.UnregisterSelectionListener(AListener: TSelectionListener);
begin
- FSelectionListeners.Exclude(AListener);
+ FSelectionListeners.Remove(AListener);
end;
procedure TfrmMain.SetCurrentTile(const AValue: TWorldItem);
@@ -3172,7 +3173,7 @@ begin
end;
end;
- for accessChangedListener in FAccessChangedListeners.Reversed do
+ for accessChangedListener in FAccessChangedListeners do
accessChangedListener(accessLevel);
end;
$08: //password change status