ewsdr/DXClusterForm.pas

unit DXClusterForm;

{
  TDXClusterForm — окно DX-кластера: список принятых спотов, лог соединения и
  строка команды в кластер (sh/dx, set/filter — диалект у каждого кластера свой,
  поэтому команды не угадываем, а даём отправить руками).

  Данные тянутся ПОЛЛИНГОМ: сетевой поток кладёт споты в TDXSpotStore и строки в
  лог клиента, а форма раз в секунду сравнивает Version/LogVersion и перечитывает
  только при изменении. Никакого Synchronize из потока в UI — та же схема, что у
  оверлея спектра.

  Двойной клик по споту (или Enter) — QSY: наружу через OnTuneSpot.
}

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Math,
  Forms, Controls, Graphics, StdCtrls, ExtCtrls,
  FlatButton, FlatEdit, FlatListBox, FlatMemo,
  AppTheme, DpiUtils, DXSpotStore, DXClusterClient;

type
  // QSY по споту: частота в display-Гц + мода (dxmUnknown — не трогать моду).
  TDXTuneEvent = procedure(FreqHz: Double; Mode: TDXMode) of object;

  TDXClusterForm = class(TForm)
  private
    FStore:   TDXSpotStore;      // не владеет
    FClient:  TDXClusterClient;  // не владеет
    FTheme:   TAppTheme;

    FTitle:     TLabel;
    FStatus:    TLabel;
    FBtnConn:   TFlatButton;
    FBtnClear:  TFlatButton;
    FBtnSort:   TFlatButton;
    FBtnClose:  TFlatButton;
    FList:      TFlatListBox;
    FLog:       TFlatMemo;
    FEdCmd:     TFlatEdit;
    FBtnSend:   TFlatButton;
    FTimer:     TTimer;

    FSpots:     TDXSpotArray;    // снимок, параллельный строкам FList
    FSortFreq:  Boolean;         // False = по времени (свежие сверху)
    FLastVer:   Int64;
    FLastLogVer: Int64;
    FOnTune:    TDXTuneEvent;

    procedure BuildUI;
    procedure StyleBtn(B: TFlatButton);
    function  FormatSpotLine(const S: TDXSpot): string;
    procedure RefreshSpots;
    procedure RefreshLog;
    procedure RefreshStatus;
    procedure TuneSelected;

    procedure OnTimerTick(Sender: TObject);
    procedure OnConnClick(Sender: TObject);
    procedure OnClearClick(Sender: TObject);
    procedure OnSortClick(Sender: TObject);
    procedure OnCloseClick(Sender: TObject);
    procedure OnSendClick(Sender: TObject);
    procedure OnListDblClick(Sender: TObject);
    procedure OnListKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure OnCmdKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure OnFormClose(Sender: TObject; var CloseAction: TCloseAction);
  protected
    procedure DoShow; override;
    procedure DoHide; override;
  public
    constructor CreateWith(AOwner: TComponent; AStore: TDXSpotStore;
      AClient: TDXClusterClient); reintroduce;
    procedure ApplyTheme(const T: TAppTheme);
    property OnTuneSpot: TDXTuneEvent read FOnTune write FOnTune;
  end;

implementation

const
  FORM_W = 860;
  FORM_H = 560;
  MARGIN = 12;
  BTN_H  = 26;
  LOG_H  = 130;

constructor TDXClusterForm.CreateWith(AOwner: TComponent; AStore: TDXSpotStore;
  AClient: TDXClusterClient);
var
  WorkArea: TRect;
begin
  inherited CreateNew(AOwner);
  FStore  := AStore;
  FClient := AClient;
  FTheme  := DarkTheme;
  FSortFreq := False;
  FLastVer    := -1;
  FLastLogVer := -1;

  Scaled      := False;
  Caption     := 'DX Cluster';
  BorderStyle := bsSizeable;
  if AOwner is TCustomForm then
  begin
    WorkArea := Screen.MonitorFromRect(TCustomForm(AOwner).BoundsRect).WorkareaRect;
    Position := poOwnerFormCenter;
  end
  else
  begin
    WorkArea := Screen.PrimaryMonitor.WorkareaRect;
    Position := poScreenCenter;
  end;
  Width  := Min(DpiScale(FORM_W), WorkArea.Right - WorkArea.Left - DpiScale(48));
  Height := Min(DpiScale(FORM_H), WorkArea.Bottom - WorkArea.Top - DpiScale(48));
  Constraints.MinWidth  := Min(DpiScale(620), Width);
  Constraints.MinHeight := Min(DpiScale(380), Height);
  OnClose := @OnFormClose;

  BuildUI;
  ApplyTheme(DarkTheme);
end;

procedure TDXClusterForm.BuildUI;
var
  BtnW, Y: Integer;
begin
  BtnW := DpiScale(96);

  FTitle := TLabel.Create(Self);
  FTitle.Parent := Self;
  FTitle.SetBounds(DpiScale(MARGIN), DpiScale(10), DpiScale(300), DpiScale(22));
  FTitle.Caption := 'DX CLUSTER';
  FTitle.Font.Size := 9;
  FTitle.Font.Style := [fsBold];

  FStatus := TLabel.Create(Self);
  FStatus.Parent := Self;
  FStatus.SetBounds(DpiScale(MARGIN), DpiScale(31), DpiScale(520), DpiScale(18));
  FStatus.Font.Size := 8;
  FStatus.Anchors := [akLeft, akTop, akRight];

  Y := DpiScale(10);
  FBtnClose := TFlatButton.Create(Self);
  FBtnClose.Parent := Self;
  FBtnClose.SetBounds(ClientWidth - DpiScale(MARGIN) - BtnW, Y, BtnW, DpiScale(BTN_H));
  FBtnClose.Caption := 'Close';
  FBtnClose.Anchors := [akTop, akRight];
  FBtnClose.OnClick := @OnCloseClick;

  FBtnSort := TFlatButton.Create(Self);
  FBtnSort.Parent := Self;
  FBtnSort.SetBounds(FBtnClose.Left - BtnW - DpiScale(6), Y, BtnW, DpiScale(BTN_H));
  FBtnSort.Caption := 'BY TIME';
  FBtnSort.Anchors := [akTop, akRight];
  FBtnSort.OnClick := @OnSortClick;

  FBtnClear := TFlatButton.Create(Self);
  FBtnClear.Parent := Self;
  FBtnClear.SetBounds(FBtnSort.Left - BtnW - DpiScale(6), Y, BtnW, DpiScale(BTN_H));
  FBtnClear.Caption := 'CLEAR';
  FBtnClear.Anchors := [akTop, akRight];
  FBtnClear.OnClick := @OnClearClick;

  FBtnConn := TFlatButton.Create(Self);
  FBtnConn.Parent := Self;
  FBtnConn.SetBounds(FBtnClear.Left - BtnW - DpiScale(6), Y, BtnW, DpiScale(BTN_H));
  FBtnConn.Caption := 'CONNECT';
  FBtnConn.Anchors := [akTop, akRight];
  FBtnConn.OnClick := @OnConnClick;

  // Строка команды — внизу, над логом.
  FBtnSend := TFlatButton.Create(Self);
  FBtnSend.Parent := Self;
  FBtnSend.SetBounds(ClientWidth - DpiScale(MARGIN) - BtnW,
    ClientHeight - DpiScale(MARGIN + BTN_H), BtnW, DpiScale(BTN_H));
  FBtnSend.Caption := 'SEND';
  FBtnSend.Anchors := [akRight, akBottom];
  FBtnSend.OnClick := @OnSendClick;

  FEdCmd := TFlatEdit.Create(Self);
  FEdCmd.Parent := Self;
  FEdCmd.SetBounds(DpiScale(MARGIN), ClientHeight - DpiScale(MARGIN + BTN_H),
    FBtnSend.Left - DpiScale(MARGIN + 6), DpiScale(BTN_H));
  FEdCmd.TextHint := 'command to cluster (sh/dx, set/filter …)';
  FEdCmd.Anchors := [akLeft, akRight, akBottom];
  FEdCmd.OnKeyDown := @OnCmdKeyDown;

  FLog := TFlatMemo.Create(Self);
  FLog.Parent := Self;
  FLog.SetBounds(DpiScale(MARGIN),
    FEdCmd.Top - DpiScale(LOG_H + 6),
    ClientWidth - DpiScale(MARGIN * 2), DpiScale(LOG_H));
  FLog.Anchors := [akLeft, akRight, akBottom];
  FLog.ReadOnly := True;
  FLog.WordWrap := False;
  FLog.Font.Name := 'Courier New';
  FLog.Font.Size := 8;

  FList := TFlatListBox.Create(Self);
  FList.Parent := Self;
  FList.SetBounds(DpiScale(MARGIN), DpiScale(56),
    ClientWidth - DpiScale(MARGIN * 2),
    FLog.Top - DpiScale(56 + 6));
  FList.Anchors := [akLeft, akTop, akRight, akBottom];
  FList.Font.Name := 'Courier New';
  FList.Font.Size := 9;
  FList.TabStop    := True;
  FList.OnDblClick := @OnListDblClick;
  FList.OnKeyDown  := @OnListKeyDown;

  FTimer := TTimer.Create(Self);
  FTimer.Interval := 1000;
  FTimer.Enabled  := False;
  FTimer.OnTimer  := @OnTimerTick;
end;

procedure TDXClusterForm.StyleBtn(B: TFlatButton);
begin
  // TFlatButton темы не знает — цвета выставляются вручную, как в ChannelsForm.
  if B = nil then Exit;
  B.Font.Assign(Font);
  B.Font.Size   := 8;
  B.Font.Style  := [];
  B.ClrNorm     := FTheme.BtnNorm;
  B.ClrActive   := FTheme.BtnActive;
  B.ClrHot      := FTheme.BtnHot;
  B.ClrBorder   := FTheme.BtnBorderNorm;
  B.ClrText     := FTheme.BtnText;
  B.ClrTextAct  := FTheme.BtnTextActive;
  B.Invalidate;
end;

procedure TDXClusterForm.ApplyTheme(const T: TAppTheme);
begin
  FTheme := T;
  Color := T.BG;
  FTitle.Font.Color  := T.Text;
  FStatus.Font.Color := T.TextDim;
  FList.SetAppTheme(T);
  FLog.SetAppTheme(T);
  FEdCmd.SetAppTheme(T);
  StyleBtn(FBtnConn);
  StyleBtn(FBtnClear);
  StyleBtn(FBtnSort);
  StyleBtn(FBtnClose);
  StyleBtn(FBtnSend);
  Invalidate;
end;

{ ── Наполнение ───────────────────────────────────────────────────────────── }

function TDXClusterForm.FormatSpotLine(const S: TDXSpot): string;
// Моноширинные колонки: частота | позывной | мода | UTC | спотер | комментарий.
var
  FreqStr, Md: string;
begin
  FreqStr := FormatFloat('0.0', S.FreqHz / 1000.0);       // кГц, как в кластере
  while Length(FreqStr) < 10 do FreqStr := ' ' + FreqStr;
  Md := DXModeName(S.Mode);
  while Length(Md) < 4 do Md := Md + ' ';
  Result := Format('%s  %-12s %s %-5s %-10s %s',
    [FreqStr, S.Call, Md, S.TimeUTC, S.Spotter, S.Comment]);
end;

procedure TDXClusterForm.RefreshSpots;
var
  i, j, Keep: Integer;
  T: TDXSpot;
  Sel: string;
begin
  if FStore = nil then Exit;
  Keep := FList.ItemIndex;
  Sel  := '';
  if (Keep >= 0) and (Keep < Length(FSpots)) then Sel := FSpots[Keep].Call;

  FStore.Snapshot(FSpots);          // приходит отсортированным по частоте
  if not FSortFreq then
    // по времени, свежие сверху (вставками — список короткий, TTL его держит)
    for i := 1 to High(FSpots) do
    begin
      T := FSpots[i];
      j := i - 1;
      while (j >= 0) and (FSpots[j].Stamp < T.Stamp) do
      begin
        FSpots[j + 1] := FSpots[j];
        Dec(j);
      end;
      FSpots[j + 1] := T;
    end;

  FList.Items.BeginUpdate;
  try
    FList.Items.Clear;
    for i := 0 to High(FSpots) do
      FList.Items.Add(FormatSpotLine(FSpots[i]));
  finally
    FList.Items.EndUpdate;
  end;

  // Держим выделение на том же позывном, если он ещё в списке.
  if Sel <> '' then
    for i := 0 to High(FSpots) do
      if SameText(FSpots[i].Call, Sel) then
      begin
        FList.ItemIndex := i;
        Break;
      end;
end;

procedure TDXClusterForm.RefreshLog;
var
  L: TStringList;
begin
  if FClient = nil then Exit;
  L := TStringList.Create;
  try
    FClient.GetLog(L);
    FLog.Lines.BeginUpdate;
    try
      FLog.Lines.Assign(L);
    finally
      FLog.Lines.EndUpdate;
    end;
    // прокрутка в конец — свежие строки внизу
    FLog.SelStart := Length(FLog.Text);
  finally
    L.Free;
  end;
end;

procedure TDXClusterForm.RefreshStatus;
var
  St: TDXClusterState;
  S: string;
begin
  if FClient = nil then Exit;
  St := FClient.State;
  S := DXStateName(St);
  if FClient.StatusMessage <> '' then S := S + ' — ' + FClient.StatusMessage;
  S := S + Format('   |  spots stored: %d   received this session: %d',
    [FStore.Count, FClient.SpotsReceived]);
  FStatus.Caption := S;
  if FClient.Running then FBtnConn.Caption := 'DISCONNECT'
  else                    FBtnConn.Caption := 'CONNECT';
end;

{ ── События ──────────────────────────────────────────────────────────────── }

procedure TDXClusterForm.OnTimerTick(Sender: TObject);
begin
  if (FStore <> nil) and (FStore.Version <> FLastVer) then
  begin
    FLastVer := FStore.Version;
    RefreshSpots;
  end;
  if (FClient <> nil) and (FClient.LogVersion <> FLastLogVer) then
  begin
    FLastLogVer := FClient.LogVersion;
    RefreshLog;
    RefreshStatus;
  end;
end;

procedure TDXClusterForm.OnConnClick(Sender: TObject);
begin
  if FClient = nil then Exit;
  if FClient.Running then FClient.Stop else FClient.Start;
  RefreshStatus;
end;

procedure TDXClusterForm.OnClearClick(Sender: TObject);
begin
  if FStore <> nil then FStore.Clear;
  FLastVer := -1;
  RefreshSpots;
end;

procedure TDXClusterForm.OnSortClick(Sender: TObject);
begin
  FSortFreq := not FSortFreq;
  if FSortFreq then FBtnSort.Caption := 'BY FREQ'
  else              FBtnSort.Caption := 'BY TIME';
  RefreshSpots;
end;

procedure TDXClusterForm.OnCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TDXClusterForm.OnSendClick(Sender: TObject);
begin
  if (FClient = nil) or (Trim(FEdCmd.Text) = '') then Exit;
  FClient.SendCommand(Trim(FEdCmd.Text));
  FEdCmd.Text := '';
end;

procedure TDXClusterForm.OnCmdKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = 13 then
  begin
    Key := 0;
    OnSendClick(nil);
  end;
end;

procedure TDXClusterForm.TuneSelected;
var i: Integer;
begin
  i := FList.ItemIndex;
  if (i < 0) or (i > High(FSpots)) then Exit;
  if Assigned(FOnTune) then FOnTune(FSpots[i].FreqHz, FSpots[i].Mode);
end;

procedure TDXClusterForm.OnListDblClick(Sender: TObject);
begin
  TuneSelected;
end;

procedure TDXClusterForm.OnListKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
// Enter по выделенной строке = то же, что двойной клик (QSY на спот).
begin
  if (Key = 13) or (Key = 10) then
  begin
    Key := 0;
    TuneSelected;
  end;
end;

procedure TDXClusterForm.OnFormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  CloseAction := caHide;
end;

procedure TDXClusterForm.DoShow;
begin
  inherited DoShow;
  // Поллинг живёт только пока окно видимо (как анализатор лупы маяка).
  FLastVer    := -1;
  FLastLogVer := -1;
  RefreshSpots;
  RefreshLog;
  RefreshStatus;
  FTimer.Enabled := True;
end;

procedure TDXClusterForm.DoHide;
begin
  FTimer.Enabled := False;
  inherited DoHide;
end;

end.