RnQ/RnQ/groupsLib.pas

{
  This file is part of R&Q.
  Under same license
}
unit groupsLib;
{$I RnQConfig.inc}

interface

uses
  System.Classes, System.Generics.Defaults, Generics.Collections,
  RDGlobal, Nodes;

{$I PubRTTI.inc}

type
  PGroup = ^TGroup;
  TGroup = record
    IsLocal: Boolean;
    ID: Integer;
    Order: Integer;
    Name: String;
    Node: array [TDivisor] of TNode;
    Expanded: array [TDivisor] of Boolean;
    function ServerUpdate(ga: TGroupAction; const old: String = ''): Boolean;
  end;

  TGroupItem = record
    id: Integer;
    caption, img: String;
  end;

  {$I NoRTTI.inc}

  TGroups = class
  public
    GList: TDictionary;
    procedure ClearNodes;
    procedure Clear;
    procedure MakeAllLocal;
//    procedure FillNodes;
    procedure RecalculateOrder;
    procedure old_FromString(s: RawByteString);
//    function IdxOf(id: Integer): Integer;
    function AddEmpty: Integer;
    function AddWithValues(ID: Integer = 0; const Name: String = ''): Integer;
    function Get(id: Integer): TGroup;
    function Exists(ID: Integer): Boolean; overload;
    function Exists(const Name: String): Boolean; overload;
    function Count: Integer;
    function GetCount(Divisor: TDivisor): Integer;
    function RenameLocal(ID: Integer; const NewName: String): TPair;
    procedure Rename(ID: Integer; const NewName: String);
    function Remove(ID: Integer): Boolean; overload;
    function Remove(const Name: String): Boolean; overload;
    function Name2ID(const Name: string): Integer;
    function ID2Name(ID: Integer): String;
    function FreeID: Integer;

    // Change values from outside
    procedure SetExpanded(ID: Integer; d: TDivisor; val: Boolean);
    procedure SetOrder(ID, order: Integer);
    procedure SetNode(ID: Integer; d: TDivisor; Node: TNode);
    procedure SetLocal(ID: Integer; IsLocal: Boolean);

    // Helpers
    function GetGroups(AddOut: Boolean): TArray;
    procedure SaveGroup(Group: TGroup);
    procedure AddGroupsToList(var ss: TStringList; pAddOut: Boolean);
    procedure SetNodesExpanded(d: TDivisor);

    constructor Create;
    destructor Destroy; override;
  end; // TGroups

implementation

uses
  System.SysUtils,
{$IFDEF UNICODE}
  System.AnsiStrings,
{$ENDIF UNICODE}
  GlobalLib, RDUtils, RnQLangs, RnQPics, ICQSession;

constructor TGroups.Create;
begin
  inherited;
  GList := TDictionary.Create;
end;

destructor TGroups.Destroy;
begin
  GList.Clear;
  FreeAndNil(GList);
  inherited;
end;

function TGroups.Get(ID: Integer): TGroup;
var
  g: TPair;
begin
  Result := Default(TGroup);
  for g in GList do
  if g.Value.ID = ID then
  begin
    Result := g.Value;
    Exit;
  end;
end;

procedure TGroups.RecalculateOrder;
var
  Cnt: Integer;
  Arr: TArray>;
  Group: TGroup;
  g: TPair;
begin
  Arr := GList.ToArray;
  TArray.Sort>(Arr, TDelegatedComparer>.Construct(
  function(const Left, Right: TPair): Integer
  begin
    Result := TComparer.Default.Compare(Left.Value.Order, Right.Value.Order);
  end));

  Cnt := 10;
  for g in Arr do
  begin
    Group := g.Value;
    Group.Order := Cnt;
    GList.AddOrSetValue(g.Key, Group);
    Inc(Cnt, 10);
  end;

  SetLength(Arr, 0);
end;

const
  StringSeparator = ';';

procedure TGroups.old_FromString(s: RawByteString);
var
  k, Line: RawByteString;
  p: TGroup;
  d: TDivisor;
begin
  Clear;
  while s > '' do
  begin
    Line := chopLine(s);
    k := Trim(chop(AnsiString('='), Line));
    Line := Trim(Line);
    if IsOnlyDigits(k) then
    try
      p := Default(TGroup);
      p.ID := StrToInt(k);
      p.Name := Trim(UnUTF(Line));
      p.Order := 0;
      for d := Low(d) to High(d) do
      begin
        p.Node[d] := nil;
        p.Expanded[d] := True;
      end;
    except end
    else if k = 'order' then
    try
      p.Order := StrToInt(Line)
    except end
    else if k = 'collapsed' then
    while Line > '' do
    try
      p.Expanded[Str2Divisor(chop(StringSeparator, Line))] := False;
    except end
    else if k = 'ssi' then
    try
      p.IsLocal := Line = '0';
      if not (p.Name = '') then
        GList.AddOrSetValue(p.Name, p);
    except end;
  end;
end; // FromString

procedure TGroups.ClearNodes;
var
  d: TDivisor;
//  p: TGroup;
  g: TPair;
begin
  for g in GList do
  for d := Low(TDivisor) to High(TDivisor) do
  begin
    g.Value.Node[d].Free;

//    p := GList.Items[g.Value.Name];
//    FreeAndNil(p.Node[d]);
//    GList.Items[g.Value.Name] := p;

//    if Assigned(g.Value.Children[d]) then
//    begin
//      for Node in g.Value.Children[d].Values do
//        Node.Free;
//      g.Value.Children[d].Clear;
//    end;
  end;
end;

procedure TGroups.Clear;
begin
  ClearNodes;
  GList.Clear;
end;

procedure TGroups.MakeAllLocal;
var
  p: TGroup;
  g: TPair;
begin
  for g in GList do
  begin
    p := g.Value;
    p.IsLocal := True;
    SaveGroup(p);
  end;
end;

//procedure TGroups.FillNodes;
//var
//  p: TGroup;
//begin
//  for g in groups.GList do
//  begin
//    p := g.Value;
//    FillChar(p.Node, SizeOf(p.Node), 0);
//    groups.GList.Items[p.Name] := p;
//  end;
//end;

procedure TGroups.SetNodesExpanded(d: TDivisor);
var
  g: TPair;
begin
  for g in groups.GList do
    if Assigned(g.Value.Node[d]) then
      g.Value.Node[d].SetExpanded(THelpers.IfThen(collapseGroups, g.Value.Expanded[d] and not (d = d_offline) and not (d = d_contacts), g.Value.Expanded[d]))
end;

procedure TGroups.SetExpanded(ID: Integer; d: TDivisor; val: Boolean);
var
  p: TGroup;
begin
  p := Get(ID);
  if p.Name = '' then
    Exit;
  p.Expanded[d] := val;
  SaveGroup(p);
end;

procedure TGroups.SetOrder(ID, order: Integer);
var
  p: TGroup;
begin
  p := Get(ID);
  if p.Name = '' then
    Exit;
  p.Order := order;
  SaveGroup(p);
  RecalculateOrder;
end;

procedure TGroups.SetNode(ID: Integer; d: TDivisor; Node: TNode);
var
  p: TGroup;
begin
  p := Get(ID);
  if p.Name = '' then
    Exit;
  p.Node[d] := Node;
  SaveGroup(p);
end;

procedure TGroups.SetLocal(ID: Integer; IsLocal: Boolean);
var
  p: TGroup;
begin
  p := Get(ID);
  if p.Name = '' then
    Exit;
  p.IsLocal := IsLocal;
  SaveGroup(p);
end;

procedure TGroups.SaveGroup(Group: TGroup);
begin
  if not (Group.Name = '') then
    GList.AddOrSetValue(Group.Name, Group);
end;
{
function TGroups.idxOf(id: integer): integer;
begin
  for result := 0 to count - 1 do
    if a[result].id = id then
      exit;
  result := -1;
end; // idxOf
}
function TGroups.FreeID: Integer;
var
  g: TPair;
begin
  Result := 1000;
  for g in GList do
    if g.Value.ID >= Result then
      Result := g.Value.ID + 1;
end; // FreeID

function TGroups.AddEmpty: Integer;
begin
  Result := AddWithValues;
end;

function TGroups.AddWithValues(ID: Integer = 0; const Name: String = ''): Integer;
var
  d: TDivisor;
  gr: TGroup;
begin
  if ID = 0 then
    gr.ID := FreeID
  else
    gr.ID := ID;
  gr.IsLocal := True;
  gr.Name := Name;
  gr.Order := 10000;
  for d := Low(d) to High(d) do
  begin
    gr.Node[d] := nil;
    gr.Expanded[d] := True;
  end;
  GList.AddOrSetValue(gr.Name, gr);
  Result := gr.ID;
end; // AddWithID

function TGroups.Exists(ID: Integer): Boolean;
var
  g: TPair;
begin
  Result := False;
  for g in GList do
    if g.Value.ID = ID then
      Result := True;
end;

function TGroups.Exists(const Name: String): Boolean;
begin
  Result := GList.ContainsKey(Name);
end;

function TGroups.RenameLocal(ID: Integer; const NewName: String): TPair;
var
  p: TGroup;
begin
  p := Get(ID);
  Result.Key := p.Name;
  if p.Name = '' then
    Exit;
  GList.Remove(p.Name);
  p.Name := NewName;
  GList.AddOrSetValue(NewName, p);
  Result.Value := p;
end;

procedure TGroups.Rename(ID: Integer; const NewName: String);
var
  Res: TPair;
  Group: TGroup;
begin
  Res := RenameLocal(ID, NewName);
  Group := Get(ID);
  if not Group.IsLocal and (Group.ID >= 0) and not (Res.Key = '') then
    Res.Value.ServerUpdate(GA_Rename, Res.Key);
end;

function TGroups.Remove(ID: Integer): Boolean;
var
  p: TGroup;
begin
  p := Get(ID);
  Result := not (p.Name = '');
  if not Result then
    Exit;
  GList.Remove(p.Name);
  if not p.IsLocal then
    if Account.AccProto.IsReady then
      Account.AccProto.SendUpdateGroup(p.Name, GA_Remove);
end; // Remove

function TGroups.Remove(const Name: String): Boolean;
var
  p: TGroup;
begin
  Result := GList.TryGetValue(Name, p);;
  if not Result then
    Exit;
  GList.Remove(p.Name);
  if not p.IsLocal then
    if Account.AccProto.IsReady then
      Account.AccProto.SendUpdateGroup(p.Name, GA_Remove);
end; // Remove

function TGroups.ID2Name(ID: Integer): String;
begin
  Result := Get(ID).Name
end; // ID2Name

function TGroups.Name2ID(const Name: String): Integer;
var
  p: TGroup;
begin
  if GList.TryGetValue(Name, p) then
    Result := p.ID
  else
    Result := 0;
end; // Name2ID

function TGroups.Count: Integer;
begin
  Result := GList.Count;
end;

function TGroups.GetCount(Divisor: TDivisor): Integer;
var
  g: TPair;
begin
  Result := 0;
  for g in GList do
    if Assigned(g.Value.Node[Divisor]) then
      Inc(Result);
end;

procedure TGroups.AddGroupsToList(var ss: TStringList; pAddOut: Boolean);
var
  g: TPair;
begin
  for g in GList do
    if pAddOut or not g.Value.IsLocal then
      ss.AddObject(g.Value.Name, TObject(g.Value.ID));
end;

function TGroups.GetGroups(AddOut: Boolean): TArray;
var
  i: Integer;
  ss: TStringList;

  procedure AddMenuItem(const caption: String; const picname: TPicName; tag: Integer = -1);
  var
    pos: Integer;
  begin
    SetLength(Result, Length(Result) + 1);
    pos := Length(Result) - 1;
    Result[pos].caption := caption;
    Result[pos].img := picname;
    Result[pos].id := tag;
  end;

begin
  SetLength(Result, 0);

  if AddOut then
  begin
    AddMenuItem(GetTranslation('Out of groups'), PIC_OUT_OF_GROUPS, 2000);
    AddMenuItem('-', '');
  end;

  ss := TStringList.Create;
  groups.AddGroupsToList(ss, AddOut);
  ss.Sort;
  for i := 0 to ss.count - 1 do
    AddMenuItem(ss[i], PIC_CLOSE_GROUP, Integer(ss.objects[I]));
  ss.Free;
end;

{ TGroup }

function TGroup.ServerUpdate(ga: TGroupAction; const old: String = ''): Boolean;
begin
  Result := Account.AccProto.SendUpdateGroup(Name, ga, old);
end;

end.