ewsdr/CWKeyer.pas

unit CWKeyer;

{$mode objfpc}{$H+}

// ---------------------------------------------------------------------------
//  Локальный (программный) телеграфный генератор + вход манипулятора.
//
//  ЗАЧЕМ. У openHPSDR P2 манипуляцию делает кейер в FPGA: PC отдаёт ему
//  скорость/вес (DUC Specific байты 5..13), а точки/тире формирует прошивка —
//  джиттера PC там нет вовсе, и это остаётся путём по умолчанию. У Pluto/
//  LibreSDR такого кейера НЕТ: это голый AD936x, в эфир идёт ровно то, что мы
//  сами положили в поток IQ. Значит телеграф там обязан формироваться здесь.
//  Эталон — pihpsdr: src/iambic.c (автомат) + cw_shape_buffer в transmitter.c
//  (огибающая прямо в TX-буфере, мимо WDSP).
//
//  ПОЧЕМУ МИМО WDSP. Голосовой TXA в телеграфе не запускается вообще (в WDSP
//  режим TXA_CWL — буквально ветка SSB), да и PostGen-тон не умеет огибающей.
//  Поэтому генератор отдаёт готовые IQ-пары прямо в бэкенд: несущая = комплексная
//  экспонента на OffsetHz с косинусной («приподнятый косинус») огибающей.
//
//  ТАЙМИНГИ ЖИВУТ В СЭМПЛАХ, а не в миллисекундах. Точка на 40 WPM — 30 мс;
//  отмеряй её Sleep-ами, и планировщик ОС растянул бы её на единицы мс, отчего
//  знак «плывёт». В сэмплах длительность точна по определению — ошибиться может
//  только ТЕМП ВЫДАЧИ блоков, а его сглаживает FIFO бэкенда (держим в нём запас
//  CW_PREFILL_MS).
//
//  СЕССИЯ. Между посылками несущей нет, но реле T/R, LO передатчика и аттенюатор
//  дёргать на каждую точку нельзя. Поэтому генератор работает сессиями: первое
//  замыкание поднимает передачу (OnSession(True)), дальше идут элементы, и через
//  hang после последнего передача снимается. Внутри сессии манипуляция — чисто
//  цифровая, в огибающей.
//
//  САЙДТОН. Огибающая пишется в кольцо на аудио-rate; аудиотракт её вычитывает
//  и умножает на свой синус (PullSidetone). Так тон точен ДЛЯ ЛЮБОГО источника —
//  и для текста, и для иамбика, — в отличие от пути с кейером в прошивке, где
//  PC знает лишь состояние лепестков.
// ---------------------------------------------------------------------------

interface

uses
  Classes, SysUtils, SyncObjs, Math, Serial, CWMorse;

const
  CW_SIDETONE_RATE = 48000;   // rate огибающей сайдтона (аудиотракт PC)
  CW_IQ_BLOCK      = 240;     // пар в блоке = ровно DUC IQ пакет openHPSDR
  // Запас в FIFO бэкенда, он же латентность РЧ. Нижняя планка задана ЖЕЛЕЗОМ:
  // TX-поток Pluto наполняет буфер целиком (16384 пары ≈ 28 мс на 576 ksps) и
  // добивает нулями всё, чего в FIFO не хватило — то есть при меньшем запасе
  // посылка получила бы дыры. Сайдтон этой латентности не наследует: его отставание
  // отдельно ограничено CW_ST_MAX_LAG_MS.
  CW_PREFILL_MS    = 60;
  CW_ST_MAX_LAG_MS = 20;      // потолок отставания сайдтона от манипуляции

type
  // Режим манипулятора. Прямой ключ = уровень на линии, иамбик = автомат по
  // двум лепесткам (A — без памяти, B — с памятью задетого элемента).
  TCWLocalMode = (clmStraight, clmIambicA, clmIambicB);

  // Линии модемного разъёма, которыми читается манипулятор.
  TCWKeyLine   = (cklCTS, cklDSR, cklCD, cklRI);

  // IQ-пары (interleaved I,Q) в конвенции WDSP: РЧ = гетеродин + f.
  TCWIQEvent      = procedure(const Buf: array of Double; Count: Integer) of object;
  // Начало/конец сессии передачи: PTT, реле T/R, антенна, аттенюатор.
  TCWSessionEvent = procedure(Active: Boolean) of object;
  // «Ключ живой» — дёргается на каждом выданном блоке (индикация/выдержка).
  TCWTickEvent    = procedure of object;

  TCWLocalConfig = record
    Rate:      Integer;   // sample rate потока IQ (TX rate движка)
    OffsetHz:  Double;    // сдвиг несущей от гетеродина (уход от утечки LO)
    Amplitude: Double;    // 0..1 — цифровой уровень несущей
    WPM:       Integer;
    Weight:    Integer;   // 33..66 (50 = точка равна паузе)
    RampMS:    Integer;   // форма фронта посылки
    Mode:      TCWLocalMode;
    Reverse:   Boolean;   // поменять лепестки местами
    Strict:    Boolean;   // строгие интервалы (см. RunSession)
    BreakIn:   Boolean;   // сессия сама поднимает передачу
    HangMS:    Integer;   // сколько держать передачу после последнего элемента
    RFDelayMS: Integer;   // пауза после подъёма передачи до первой посылки
    Sidetone:  Boolean;   // писать огибающую в кольцо сайдтона
  end;

  { Генератор. Один поток: решает, что передавать, и сам же рисует IQ. }
  TCWLocalKeyer = class(TThread)
  private
    FLock:      TCriticalSection;
    FSTLock:    TCriticalSection;
    FWake:      TEvent;
    // ---- вход (под FLock) --------------------------------------------------
    FCfg:       TCWLocalConfig;
    FArmed:     Boolean;
    FPending:   string;       // очередь текста
    FAbortReq:  Boolean;
    FBusyText:  Boolean;
    FDotIn:     Boolean;      // лепесток «точка» (сырой, до Reverse)
    FDashIn:    Boolean;
    FStraightIn:Boolean;      // прямой ключ отдельным источником
    FTouched:   Boolean;      // касание манипулятора — обрывает текст
    // Эхо передачи для окна-терминала: знаки, которые УЖЕ ушли в эфир, и хвост,
    // который ещё стоит в очереди. Ведём под FLock, потому что читает их UI.
    FSent:      string;
    FUnsent:    string;
    FTrimTail:  Boolean;      // Backspace съел знак из уже разобранного текста
    // ---- рабочая копия (только поток генератора) ---------------------------
    FRate:      Integer;
    FAmp:       Double;
    FDit:       Int64;        // длительности в сэмплах
    FMark:      Int64;
    FGap:       Int64;
    FRamp:      Int64;
    FHang:      Int64;
    FRFDelay:   Integer;
    FMode:      TCWLocalMode;
    FReverse:   Boolean;
    FStrict:    Boolean;
    FSidetoneOn:Boolean;
    FCosStep:   Double;       // поворот фазора на сэмпл
    FSinStep:   Double;
    FPhI:       Double;       // текущий фазор
    FPhQ:       Double;
    FPhCnt:     Integer;      // счётчик до перенормировки
    FEnvPos:    Int64;        // позиция в рампе 0..FRamp
    FBuf:       array of Double;
    FBufCnt:    Integer;
    FEmitted:   Int64;        // сэмплов с начала сессии (пейсинг)
    FT0:        QWord;
    FSTAcc:     Integer;      // делитель rate → CW_SIDETONE_RATE
    FSTRing:    array of Single;
    FSTHead:    Integer;
    FSTTail:    Integer;
    // ---- разбор текста (только поток) --------------------------------------
    FText:      string;
    FTextPos:   Integer;
    FCode:      string;       // код текущего знака ('.' и '-')
    FCodePos:   Integer;
    FLeadGap:   Int64;        // пауза ПЕРЕД следующим элементом (межсловная)
    FTailGap:   Int64;        // добор паузы ПОСЛЕ элемента (межзнаковая)
    // ---- иамбик (только поток) ---------------------------------------------
    FLastDot:   Boolean;
    FDotMem:    Boolean;
    FDashMem:   Boolean;
    FSeenDot:   Boolean;      // лепесток задет во время элемента (режим B)
    FSeenDash:  Boolean;
    // ---- события -----------------------------------------------------------
    FOnIQ:      TCWIQEvent;
    FOnSession: TCWSessionEvent;
    FOnTick:    TCWTickEvent;

    function  Snapshot: Boolean;   // конфиг → рабочие поля; False = не вооружён
    function  MsToSamples(Ms: Integer): Int64;
    procedure Flush;
    procedure Pace;
    procedure Emit(KeyOn: Boolean; N: Int64; Watch: Boolean);
    procedure PushSidetone(E: Double);
    procedure ReadPaddles(out Dot, Dash: Boolean);
    function  WorkPending: Boolean;
    function  TakeTextElement(out IsDot: Boolean): Boolean;
    function  TakeIambicElement(out IsDot: Boolean): Boolean;
    procedure ResetText;
    procedure RunSession;
  protected
    procedure Execute; override;
  public
    constructor Create;
    destructor  Destroy; override;

    procedure Configure(const C: TCWLocalConfig);
    // Вооружение: снятие мгновенно обрывает передачу и отпускает ключ.
    procedure SetArmed(Value: Boolean);
    function  Armed: Boolean;

    procedure SendText(const S: string);
    procedure AbortText;
    function  Busy: Boolean;
    // Терминал: знаки, ушедшие в эфир с прошлого опроса (эхо своей передачи).
    function  TakeSentText: string;
    // Терминал: что ещё стоит в очереди (набранное вперёд).
    function  PendingText: string;
    // Стереть последний НЕ ушедший знак (Backspace в окне набора).
    function  Backspace: Boolean;

    // Вход манипулятора (поток опроса порта / GUI). Состояния лепестков сырые,
    // Reverse применяет сам генератор.
    procedure Paddle(Dot, Dash: Boolean);
    procedure StraightKey(Down: Boolean);

    // Аудиотракт: вычитать до N отсчётов огибающей (0..1). Возвращает сколько
    // реально отдано — остальное вызывающий доигрывает спадом.
    function  PullSidetone(var Buf: array of Single; N: Integer): Integer;

    property OnIQ:      TCWIQEvent      read FOnIQ      write FOnIQ;
    property OnSession: TCWSessionEvent read FOnSession write FOnSession;
    property OnTick:    TCWTickEvent    read FOnTick    write FOnTick;
  end;

  TCWKeyPortConfig = record
    Enabled:  Boolean;
    Port:     string;
    DotLine:  TCWKeyLine;
    DashLine: TCWKeyLine;
    Invert:   Boolean;    // ключ замыкает линию в «0» (инверсный интерфейс)
    PowerDTR: Boolean;    // поднять DTR (питание/общий провод ключа)
    PowerRTS: Boolean;
  end;

  TCWKeyPortEvent = procedure(Dot, Dash: Boolean) of object;

  { Опрос манипулятора на модемных линиях COM/USB-serial: DTR/RTS питают ключ,
    CTS/DSR/DCD/RI читаются как лепестки. Так же делают Thetis (cwkeyer.cs),
    hamlib и fldigi — это единственный вход ключа, доступный на любом железе. }
  TCWKeyPort = class(TThread)
  private
    FLock:     TCriticalSection;
    FCfg:      TCWKeyPortConfig;
    FDirty:    Boolean;         // конфиг сменился — переоткрыть
    FHandle:   TSerialHandle;
    FLastErr:  string;
    FOnKey:    TCWKeyPortEvent;
    FPrevDot:  Boolean;
    FPrevDash: Boolean;
    function  ReadLine(L: TCWKeyLine): Boolean;
    procedure ClosePort;
    function  OpenPort(const C: TCWKeyPortConfig): Boolean;
    procedure SetErr(const S: string);
    procedure Release;
  protected
    procedure Execute; override;
  public
    constructor Create;
    destructor  Destroy; override;
    procedure Configure(const C: TCWKeyPortConfig);
    function  LastError: string;
    property OnKey: TCWKeyPortEvent read FOnKey write FOnKey;
  end;

implementation

const
  DIT_MS_AT_1WPM = 1200;   // стандарт PARIS
  ST_RING_MS     = 250;    // глубина кольца сайдтона

{ ── TCWLocalKeyer ─────────────────────────────────────────────────────────── }

constructor TCWLocalKeyer.Create;
begin
  FLock   := TCriticalSection.Create;
  FSTLock := TCriticalSection.Create;
  FWake   := TEvent.Create(nil, False, False, '');
  FCfg.Rate      := 192000;
  FCfg.Amplitude := 0.99;
  FCfg.WPM       := 20;
  FCfg.Weight    := 50;
  FCfg.RampMS    := 9;
  FCfg.Mode      := clmIambicB;
  FCfg.BreakIn   := True;
  FCfg.HangMS    := 300;
  FRate    := FCfg.Rate;
  FCodePos := 1;
  SetLength(FBuf, CW_IQ_BLOCK * 2);
  SetLength(FSTRing, (CW_SIDETONE_RATE * ST_RING_MS) div 1000);
  FreeOnTerminate := False;
  inherited Create(False);
end;

destructor TCWLocalKeyer.Destroy;
begin
  Terminate;
  SetArmed(False);
  FWake.SetEvent;
  WaitFor;
  FWake.Free;
  FSTLock.Free;
  FLock.Free;
  inherited Destroy;
end;

procedure TCWLocalKeyer.Configure(const C: TCWLocalConfig);
begin
  FLock.Enter;
  try
    FCfg := C;
    if FCfg.Rate      < 8000 then FCfg.Rate      := 8000;
    if FCfg.WPM       < 5    then FCfg.WPM       := 5;
    if FCfg.WPM       > 60   then FCfg.WPM       := 60;
    if FCfg.Weight    < 33   then FCfg.Weight    := 33;
    if FCfg.Weight    > 66   then FCfg.Weight    := 66;
    if FCfg.RampMS    < 0    then FCfg.RampMS    := 0;
    if FCfg.RampMS    > 20   then FCfg.RampMS    := 20;
    if FCfg.HangMS    < 0    then FCfg.HangMS    := 0;
    if FCfg.RFDelayMS < 0    then FCfg.RFDelayMS := 0;
    if FCfg.Amplitude < 0    then FCfg.Amplitude := 0;
    if FCfg.Amplitude > 1    then FCfg.Amplitude := 1;
  finally
    FLock.Leave;
  end;
end;

procedure TCWLocalKeyer.SetArmed(Value: Boolean);
begin
  FLock.Enter;
  try
    if FArmed = Value then Exit;
    FArmed := Value;
    if not Value then
    begin
      // Разоружение — это «передавать нельзя» (ушли из CW, зашли в RX-only слот
      // трансвертера, встали на бэнд с DoNotTx). Всё бросаем немедленно.
      FPending    := '';
      FAbortReq   := True;
      FDotIn      := False;
      FDashIn     := False;
      FStraightIn := False;
    end;
  finally
    FLock.Leave;
  end;
  FWake.SetEvent;
end;

function TCWLocalKeyer.Armed: Boolean;
begin
  FLock.Enter;
  try
    Result := FArmed;
  finally
    FLock.Leave;
  end;
end;

procedure TCWLocalKeyer.SendText(const S: string);
begin
  if S = '' then Exit;
  FLock.Enter;
  try
    if not FArmed then Exit;
    FAbortReq := False;
    FTouched  := False;
    FPending  := FPending + S;
    FBusyText := True;
  finally
    FLock.Leave;
  end;
  FWake.SetEvent;
end;

procedure TCWLocalKeyer.AbortText;
begin
  FLock.Enter;
  try
    FPending  := '';
    FAbortReq := True;
  finally
    FLock.Leave;
  end;
  FWake.SetEvent;
end;

function TCWLocalKeyer.Busy: Boolean;
begin
  FLock.Enter;
  try
    Result := FBusyText or (FPending <> '');
  finally
    FLock.Leave;
  end;
end;

function TCWLocalKeyer.TakeSentText: string;
begin
  FLock.Enter;
  try
    Result := FSent;
    FSent  := '';
  finally
    FLock.Leave;
  end;
end;

function TCWLocalKeyer.PendingText: string;
begin
  FLock.Enter;
  try
    Result := FUnsent + FPending;
  finally
    FLock.Leave;
  end;
end;

function TCWLocalKeyer.Backspace: Boolean;
// Стираем с ХВОСТА очереди: то, что уже звучит в эфире, вернуть нельзя, а
// набранное вперёд — можно и нужно (иначе опечатка обязательно уедет).
begin
  FLock.Enter;
  try
    Result := False;
    if FPending <> '' then
    begin
      SetLength(FPending, Length(FPending) - 1);
      Result := True;
    end
    else if FUnsent <> '' then
    begin
      // Хвост уже разобранного текста: помечаем к отсечению — генератор увидит
      // укороченный FUnsent на следующем знаке (см. TakeTextElement).
      SetLength(FUnsent, Length(FUnsent) - 1);
      FTrimTail := True;
      Result := True;
    end;
  finally
    FLock.Leave;
  end;
end;

procedure TCWLocalKeyer.Paddle(Dot, Dash: Boolean);
begin
  FLock.Enter;
  try
    if (Dot and not FDotIn) or (Dash and not FDashIn) then FTouched := True;
    FDotIn  := Dot;
    FDashIn := Dash;
  finally
    FLock.Leave;
  end;
  if Dot or Dash then FWake.SetEvent;
end;

procedure TCWLocalKeyer.StraightKey(Down: Boolean);
begin
  FLock.Enter;
  try
    if Down and not FStraightIn then FTouched := True;
    FStraightIn := Down;
  finally
    FLock.Leave;
  end;
  if Down then FWake.SetEvent;
end;

function TCWLocalKeyer.PullSidetone(var Buf: array of Single; N: Integer): Integer;
var
  Avail, MaxLag: Integer;
begin
  Result := 0;
  if N <= 0 then Exit;
  FSTLock.Enter;
  try
    // Генератор идёт впереди эфира на CW_PREFILL_MS, и весь этот запас оседал бы
    // в кольце — сайдтон отставал бы от руки на всю латентность РЧ. Лишнее
    // пролистываем: в начале сессии это тишина (окно RF delay), а дальше темпы
    // равны и листать уже нечего.
    Avail := FSTHead - FSTTail;
    if Avail < 0 then Inc(Avail, Length(FSTRing));
    MaxLag := N + (CW_SIDETONE_RATE * CW_ST_MAX_LAG_MS) div 1000;
    if Avail > MaxLag then
      FSTTail := (FSTTail + (Avail - MaxLag)) mod Length(FSTRing);
    while (Result < N) and (FSTTail <> FSTHead) do
    begin
      Buf[Result] := FSTRing[FSTTail];
      FSTTail := (FSTTail + 1) mod Length(FSTRing);
      Inc(Result);
    end;
  finally
    FSTLock.Leave;
  end;
end;

procedure TCWLocalKeyer.PushSidetone(E: Double);
var
  NextH: Integer;
begin
  FSTLock.Enter;
  try
    NextH := (FSTHead + 1) mod Length(FSTRing);
    if NextH = FSTTail then
      // Переполнение: аудиотракт молчит или отстал — держим ХВОСТ, иначе
      // сайдтон уезжал бы по времени от манипуляции.
      FSTTail := (FSTTail + 1) mod Length(FSTRing);
    FSTRing[FSTHead] := E;
    FSTHead := NextH;
  finally
    FSTLock.Leave;
  end;
end;

function TCWLocalKeyer.MsToSamples(Ms: Integer): Int64;
begin
  if Ms <= 0 then Exit(0);
  Result := (Int64(FRate) * Ms) div 1000;
end;

function TCWLocalKeyer.Snapshot: Boolean;
// Копия конфига в рабочие поля. Зовётся на каждом элементе — скорость/вес можно
// крутить прямо во время передачи.
var
  C:  TCWLocalConfig;
  Th: Double;
begin
  FLock.Enter;
  try
    C      := FCfg;
    Result := FArmed;
  finally
    FLock.Leave;
  end;
  FRate       := C.Rate;
  FAmp        := C.Amplitude;
  FMode       := C.Mode;
  FReverse    := C.Reverse;
  FStrict     := C.Strict;
  FSidetoneOn := C.Sidetone;
  FRFDelay    := C.RFDelayMS;
  FDit  := (Int64(FRate) * DIT_MS_AT_1WPM) div (Int64(C.WPM) * 1000);
  // Вес: 50 = точка равна паузе. Выше — посылки длиннее за счёт пауз ВНУТРИ
  // знака; межзнаковые интервалы остаются стандартными (иначе плывёт темп).
  FMark := (FDit * C.Weight) div 50;
  FGap  := (FDit * (100 - C.Weight)) div 50;
  if FMark < 1 then FMark := 1;
  if FGap  < 1 then FGap  := 1;
  FRamp := (Int64(FRate) * C.RampMS) div 1000;
  if FRamp * 2 > FMark then FRamp := FMark div 2;   // рампа не длиннее посылки
  if FRamp < 0 then FRamp := 0;
  FHang := MsToSamples(C.HangMS);
  Th := 2.0 * Pi * C.OffsetHz / FRate;
  FCosStep := Cos(Th);
  FSinStep := Sin(Th);
end;

procedure TCWLocalKeyer.Flush;
begin
  if FBufCnt <= 0 then Exit;
  if Assigned(FOnIQ) then FOnIQ(FBuf, FBufCnt);
  FBufCnt := 0;
  if Assigned(FOnTick) then FOnTick;
end;

procedure TCWLocalKeyer.Pace;
// Держим в FIFO бэкенда запас CW_PREFILL_MS: продюсер идёт по часам PC, а
// потребитель — по радиоклоку. Больше запас — больше латентность РЧ и сайдтона,
// меньше — риск подсоса нулей посреди посылки.
var
  Target, Elapsed: Int64;
begin
  Target := (FEmitted * 1000) div FRate - CW_PREFILL_MS;
  if Target <= 0 then Exit;
  repeat
    if Terminated then Exit;
    Elapsed := Int64(GetTickCount64 - FT0);
    if Elapsed >= Target then Exit;
    Sleep(1);
  until False;
end;

procedure TCWLocalKeyer.Emit(KeyOn: Boolean; N: Int64; Watch: Boolean);
// Рисует N сэмплов при заданном состоянии ключа. Огибающая живёт МЕЖДУ
// вызовами (FEnvPos): посылка = Emit(True, mark) поднимает фронт в первые FRamp
// сэмплов, пауза = Emit(False, gap) роняет его в свои первые FRamp. Так точка
// длится ровно mark по уровню 50%, а щелчка нет ни на одном фронте.
var
  i: Int64;
  E, A, NI, NQ, Nrm: Double;
  Dot, Dash: Boolean;
begin
  i := 0;
  while i < N do
  begin
    if Terminated then Exit;
    if KeyOn then
    begin
      if FEnvPos < FRamp then Inc(FEnvPos) else FEnvPos := FRamp;
    end
    else if FEnvPos > 0 then
      Dec(FEnvPos);

    if FRamp > 0 then
      E := 0.5 * (1.0 - Cos(Pi * FEnvPos / FRamp))
    else if KeyOn then
      E := 1.0
    else
      E := 0.0;

    A := FAmp * E;
    if (FSinStep <> 0.0) or (FCosStep <> 1.0) then
    begin
      // Поворот фазора вместо Sin/Cos на каждый сэмпл (192к вызовов в секунду).
      NI := FPhI * FCosStep - FPhQ * FSinStep;
      NQ := FPhI * FSinStep + FPhQ * FCosStep;
      FPhI := NI; FPhQ := NQ;
      Inc(FPhCnt);
      if FPhCnt >= 1024 then
      begin
        FPhCnt := 0;
        Nrm := Sqrt(FPhI * FPhI + FPhQ * FPhQ);
        if Nrm > 0 then begin FPhI := FPhI / Nrm; FPhQ := FPhQ / Nrm; end
                   else begin FPhI := 1.0;        FPhQ := 0.0;        end;
      end;
      FBuf[FBufCnt * 2]     := A * FPhI;
      FBuf[FBufCnt * 2 + 1] := A * FPhQ;
    end
    else
    begin
      FBuf[FBufCnt * 2]     := A;     // нулевой сдвиг — несущая прямо на DUC
      FBuf[FBufCnt * 2 + 1] := 0.0;
    end;
    Inc(FBufCnt);

    if FSidetoneOn then
    begin
      Inc(FSTAcc, CW_SIDETONE_RATE);
      if FSTAcc >= FRate then
      begin
        Dec(FSTAcc, FRate);
        PushSidetone(E);
      end;
    end;

    if FBufCnt >= CW_IQ_BLOCK then
    begin
      Flush;
      Pace;
      // Лепестки во время элемента — память режима B (см. RunSession).
      if Watch then
      begin
        ReadPaddles(Dot, Dash);
        if Dot  then FSeenDot  := True;
        if Dash then FSeenDash := True;
      end;
    end;
    Inc(i);
    Inc(FEmitted);
  end;
end;

procedure TCWLocalKeyer.ReadPaddles(out Dot, Dash: Boolean);
var
  D, H: Boolean;
begin
  FLock.Enter;
  try
    D := FDotIn;
    H := FDashIn;
  finally
    FLock.Leave;
  end;
  if FReverse then begin Dot := H;    Dash := D;    end
              else begin Dot := D;    Dash := H;    end;
end;

function TCWLocalKeyer.WorkPending: Boolean;
begin
  FLock.Enter;
  try
    Result := FArmed and ((FPending <> '') or FDotIn or FDashIn or FStraightIn);
  finally
    FLock.Leave;
  end;
end;

procedure TCWLocalKeyer.ResetText;
begin
  FText     := '';
  FTextPos  := 0;
  FCode     := '';
  FCodePos  := 1;
  FLeadGap  := 0;
  FTailGap  := 0;
  FLock.Enter;
  try
    FBusyText := False;
    FUnsent   := '';
    FTrimTail := False;
  finally
    FLock.Leave;
  end;
end;

function TCWLocalKeyer.TakeTextElement(out IsDot: Boolean): Boolean;
// Очередной элемент передаваемого текста. Раскладка пауз та же, что у кейера
// прошивки: 1 точка между элементами знака, 3 между знаками, 7 между словами.
// Межсловная пауза копится в FLeadGap (отдаётся ПЕРЕД элементом), межзнаковая —
// в FTailGap (после).
var
  Ch:  Char;
  Add: string;
  Drop, Trim: Boolean;
  KeepLen: Integer;
begin
  Result   := False;
  IsDot    := True;
  FTailGap := 0;

  FLock.Enter;
  try
    Drop := FAbortReq or FTouched;
    if Drop then
    begin
      FPending  := '';
      FAbortReq := False;
      FTouched  := False;
    end;
    Add := FPending;
    FPending := '';
    Trim := FTrimTail;
    FTrimTail := False;
    KeepLen := FTextPos + Length(FUnsent);
  finally
    FLock.Leave;
  end;
  if Drop then
  begin
    ResetText;
    Exit;
  end;
  // Backspace дотянулся до уже разобранного текста — отсекаем хвост.
  if Trim and (Length(FText) > KeepLen) then SetLength(FText, KeepLen);
  if Add <> '' then FText := FText + Add;

  // Ищем следующий элемент, пропуская пробелы и знаки не из таблицы.
  while FCodePos > Length(FCode) do
  begin
    if FTextPos >= Length(FText) then
    begin
      ResetText;
      Exit;
    end;
    Inc(FTextPos);
    Ch := FText[FTextPos];
    // Эхо: знак пошёл в эфир — отдаём его окну-терминалу, а хвост очереди
    // обновляем, чтобы строка набора показывала только ненабранное.
    FLock.Enter;
    try
      FSent   := FSent + Ch;
      FUnsent := Copy(FText, FTextPos + 1, MaxInt);
      if Length(FSent) > 4096 then FSent := Copy(FSent, Length(FSent) - 4095, 4096);
    finally
      FLock.Leave;
    end;
    if Ch = ' ' then
    begin
      // 3 точки уже отданы после прошлого знака — добираем до 7.
      Inc(FLeadGap, 4 * FDit);
      Continue;
    end;
    FCode    := MorseCode(Ch);
    FCodePos := 1;
  end;

  IsDot  := FCode[FCodePos] = '.';
  Result := True;
  Inc(FCodePos);
  // Последний элемент знака — добираем межзнаковый интервал до 3 точек.
  if FCodePos > Length(FCode) then FTailGap := 2 * FDit;
  FLock.Enter;
  try
    FBusyText := True;
  finally
    FLock.Leave;
  end;
end;

function TCWLocalKeyer.TakeIambicElement(out IsDot: Boolean): Boolean;
// Автомат иамбика (логика pihpsdr src/iambic.c в терминах элементов):
//  * зажаты оба лепестка — элементы чередуются (иначе точка «съедала» бы тире);
//  * режим B — лепесток, задетый ВО ВРЕМЯ элемента, запоминается и отыгрывается
//    следующим; режим A памяти не имеет (в этом и вся разница);
//  * strict spacing — лепестки во время межэлементной паузы не запоминаются:
//    ритм задаёт кейер, а не рука.
var
  Dot, Dash: Boolean;
begin
  ReadPaddles(Dot, Dash);
  Result := True;
  if Dot and Dash then IsDot := not FLastDot
  else if Dot     then IsDot := True
  else if Dash    then IsDot := False
  else if FDotMem then IsDot := True
  else if FDashMem then IsDot := False
  else Result := False;
  if Result then
  begin
    FDotMem  := False;
    FDashMem := False;
    FLastDot := IsDot;
  end;
end;

procedure TCWLocalKeyer.RunSession;
// Одна сессия передачи: подъём T/R → элементы → hang → снятие T/R.
var
  Idle:  Int64;
  Chunk: Int64;
  IsDot: Boolean;
  Level: Boolean;
  Got:   Boolean;
  Dot, Dash: Boolean;
  Br: Boolean;
begin
  if not Snapshot then Exit;
  FLock.Enter;
  try
    Br := FCfg.BreakIn;
  finally
    FLock.Leave;
  end;

  FEnvPos := 0; FEmitted := 0; FBufCnt := 0; FSTAcc := 0;
  FPhI := 1.0; FPhQ := 0.0; FPhCnt := 0;
  FDotMem := False; FDashMem := False; FSeenDot := False; FSeenDash := False;
  FSTLock.Enter;
  try
    FSTHead := 0; FSTTail := 0;   // старую огибающую в кольце не доигрываем
  finally
    FSTLock.Leave;
  end;

  if Br and Assigned(FOnSession) then FOnSession(True);
  FT0 := GetTickCount64;
  try
    // Окно на реле T/R, LO передатчика и аттенюатор: без него первая точка
    // ушла бы в ещё приёмную обвязку.
    Emit(False, MsToSamples(FRFDelay), False);
    Idle := 0;
    while not Terminated do
    begin
      if not Snapshot then Break;          // разоружили посреди передачи
      FLock.Enter;
      try
        Level := FStraightIn;
      finally
        FLock.Leave;
      end;
      if FMode = clmStraight then
      begin
        ReadPaddles(Dot, Dash);
        Level := Level or Dot or Dash;     // прямой ключ на любом лепестке
      end;
      // Прямой ключ — следуем за уровнем: длительность задаёт рука, наше дело
      // форма фронта. Квант 2 мс = задержка реакции на отпускание.
      if Level then
      begin
        Emit(True, MsToSamples(2), False);
        Idle := 0;
        Continue;
      end;

      // Текст имеет приоритет над манипулятором; касание лепестка его обрывает
      // (это ловит сам TakeTextElement по FTouched).
      Got := TakeTextElement(IsDot);
      if (not Got) and (FMode <> clmStraight) then Got := TakeIambicElement(IsDot);
      if Got then
      begin
        if FLeadGap > 0 then
        begin
          Emit(False, FLeadGap, not FStrict);
          FLeadGap := 0;
        end;
        FSeenDot := False; FSeenDash := False;
        if IsDot then Emit(True, FMark, True)
                 else Emit(True, 3 * FMark, True);
        Emit(False, FGap, not FStrict);
        if FTailGap > 0 then
        begin
          Emit(False, FTailGap, not FStrict);
          FTailGap := 0;
        end;
        if FMode = clmIambicB then
        begin
          if IsDot and FSeenDash then FDashMem := True;
          if (not IsDot) and FSeenDot then FDotMem := True;
        end;
        Idle := 0;
        Continue;
      end;

      // Передавать нечего: держим передачу hang, потом закрываем сессию.
      Chunk := MsToSamples(4);
      if Chunk < 1 then Chunk := 1;
      Emit(False, Chunk, False);
      Inc(Idle, Chunk);
      if Idle >= FHang then Break;
    end;
    // Добить спад огибающей — сессия не должна обрываться щелчком.
    if FEnvPos > 0 then Emit(False, FRamp + 1, False);
    // ★Хвост тишины на всю глубину предзаполнения: конец сессии сбрасывает
    // очередь IQ в бэкенде, и без него в мусор ушёл бы ЕЩЁ НЕ СЫГРАННЫЙ спад
    // последней посылки (то есть щелчок в эфир). При hang > 0 хвост и так
    // тишина, но полагаться на настройку тут нельзя.
    Emit(False, MsToSamples(CW_PREFILL_MS + 5), False);
    Flush;
  finally
    if Br and Assigned(FOnSession) then FOnSession(False);
  end;
end;

procedure TCWLocalKeyer.Execute;
begin
  while not Terminated do
  begin
    if not WorkPending then
    begin
      FWake.WaitFor(100);
      Continue;
    end;
    RunSession;
  end;
end;

{ ── TCWKeyPort ────────────────────────────────────────────────────────────── }

constructor TCWKeyPort.Create;
begin
  FLock   := TCriticalSection.Create;
  FHandle := 0;
  FreeOnTerminate := False;
  inherited Create(False);
end;

destructor TCWKeyPort.Destroy;
begin
  Terminate;
  WaitFor;
  ClosePort;
  FLock.Free;
  inherited Destroy;
end;

procedure TCWKeyPort.Configure(const C: TCWKeyPortConfig);
begin
  FLock.Enter;
  try
    if (FCfg.Enabled = C.Enabled) and (FCfg.Port = C.Port)
       and (FCfg.DotLine = C.DotLine) and (FCfg.DashLine = C.DashLine)
       and (FCfg.Invert = C.Invert) and (FCfg.PowerDTR = C.PowerDTR)
       and (FCfg.PowerRTS = C.PowerRTS) then Exit;
    FCfg   := C;
    FDirty := True;
  finally
    FLock.Leave;
  end;
end;

function TCWKeyPort.LastError: string;
begin
  FLock.Enter;
  try
    Result := FLastErr;
  finally
    FLock.Leave;
  end;
end;

procedure TCWKeyPort.SetErr(const S: string);
begin
  FLock.Enter;
  try
    FLastErr := S;
  finally
    FLock.Leave;
  end;
end;

procedure TCWKeyPort.Release;
// Отпустить ключ: порт закрылся/выключили — генератор не должен остаться с
// «зажатым» лепестком, иначе несущая повиснет в эфире.
begin
  if (FPrevDot or FPrevDash) and Assigned(FOnKey) then FOnKey(False, False);
  FPrevDot  := False;
  FPrevDash := False;
end;

procedure TCWKeyPort.ClosePort;
begin
  if FHandle > 0 then
  begin
    SerSetDTR(FHandle, False);
    SerSetRTS(FHandle, False);
    SerClose(FHandle);
  end;
  FHandle := 0;
end;

function TCWKeyPort.OpenPort(const C: TCWKeyPortConfig): Boolean;
begin
  Result := False;
  if C.Port = '' then Exit;
  FHandle := SerOpen(C.Port);
  if FHandle <= 0 then
  begin
    FHandle := 0;
    SetErr('cannot open ' + C.Port);
    Exit;
  end;
  // Скорость/формат манипулятору безразличны (данные не идут), но порт должен
  // быть настроен — иначе часть драйверов не отдаёт модемные линии.
  SerSetParams(FHandle, 9600, 8, NoneParity, 1, []);
  SerSetDTR(FHandle, C.PowerDTR);
  SerSetRTS(FHandle, C.PowerRTS);
  SetErr('');
  Result := True;
end;

function TCWKeyPort.ReadLine(L: TCWKeyLine): Boolean;
begin
  case L of
    cklDSR: Result := SerGetDSR(FHandle);
    cklCD:  Result := SerGetCD(FHandle);
    cklRI:  Result := SerGetRI(FHandle);
  else
    Result := SerGetCTS(FHandle);
  end;
end;

procedure TCWKeyPort.Execute;
var
  C: TCWKeyPortConfig;
  Dot, Dash: Boolean;
  Retry: QWord;
  NeedReopen: Boolean;
begin
  Retry := 0;
  while not Terminated do
  begin
    FLock.Enter;
    try
      C := FCfg;
      NeedReopen := FDirty;
      FDirty := False;
    finally
      FLock.Leave;
    end;
    if NeedReopen then
    begin
      Release;
      ClosePort;
      Retry := 0;
    end;

    if not C.Enabled then
    begin
      if FHandle > 0 then begin Release; ClosePort; end;
      Sleep(100);
      Continue;
    end;

    if FHandle <= 0 then
    begin
      // Переоткрытие раз в 2 с: адаптер могли воткнуть уже после старта.
      if GetTickCount64 < Retry then begin Sleep(100); Continue; end;
      Retry := GetTickCount64 + 2000;
      if not OpenPort(C) then begin Sleep(100); Continue; end;
    end;

    Dot  := ReadLine(C.DotLine);
    Dash := ReadLine(C.DashLine);
    if C.Invert then begin Dot := not Dot; Dash := not Dash; end;
    if (Dot <> FPrevDot) or (Dash <> FPrevDash) then
    begin
      FPrevDot  := Dot;
      FPrevDash := Dash;
      if Assigned(FOnKey) then FOnKey(Dot, Dash);
    end;
    Sleep(1);
  end;
  Release;
end;

end.