Draw UOA designs

This commit is contained in:
Andreas Schneider 2022-07-19 20:09:24 +02:00
parent 0e5cb1b48b
commit 7a67e62398
3 changed files with 57 additions and 20 deletions

View File

@ -42,7 +42,8 @@ type
constructor Create(AIdxFile, ABinFile: String);
destructor Destroy; override;
function LoadTiles(AHeader: TUoaDesignHeader; AOffsetX, AOffsetY: Word): TStaticItemList;
function LoadTiles(AHeader: TUoaDesignHeader; AOffsetX, AOffsetY: Word;
AOffsetZ: ShortInt): TStaticItemList;
public
property Headers: TUoaDesignHeaders read FHeaders;
end;
@ -120,7 +121,7 @@ begin
end;
function TUoaDesigns.LoadTiles(AHeader: TUoaDesignHeader; AOffsetX,
AOffsetY: Word): TStaticItemList;
AOffsetY: Word; AOffsetZ: ShortInt): TStaticItemList;
var
i: Integer;
tile: TStaticItem;
@ -144,7 +145,7 @@ begin
tile.TileID := ReadInt;
tile.X := AOffsetX + ReadInt;
tile.Y := AOffsetY + ReadInt;
tile.Z := ReadInt;
tile.Z := AOffsetZ + ReadInt;
ReadInt; // TODO: Level??
if version = 1 then

View File

@ -133,7 +133,7 @@ object frmMain: TfrmMain
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 = 313
Height = 319
Hint = '-'
Top = 74
Top = 68
Width = 328
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 6
@ -217,7 +217,7 @@ object frmMain: TfrmMain
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
@ -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'
@ -824,7 +824,7 @@ object frmMain: TfrmMain
item
Position = 1
Text = 'Name'
Width = 208
Width = 206
end>
Header.DefaultHeight = 26
Header.Height = 26
@ -874,6 +874,7 @@ object frmMain: TfrmMain
TreeOptions.MiscOptions = [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
TreeOptions.SelectionOptions = [toFullRowSelect]
OnDblClick = vstUoaDesignsDblClick
OnGetText = vstUoaDesignsGetText
end
end

View File

@ -322,6 +322,7 @@ 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);
@ -377,6 +378,7 @@ type
procedure LoadRandomPresets;
procedure LoadUoaDesigns;
procedure MoveBy(AOffsetX, AOffsetY: Integer); inline;
procedure PlaceUoaDesign(AWorldItem: TWorldItem);
procedure PrepareMapCell(AMapCell: TMapCell);
procedure PrepareScreenBlock(ABlockInfo: PBlockInfo);
procedure ProcessToolState;
@ -1986,6 +1988,11 @@ begin
Stream.Write(locationInfo^.Name[1], stringLength);
end;
procedure TfrmMain.vstUoaDesignsDblClick(Sender: TObject);
begin
RegisterSelectionListener(@PlaceUoaDesign);
end;
procedure TfrmMain.vstUoaDesignsGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: String);
@ -2060,6 +2067,7 @@ end;
procedure TfrmMain.RegisterSelectionListener(AListener: TSelectionListener);
begin
if FSelectionListeners.IndexOf(AListener) = -1 then
FSelectionListeners.Add(AListener);
end;
@ -2273,6 +2281,33 @@ begin
UpdateCurrentTile;
end;
procedure TfrmMain.PlaceUoaDesign(AWorldItem: TWorldItem);
var
selectedNode: PVirtualNode;
header: TUoaDesignHeader;
tiles: TStaticItemList;
newTile: TStaticItem;
begin
UnregisterSelectionListener(@PlaceUoaDesign);
selectedNode := vstUoaDesigns.GetFirstSelected();
if selectedNode = nil then
Exit;
header := FUoaDesigns.Headers[selectedNode^.Index];
tiles := FUoaDesigns.LoadTiles(header, AWorldItem.X, AWorldItem.Y, AWorldItem.Z);
try
FUndoList.Clear;
for newTile in tiles do
begin
dmNetwork.Send(TInsertStaticPacket.Create(newTile));
FUndoList.Add(TDeleteStaticPacket.Create(newTile));
end;
finally
tiles.Free;
end;
end;
procedure TfrmMain.PrepareMapCell(AMapCell: TMapCell);
var
current, north, east, west: PBlockInfo;