From 0e5cb1b48ba9aa8a224ab04195b055a6885dec67 Mon Sep 17 00:00:00 2001 From: Andreas Schneider Date: Tue, 19 Jul 2022 18:24:03 +0200 Subject: [PATCH] =?UTF-8?q?=E2=9C=A8=20Load=20and=20list=20UOA=20designs?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Client/CentrED.lpi | 6 +- Client/UUoaDesigns.pas | 158 +++++++++++++++++++++++++++++++++++++++++ Client/UfrmMain.lfm | 112 +++++++++++++++++++---------- Client/UfrmMain.pas | 62 +++++++++++++++- 4 files changed, 297 insertions(+), 41 deletions(-) create mode 100644 Client/UUoaDesigns.pas 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/UUoaDesigns.pas b/Client/UUoaDesigns.pas new file mode 100644 index 0000000..f609f9c --- /dev/null +++ b/Client/UUoaDesigns.pas @@ -0,0 +1,158 @@ +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; + + { TUoaDesigns } + + TUoaDesigns = class + private + FHeaders: TUoaDesignHeaders; + FData: TFileStream; + public + constructor Create(AIdxFile, ABinFile: String); + destructor Destroy; override; + + function LoadTiles(AHeader: TUoaDesignHeader; AOffsetX, AOffsetY: Word): TStaticItemList; + public + property Headers: TUoaDesignHeaders read FHeaders; + end; + +implementation + +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; + +{ 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.LoadTiles(AHeader: TUoaDesignHeader; AOffsetX, + AOffsetY: Word): TStaticItemList; +var + i: Integer; + tile: TStaticItem; + version: Int32; + + function ReadInt: Int32; + begin + FData.Read(Result, SizeOf(Result)); + end; + +begin + Result := TStaticItemList.Create(True); + FData.Seek(AHeader.FilePosition, soFromBeginning); + for i := 0 to AHeader.TileCount - 1 do + begin + FData.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 := AOffsetX + ReadInt; + tile.Y := AOffsetY + ReadInt; + tile.Z := ReadInt; + ReadInt; // TODO: Level?? + + if version = 1 then + tile.Hue := ReadInt; + + Result.Add(tile); + end; +end; + +end. + diff --git a/Client/UfrmMain.lfm b/Client/UfrmMain.lfm index 2ac5abe..fd33611 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,16 +118,16 @@ 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 @@ -152,7 +152,7 @@ object frmMain: TfrmMain AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = spTileList Left = 6 - Height = 493 + Height = 313 Hint = '-' Top = 74 Width = 328 @@ -213,7 +213,7 @@ object frmMain: TfrmMain AnchorSideBottom.Side = asrBottom Left = 0 Height = 261 - Top = 575 + Top = 395 Width = 340 Anchors = [akTop, akLeft, akRight, akBottom] Caption = 'Random pool' @@ -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 @@ -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] @@ -824,7 +824,7 @@ object frmMain: TfrmMain item Position = 1 Text = 'Name' - Width = 206 + Width = 208 end> Header.DefaultHeight = 26 Header.Height = 26 @@ -843,12 +843,46 @@ 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] + OnGetText = vstUoaDesignsGetText + end + end end object tbMain: TToolBar Left = 0 Height = 38 Top = 0 - Width = 1180 + Width = 1172 Caption = 'tbMain' Images = ImageList1 ParentShowHint = False @@ -1038,13 +1072,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 +1108,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 +1121,7 @@ object frmMain: TfrmMain Left = 0 Height = 164 Top = 0 - Width = 830 + Width = 822 Align = alClient DefaultText = 'Node' Header.AutoSizeIndex = 2 @@ -1105,7 +1139,7 @@ object frmMain: TfrmMain item Position = 2 Text = 'Message' - Width = 592 + Width = 584 end> Header.DefaultHeight = 26 Header.Height = 26 @@ -1126,7 +1160,7 @@ object frmMain: TfrmMain Left = 0 Height = 38 Top = 164 - Width = 830 + Width = 822 Align = alBottom OnKeyPress = edChatKeyPress TabOrder = 1 @@ -1140,8 +1174,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 +1191,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..f0f58be 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; @@ -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; @@ -320,6 +322,9 @@ type Column: TColumnIndex; const NewText: String); procedure vstLocationsSaveNode(Sender: TBaseVirtualTree; Node: PVirtualNode; Stream: TStream); + procedure vstUoaDesignsGetText(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; + var CellText: String); procedure XMLPropStorage1RestoreProperties(Sender: TObject); protected { Members } @@ -357,6 +362,7 @@ type FTileHint: TTileHintInfo; FLightManager: TLightManager; FTileFilter: TTileDataFlags; + FUoaDesigns: TUoaDesigns; { Methods } procedure BuildTileList; function ConfirmAction: Boolean; @@ -369,6 +375,7 @@ type procedure InitSize; procedure LoadLocations; procedure LoadRandomPresets; + procedure LoadUoaDesigns; procedure MoveBy(AOffsetX, AOffsetY: Integer); inline; procedure PrepareMapCell(AMapCell: TMapCell); procedure PrepareScreenBlock(ABlockInfo: PBlockInfo); @@ -1023,6 +1030,8 @@ begin FRandomPresetsFile := FConfigDir + 'RandomPresets.xml'; LoadRandomPresets; + LoadUoaDesigns; + DoubleBuffered := True; pnlBottom.DoubleBuffered := True; @@ -1030,6 +1039,8 @@ begin FSelectionListeners := TSelectionListeners.Create; FLastDraw := Now; + + pcLeft.ActivePage := tsTiles; end; procedure TfrmMain.btnGoToClick(Sender: TObject); @@ -1396,6 +1407,7 @@ begin FreeAndNil(FRandomPresetsDoc); FreeAndNil(FAccessChangedListeners); FreeAndNil(FSelectionListeners); + FreeAndNil(FUoaDesigns); RegisterPacketHandler($0C, nil); end; @@ -1974,6 +1986,34 @@ begin Stream.Write(locationInfo^.Name[1], stringLength); 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; @@ -2206,6 +2246,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),