From d75a85d2691379a1dfc94b446fee4ae5db1875ac Mon Sep 17 00:00:00 2001 From: Andreas Schneider Date: Sun, 29 May 2022 11:46:22 +0200 Subject: [PATCH] =?UTF-8?q?=F0=9F=9A=A7=20Implement=20actions=20as=20objec?= =?UTF-8?q?ts?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Client/CentrED.lpi | 6 +- Client/UActions.pas | 465 ++++++++++++++++++++++++++++++++++++++++++ Client/ULandscape.pas | 29 +++ Client/UPackets.pas | 11 +- Client/UfrmMain.lfm | 43 ++-- Client/UfrmMain.pas | 3 +- 6 files changed, 531 insertions(+), 26 deletions(-) create mode 100644 Client/UActions.pas diff --git a/Client/CentrED.lpi b/Client/CentrED.lpi index 41850a2..133db83 100644 --- a/Client/CentrED.lpi +++ b/Client/CentrED.lpi @@ -325,7 +325,7 @@ - + @@ -577,6 +577,10 @@ + + + + diff --git a/Client/UActions.pas b/Client/UActions.pas new file mode 100644 index 0000000..f380877 --- /dev/null +++ b/Client/UActions.pas @@ -0,0 +1,465 @@ +(* + * 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 2022 Andreas Schneider + *) + +unit UActions; + +{$mode ObjFPC}{$H+} + +interface + +uses + Classes, SysUtils, fgl, UWorldItem, UStatics, UMap, UPacket, ULandscape; + +type + + TPacketList = specialize TFPGObjectList; + TIdList = specialize TFPGList; + + { TBaseEditAction } + + TBaseEditAction = class(TObject) + private + FLandscape: TLandscape; + FMapTiles: TMapCellList; + FStaticTiles: TStaticItemList; + public + constructor Create(ALandscape: TLandscape); + destructor Destroy; override; + public + property MapTiles: TMapCellList read FMapTiles; + property StaticTiles: TStaticItemList read FStaticTiles; + + procedure StartSelection(ATile: TWorldItem); virtual; abstract; + procedure AddSelection(ATile: TWorldItem); virtual; abstract; + function IsHighlighted(ATile: TWorldItem): Boolean; virtual; abstract; + procedure Execute(AScreenBuffer: TScreenBuffer; out AForwardActions, AReverseActions: TPacketList); virtual; + end; + + { TRectangleEditAction } + + TRectangleEditAction = class(TBaseEditAction) + private + FFirstTile: TWorldItem; + FLastTile: TWorldItem; + FRect: TRect; + public + constructor Create(ALandscape: TLandscape); + procedure StartSelection(ATile: TWorldItem); override; + procedure AddSelection(ATile: TWorldItem); override; + function IsHighlighted(ATile: TWorldItem): Boolean; override; + private + procedure UpdateArea; virtual; + function IsEditableTile(AWorldItem: TWorldItem): Boolean; inline; + function IsEditableStaticTile(AWorldItem: TWorldItem): Boolean; inline; + end; + + { TDrawAction } + + TDrawAction = class(TRectangleEditAction) + private + FTileIds: TIdList; + FForceZ: Boolean; + FForceZValue: ShortInt; + FRandomZ: Boolean; + FRandomZValue: Byte; + FHue: Word; + public + property TileIds: TIdList read FTileIds; + property ForceZ: Boolean read FForceZ write FForceZ; + property ForceZValue: ShortInt read FForceZValue write FForceZValue; + property RandomZ: Boolean read FRandomZ write FRandomZ; + property RandomZValue: Byte read FRandomZValue write FRandomZValue; + + constructor Create(ALandscape: TLandscape); + + function IsHighlighted(ATile: TWorldItem): Boolean; override; + procedure Execute(AScreenBuffer: TScreenBuffer; out AForwardActions, + AReverseActions: TPacketList); override; + private + procedure UpdateArea; override; + end; + + { TMoveAction } + + TMoveAction = class(TRectangleEditAction) + private + FOffsetX: Integer; + FOffsetY: Integer; + public + property OffsetX: Integer read FOffsetX write FOffsetX; + property OffsetY: Integer read FOffsetY write FOffsetY; + + procedure Execute(AScreenBuffer: TScreenBuffer; out AForwardActions, + AReverseActions: TPacketList); override; + end; + + { TElevateAction } + + TElevateAction = class(TRectangleEditAction) + public type + TMode = (emSet, emRaise, emLower); + private + FMode: TMode; + FZ: ShortInt; + FRandomZ: Boolean; + FRandomZValue: Byte; + public + property Mode: TMode read FMode write FMode; + property Z: ShortInt read FZ write FZ; + + procedure Execute(AScreenBuffer: TScreenBuffer; out AForwardActions, + AReverseActions: TPacketList); override; + end; + + { TDeleteAction } + + TDeleteAction = class(TRectangleEditAction) + public + procedure Execute(AScreenBuffer: TScreenBuffer; out AForwardActions, + AReverseActions: TPacketList); override; + end; + + { THueAction } + + THueAction = class(TRectangleEditAction) + private + FHue: Word; + public + property Hue: Word read FHue write FHue; + + procedure Execute(AScreenBuffer: TScreenBuffer; out AForwardActions, + AReverseActions: TPacketList); override; + end; + +implementation + +uses + Math, UGameResources, UPackets; + +{ TBaseEditAction } + +constructor TBaseEditAction.Create(ALandscape: TLandscape); +begin + FLandscape := ALandscape; + FMapTiles := TMapCellList.Create; + FStaticTiles := TStaticItemList.Create; +end; + +destructor TBaseEditAction.Destroy; +begin + FMapTiles.Free; + FStaticTiles.Free; + inherited Destroy; +end; + +procedure TBaseEditAction.Execute(AScreenBuffer: TScreenBuffer; out + AForwardActions, AReverseActions: TPacketList); +begin + AForwardActions := TPacketList.Create; + AReverseActions := TPacketList.Create; +end; + +{ TRectangleEditAction } + +constructor TRectangleEditAction.Create(ALandscape: TLandscape); +begin + inherited Create(ALandscape); + FRect.Left := -1; + FRect.Top := -1; + FRect.Bottom := -1; + FRect.Right := -1; +end; + +procedure TRectangleEditAction.StartSelection(ATile: TWorldItem); +begin + FFirstTile := ATile; + FLastTile := ATile; + UpdateArea; +end; + +procedure TRectangleEditAction.AddSelection(ATile: TWorldItem); +begin + FLastTile := ATile; + UpdateArea; +end; + +function TRectangleEditAction.IsHighlighted(ATile: TWorldItem): Boolean; +begin + Result := ((FFirstTile = FLastTile) and (FFirsttile = ATile)) or + FRect.Contains(TPoint.Create(ATile.X, ATile.Y)); +end; + +procedure TRectangleEditAction.UpdateArea; +begin + if FFirstTile = FLastTile then + begin + FRect.Left := -1; + FRect.Top := -1; + FRect.Bottom := -1; + FRect.Right := -1; + end else + begin + FRect.Left := Min(FFirstTile.X, FLastTile.X); + FRect.Top := Min(FFirstTile.Y, FLastTile.Y); + FRect.Right := Max(FFirstTile.X, FLastTile.X); + FRect.Bottom := Max(FFirstTile.Y, FLastTile.Y); + end; +end; + +function TRectangleEditAction.IsEditableTile(AWorldItem: TWorldItem): Boolean; +begin + if not AWorldItem.CanBeEdited then + Exit(False); + + if FFirstTile = FLastTile then + begin + if AWorldItem <> FFirstTile then + Exit(False); + end else + begin + if not FRect.Contains(TPoint.Create(AWorldItem.X, AWorldItem.Y)) then + Exit(False); + end; + + Result := True; +end; + +function TRectangleEditAction.IsEditableStaticTile(AWorldItem: TWorldItem): Boolean; +begin + if not IsEditableTile(AWorldItem) then + Exit(False); + + if not (AWorldItem is TStaticItem) then + Exit(False); + + Result := True; +end; + +{ TDrawAction } + +constructor TDrawAction.Create(ALandscape: TLandscape); +begin + inherited Create(ALandscape); + FTileIds := TIdList.Create; +end; + +function TDrawAction.IsHighlighted(ATile: TWorldItem): Boolean; +begin + // Since we add new tiles, we don't need to highlight any existing + // tiles. + Result := False; +end; + +procedure TDrawAction.Execute(AScreenBuffer: TScreenBuffer; out + AForwardActions, AReverseActions: TPacketList); +var + staticTile: TStaticItem; + mapTile, previousMapTile: TMapCell; +begin + inherited Execute(AScreenBuffer, AForwardActions, AReverseActions); + + if FTileIds.Count < 1 then + Exit; + + for mapTile in FMapTiles do + begin + previousMapTile := FLandscape.MapCell[mapTile.X, mapTile.Y]; + AForwardActions.Add(TDrawMapPacket.Create(mapTile.X, mapTile.Y, mapTile.Z, mapTile.TileID)); + AReverseActions.Add(TDrawMapPacket.Create(previousMapTile.X, previousMapTile.Y, previousMapTile.Z, previousMapTile.TileID)); + end; + + for staticTile in FStaticTiles do + begin + AForwardActions.Add(TInsertStaticPacket.Create(staticTile)); + AReverseActions.Add(TDeleteStaticPacket.Create(staticTile)); + end; +end; + +procedure TDrawAction.UpdateArea; +var + targetArea: TRect; + tileX, tileY: Word; + tileId: Word; + mapCell: TMapCell; + staticItem: TStaticItem; + worldItem: TWorldItem; +begin + inherited UpdateArea; + + FMapTiles.Clear; + FStaticTiles.Clear; + + // TODO Only update relevant section of the tile lists. + + if FFirstTile = nil then + Exit; + + targetArea.Left := Min(FFirstTile.X, FLastTile.X); + targetArea.Top := Min(FFirstTile.Y, FLastTile.Y); + targetArea.Right := Max(FFirstTile.X, FLastTile.X); + targetArea.Bottom := Max(FFirstTile.Y, FLastTile.Y); + + for tileX := targetArea.Left to targetArea.Right do + for tileY := targetArea.Top to targetArea.Bottom do + begin + tileId := FTileIds[Random(FTileIds.Count)]; + if tileId < $4000 then + begin + // Map Tile + mapCell := FLandscape.MapCell[tileX, tileY].Clone; + mapCell.TileID := tileId; + worldItem := mapCell; + FMapTiles.Add(mapCell); + end else + begin + // Static Tile + staticItem := TStaticItem.Create(nil, nil, 0, 0); + staticItem.TileID := tileId - $4000; + staticItem.Hue := FHue; + if not FForceZ then + begin + staticItem.Z := FFirstTile.Z; + if FFirstTile is TStaticItem then + staticItem.Z := staticItem.Z + ResMan.Tiledata.StaticTiles[FFirstTile.TileID].Height; + end; + worldItem := staticItem; + FStaticTiles.Add(staticItem); + end; + + worldItem.X := tileX; + worldItem.Y := tileY; + + if FForceZ then + worldItem.Z := FForceZValue; + if FRandomZ then + worldItem.Z := worldItem.Z + Random(FRandomZValue); + end; +end; + +{ TDeleteAction } + +procedure TDeleteAction.Execute(AScreenBuffer: TScreenBuffer; out + AForwardActions, AReverseActions: TPacketList); +var + item: TWorldItem; +begin + inherited Execute(AScreenBuffer, AForwardActions, AReverseActions); + + for item in AScreenBuffer do + begin + if not IsEditableStaticTile(item) then + Continue; + + AForwardActions.Add(TDeleteStaticPacket.Create(TStaticItem(item))); + AReverseActions.Add(TInsertStaticPacket.Create(TStaticItem(item))); + end; +end; + +{ TMoveAction } + +procedure TMoveAction.Execute(AScreenBuffer: TScreenBuffer; out + AForwardActions, AReverseActions: TPacketList); +var + newX, newY: Word; + item: TWorldItem; +begin + inherited Execute(AScreenBuffer, AForwardActions, AReverseActions); + + for item in AScreenBuffer do + begin + if not IsEditableStaticTile(item) then + Continue; + + newX := EnsureRange(item.X + FOffsetX, 0, FLandscape.CellWidth - 1); + newY := EnsureRange(item.Y + FOffsetY, 0, FLandscape.CellHeight - 1); + + AForwardActions.Add(TMoveStaticPacket.Create(TStaticItem(item), newX, newY)); + AReverseActions.Add(TMoveStaticPacket.Create(TStaticItem(item), item.X, item.Y)); + end; +end; + +{ TElevateAction } + +procedure TElevateAction.Execute(AScreenBuffer: TScreenBuffer; out + AForwardActions, AReverseActions: TPacketList); +var + item: TWorldItem; + newZ: Integer; +begin + inherited Execute(AScreenBuffer, AForwardActions, AReverseActions); + + for item in AScreenBuffer do + begin + if not IsEditableTile(item) then + Continue; + + newZ := FZ; + if FRandomZ then + newZ := newZ + Random(FRandomZValue); + + case FMode of + emRaise: newZ := item.Z + FZ; + emLower: newZ := item.Z - FZ; + end; + + newZ := EnsureRange(newZ, -128, 127); + + if item is TMapCell then + begin + AForwardActions.Add(TDrawMapPacket.Create(item.X, item.Y, newZ, item.TileID)); + AReverseActions.Add(TDrawMapPacket.Create(item.X, item.Y, item.Z, item.TileID)); + end else if item is TStaticItem then + begin + AForwardActions.Add(TElevateStaticPacket.Create(TStaticItem(item), newZ)); + AReverseActions.Add(TElevateStaticPacket.Create(TStaticItem(item), item.Z)); + end; + end; +end; + +{ THueAction } + +procedure THueAction.Execute(AScreenBuffer: TScreenBuffer; out AForwardActions, + AReverseActions: TPacketList); +var + item: TWorldItem; +begin + inherited Execute(AScreenBuffer, AForwardActions, AReverseActions); + + for item in AScreenBuffer do + begin + if not IsEditableStaticTile(item) then + Continue; + + if TStaticItem(item).Hue = FHue then + Continue; + + AForwardActions.Add(THueStaticPacket.Create(TStaticItem(item), FHue)); + AReverseActions.Add(THueStaticPacket.Create(TStaticItem(item), TStaticItem(item).Hue)); + end; +end; + +end. + diff --git a/Client/ULandscape.pas b/Client/ULandscape.pas index 00313b1..d35d4de 100644 --- a/Client/ULandscape.pas +++ b/Client/ULandscape.pas @@ -299,6 +299,18 @@ type { Events } procedure OnTileRemoved(ATile: TMulBlock); end; + + { TScreenBufferItemEnumerator } + + TScreenBufferItemEnumerator = object + private + FScreenBuffer: TScreenBuffer; + FCurrentBlock: PBlockInfo; + FCurrentItem: TWorldItem; + public + function MoveNext: Boolean; + property Current: TWorldItem read FCurrentItem; + end; TStaticInfo = packed record X: Word; @@ -308,6 +320,8 @@ type Hue: Word; end; +operator enumerator(AScreenBuffer: TScreenBuffer): TScreenBufferItemEnumerator; + implementation uses @@ -325,6 +339,21 @@ begin GLVector[2] := AVector.data[2]; end; +operator enumerator(AScreenBuffer: TScreenBuffer): TScreenBufferItemEnumerator; +begin + Result.FScreenBuffer := AScreenBuffer; + Result.MoveNext; +end; + +{ TScreenBufferItemEnumerator } + +function TScreenBufferItemEnumerator.MoveNext: Boolean; +begin + Result := FScreenBuffer.Iterate(FCurrentBlock); + if not Result then + FCurrentItem := nil; +end; + { TLandTextureManager } constructor TLandTextureManager.Create; diff --git a/Client/UPackets.pas b/Client/UPackets.pas index 8d4a078..2c0d1d9 100644 --- a/Client/UPackets.pas +++ b/Client/UPackets.pas @@ -82,8 +82,9 @@ type { TInsertStaticPacket } - TInsertStaticPacket = class(TPacket) - constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word); + TInsertStaticPacket = class(TStaticPacket) + constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word); overload; + constructor Create(AStaticItem: TStaticItem); overload; end; { TDeleteStaticPacket } @@ -250,6 +251,12 @@ begin FStream.WriteWord(AHue); end; +constructor TInsertStaticPacket.Create(AStaticItem: TStaticItem); +begin + inherited Create($07, 10); + WriteStaticItem(AStaticItem); +end; + { TDeleteStaticPacket } constructor TDeleteStaticPacket.Create(AStaticItem: TStaticItem); diff --git a/Client/UfrmMain.lfm b/Client/UfrmMain.lfm index 1bef31e..2ac5abe 100644 --- a/Client/UfrmMain.lfm +++ b/Client/UfrmMain.lfm @@ -1,11 +1,11 @@ object frmMain: TfrmMain - Left = 283 + Left = 87 Height = 961 - Top = 179 + Top = 70 Width = 1180 ActiveControl = oglGameWindow Caption = 'UO CentrED' - ClientHeight = 928 + ClientHeight = 961 ClientWidth = 1180 Constraints.MinHeight = 781 Constraints.MinWidth = 1172 @@ -19,12 +19,11 @@ object frmMain: TfrmMain Position = poScreenCenter SessionProperties = 'acFlat.Checked;acNoDraw.Checked;Height;Left;mnuFlatShowHeight.Checked;mnuSecurityQuestion.Checked;mnuShowAnimations.Checked;spTileList.Top;tbStatics.Down;tbTerrain.Down;Top;Width;WindowState;mnuWhiteBackground.Checked' ShowInTaskBar = stAlways - LCLVersion = '2.2.3.0' WindowState = wsMaximized object pnlBottom: TPanel Left = 0 Height = 49 - Top = 879 + Top = 912 Width = 1180 Align = alBottom BevelOuter = bvNone @@ -119,7 +118,7 @@ object frmMain: TfrmMain end object pcLeft: TPageControl Left = 0 - Height = 841 + Height = 874 Top = 38 Width = 350 ActivePage = tsTiles @@ -128,7 +127,7 @@ object frmMain: TfrmMain TabOrder = 1 object tsTiles: TTabSheet Caption = 'Tiles' - ClientHeight = 803 + ClientHeight = 836 ClientWidth = 340 object lblFilter: TLabel AnchorSideLeft.Control = cbTerrain @@ -153,7 +152,7 @@ object frmMain: TfrmMain AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = spTileList Left = 6 - Height = 460 + Height = 493 Hint = '-' Top = 74 Width = 328 @@ -214,7 +213,7 @@ object frmMain: TfrmMain AnchorSideBottom.Side = asrBottom Left = 0 Height = 261 - Top = 542 + Top = 575 Width = 340 Anchors = [akTop, akLeft, akRight, akBottom] Caption = 'Random pool' @@ -553,7 +552,7 @@ object frmMain: TfrmMain Cursor = crVSplit Left = 0 Height = 8 - Top = 534 + Top = 567 Width = 340 Align = alNone Anchors = [akLeft, akRight, akBottom] @@ -567,7 +566,7 @@ object frmMain: TfrmMain Left = 172 Height = 38 Hint = 'Append S or T to restrict the search to Statics or Terrain.' - Top = 484 + Top = 517 Width = 150 Anchors = [akRight, akBottom] BorderSpacing.Right = 12 @@ -628,11 +627,11 @@ object frmMain: TfrmMain end object tsClients: TTabSheet Caption = 'Clients' - ClientHeight = 803 + ClientHeight = 836 ClientWidth = 340 object lbClients: TListBox Left = 0 - Height = 803 + Height = 836 Top = 0 Width = 340 Align = alClient @@ -647,7 +646,7 @@ object frmMain: TfrmMain end object tsLocations: TTabSheet Caption = 'Locations' - ClientHeight = 803 + ClientHeight = 836 ClientWidth = 340 object btnClearLocations: TSpeedButton AnchorSideLeft.Control = btnDeleteLocation @@ -656,7 +655,7 @@ object frmMain: TfrmMain Left = 194 Height = 35 Hint = 'Clear' - Top = 762 + Top = 795 Width = 36 BorderSpacing.Left = 6 Glyph.Data = { @@ -707,7 +706,7 @@ object frmMain: TfrmMain Left = 152 Height = 35 Hint = 'Delete' - Top = 762 + Top = 795 Width = 36 Anchors = [akLeft, akBottom] BorderSpacing.Bottom = 6 @@ -757,7 +756,7 @@ object frmMain: TfrmMain Left = 110 Height = 35 Hint = 'Add' - Top = 762 + Top = 795 Width = 36 Anchors = [akTop, akRight] BorderSpacing.Right = 6 @@ -809,7 +808,7 @@ object frmMain: TfrmMain AnchorSideBottom.Control = btnDeleteLocation Cursor = 63 Left = 6 - Height = 750 + Height = 783 Top = 6 Width = 328 Anchors = [akTop, akLeft, akRight, akBottom] @@ -1039,7 +1038,7 @@ object frmMain: TfrmMain AnchorSideBottom.Control = spChat Left = 350 Height = 35 - Top = 634 + Top = 667 Width = 830 Anchors = [akLeft, akRight, akBottom] BevelInner = bvRaised @@ -1075,7 +1074,7 @@ object frmMain: TfrmMain AnchorSideBottom.Control = pnlBottom Left = 350 Height = 202 - Top = 677 + Top = 710 Width = 830 Anchors = [akTop, akLeft, akRight, akBottom] BevelOuter = bvNone @@ -1141,7 +1140,7 @@ object frmMain: TfrmMain Cursor = crVSplit Left = 350 Height = 8 - Top = 669 + Top = 702 Width = 830 Align = alNone Anchors = [akLeft, akRight, akBottom] @@ -1158,7 +1157,7 @@ object frmMain: TfrmMain AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = pnlChatHeader Left = 350 - Height = 596 + Height = 629 Top = 38 Width = 830 Anchors = [akTop, akLeft, akRight, akBottom] diff --git a/Client/UfrmMain.pas b/Client/UfrmMain.pas index b1f6c2d..cb4a749 100644 --- a/Client/UfrmMain.pas +++ b/Client/UfrmMain.pas @@ -36,7 +36,8 @@ uses StdCtrls, Spin, UEnums, laz.VirtualTrees, Buttons, UMulBlock, UWorldItem, math, LCLIntf, UOverlayUI, UStatics, UEnhancedMemoryStream, ActnList, XMLPropStorage, ImagingClasses, dateutils, UPlatformTypes, UMap, UPacket, - UGLFont, DOM, XMLRead, XMLWrite, strutils, ULightManager, fgl, UTiledata; + UGLFont, DOM, XMLRead, XMLWrite, strutils, ULightManager, fgl, UTiledata, + UActions; type TAccessChangedListener = procedure(AAccessLevel: TAccessLevel) of object;