mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 18:43:51 +00:00
feat(cw): программный кейер — телеграф на Pluto/LibreSDR
У openHPSDR точки и тире формирует кейер в FPGA, и это остаётся путём по умолчанию: тайминги в железе, джиттер PC не влияет вовсе. У AD936x такого кейера нет вовсе, поэтому телеграфа на Pluto не было в принципе — голосовой TXA в CW не запускается, а несущую давать некому. CWKeyer.pas: TCWLocalKeyer рисует манипулированную несущую прямо в поток IQ, мимо WDSP (эталон pihpsdr cw_shape_buffer: в WDSP режим TXA_CWL — ветка SSB, да и PostGen не умеет огибающей). Длительности живут В СЭМПЛАХ, а не в миллисекундах: планировщик ОС влияет только на темп выдачи блоков, а его сглаживает FIFO бэкенда. Умеет текст, иамбик A/B и прямой ключ; TCWKeyPort читает манипулятор с модемных линий COM/USB-serial (DTR/RTS питают ключ, CTS/DSR/DCD/RI — лепестки). Оффлайн-прогон: PARIS занимает ровно 43 точки, все посылки и паузы 1/3/7 dit с точностью до сэмпла. Сессия = одна передача, а не одна посылка: PTT, реле T/R, антенна, OC и аттенюатор Pluto поднимаются один раз и держатся до конца hang — внутри манипуляция чисто цифровая. Предзаполнение FIFO задано железом: TX-поток Pluto наполняет буфер целиком (16384 пары ≈ 28 мс на 576k) и добивает нулями, чего не хватило. Сайдтон эту латентность не наследует — кольцо огибающей листается, если отставание больше 20 мс. Сдвиг несущей: у zero-IF ноль бейсбенда совпадает с частотой гетеродина, и там же его утечка — манипуляция на нуле дала бы backwave ровно на рабочей частоте. Поэтому несущая идёт на сдвиге, а гетеродин уезжает навстречу через новую единую дверь TXTuneFreqHz (все пуши TX-частоты переведены на неё). Знак (CW_TX_BB_SIGN) замерен на эфире, а не выведен. Развилка источника в UI — один список Keyer: firmware / software (PC) / off; хранится прежней парой флагов, и на железе без кейера выбор «прошивка» вырождается в программный, поэтому Pluto работает из коробки. Новое поле caps HasCWKeyer (раньше это неявно жило в HasHWMic). Попутно: у AD9361 calib_mode стоял manual_tx_quad, то есть драйвер не переигрывал калибровку TX quad (она нулит утечку гетеродина) на сменах TX LO — выставляем auto при подключении. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
Claude Opus 5
+994
@@ -0,0 +1,994 @@
|
||||
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; // касание манипулятора — обрывает текст
|
||||
// ---- рабочая копия (только поток генератора) ---------------------------
|
||||
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;
|
||||
|
||||
// Вход манипулятора (поток опроса порта / 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;
|
||||
|
||||
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;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCWLocalKeyer.TakeTextElement(out IsDot: Boolean): Boolean;
|
||||
// Очередной элемент передаваемого текста. Раскладка пауз та же, что у кейера
|
||||
// прошивки: 1 точка между элементами знака, 3 между знаками, 7 между словами.
|
||||
// Межсловная пауза копится в FLeadGap (отдаётся ПЕРЕД элементом), межзнаковая —
|
||||
// в FTailGap (после).
|
||||
var
|
||||
Ch: Char;
|
||||
Add: string;
|
||||
Drop: Boolean;
|
||||
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 := '';
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
if Drop then
|
||||
begin
|
||||
ResetText;
|
||||
Exit;
|
||||
end;
|
||||
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];
|
||||
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.
|
||||
Reference in New Issue
Block a user