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

Place UOA design #4

Merged
aksdb merged 8 commits from uoa_designs into master 2022-07-21 08:47:40 +02:00
Conversation 0 Commits 8 Files Changed 6 +572 -61
6 changed files with 572 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
Client/CentrED.lpi
View File

@ -325,7 +325,7 @@
<MinVersion Minor="5" Release="3" Valid="True"/> <MinVersion Minor="5" Release="3" Valid="True"/>
</Item6> </Item6>
</RequiredPackages> </RequiredPackages>
<Units Count="48"> <Units Count="49">
<Unit0> <Unit0>
<Filename Value="CentrED.lpr"/> <Filename Value="CentrED.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@ -581,6 +581,10 @@
<Filename Value="UActions.pas"/> <Filename Value="UActions.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
</Unit47> </Unit47>
<Unit48>
<Filename Value="UUoaDesigns.pas"/>
<IsPartOfProject Value="True"/>
</Unit48>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>

22
Client/ULandscape.pas
View File

@ -320,6 +320,21 @@ type
Hue: Word; Hue: Word;
end; 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; operator enumerator(AScreenBuffer: TScreenBuffer): TScreenBufferItemEnumerator;
implementation implementation
@ -996,6 +1011,7 @@ var
i, x, y: Integer; i, x, y: Integer;
tempDrawList: TWorldItemList; tempDrawList: TWorldItemList;
staticTileData: TStaticTiledata; staticTileData: TStaticTiledata;
blockInfo: PBlockInfo;
begin begin
ADrawList.Clear; ADrawList.Clear;
tempDrawList := TWorldItemList.Create(False);; tempDrawList := TWorldItemList.Create(False);;
@ -1042,7 +1058,11 @@ begin
tempDrawList.Sort(@CompareWorldItems); tempDrawList.Sort(@CompareWorldItems);
for i := 0 to tempDrawList.Count - 1 do 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; tempDrawList.Free;
end; end;

2
Client/ULightManager.pas
View File

@ -370,7 +370,7 @@ var
s: string; s: string;
i, id, col, r, g, b: Integer; i, id, col, r, g, b: Integer;
begin begin
writeln('Loading Colors from ', AFileName); //TODO //writeln('Loading Colors from ', AFileName); //TODO
for i := 1 to ColorsCount do begin for i := 1 to ColorsCount do begin
FLightColors[i].R := 1.0; FLightColors[i].R := 1.0;
FLightColors[i].G := 1.0; FLightColors[i].G := 1.0;

187
Client/UUoaDesigns.pas Normal file
View File

@ -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<TUoaDesignHeader>)
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.

153
Client/UfrmMain.lfm
View File

@ -1,12 +1,12 @@
object frmMain: TfrmMain object frmMain: TfrmMain
Left = 87 Left = 87
Height = 961 Height = 781
Top = 70 Top = 70
Width = 1180 Width = 1172
ActiveControl = oglGameWindow ActiveControl = oglGameWindow
Caption = 'UO CentrED' Caption = 'UO CentrED'
ClientHeight = 961 ClientHeight = 781
ClientWidth = 1180 ClientWidth = 1172
Constraints.MinHeight = 781 Constraints.MinHeight = 781
Constraints.MinWidth = 1172 Constraints.MinWidth = 1172
DesignTimePPI = 120 DesignTimePPI = 120
@ -23,12 +23,12 @@ object frmMain: TfrmMain
object pnlBottom: TPanel object pnlBottom: TPanel
Left = 0 Left = 0
Height = 49 Height = 49
Top = 912 Top = 732
Width = 1180 Width = 1172
Align = alBottom Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 49 ClientHeight = 49
ClientWidth = 1180 ClientWidth = 1172
TabOrder = 0 TabOrder = 0
object lblX: TLabel object lblX: TLabel
Left = 18 Left = 18
@ -61,7 +61,7 @@ object frmMain: TfrmMain
Transparent = False Transparent = False
end end
object lblTip: TLabel object lblTip: TLabel
Left = 803 Left = 795
Height = 49 Height = 49
Top = 0 Top = 0
Width = 365 Width = 365
@ -75,7 +75,7 @@ object frmMain: TfrmMain
Transparent = False Transparent = False
end end
object lblTipC: TLabel object lblTipC: TLabel
Left = 767 Left = 759
Height = 49 Height = 49
Top = 0 Top = 0
Width = 36 Width = 36
@ -118,22 +118,22 @@ object frmMain: TfrmMain
end end
object pcLeft: TPageControl object pcLeft: TPageControl
Left = 0 Left = 0
Height = 874 Height = 694
Top = 38 Top = 38
Width = 350 Width = 350
ActivePage = tsTiles ActivePage = tsUoaDesigns
Align = alLeft Align = alLeft
TabIndex = 0 TabIndex = 3
TabOrder = 1 TabOrder = 1
object tsTiles: TTabSheet object tsTiles: TTabSheet
Caption = 'Tiles' Caption = 'Tiles'
ClientHeight = 836 ClientHeight = 656
ClientWidth = 340 ClientWidth = 340
object lblFilter: TLabel object lblFilter: TLabel
AnchorSideLeft.Control = cbTerrain AnchorSideLeft.Control = cbTerrain
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = cbTerrain AnchorSideTop.Control = cbTerrain
Left = 114 Left = 109
Height = 26 Height = 26
Top = 12 Top = 12
Width = 47 Width = 47
@ -152,9 +152,9 @@ object frmMain: TfrmMain
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = spTileList AnchorSideBottom.Control = spTileList
Left = 6 Left = 6
Height = 493 Height = 319
Hint = '-' Hint = '-'
Top = 74 Top = 68
Width = 328 Width = 328
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 6 BorderSpacing.Left = 6
@ -213,11 +213,11 @@ object frmMain: TfrmMain
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 0 Left = 0
Height = 261 Height = 261
Top = 575 Top = 395
Width = 340 Width = 340
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
Caption = 'Random pool' Caption = 'Random pool'
ClientHeight = 234 ClientHeight = 237
ClientWidth = 338 ClientWidth = 338
TabOrder = 1 TabOrder = 1
object btnAddRandom: TSpeedButton object btnAddRandom: TSpeedButton
@ -375,7 +375,7 @@ object frmMain: TfrmMain
Left = 256 Left = 256
Height = 35 Height = 35
Hint = 'Save Preset' Hint = 'Save Preset'
Top = 186 Top = 189
Width = 35 Width = 35
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
BorderSpacing.Right = 6 BorderSpacing.Right = 6
@ -427,7 +427,7 @@ object frmMain: TfrmMain
Left = 297 Left = 297
Height = 35 Height = 35
Hint = 'Delete Preset' Hint = 'Delete Preset'
Top = 186 Top = 189
Width = 35 Width = 35
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
BorderSpacing.Right = 6 BorderSpacing.Right = 6
@ -482,7 +482,7 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = cbRandomPreset AnchorSideBottom.Control = cbRandomPreset
Cursor = 63 Cursor = 63
Left = 6 Left = 6
Height = 143 Height = 146
Top = 37 Top = 37
Width = 326 Width = 326
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
@ -532,7 +532,7 @@ object frmMain: TfrmMain
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 6 Left = 6
Height = 42 Height = 42
Top = 186 Top = 189
Width = 244 Width = 244
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 6 BorderSpacing.Left = 6
@ -552,7 +552,7 @@ object frmMain: TfrmMain
Cursor = crVSplit Cursor = crVSplit
Left = 0 Left = 0
Height = 8 Height = 8
Top = 567 Top = 387
Width = 340 Width = 340
Align = alNone Align = alNone
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
@ -566,7 +566,7 @@ object frmMain: TfrmMain
Left = 172 Left = 172
Height = 38 Height = 38
Hint = 'Append S or T to restrict the search to Statics or Terrain.' Hint = 'Append S or T to restrict the search to Statics or Terrain.'
Top = 517 Top = 337
Width = 150 Width = 150
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
BorderSpacing.Right = 12 BorderSpacing.Right = 12
@ -585,10 +585,10 @@ object frmMain: TfrmMain
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = tsTiles AnchorSideRight.Control = tsTiles
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 114 Left = 109
Height = 38 Height = 38
Top = 38 Top = 38
Width = 201 Width = 206
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Right = 25 BorderSpacing.Right = 25
OnEditingDone = edFilterEditingDone OnEditingDone = edFilterEditingDone
@ -600,9 +600,9 @@ object frmMain: TfrmMain
AnchorSideTop.Control = cbTerrain AnchorSideTop.Control = cbTerrain
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 8 Left = 8
Height = 28 Height = 25
Top = 40 Top = 37
Width = 79 Width = 74
Caption = 'Statics' Caption = 'Statics'
Checked = True Checked = True
OnChange = cbStaticsChange OnChange = cbStaticsChange
@ -613,9 +613,9 @@ object frmMain: TfrmMain
AnchorSideLeft.Control = tsTiles AnchorSideLeft.Control = tsTiles
AnchorSideTop.Control = tsTiles AnchorSideTop.Control = tsTiles
Left = 6 Left = 6
Height = 28 Height = 25
Top = 12 Top = 12
Width = 83 Width = 78
BorderSpacing.Left = 6 BorderSpacing.Left = 6
BorderSpacing.Top = 12 BorderSpacing.Top = 12
Caption = 'Terrain' Caption = 'Terrain'
@ -627,11 +627,11 @@ object frmMain: TfrmMain
end end
object tsClients: TTabSheet object tsClients: TTabSheet
Caption = 'Clients' Caption = 'Clients'
ClientHeight = 836 ClientHeight = 656
ClientWidth = 340 ClientWidth = 340
object lbClients: TListBox object lbClients: TListBox
Left = 0 Left = 0
Height = 836 Height = 656
Top = 0 Top = 0
Width = 340 Width = 340
Align = alClient Align = alClient
@ -646,7 +646,7 @@ object frmMain: TfrmMain
end end
object tsLocations: TTabSheet object tsLocations: TTabSheet
Caption = 'Locations' Caption = 'Locations'
ClientHeight = 836 ClientHeight = 656
ClientWidth = 340 ClientWidth = 340
object btnClearLocations: TSpeedButton object btnClearLocations: TSpeedButton
AnchorSideLeft.Control = btnDeleteLocation AnchorSideLeft.Control = btnDeleteLocation
@ -655,7 +655,7 @@ object frmMain: TfrmMain
Left = 194 Left = 194
Height = 35 Height = 35
Hint = 'Clear' Hint = 'Clear'
Top = 795 Top = 615
Width = 36 Width = 36
BorderSpacing.Left = 6 BorderSpacing.Left = 6
Glyph.Data = { Glyph.Data = {
@ -706,7 +706,7 @@ object frmMain: TfrmMain
Left = 152 Left = 152
Height = 35 Height = 35
Hint = 'Delete' Hint = 'Delete'
Top = 795 Top = 615
Width = 36 Width = 36
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 6 BorderSpacing.Bottom = 6
@ -756,7 +756,7 @@ object frmMain: TfrmMain
Left = 110 Left = 110
Height = 35 Height = 35
Hint = 'Add' Hint = 'Add'
Top = 795 Top = 615
Width = 36 Width = 36
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
BorderSpacing.Right = 6 BorderSpacing.Right = 6
@ -808,7 +808,7 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = btnDeleteLocation AnchorSideBottom.Control = btnDeleteLocation
Cursor = 63 Cursor = 63
Left = 6 Left = 6
Height = 783 Height = 603
Top = 6 Top = 6
Width = 328 Width = 328
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
@ -843,12 +843,61 @@ object frmMain: TfrmMain
OnSaveNode = vstLocationsSaveNode OnSaveNode = vstLocationsSaveNode
end end
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 end
object tbMain: TToolBar object tbMain: TToolBar
Left = 0 Left = 0
Height = 38 Height = 38
Top = 0 Top = 0
Width = 1180 Width = 1172
Caption = 'tbMain' Caption = 'tbMain'
Images = ImageList1 Images = ImageList1
ParentShowHint = False ParentShowHint = False
@ -1038,13 +1087,13 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = spChat AnchorSideBottom.Control = spChat
Left = 350 Left = 350
Height = 35 Height = 35
Top = 667 Top = 487
Width = 830 Width = 822
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
BevelInner = bvRaised BevelInner = bvRaised
BevelOuter = bvLowered BevelOuter = bvLowered
ClientHeight = 35 ClientHeight = 35
ClientWidth = 830 ClientWidth = 822
TabOrder = 3 TabOrder = 3
object lblChatHeaderCaption: TLabel object lblChatHeaderCaption: TLabel
Cursor = crHandPoint Cursor = crHandPoint
@ -1074,12 +1123,12 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = pnlBottom AnchorSideBottom.Control = pnlBottom
Left = 350 Left = 350
Height = 202 Height = 202
Top = 710 Top = 530
Width = 830 Width = 822
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 202 ClientHeight = 202
ClientWidth = 830 ClientWidth = 822
TabOrder = 4 TabOrder = 4
Visible = False Visible = False
object vstChat: TLazVirtualStringTree object vstChat: TLazVirtualStringTree
@ -1087,7 +1136,7 @@ object frmMain: TfrmMain
Left = 0 Left = 0
Height = 164 Height = 164
Top = 0 Top = 0
Width = 830 Width = 822
Align = alClient Align = alClient
DefaultText = 'Node' DefaultText = 'Node'
Header.AutoSizeIndex = 2 Header.AutoSizeIndex = 2
@ -1105,7 +1154,7 @@ object frmMain: TfrmMain
item item
Position = 2 Position = 2
Text = 'Message' Text = 'Message'
Width = 592 Width = 584
end> end>
Header.DefaultHeight = 26 Header.DefaultHeight = 26
Header.Height = 26 Header.Height = 26
@ -1126,7 +1175,7 @@ object frmMain: TfrmMain
Left = 0 Left = 0
Height = 38 Height = 38
Top = 164 Top = 164
Width = 830 Width = 822
Align = alBottom Align = alBottom
OnKeyPress = edChatKeyPress OnKeyPress = edChatKeyPress
TabOrder = 1 TabOrder = 1
@ -1140,8 +1189,8 @@ object frmMain: TfrmMain
Cursor = crVSplit Cursor = crVSplit
Left = 350 Left = 350
Height = 8 Height = 8
Top = 702 Top = 522
Width = 830 Width = 822
Align = alNone Align = alNone
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
AutoSnap = False AutoSnap = False
@ -1157,9 +1206,9 @@ object frmMain: TfrmMain
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = pnlChatHeader AnchorSideBottom.Control = pnlChatHeader
Left = 350 Left = 350
Height = 629 Height = 449
Top = 38 Top = 38
Width = 830 Width = 822
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
OnDblClick = oglGameWindowDblClick OnDblClick = oglGameWindowDblClick
OnKeyDown = oglGameWindowKeyDown OnKeyDown = oglGameWindowKeyDown

263
Client/UfrmMain.pas
View File

@ -37,7 +37,7 @@ uses
LCLIntf, UOverlayUI, UStatics, UEnhancedMemoryStream, ActnList, LCLIntf, UOverlayUI, UStatics, UEnhancedMemoryStream, ActnList,
XMLPropStorage, ImagingClasses, dateutils, UPlatformTypes, UMap, UPacket, XMLPropStorage, ImagingClasses, dateutils, UPlatformTypes, UMap, UPacket,
UGLFont, DOM, XMLRead, XMLWrite, strutils, ULightManager, fgl, UTiledata, UGLFont, DOM, XMLRead, XMLWrite, strutils, ULightManager, fgl, UTiledata,
UActions; UActions, UUoaDesigns;
type type
TAccessChangedListener = procedure(AAccessLevel: TAccessLevel) of object; TAccessChangedListener = procedure(AAccessLevel: TAccessLevel) of object;
@ -47,7 +47,6 @@ type
TBlockInfoList = specialize TFPGList<PBlockInfo>; TBlockInfoList = specialize TFPGList<PBlockInfo>;
TGhostTile = class(TStaticItem);
TPacketList = specialize TFPGObjectList<TPacket>; TPacketList = specialize TFPGObjectList<TPacket>;
TAccessChangedListeners = specialize TFPGList<TAccessChangedListener>; TAccessChangedListeners = specialize TFPGList<TAccessChangedListener>;
TSelectionListeners = specialize TFPGList<TSelectionListener>; TSelectionListeners = specialize TFPGList<TSelectionListener>;
@ -89,6 +88,7 @@ type
btnGoTo: TButton; btnGoTo: TButton;
btnRandomPresetDelete: TSpeedButton; btnRandomPresetDelete: TSpeedButton;
btnRandomPresetSave: TSpeedButton; btnRandomPresetSave: TSpeedButton;
btnCancelUOAPlacement: TButton;
cbRandomPreset: TComboBox; cbRandomPreset: TComboBox;
cbStatics: TCheckBox; cbStatics: TCheckBox;
cbTerrain: TCheckBox; cbTerrain: TCheckBox;
@ -97,6 +97,7 @@ type
edSearchID: TEdit; edSearchID: TEdit;
gbRandom: TGroupBox; gbRandom: TGroupBox;
ImageList1: TImageList; ImageList1: TImageList;
vstUoaDesigns: TLazVirtualStringTree;
lblChatHeaderCaption: TLabel; lblChatHeaderCaption: TLabel;
lblFilter: TLabel; lblFilter: TLabel;
lblTipC: TLabel; lblTipC: TLabel;
@ -162,6 +163,7 @@ type
pmViewTerrainSettings: TPopupMenu; pmViewTerrainSettings: TPopupMenu;
spChat: TSplitter; spChat: TSplitter;
spTileList: TSplitter; spTileList: TSplitter;
tsUoaDesigns: TTabSheet;
tbFilter: TToolButton; tbFilter: TToolButton;
tbFlat: TToolButton; tbFlat: TToolButton;
tbNoDraw: TToolButton; tbNoDraw: TToolButton;
@ -218,6 +220,7 @@ type
var CanShow: Boolean; var HintInfo: THintInfo); var CanShow: Boolean; var HintInfo: THintInfo);
procedure btnAddLocationClick(Sender: TObject); procedure btnAddLocationClick(Sender: TObject);
procedure btnAddRandomClick(Sender: TObject); procedure btnAddRandomClick(Sender: TObject);
procedure btnCancelUOAPlacementClick(Sender: TObject);
procedure btnClearLocationsClick(Sender: TObject); procedure btnClearLocationsClick(Sender: TObject);
procedure btnClearRandomClick(Sender: TObject); procedure btnClearRandomClick(Sender: TObject);
procedure btnDeleteLocationClick(Sender: TObject); procedure btnDeleteLocationClick(Sender: TObject);
@ -320,6 +323,10 @@ type
Column: TColumnIndex; const NewText: String); Column: TColumnIndex; const NewText: String);
procedure vstLocationsSaveNode(Sender: TBaseVirtualTree; procedure vstLocationsSaveNode(Sender: TBaseVirtualTree;
Node: PVirtualNode; Stream: TStream); 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); procedure XMLPropStorage1RestoreProperties(Sender: TObject);
protected protected
{ Members } { Members }
@ -354,12 +361,18 @@ type
FUndoList: TPacketList; FUndoList: TPacketList;
FGLFont: TGLFont; FGLFont: TGLFont;
FSelectionListeners: TSelectionListeners; FSelectionListeners: TSelectionListeners;
FHoverListeners: TSelectionListeners;
FTileHint: TTileHintInfo; FTileHint: TTileHintInfo;
FLightManager: TLightManager; FLightManager: TLightManager;
FTileFilter: TTileDataFlags; FTileFilter: TTileDataFlags;
FUoaDesigns: TUoaDesigns;
FCurrentUoaDesign: TUoaDesign;
FCurrentUoaDesignAnchor: TWorldItem;
FCurrentUoaTiles: TStaticItemList;
{ Methods } { Methods }
procedure BuildTileList; procedure BuildTileList;
function ConfirmAction: Boolean; function ConfirmAction: Boolean;
procedure EnableActions(AEnabled: Boolean);
function FindRandomPreset(AName: String): TDOMElement; function FindRandomPreset(AName: String): TDOMElement;
procedure ForceUpdateCurrentTile; procedure ForceUpdateCurrentTile;
procedure GetDrawOffset(AX, AY: Integer; out DrawX, DrawY: Integer); inline; procedure GetDrawOffset(AX, AY: Integer; out DrawX, DrawY: Integer); inline;
@ -369,9 +382,13 @@ type
procedure InitSize; procedure InitSize;
procedure LoadLocations; procedure LoadLocations;
procedure LoadRandomPresets; procedure LoadRandomPresets;
procedure LoadUoaDesigns;
procedure MoveBy(AOffsetX, AOffsetY: Integer); inline; procedure MoveBy(AOffsetX, AOffsetY: Integer); inline;
procedure MoveUoaDesign(AX, AY: Word; AZ: ShortInt);
procedure PlaceUoaDesign(AWorldItem: TWorldItem);
procedure PrepareMapCell(AMapCell: TMapCell); procedure PrepareMapCell(AMapCell: TMapCell);
procedure PrepareScreenBlock(ABlockInfo: PBlockInfo); procedure PrepareScreenBlock(ABlockInfo: PBlockInfo);
procedure PreviewUoaDesign(AWorldItem: TWorldItem);
procedure ProcessToolState; procedure ProcessToolState;
procedure ProcessAccessLevel; procedure ProcessAccessLevel;
procedure RebuildScreenBuffer; procedure RebuildScreenBuffer;
@ -411,10 +428,12 @@ type
procedure InvalidateFilter; procedure InvalidateFilter;
procedure InvalidateScreenBuffer; procedure InvalidateScreenBuffer;
procedure RegisterAccessChangedListener(AListener: TAccessChangedListener); procedure RegisterAccessChangedListener(AListener: TAccessChangedListener);
procedure RegisterHoverListener(AListener: TSelectionListener);
procedure RegisterSelectionListener(AListener: TSelectionListener); procedure RegisterSelectionListener(AListener: TSelectionListener);
procedure SetPos(AX, AY: Word); procedure SetPos(AX, AY: Word);
procedure SwitchToSelection; procedure SwitchToSelection;
procedure UnregisterAccessChangedListener(AListener: TAccessChangedListener); procedure UnregisterAccessChangedListener(AListener: TAccessChangedListener);
procedure UnregisterHoverListener(AListener: TSelectionListener);
procedure UnregisterSelectionListener(AListener: TSelectionListener); procedure UnregisterSelectionListener(AListener: TSelectionListener);
end; end;
@ -1023,13 +1042,18 @@ begin
FRandomPresetsFile := FConfigDir + 'RandomPresets.xml'; FRandomPresetsFile := FConfigDir + 'RandomPresets.xml';
LoadRandomPresets; LoadRandomPresets;
LoadUoaDesigns;
DoubleBuffered := True; DoubleBuffered := True;
pnlBottom.DoubleBuffered := True; pnlBottom.DoubleBuffered := True;
FAccessChangedListeners := TAccessChangedListeners.Create; FAccessChangedListeners := TAccessChangedListeners.Create;
FHoverListeners := TSelectionListeners.Create;
FSelectionListeners := TSelectionListeners.Create; FSelectionListeners := TSelectionListeners.Create;
FLastDraw := Now; FLastDraw := Now;
pcLeft.ActivePage := tsTiles;
end; end;
procedure TfrmMain.btnGoToClick(Sender: TObject); procedure TfrmMain.btnGoToClick(Sender: TObject);
@ -1138,6 +1162,11 @@ begin
vdtRandom.EndUpdate; vdtRandom.EndUpdate;
end; end;
procedure TfrmMain.btnCancelUOAPlacementClick(Sender: TObject);
begin
PlaceUoaDesign(nil);
end;
procedure TfrmMain.btnClearLocationsClick(Sender: TObject); procedure TfrmMain.btnClearLocationsClick(Sender: TObject);
begin begin
if MessageDlg('Are you sure you want to delete all saved locations?', if MessageDlg('Are you sure you want to delete all saved locations?',
@ -1395,7 +1424,9 @@ begin
FreeAndNil(FGLFont); FreeAndNil(FGLFont);
FreeAndNil(FRandomPresetsDoc); FreeAndNil(FRandomPresetsDoc);
FreeAndNil(FAccessChangedListeners); FreeAndNil(FAccessChangedListeners);
FreeAndNil(FHoverListeners);
FreeAndNil(FSelectionListeners); FreeAndNil(FSelectionListeners);
FreeAndNil(FUoaDesigns);
RegisterPacketHandler($0C, nil); RegisterPacketHandler($0C, nil);
end; end;
@ -1974,6 +2005,80 @@ begin
Stream.Write(locationInfo^.Name[1], stringLength); Stream.Write(locationInfo^.Name[1], stringLength);
end; 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); procedure TfrmMain.XMLPropStorage1RestoreProperties(Sender: TObject);
begin begin
FTextureManager.UseAnims := mnuShowAnimations.Checked; FTextureManager.UseAnims := mnuShowAnimations.Checked;
@ -2018,9 +2123,16 @@ begin
FAccessChangedListeners.Add(AListener); FAccessChangedListeners.Add(AListener);
end; end;
procedure TfrmMain.RegisterHoverListener(AListener: TSelectionListener);
begin
if FHoverListeners.IndexOf(AListener) = -1 then
FHoverListeners.Add(AListener);
end;
procedure TfrmMain.RegisterSelectionListener(AListener: TSelectionListener); procedure TfrmMain.RegisterSelectionListener(AListener: TSelectionListener);
begin begin
FSelectionListeners.Add(AListener); if FSelectionListeners.IndexOf(AListener) = -1 then
FSelectionListeners.Add(AListener);
end; end;
procedure TfrmMain.UnregisterAccessChangedListener( procedure TfrmMain.UnregisterAccessChangedListener(
@ -2029,6 +2141,11 @@ begin
FAccessChangedListeners.Remove(AListener); FAccessChangedListeners.Remove(AListener);
end; end;
procedure TfrmMain.UnregisterHoverListener(AListener: TSelectionListener);
begin
FHoverListeners.Remove(Alistener);
end;
procedure TfrmMain.UnregisterSelectionListener(AListener: TSelectionListener); procedure TfrmMain.UnregisterSelectionListener(AListener: TSelectionListener);
begin begin
FSelectionListeners.Remove(AListener); FSelectionListeners.Remove(AListener);
@ -2206,6 +2323,26 @@ begin
end; end;
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; procedure TfrmMain.MoveBy(AOffsetX, AOffsetY: Integer); inline;
begin begin
SetPos(EnsureRange(FX + AOffsetX, 0, FLandscape.CellWidth - 1), SetPos(EnsureRange(FX + AOffsetX, 0, FLandscape.CellWidth - 1),
@ -2213,6 +2350,88 @@ begin
UpdateCurrentTile; UpdateCurrentTile;
end; 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); procedure TfrmMain.PrepareMapCell(AMapCell: TMapCell);
var var
current, north, east, west: PBlockInfo; current, north, east, west: PBlockInfo;
@ -2473,6 +2692,23 @@ begin
end; end;
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; procedure TfrmMain.Render;
var var
highlight: Boolean; highlight: Boolean;
@ -2965,6 +3201,7 @@ end;
procedure TfrmMain.UpdateCurrentTile(AX, AY: Integer); procedure TfrmMain.UpdateCurrentTile(AX, AY: Integer);
var var
blockInfo: PBlockInfo; blockInfo: PBlockInfo;
listener: TSelectionListener;
begin begin
//Logger.EnterMethod([lcClient, lcDebug], 'UpdateCurrentTile'); //Logger.EnterMethod([lcClient, lcDebug], 'UpdateCurrentTile');
FOverlayUI.ActiveArrow := FOverlayUI.HitTest(AX, AY); FOverlayUI.ActiveArrow := FOverlayUI.HitTest(AX, AY);
@ -2982,6 +3219,9 @@ begin
else else
CurrentTile := nil; CurrentTile := nil;
for listener in FHoverListeners do
listener(CurrentTile);
//Logger.ExitMethod([lcClient, lcDebug], 'UpdateCurrentTile'); //Logger.ExitMethod([lcClient, lcDebug], 'UpdateCurrentTile');
end; end;
@ -3181,9 +3421,11 @@ var
begin begin
//Logger.EnterMethod([lcClient, lcDebug], 'UpdateSelection'); //Logger.EnterMethod([lcClient, lcDebug], 'UpdateSelection');
//If the current tile is nil, but we still have a selected tile, the // If the current tile is nil, but we still have a selected tile, the
//procedure is pointless - the selection should stay intact. // procedure is pointless - the selection should stay intact.
if (CurrentTile <> nil) or (SelectedTile = nil) then // 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 begin
if CurrentTile = nil then if CurrentTile = nil then
selectedRect := Rect(-1, -1, -1, -1) selectedRect := Rect(-1, -1, -1, -1)
@ -3410,6 +3652,15 @@ begin
oglGameWindowMouseLeave(nil); oglGameWindowMouseLeave(nil);
end; 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; function TfrmMain.FindRandomPreset(AName: String): TDOMElement;
var var
preset: TDOMElement; preset: TDOMElement;