ewsdr/CWDecoder.pas

unit CWDecoder;

{$mode objfpc}{$H+}

// ---------------------------------------------------------------------------
//  Декодер телеграфа: RX-аудио → текст.
//
//  ОТКУДА СИГНАЛ. Отвод берётся ДО громкости и мьюта (OnDemodAudioReady) — там
//  нет программного сайдтона (он подмешивается позже) и там уже отработал узкий
//  CW-фильтр приёмника. Лучшего предетектора не найти: полоса 250-500 Гц режет
//  всё, кроме корреспондента, а тон стоит ровно на pitch, потому что сдвиг
//  гетеродина в телеграфе делаем мы сами (WDSPEngine.CWLOOffset).
//
//  ЦЕПОЧКА. Гёрцель гребёнкой бинов вокруг pitch (оператор редко попадает в
//  ноль, поэтому берём максимум и заодно знаем расстройку) → огибающая →
//  адаптивный порог с гистерезисом → длительности посылок и пауз → адаптивная
//  ТОЧКА → дерево Морзе.
//
//  ★Длительности живут в ШАГАХ анализа (то есть в сэмплах), а не в показаниях
//  часов: разбор идёт пачками с таймера окна, и привязка ко времени вызова
//  ломала бы тайминг на любой загрузке. Ровно то же правило, что в CWKeyer.
//
//  ГРАНИЦА, которую надо знать. Машинную передачу (кейер, компьютер, маяк) такой
//  декодер читает почти без ошибок; рукопашный «фист» с плавающим весом — плохо.
//  Это свойство задачи, а не реализации: у fldigi и трансиверов с декодером на
//  борту ровно та же картина.
// ---------------------------------------------------------------------------

interface

uses
  Classes, SysUtils, SyncObjs, Math, CWMorse;

const
  CWD_RATE  = 48000;   // rate отвода аудио
  CWD_N     = 512;     // окно Гёрцеля (10.7 мс — полоса ~100 Гц)
  CWD_HOP   = 256;     // шаг анализа (5.33 мс), окна перекрываются вдвое
  CWD_BINS  = 5;       // бинов в гребёнке (центр ± 2 шага)
  CWD_BIN_HZ = 100;    // шаг гребёнки, Гц

type
  TCWDecoder = class
  private
    FLock:     TCriticalSection;
    // ---- кольцо аудио (продюсер — DSP-поток, консьюмер — Process) ----------
    FRing:     array of Single;
    FHead:     Integer;
    FTail:     Integer;
    // ---- параметры ---------------------------------------------------------
    FPitch:    Integer;
    FEnabled:  Boolean;
    // ---- гребёнка Гёрцеля --------------------------------------------------
    FCoef:     array[0..CWD_BINS-1] of Double;
    FWin:      array[0..CWD_N-1] of Double;   // окно Ханна
    FBuf:      array[0..CWD_N-1] of Double;   // оконный кадр
    FBestBin:  Integer;
    FBestPow:  Double;     // уровень лучшего бина (для гейта расстройки)
    // ---- пороги ------------------------------------------------------------
    FNoise:    Double;
    FPeak:     Double;
    FMarkNow:  Boolean;
    FRunLen:   Integer;    // длина текущего состояния в шагах
    FCandLen:  Integer;    // длина «дребезга» — кандидата на смену состояния
    FCandMark: Boolean;
    FWarmup:   Integer;    // шаги до первого решения (пороги должны устояться)
    FDebounce: Integer;    // сколько шагов подряд держать новое состояние
    // ---- разбор ------------------------------------------------------------
    FDitMs:    Double;     // адаптивная длина точки
    FPattern:  string;     // накопленный знак ('.' и '-')
    FIdleSteps: Integer;   // тишина после последнего знака (шаги)
    FWordDone: Boolean;    // межсловный пробел уже выдан
    FOut:      string;     // очередь декодированного текста (под FLock)
    FSignal:   Boolean;
    procedure BuildTables;
    procedure StepEnvelope(Mag: Double);
    procedure OnMark(Steps: Integer);
    procedure OnSpace(Steps: Integer);
    procedure FlushChar;
    procedure Emit(const S: string);
    function  StepMs: Double;
  public
    constructor Create;
    destructor  Destroy; override;

    procedure SetPitch(Hz: Integer);
    procedure SetSpeedHint(WPM: Integer);   // старт адаптации (своя скорость)
    procedure Reset;
    property  Enabled: Boolean read FEnabled write FEnabled;

    // DSP-поток: только копирование в кольцо.
    procedure FeedAudio(const Left: array of Single; Count: Integer);
    // Поток-хозяин (таймер): разбор накопленного.
    procedure Process;
    // Забрать декодированное (и очистить очередь).
    function  TakeText: string;

    function  SpeedWPM: Integer;       // оценка скорости корреспондента
    function  ToneOffsetHz: Integer;   // расстройка: где нашёлся тон
    function  SignalPresent: Boolean;
  end;

// Обратная таблица: код ('.', '-') → знак. '' если такого кода нет.
function MorseDecode(const Code: string): string;

implementation

const
  RING_BITS = 15;
  RING_SIZE = 1 shl RING_BITS;   // 32768 сэмплов ≈ 0.68 с
  RING_MASK = RING_SIZE - 1;
  DIT_MIN_MS = 20.0;             // 60 WPM
  DIT_MAX_MS = 240.0;            // 5 WPM
  SNR_GATE   = 2.2;              // во сколько раз пик должен быть выше шума

var
  GCodes: array[0..127] of string;   // знак → код, строится один раз
  GBuilt: Boolean = False;

procedure BuildCodeTable;
var C: Char;
begin
  if GBuilt then Exit;
  for C := #32 to #126 do GCodes[Ord(C)] := MorseCode(C);
  GBuilt := True;
end;

function MorseDecode(const Code: string): string;
var i: Integer;
begin
  Result := '';
  if Code = '' then Exit;
  BuildCodeTable;
  for i := 32 to 126 do
    if GCodes[i] = Code then
    begin
      // Таблица кодирования отдаёт заглавные — их и печатаем.
      Result := UpCase(Chr(i));
      Exit;
    end;
  // Служебные сочетания, которых нет в таблице передачи (принимают их часто).
  if Code = '...-.-'  then Result := '<SK>'
  else if Code = '-.--.'  then Result := '<KN>'
  else if Code = '.-...'  then Result := '<AS>'
  else if Code = '........' then Result := '<ERR>';
end;

{ ── TCWDecoder ────────────────────────────────────────────────────────────── }

constructor TCWDecoder.Create;
begin
  FLock  := TCriticalSection.Create;
  SetLength(FRing, RING_SIZE);
  FPitch := 600;
  FDitMs := 60.0;    // 20 WPM — стартовая догадка, дальше адаптация
  BuildTables;
  Reset;
end;

destructor TCWDecoder.Destroy;
begin
  FLock.Free;
  inherited Destroy;
end;

function TCWDecoder.StepMs: Double;
begin
  Result := 1000.0 * CWD_HOP / CWD_RATE;
end;

procedure TCWDecoder.BuildTables;
var
  i: Integer;
  F: Double;
begin
  for i := 0 to CWD_BINS - 1 do
  begin
    F := FPitch + (i - CWD_BINS div 2) * CWD_BIN_HZ;
    if F < 100 then F := 100;
    FCoef[i] := 2.0 * Cos(2.0 * Pi * F / CWD_RATE);
  end;
  for i := 0 to CWD_N - 1 do
    FWin[i] := 0.5 - 0.5 * Cos(2.0 * Pi * i / (CWD_N - 1));   // Ханн
end;

procedure TCWDecoder.SetPitch(Hz: Integer);
begin
  Hz := EnsureRange(Hz, 200, 1200);
  if Hz = FPitch then Exit;
  FPitch := Hz;
  BuildTables;
end;

procedure TCWDecoder.SetSpeedHint(WPM: Integer);
begin
  WPM := EnsureRange(WPM, 5, 60);
  FDitMs := 1200.0 / WPM;
end;

procedure TCWDecoder.Reset;
begin
  FLock.Enter;
  try
    FHead := 0; FTail := 0; FOut := '';
  finally
    FLock.Leave;
  end;
  FNoise := 0; FPeak := 0;
  // Пол шума и пик стартуют с нуля — пока они не устоялись, порог стоит где
  // попало, и первый же знак прочитался бы с лишним элементом. Полсекунды
  // молчания в начале никому не мешают: приёмник работает задолго до сигнала.
  FWarmup := Round(500.0 / StepMs);
  FMarkNow := False; FRunLen := 0; FCandLen := 0; FCandMark := False;
  FPattern := ''; FIdleSteps := 0; FWordDone := True;
  FSignal := False; FBestBin := CWD_BINS div 2;
end;

procedure TCWDecoder.FeedAudio(const Left: array of Single; Count: Integer);
// DSP-поток. Кольцо на 0.68 с: таймер разбора ходит в разы чаще, а если
// подвиснет — потеряем старое, но не сломаем состояние (это лучше, чем ждать).
var
  i, H: Integer;
begin
  if not FEnabled then Exit;
  if Count > Length(Left) then Count := Length(Left);
  FLock.Enter;
  try
    H := FHead;
    for i := 0 to Count - 1 do
    begin
      FRing[H] := Left[i];
      H := (H + 1) and RING_MASK;
      if H = FTail then FTail := (FTail + 1) and RING_MASK;   // переполнение
    end;
    FHead := H;
  finally
    FLock.Leave;
  end;
end;

procedure TCWDecoder.Process;
// Поток-хозяин. Гёрцель по перекрывающимся окнам: на каждый шаг — одно решение
// «есть тон / нет тона».
var
  Avail, i, k, T, BestK: Integer;
  S0, S1, S2, W, P, Best: Double;
begin
  if not FEnabled then Exit;
  while True do
  begin
    FLock.Enter;
    try
      Avail := (FHead - FTail) and RING_MASK;
      if Avail < CWD_N then Break;   // finally отработает, кольцо не тронуто
      T := FTail;
      for i := 0 to CWD_N - 1 do
      begin
        FBuf[i] := FRing[T] * FWin[i];
        T := (T + 1) and RING_MASK;
      end;
      FTail := (FTail + CWD_HOP) and RING_MASK;
    finally
      FLock.Leave;
    end;

    Best := 0; BestK := FBestBin;
    for k := 0 to CWD_BINS - 1 do
    begin
      S1 := 0; S2 := 0; W := FCoef[k];
      for i := 0 to CWD_N - 1 do
      begin
        S0 := FBuf[i] + W * S1 - S2;
        S2 := S1;
        S1 := S0;
      end;
      P := S1 * S1 + S2 * S2 - W * S1 * S2;
      if P > Best then begin Best := P; BestK := k; end;
    end;
    FBestPow := Sqrt(Max(0.0, Best)) / (CWD_N / 2);
    // ★Расстройку запоминаем ТОЛЬКО на посылке: в паузе максимум выбирает шум,
    // и индикатор в окне плясал бы от −200 до +200 Гц. Между посылками
    // показываем последнее осмысленное значение.
    // Только на ПОЛНОЙ амплитуде посылки: на спаде фронта максимум уже
    // разыгрывают шум и соседи по полосе.
    if FMarkNow and (FBestPow > FNoise + (FPeak - FNoise) * 0.7) then
      FBestBin := BestK;
    StepEnvelope(FBestPow);
  end;
end;

procedure TCWDecoder.StepEnvelope(Mag: Double);
// Порог плавает между полом шума и пиком сигнала: QSB, разные корреспонденты и
// разные уровни AGC иначе требовали бы ручной подстройки на каждую связь.
// Гистерезис (0.6/0.4) не даёт дребезжать на фронте посылки.
var
  Span, ThrOn, ThrOff: Double;
  IsMark: Boolean;
begin
  // Пол шума: быстро вниз, очень медленно вверх (иначе он «догоняет» длинное
  // тире и посылка обрывается посередине).
  if Mag < FNoise then FNoise := FNoise + (Mag - FNoise) * 0.05
  else                 FNoise := FNoise + (Mag - FNoise) * 0.002;
  if Mag > FPeak then FPeak := Mag
  else FPeak := FNoise + (FPeak - FNoise) * 0.9995;
  // ★Пик обязан быть не ниже пола: на старте (и в полной тишине) он ещё нулевой,
  // размах уходил в минус, порог оказывался НИЖЕ шума — и первым же «знаком»
  // декодер читал собственный шум, портя начало передачи.
  if FPeak < FNoise then FPeak := FNoise;

  Span   := FPeak - FNoise;
  FSignal := Span > FNoise * (SNR_GATE - 1.0) + 1e-9;
  if FWarmup > 0 then
  begin
    Dec(FWarmup);
    Exit;                     // трекеры набирают уровень, решений не принимаем
  end;
  ThrOn  := FNoise + Span * 0.6;
  ThrOff := FNoise + Span * 0.4;

  if FMarkNow then IsMark := Mag > ThrOff
  else             IsMark := Mag > ThrOn;
  // Пока сигнал не выделяется из шума, посылок не бывает по определению.
  if not FSignal then IsMark := False;

  // Дребезг не считается сменой состояния: это либо импульсная помеха, либо
  // провал на границе окна. Порог берём от текущей точки (четверть её длины,
  // но не меньше двух шагов): фиксированный либо пропускал бы щелчки на 20 WPM,
  // либо съедал бы настоящие посылки на 60.
  FDebounce := Round(0.25 * FDitMs / StepMs);
  if FDebounce < 2 then FDebounce := 2;
  if IsMark <> FMarkNow then
  begin
    if FCandMark = IsMark then Inc(FCandLen)
    else begin FCandMark := IsMark; FCandLen := 1; end;
    if FCandLen >= FDebounce then
    begin
      // ★Длину меряем ЗА ВЫЧЕТОМ подтверждения: пока копился кандидат, сигнал
      // уже сменился, и эти шаги принадлежат новому состоянию. Без поправки
      // каждая посылка выходила длиннее на порог дребезга — на 20 WPM это
      // давало оценку 17 WPM и смещало границу «точка/тире».
      if FMarkNow then OnMark(FRunLen - (FDebounce - 1))
      else             OnSpace(FRunLen - (FDebounce - 1));
      FMarkNow := IsMark;
      FRunLen  := FDebounce;
      FCandLen := 0;
      Exit;
    end;
  end
  else
    FCandLen := 0;
  Inc(FRunLen);

  // Хвосты в тишине: знак пора закрыть, а слово — отбить пробелом.
  if not FMarkNow then
  begin
    Inc(FIdleSteps);
    if (FPattern <> '') and (FIdleSteps * StepMs > 2.5 * FDitMs) then FlushChar;
    if (not FWordDone) and (FIdleSteps * StepMs > 6.0 * FDitMs) then
    begin
      Emit(' ');
      FWordDone := True;
    end;
  end;
end;

procedure TCWDecoder.OnMark(Steps: Integer);
// Посылка кончилась: точка это или тире — решает адаптивная длина точки, и она
// же по этой посылке уточняется. Порог 2 точки — классический.
var
  Ms: Double;
begin
  Ms := Steps * StepMs;
  if Ms < 0.5 * DIT_MIN_MS then Exit;   // мусор
  if Ms < 2.0 * FDitMs then
  begin
    FPattern := FPattern + '.';
    // ★Вниз — сразу, вверх — плавно. Корреспондент может оказаться вдвое быстрее
    // нашей подсказки, и тогда его тире мы читаем как точку; пока оценка ползёт
    // вверх-вниз усреднением, теряется целое слово. Посылка заметно короче
    // текущей точки — это и есть новая точка, спорить не о чем.
    if Ms < 0.6 * FDitMs then FDitMs := Ms
    else FDitMs := FDitMs + 0.3 * (Ms - FDitMs);
  end
  else
  begin
    FPattern := FPattern + '-';
    FDitMs := FDitMs + 0.15 * (Ms / 3.0 - FDitMs);
  end;
  FDitMs := EnsureRange(FDitMs, DIT_MIN_MS, DIT_MAX_MS);
  FIdleSteps := 0;
  FWordDone  := False;
end;

procedure TCWDecoder.OnSpace(Steps: Integer);
// Пауза кончилась (началась посылка): по её длине понимаем, был ли это разрыв
// внутри знака, между знаками или между словами.
var
  Ms: Double;
begin
  Ms := Steps * StepMs;
  FIdleSteps := 0;
  if Ms > 2.0 * FDitMs then FlushChar;
  if Ms > 5.0 * FDitMs then
  begin
    if not FWordDone then
    begin
      Emit(' ');
      FWordDone := True;
    end;
  end;
end;

procedure TCWDecoder.FlushChar;
var
  S: string;
begin
  if FPattern = '' then Exit;
  S := MorseDecode(FPattern);
  if S = '' then S := '*';    // не опознали — метка, а не тишина
  FPattern := '';
  Emit(S);
end;

procedure TCWDecoder.Emit(const S: string);
begin
  if S = '' then Exit;
  FLock.Enter;
  try
    FOut := FOut + S;
    if Length(FOut) > 4096 then FOut := Copy(FOut, Length(FOut) - 4095, 4096);
  finally
    FLock.Leave;
  end;
end;

function TCWDecoder.TakeText: string;
begin
  FLock.Enter;
  try
    Result := FOut;
    FOut   := '';
  finally
    FLock.Leave;
  end;
end;

function TCWDecoder.SpeedWPM: Integer;
begin
  if FDitMs <= 0 then Exit(0);
  Result := Round(1200.0 / FDitMs);
end;

function TCWDecoder.ToneOffsetHz: Integer;
begin
  Result := (FBestBin - CWD_BINS div 2) * CWD_BIN_HZ;
end;

function TCWDecoder.SignalPresent: Boolean;
begin
  Result := FSignal;
end;

end.