diff --git a/Client/CentrED.lpi b/Client/CentrED.lpi
index 133db83..496dd86 100644
--- a/Client/CentrED.lpi
+++ b/Client/CentrED.lpi
@@ -325,7 +325,7 @@
-
+
@@ -581,6 +581,10 @@
+
+
+
+
diff --git a/Client/ULandscape.pas b/Client/ULandscape.pas
index d35d4de..2816128 100644
--- a/Client/ULandscape.pas
+++ b/Client/ULandscape.pas
@@ -320,6 +320,21 @@ type
Hue: Word;
end;
+ TGhostTile = class(TStaticItem);
+
+ { TMovableGhostTile }
+
+ TMovableGhostTile = class(TGhostTile)
+ private
+ FOriginalX: Word;
+ FOriginalY: Word;
+ FOriginalZ: ShortInt;
+ public
+ property OriginalX: Word read FOriginalX write FOriginalX;
+ property OriginalY: Word read FOriginalY write FOriginalY;
+ property OriginalZ: ShortInt read FOriginalZ write FOriginalZ;
+ end;
+
operator enumerator(AScreenBuffer: TScreenBuffer): TScreenBufferItemEnumerator;
implementation
@@ -996,6 +1011,7 @@ var
i, x, y: Integer;
tempDrawList: TWorldItemList;
staticTileData: TStaticTiledata;
+ blockInfo: PBlockInfo;
begin
ADrawList.Clear;
tempDrawList := TWorldItemList.Create(False);;
@@ -1042,7 +1058,11 @@ begin
tempDrawList.Sort(@CompareWorldItems);
for i := 0 to tempDrawList.Count - 1 do
- ADrawList.Add(TWorldItem(tempDrawList[i]));
+ begin
+ blockInfo := ADrawList.Add(TWorldItem(tempDrawList[i]));
+ if tempDrawList[i] is TGhostTile then
+ blockInfo^.State := ssGhost;
+ end;
tempDrawList.Free;
end;
diff --git a/Client/ULightManager.pas b/Client/ULightManager.pas
index 3b434e6..84828da 100644
--- a/Client/ULightManager.pas
+++ b/Client/ULightManager.pas
@@ -370,7 +370,7 @@ var
s: string;
i, id, col, r, g, b: Integer;
begin
- writeln('Loading Colors from ', AFileName); //TODO
+ //writeln('Loading Colors from ', AFileName); //TODO
for i := 1 to ColorsCount do begin
FLightColors[i].R := 1.0;
FLightColors[i].G := 1.0;
diff --git a/Client/UUoaDesigns.pas b/Client/UUoaDesigns.pas
new file mode 100644
index 0000000..ce49ecd
--- /dev/null
+++ b/Client/UUoaDesigns.pas
@@ -0,0 +1,187 @@
+unit UUoaDesigns;
+
+{$mode ObjFPC}{$H+}
+{$modeSwitch advancedRecords}
+
+interface
+
+uses
+ Classes, SysUtils, Generics.Collections, UStatics;
+
+type
+
+ { TUoaDesignHeader }
+
+ TUoaDesignHeader = record
+ Name: String;
+ Category: String;
+ Subcategory: String;
+ Width: Int32;
+ Height: Int32;
+ UserWidth: Int32;
+ UserHeight: Int32;
+ FilePosition: Int64;
+ TileCount: Int32;
+ public
+ constructor CreateFromStream(AStream: TStream);
+ end;
+
+ { TUoaDesignHeaders }
+
+ TUoaDesignHeaders = class(specialize TList)
+ constructor CreateFromStream(AStream: TStream);
+ end;
+
+ TUoaDesign = class
+ private
+ FHeader: TUoaDesignHeader;
+ FTiles: TStaticItemList;
+
+ constructor Create(AHeader: TUoaDesignHeader; AData: TStream);
+ public
+ property Header: TUoaDesignHeader read FHeader;
+ property Tiles: TStaticItemList read Ftiles;
+
+ destructor Destroy; override;
+ end;
+
+ { TUoaDesigns }
+
+ TUoaDesigns = class
+ private
+ FHeaders: TUoaDesignHeaders;
+ FData: TFileStream;
+ public
+ constructor Create(AIdxFile, ABinFile: String);
+ destructor Destroy; override;
+
+ function LoadDesign(AHeader: TUoaDesignHeader): TUoaDesign;
+ public
+ property Headers: TUoaDesignHeaders read FHeaders;
+ end;
+
+implementation
+
+uses
+ Math;
+
+function ReadString(AStream: TStream): String;
+var
+ nonNullFlag: Byte;
+ length: Byte;
+begin
+ nonNullFlag := AStream.ReadByte;
+ if nonNullFlag = 1 then
+ begin
+ length := AStream.ReadByte;
+ SetLength(Result, length);
+ if length > 0 then
+ AStream.Read(PChar(Result)^, length);
+ end;
+end;
+
+{ TUoaDesign }
+
+constructor TUoaDesign.Create(AHeader: TUoaDesignHeader; AData: TStream);
+var
+ i: Integer;
+ tile: TStaticItem;
+ version: Int32;
+
+ function ReadInt: Int32;
+ begin
+ AData.Read(Result, SizeOf(Result));
+ end;
+
+begin
+ FHeader := AHeader;
+ FTiles := TStaticItemList.Create(True);
+ AData.Seek(FHeader.FilePosition, soFromBeginning);
+ for i := 0 to FHeader.TileCount - 1 do
+ begin
+ AData.Read(version, SizeOf(version));
+ if (version < 0) or (version > 1) then
+ raise Exception.Create('Unsupported binary version');
+
+ tile := TStaticItem.Create(nil);
+ tile.TileID := ReadInt;
+ tile.X := ReadInt;
+ tile.Y := ReadInt;
+ tile.Z := EnsureRange(ReadInt, -128, 127);
+ ReadInt; // Level; unused
+
+ if version = 1 then
+ tile.Hue := ReadInt;
+
+ FTiles.Add(tile);
+ end;
+end;
+
+destructor TUoaDesign.Destroy;
+begin
+ FTiles.Free;
+ inherited Destroy;
+end;
+
+{ TUoaDesignHeaders }
+
+constructor TUoaDesignHeaders.CreateFromStream(AStream: TStream);
+var
+ headerCount, version: Int32;
+ i: Integer;
+begin
+ AStream.Read(headerCount, SizeOf(headerCount));
+ AStream.Read(version, SizeOf(version));
+
+ if version <> 0 then
+ raise Exception.Create('Unknown UOA design index version');
+
+ inherited Create;
+
+ for i := 0 to headerCount-1 do
+ Add(TUoaDesignHeader.CreateFromStream(AStream));
+end;
+
+{ TUoaDesignHeader }
+
+constructor TUoaDesignHeader.CreateFromStream(AStream: TStream);
+begin
+ Name := ReadString(AStream);
+ Category := ReadString(AStream);
+ Subcategory := ReadString(AStream);
+ AStream.Read(Width, SizeOf(Width));
+ AStream.Read(Height, SizeOf(Height));
+ AStream.Read(UserWidth, SizeOf(UserWidth));
+ AStream.Read(UserHeight, SizeOf(UserHeight));
+ AStream.Read(FilePosition, SizeOf(FilePosition));
+ AStream.Read(TileCount, SizeOf(TileCount));
+end;
+
+{ TUoaDesigns }
+
+constructor TUoaDesigns.Create(AIdxFile, ABinFile: String);
+var
+ idxStream: TFileStream;
+begin
+ idxStream := TFileStream.Create(AIdxFile, fmOpenRead);
+ try
+ FHeaders := TUoaDesignHeaders.CreateFromStream(idxStream);
+ finally
+ idxStream.Free;
+ end;
+
+ FData := TFileStream.Create(ABinFile, fmOpenRead);
+end;
+
+destructor TUoaDesigns.Destroy;
+begin
+ Headers.Free;
+end;
+
+function TUoaDesigns.LoadDesign(AHeader: TUoaDesignHeader): TUoaDesign;
+begin
+ Result := TUoaDesign.Create(AHeader, FData);
+end;
+
+end.
+
diff --git a/Client/UfrmMain.lfm b/Client/UfrmMain.lfm
index 2ac5abe..1eaa144 100644
--- a/Client/UfrmMain.lfm
+++ b/Client/UfrmMain.lfm
@@ -1,12 +1,12 @@
object frmMain: TfrmMain
Left = 87
- Height = 961
+ Height = 781
Top = 70
- Width = 1180
+ Width = 1172
ActiveControl = oglGameWindow
Caption = 'UO CentrED'
- ClientHeight = 961
- ClientWidth = 1180
+ ClientHeight = 781
+ ClientWidth = 1172
Constraints.MinHeight = 781
Constraints.MinWidth = 1172
DesignTimePPI = 120
@@ -23,12 +23,12 @@ object frmMain: TfrmMain
object pnlBottom: TPanel
Left = 0
Height = 49
- Top = 912
- Width = 1180
+ Top = 732
+ Width = 1172
Align = alBottom
BevelOuter = bvNone
ClientHeight = 49
- ClientWidth = 1180
+ ClientWidth = 1172
TabOrder = 0
object lblX: TLabel
Left = 18
@@ -61,7 +61,7 @@ object frmMain: TfrmMain
Transparent = False
end
object lblTip: TLabel
- Left = 803
+ Left = 795
Height = 49
Top = 0
Width = 365
@@ -75,7 +75,7 @@ object frmMain: TfrmMain
Transparent = False
end
object lblTipC: TLabel
- Left = 767
+ Left = 759
Height = 49
Top = 0
Width = 36
@@ -118,22 +118,22 @@ object frmMain: TfrmMain
end
object pcLeft: TPageControl
Left = 0
- Height = 874
+ Height = 694
Top = 38
Width = 350
- ActivePage = tsTiles
+ ActivePage = tsUoaDesigns
Align = alLeft
- TabIndex = 0
+ TabIndex = 3
TabOrder = 1
object tsTiles: TTabSheet
Caption = 'Tiles'
- ClientHeight = 836
+ ClientHeight = 656
ClientWidth = 340
object lblFilter: TLabel
AnchorSideLeft.Control = cbTerrain
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = cbTerrain
- Left = 114
+ Left = 109
Height = 26
Top = 12
Width = 47
@@ -152,9 +152,9 @@ object frmMain: TfrmMain
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = spTileList
Left = 6
- Height = 493
+ Height = 319
Hint = '-'
- Top = 74
+ Top = 68
Width = 328
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 6
@@ -213,11 +213,11 @@ object frmMain: TfrmMain
AnchorSideBottom.Side = asrBottom
Left = 0
Height = 261
- Top = 575
+ Top = 395
Width = 340
Anchors = [akTop, akLeft, akRight, akBottom]
Caption = 'Random pool'
- ClientHeight = 234
+ ClientHeight = 237
ClientWidth = 338
TabOrder = 1
object btnAddRandom: TSpeedButton
@@ -375,7 +375,7 @@ object frmMain: TfrmMain
Left = 256
Height = 35
Hint = 'Save Preset'
- Top = 186
+ Top = 189
Width = 35
Anchors = [akTop, akRight]
BorderSpacing.Right = 6
@@ -427,7 +427,7 @@ object frmMain: TfrmMain
Left = 297
Height = 35
Hint = 'Delete Preset'
- Top = 186
+ Top = 189
Width = 35
Anchors = [akTop, akRight]
BorderSpacing.Right = 6
@@ -482,7 +482,7 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = cbRandomPreset
Cursor = 63
Left = 6
- Height = 143
+ Height = 146
Top = 37
Width = 326
Anchors = [akTop, akLeft, akRight, akBottom]
@@ -532,7 +532,7 @@ object frmMain: TfrmMain
AnchorSideBottom.Side = asrBottom
Left = 6
Height = 42
- Top = 186
+ Top = 189
Width = 244
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 6
@@ -552,7 +552,7 @@ object frmMain: TfrmMain
Cursor = crVSplit
Left = 0
Height = 8
- Top = 567
+ Top = 387
Width = 340
Align = alNone
Anchors = [akLeft, akRight, akBottom]
@@ -566,7 +566,7 @@ object frmMain: TfrmMain
Left = 172
Height = 38
Hint = 'Append S or T to restrict the search to Statics or Terrain.'
- Top = 517
+ Top = 337
Width = 150
Anchors = [akRight, akBottom]
BorderSpacing.Right = 12
@@ -585,10 +585,10 @@ object frmMain: TfrmMain
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = tsTiles
AnchorSideRight.Side = asrBottom
- Left = 114
+ Left = 109
Height = 38
Top = 38
- Width = 201
+ Width = 206
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Right = 25
OnEditingDone = edFilterEditingDone
@@ -600,9 +600,9 @@ object frmMain: TfrmMain
AnchorSideTop.Control = cbTerrain
AnchorSideTop.Side = asrBottom
Left = 8
- Height = 28
- Top = 40
- Width = 79
+ Height = 25
+ Top = 37
+ Width = 74
Caption = 'Statics'
Checked = True
OnChange = cbStaticsChange
@@ -613,9 +613,9 @@ object frmMain: TfrmMain
AnchorSideLeft.Control = tsTiles
AnchorSideTop.Control = tsTiles
Left = 6
- Height = 28
+ Height = 25
Top = 12
- Width = 83
+ Width = 78
BorderSpacing.Left = 6
BorderSpacing.Top = 12
Caption = 'Terrain'
@@ -627,11 +627,11 @@ object frmMain: TfrmMain
end
object tsClients: TTabSheet
Caption = 'Clients'
- ClientHeight = 836
+ ClientHeight = 656
ClientWidth = 340
object lbClients: TListBox
Left = 0
- Height = 836
+ Height = 656
Top = 0
Width = 340
Align = alClient
@@ -646,7 +646,7 @@ object frmMain: TfrmMain
end
object tsLocations: TTabSheet
Caption = 'Locations'
- ClientHeight = 836
+ ClientHeight = 656
ClientWidth = 340
object btnClearLocations: TSpeedButton
AnchorSideLeft.Control = btnDeleteLocation
@@ -655,7 +655,7 @@ object frmMain: TfrmMain
Left = 194
Height = 35
Hint = 'Clear'
- Top = 795
+ Top = 615
Width = 36
BorderSpacing.Left = 6
Glyph.Data = {
@@ -706,7 +706,7 @@ object frmMain: TfrmMain
Left = 152
Height = 35
Hint = 'Delete'
- Top = 795
+ Top = 615
Width = 36
Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 6
@@ -756,7 +756,7 @@ object frmMain: TfrmMain
Left = 110
Height = 35
Hint = 'Add'
- Top = 795
+ Top = 615
Width = 36
Anchors = [akTop, akRight]
BorderSpacing.Right = 6
@@ -808,7 +808,7 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = btnDeleteLocation
Cursor = 63
Left = 6
- Height = 783
+ Height = 603
Top = 6
Width = 328
Anchors = [akTop, akLeft, akRight, akBottom]
@@ -843,12 +843,61 @@ object frmMain: TfrmMain
OnSaveNode = vstLocationsSaveNode
end
end
+ object tsUoaDesigns: TTabSheet
+ Caption = 'UOA Designs'
+ ClientHeight = 656
+ ClientWidth = 340
+ object vstUoaDesigns: TLazVirtualStringTree
+ Cursor = 63
+ Left = 8
+ Height = 640
+ Top = 8
+ Width = 324
+ Align = alClient
+ BorderSpacing.Around = 8
+ DefaultNodeHeight = 26
+ DefaultText = 'Node'
+ Header.AutoSizeIndex = 0
+ Header.Columns = <
+ item
+ Position = 0
+ Text = 'Name'
+ Width = 200
+ end
+ item
+ Position = 1
+ Text = 'Category'
+ Width = 100
+ end>
+ Header.Options = [hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible]
+ TabOrder = 0
+ TreeOptions.MiscOptions = [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
+ TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
+ TreeOptions.SelectionOptions = [toFullRowSelect]
+ OnDblClick = vstUoaDesignsDblClick
+ OnGetText = vstUoaDesignsGetText
+ end
+ object btnCancelUOAPlacement: TButton
+ AnchorSideLeft.Control = vstUoaDesigns
+ AnchorSideLeft.Side = asrCenter
+ AnchorSideTop.Control = vstUoaDesigns
+ AnchorSideTop.Side = asrCenter
+ Left = 103
+ Height = 47
+ Top = 305
+ Width = 134
+ Caption = 'Cancel'
+ OnClick = btnCancelUOAPlacementClick
+ TabOrder = 1
+ Visible = False
+ end
+ end
end
object tbMain: TToolBar
Left = 0
Height = 38
Top = 0
- Width = 1180
+ Width = 1172
Caption = 'tbMain'
Images = ImageList1
ParentShowHint = False
@@ -1038,13 +1087,13 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = spChat
Left = 350
Height = 35
- Top = 667
- Width = 830
+ Top = 487
+ Width = 822
Anchors = [akLeft, akRight, akBottom]
BevelInner = bvRaised
BevelOuter = bvLowered
ClientHeight = 35
- ClientWidth = 830
+ ClientWidth = 822
TabOrder = 3
object lblChatHeaderCaption: TLabel
Cursor = crHandPoint
@@ -1074,12 +1123,12 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = pnlBottom
Left = 350
Height = 202
- Top = 710
- Width = 830
+ Top = 530
+ Width = 822
Anchors = [akTop, akLeft, akRight, akBottom]
BevelOuter = bvNone
ClientHeight = 202
- ClientWidth = 830
+ ClientWidth = 822
TabOrder = 4
Visible = False
object vstChat: TLazVirtualStringTree
@@ -1087,7 +1136,7 @@ object frmMain: TfrmMain
Left = 0
Height = 164
Top = 0
- Width = 830
+ Width = 822
Align = alClient
DefaultText = 'Node'
Header.AutoSizeIndex = 2
@@ -1105,7 +1154,7 @@ object frmMain: TfrmMain
item
Position = 2
Text = 'Message'
- Width = 592
+ Width = 584
end>
Header.DefaultHeight = 26
Header.Height = 26
@@ -1126,7 +1175,7 @@ object frmMain: TfrmMain
Left = 0
Height = 38
Top = 164
- Width = 830
+ Width = 822
Align = alBottom
OnKeyPress = edChatKeyPress
TabOrder = 1
@@ -1140,8 +1189,8 @@ object frmMain: TfrmMain
Cursor = crVSplit
Left = 350
Height = 8
- Top = 702
- Width = 830
+ Top = 522
+ Width = 822
Align = alNone
Anchors = [akLeft, akRight, akBottom]
AutoSnap = False
@@ -1157,9 +1206,9 @@ object frmMain: TfrmMain
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = pnlChatHeader
Left = 350
- Height = 629
+ Height = 449
Top = 38
- Width = 830
+ Width = 822
Anchors = [akTop, akLeft, akRight, akBottom]
OnDblClick = oglGameWindowDblClick
OnKeyDown = oglGameWindowKeyDown
diff --git a/Client/UfrmMain.pas b/Client/UfrmMain.pas
index cb4a749..0cdef58 100644
--- a/Client/UfrmMain.pas
+++ b/Client/UfrmMain.pas
@@ -37,7 +37,7 @@ uses
LCLIntf, UOverlayUI, UStatics, UEnhancedMemoryStream, ActnList,
XMLPropStorage, ImagingClasses, dateutils, UPlatformTypes, UMap, UPacket,
UGLFont, DOM, XMLRead, XMLWrite, strutils, ULightManager, fgl, UTiledata,
- UActions;
+ UActions, UUoaDesigns;
type
TAccessChangedListener = procedure(AAccessLevel: TAccessLevel) of object;
@@ -47,7 +47,6 @@ type
TBlockInfoList = specialize TFPGList;
- TGhostTile = class(TStaticItem);
TPacketList = specialize TFPGObjectList;
TAccessChangedListeners = specialize TFPGList;
TSelectionListeners = specialize TFPGList;
@@ -89,6 +88,7 @@ type
btnGoTo: TButton;
btnRandomPresetDelete: TSpeedButton;
btnRandomPresetSave: TSpeedButton;
+ btnCancelUOAPlacement: TButton;
cbRandomPreset: TComboBox;
cbStatics: TCheckBox;
cbTerrain: TCheckBox;
@@ -97,6 +97,7 @@ type
edSearchID: TEdit;
gbRandom: TGroupBox;
ImageList1: TImageList;
+ vstUoaDesigns: TLazVirtualStringTree;
lblChatHeaderCaption: TLabel;
lblFilter: TLabel;
lblTipC: TLabel;
@@ -162,6 +163,7 @@ type
pmViewTerrainSettings: TPopupMenu;
spChat: TSplitter;
spTileList: TSplitter;
+ tsUoaDesigns: TTabSheet;
tbFilter: TToolButton;
tbFlat: TToolButton;
tbNoDraw: TToolButton;
@@ -218,6 +220,7 @@ type
var CanShow: Boolean; var HintInfo: THintInfo);
procedure btnAddLocationClick(Sender: TObject);
procedure btnAddRandomClick(Sender: TObject);
+ procedure btnCancelUOAPlacementClick(Sender: TObject);
procedure btnClearLocationsClick(Sender: TObject);
procedure btnClearRandomClick(Sender: TObject);
procedure btnDeleteLocationClick(Sender: TObject);
@@ -320,6 +323,10 @@ type
Column: TColumnIndex; const NewText: String);
procedure vstLocationsSaveNode(Sender: TBaseVirtualTree;
Node: PVirtualNode; Stream: TStream);
+ procedure vstUoaDesignsDblClick(Sender: TObject);
+ procedure vstUoaDesignsGetText(Sender: TBaseVirtualTree;
+ Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
+ var CellText: String);
procedure XMLPropStorage1RestoreProperties(Sender: TObject);
protected
{ Members }
@@ -354,12 +361,18 @@ type
FUndoList: TPacketList;
FGLFont: TGLFont;
FSelectionListeners: TSelectionListeners;
+ FHoverListeners: TSelectionListeners;
FTileHint: TTileHintInfo;
FLightManager: TLightManager;
FTileFilter: TTileDataFlags;
+ FUoaDesigns: TUoaDesigns;
+ FCurrentUoaDesign: TUoaDesign;
+ FCurrentUoaDesignAnchor: TWorldItem;
+ FCurrentUoaTiles: TStaticItemList;
{ Methods }
procedure BuildTileList;
function ConfirmAction: Boolean;
+ procedure EnableActions(AEnabled: Boolean);
function FindRandomPreset(AName: String): TDOMElement;
procedure ForceUpdateCurrentTile;
procedure GetDrawOffset(AX, AY: Integer; out DrawX, DrawY: Integer); inline;
@@ -369,9 +382,13 @@ type
procedure InitSize;
procedure LoadLocations;
procedure LoadRandomPresets;
+ procedure LoadUoaDesigns;
procedure MoveBy(AOffsetX, AOffsetY: Integer); inline;
+ procedure MoveUoaDesign(AX, AY: Word; AZ: ShortInt);
+ procedure PlaceUoaDesign(AWorldItem: TWorldItem);
procedure PrepareMapCell(AMapCell: TMapCell);
procedure PrepareScreenBlock(ABlockInfo: PBlockInfo);
+ procedure PreviewUoaDesign(AWorldItem: TWorldItem);
procedure ProcessToolState;
procedure ProcessAccessLevel;
procedure RebuildScreenBuffer;
@@ -411,10 +428,12 @@ type
procedure InvalidateFilter;
procedure InvalidateScreenBuffer;
procedure RegisterAccessChangedListener(AListener: TAccessChangedListener);
+ procedure RegisterHoverListener(AListener: TSelectionListener);
procedure RegisterSelectionListener(AListener: TSelectionListener);
procedure SetPos(AX, AY: Word);
procedure SwitchToSelection;
procedure UnregisterAccessChangedListener(AListener: TAccessChangedListener);
+ procedure UnregisterHoverListener(AListener: TSelectionListener);
procedure UnregisterSelectionListener(AListener: TSelectionListener);
end;
@@ -1023,13 +1042,18 @@ begin
FRandomPresetsFile := FConfigDir + 'RandomPresets.xml';
LoadRandomPresets;
+ LoadUoaDesigns;
+
DoubleBuffered := True;
pnlBottom.DoubleBuffered := True;
FAccessChangedListeners := TAccessChangedListeners.Create;
+ FHoverListeners := TSelectionListeners.Create;
FSelectionListeners := TSelectionListeners.Create;
FLastDraw := Now;
+
+ pcLeft.ActivePage := tsTiles;
end;
procedure TfrmMain.btnGoToClick(Sender: TObject);
@@ -1138,6 +1162,11 @@ begin
vdtRandom.EndUpdate;
end;
+procedure TfrmMain.btnCancelUOAPlacementClick(Sender: TObject);
+begin
+ PlaceUoaDesign(nil);
+end;
+
procedure TfrmMain.btnClearLocationsClick(Sender: TObject);
begin
if MessageDlg('Are you sure you want to delete all saved locations?',
@@ -1395,7 +1424,9 @@ begin
FreeAndNil(FGLFont);
FreeAndNil(FRandomPresetsDoc);
FreeAndNil(FAccessChangedListeners);
+ FreeAndNil(FHoverListeners);
FreeAndNil(FSelectionListeners);
+ FreeAndNil(FUoaDesigns);
RegisterPacketHandler($0C, nil);
end;
@@ -1974,6 +2005,80 @@ begin
Stream.Write(locationInfo^.Name[1], stringLength);
end;
+procedure TfrmMain.vstUoaDesignsDblClick(Sender: TObject);
+var
+ selectedNode: PVirtualNode;
+ designTile: TStaticItem;
+ virtualTile: TMovableGhostTile;
+begin
+ // Make sure to reset the current view first.
+ PreviewUoaDesign(nil);
+ acSelect.Checked := True;
+ EnableActions(False);
+
+ UnregisterSelectionListener(@PlaceUoaDesign);
+ UnregisterHoverListener(@PreviewUoaDesign);
+
+ selectedNode := vstUoaDesigns.GetFirstSelected();
+ if selectedNode = nil then
+ Exit;
+
+ FreeAndNil(FCurrentUoaDesign);
+ FreeAndNil(FCurrentUoaTiles);
+ FCurrentUoaDesign := FUoaDesigns.LoadDesign(FUoaDesigns.Headers[selectedNode^.Index]);
+ FCurrentUoaTiles := TStaticItemList.Create(False);
+
+ for designTile in FCurrentUoaDesign.Tiles do
+ begin
+ virtualTile := TMovableGhostTile.Create(nil, nil, 0, 0);
+ virtualTile.X := designTile.X;
+ virtualTile.Y := designTile.Y;
+ virtualTile.Z := designTile.Z;
+ virtualTile.OriginalX := designTile.X;
+ virtualTile.OriginalY := designTile.Y;
+ virtualTile.OriginalZ := designTile.Z;
+ virtualTile.TileID := designTile.TileID;
+ virtualTile.Hue := designTile.Hue;
+ FCurrentUoaTiles.Add(virtualTile);
+ FVirtualTiles.Add(virtualTile);
+ end;
+ MoveUoaDesign(FX, FY, FLandscape.GetLandAlt(FX, FY, 0));
+
+ RegisterSelectionListener(@PlaceUoaDesign);
+ RegisterHoverListener(@PreviewUoaDesign);
+
+ vstUoaDesigns.Enabled := False;
+ btnCancelUOAPlacement.Visible := True;
+end;
+
+procedure TfrmMain.vstUoaDesignsGetText(Sender: TBaseVirtualTree;
+ Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
+ var CellText: String);
+var
+ header: TUoaDesignHeader;
+
+ function BuildCategoryName: String;
+ begin
+ if header.Category <> EmptyStr then
+ Result := header.Category;
+
+ if header.Subcategory <> EmptyStr then
+ begin
+ if Result <> EmptyStr then
+ Result := Result + '/';
+ Result := Result + header.Subcategory;
+ end;
+ end;
+
+begin
+ header := FUoaDesigns.Headers[Node^.Index];
+
+ case Column of
+ 0: CellText := header.Name;
+ 1: CellText := BuildCategoryName;
+ end;
+end;
+
procedure TfrmMain.XMLPropStorage1RestoreProperties(Sender: TObject);
begin
FTextureManager.UseAnims := mnuShowAnimations.Checked;
@@ -2018,9 +2123,16 @@ begin
FAccessChangedListeners.Add(AListener);
end;
+procedure TfrmMain.RegisterHoverListener(AListener: TSelectionListener);
+begin
+ if FHoverListeners.IndexOf(AListener) = -1 then
+ FHoverListeners.Add(AListener);
+end;
+
procedure TfrmMain.RegisterSelectionListener(AListener: TSelectionListener);
begin
- FSelectionListeners.Add(AListener);
+ if FSelectionListeners.IndexOf(AListener) = -1 then
+ FSelectionListeners.Add(AListener);
end;
procedure TfrmMain.UnregisterAccessChangedListener(
@@ -2029,6 +2141,11 @@ begin
FAccessChangedListeners.Remove(AListener);
end;
+procedure TfrmMain.UnregisterHoverListener(AListener: TSelectionListener);
+begin
+ FHoverListeners.Remove(Alistener);
+end;
+
procedure TfrmMain.UnregisterSelectionListener(AListener: TSelectionListener);
begin
FSelectionListeners.Remove(AListener);
@@ -2206,6 +2323,26 @@ begin
end;
end;
+procedure TfrmMain.LoadUoaDesigns;
+var
+ idxFile, binFile: String;
+ i: Integer;
+begin
+ idxFile := FAppDir + 'Designs.idx';
+ binFile := FAppDir + 'Designs.bin';
+
+ if (not FileExists(idxFile)) or (not FileExists(binFile)) then
+ begin
+ tsUoaDesigns.TabVisible := False;
+ Exit;
+ end;
+
+ FUoaDesigns := TUoaDesigns.Create(idxFile, binFile);
+ tsUoaDesigns.TabVisible := True;
+ for i := 1 to FUoaDesigns.Headers.Count do
+ vstUoaDesigns.AddChild(nil);
+end;
+
procedure TfrmMain.MoveBy(AOffsetX, AOffsetY: Integer); inline;
begin
SetPos(EnsureRange(FX + AOffsetX, 0, FLandscape.CellWidth - 1),
@@ -2213,6 +2350,88 @@ begin
UpdateCurrentTile;
end;
+procedure TfrmMain.MoveUoaDesign(AX, AY: Word; AZ: ShortInt);
+var
+ offsetX, offsetY, offsetZ, maxZ: Integer;
+ item: TStaticItem;
+begin
+ maxZ := Low(Integer);
+ for item in FCurrentUoaDesign.Tiles do
+ if item.Z > maxZ then
+ maxZ := item.Z;
+
+ offsetX := AX - FCurrentUoaDesign.Header.Width div 2;
+ offsetY := AY - FCurrentUoaDesign.Header.Height div 2;
+ offsetZ := EnsureRange(AZ, -128, 127);
+
+ if offsetX < 0 then offsetX := 0;
+ if offsetX + FCurrentUoaDesign.Header.Width > FLandscape.CellWidth then
+ offsetX := FLandscape.CellWidth - FCurrentUoaDesign.Header.Width;
+ if offsetY < 0 then offsetY := 0;
+ if offsetY + FCurrentUoaDesign.Header.Height > FLandscape.CellHeight then
+ offsetY := FLandscape.CellHeight - FCurrentUoaDesign.Header.Height;
+ if offsetZ + maxZ > 127 then
+ offsetZ := 127 - maxZ;
+
+ for item in FCurrentUoaTiles do
+ begin
+ item.X := TMovableGhostTile(item).OriginalX + offsetX;
+ item.Y := TMovableGhostTile(item).OriginalY + offsetY;
+ item.Z := TMovableGhostTile(item).OriginalZ + offsetZ;
+ end;
+
+ InvalidateScreenBuffer;
+end;
+
+procedure TfrmMain.PlaceUoaDesign(AWorldItem: TWorldItem);
+var
+ selectedNode: PVirtualNode;
+ header: TUoaDesignHeader;
+ item: TWorldItem;
+ i: Integer;
+begin
+ UnregisterSelectionListener(@PlaceUoaDesign);
+ UnregisterHoverListener(@PreviewUoaDesign);
+ FreeAndNil(FCurrentUoaDesign);
+ FreeAndNil(FCurrentUoaTiles);
+ FCurrentUoaDesignAnchor := nil;
+ vstUoaDesigns.Enabled := True;
+ btnCancelUOAPlacement.Visible := False;
+ EnableActions(True);
+
+ selectedNode := vstUoaDesigns.GetFirstSelected();
+ if selectedNode = nil then
+ Exit;
+
+ if AWorldItem = nil then
+ begin
+ for i := FVirtualTiles.Count - 1 downto 0 do
+ begin
+ if FVirtualTiles[i] is TGhostTile then
+ begin
+ FScreenBuffer.Delete(FVirtualTiles[i]);
+ FVirtualTiles.Delete(i);
+ end;
+ end;
+ Exit;
+ end;
+
+ FUndoList.Clear;
+ for i := FVirtualTiles.Count - 1 downto 0 do
+ begin
+ item := FVirtualTiles[i];
+ if item is TGhostTile then
+ begin
+ dmNetwork.Send(TInsertStaticPacket.Create(TGhostTile(item)));
+ FUndoList.Add(TDeleteStaticPacket.Create(TGhostTile(item)));
+ FVirtualTiles.Delete(i);
+ FScreenBuffer.Delete(item);
+ end;
+ end;
+
+ vstUoaDesigns.ClearSelection;
+end;
+
procedure TfrmMain.PrepareMapCell(AMapCell: TMapCell);
var
current, north, east, west: PBlockInfo;
@@ -2473,6 +2692,23 @@ begin
end;
end;
+procedure TfrmMain.PreviewUoaDesign(AWorldItem: TWorldItem);
+begin
+ // If nothing has changed, we can keep this short.
+ if FCurrentUoaDesignAnchor = AWorldItem then
+ Exit;
+ FCurrentUoaDesignAnchor := AWorldItem;
+
+ // No design selected? Well then.
+ if FCurrentUoaDesign = nil then
+ Exit;
+
+ if AWorldItem = nil then
+ Exit;
+
+ MoveUoaDesign(AWorldItem.X, AWorldItem.Y, AWorldItem.Z);
+end;
+
procedure TfrmMain.Render;
var
highlight: Boolean;
@@ -2965,6 +3201,7 @@ end;
procedure TfrmMain.UpdateCurrentTile(AX, AY: Integer);
var
blockInfo: PBlockInfo;
+ listener: TSelectionListener;
begin
//Logger.EnterMethod([lcClient, lcDebug], 'UpdateCurrentTile');
FOverlayUI.ActiveArrow := FOverlayUI.HitTest(AX, AY);
@@ -2982,6 +3219,9 @@ begin
else
CurrentTile := nil;
+ for listener in FHoverListeners do
+ listener(CurrentTile);
+
//Logger.ExitMethod([lcClient, lcDebug], 'UpdateCurrentTile');
end;
@@ -3181,9 +3421,11 @@ var
begin
//Logger.EnterMethod([lcClient, lcDebug], 'UpdateSelection');
- //If the current tile is nil, but we still have a selected tile, the
- //procedure is pointless - the selection should stay intact.
- if (CurrentTile <> nil) or (SelectedTile = nil) then
+ // If the current tile is nil, but we still have a selected tile, the
+ // procedure is pointless - the selection should stay intact.
+ // Same if we are currently placing a UOA design, since we reuse the virtual
+ // tile and just update its position.
+ if ((CurrentTile <> nil) or (SelectedTile = nil)) and (FCurrentUoaTiles = nil) then
begin
if CurrentTile = nil then
selectedRect := Rect(-1, -1, -1, -1)
@@ -3410,6 +3652,15 @@ begin
oglGameWindowMouseLeave(nil);
end;
+procedure TfrmMain.EnableActions(AEnabled: Boolean);
+begin
+ acSelect.Enabled := AEnabled;
+ acMove.Enabled := AEnabled;
+ acElevate.Enabled := AEnabled;
+ acDelete.Enabled := AEnabled;
+ acHue.Enabled := AEnabled;
+end;
+
function TfrmMain.FindRandomPreset(AName: String): TDOMElement;
var
preset: TDOMElement;