✨ Load and list UOA designs

Client/CentrED.lpi

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

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

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

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),