mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 20:37:33 +00:00
feat(cw): терминал телеграфа — набор с клавиатуры и декодер приёма
Окно (ПКМ по CWL/CWU, F9, кнопка в настройках CW): одна лента, где принятое декодером и СВОЯ передача идут вперемешку — своё акцентным цветом. Разделять их нельзя: в QSK они перемежаются посреди фразы. Под лентой строка набора. Печать уходит в эфир ПОСИМВОЛЬНО, а не по Enter: строка показывает ровно то, что ещё не передано (очередь генератора), знаки уходят из неё по мере отправки, Backspace стирает с хвоста очереди — то, что уже звучит, вернуть нельзя. Ctrl работает манипулятором (левый точка, правый тире; у кейера прошивки лепестков нет — там это прямой ключ через бит CWX), по умолчанию выключено, чтобы Ctrl+C не уводил в эфир. Отпускание ключа ловится и на потере фокуса: иначе уход из окна с зажатым Ctrl оставил бы несущую в эфире навсегда. CWDecoder.pas: аудио → текст. Отвод берётся до громкости и мьюта — там нет программного сайдтона, зато уже отработал узкий CW-фильтр, лучшего предетектора не найти. Гёрцель гребёнкой из пяти бинов вокруг pitch (заодно показывает расстройку) → огибающая → адаптивный порог с гистерезисом → длительности → адаптивная точка → обратная таблица Морзе. Длительности живут в шагах анализа, а не в показаниях часов: разбор идёт пачками с таймера, и привязка ко времени вызова ломала бы тайминг на любой загрузке. Вылезло на тестах и учтено: пик обязан клампиться не ниже пола шума (иначе на старте порог уходит НИЖЕ шума и первым «знаком» читается собственный шум); порог дребезга берётся от текущей точки, фиксированный либо пропускает щелчки на медленной передаче, либо ест посылки на быстрой; длина посылки меряется за вычетом подтверждения дребезга, иначе скорость занижалась на 15%; расстройка запоминается только на полной амплитуде посылки, иначе индикатор пляшет. Граница честная: при вдвое неверной подсказке скорости теряется первое слово — пока не услышана настоящая точка, длина элемента неизвестна. Лента расшифровки продублирована строкой под спектром (пан 0), эхо передачи и очередь набора появились у обоих отправителей — и у локального генератора, и у кейера прошивки. ★TFlatEdit получил публичный CaretPos: он вставляет знак сам в UTF8KeyPress и гасит клавишу, поэтому OnKeyPress контрола не вызывается вовсе — из-за этого набранное «исчезало», а в эфир не уходило. Ввод перенесён на уровень формы. Проверено оффлайн: 12/20/40 WPM, расстройка, шум, слабый сигнал, цифры и знаки; плюс сквозной прогон против шести станций CW-стенда в hpsdrsim. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
Claude Opus 5
+462
@@ -0,0 +1,462 @@
|
||||
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.
|
||||
+76
-1
@@ -99,6 +99,11 @@ type
|
||||
FDashIn: Boolean;
|
||||
FStraightIn:Boolean; // прямой ключ отдельным источником
|
||||
FTouched: Boolean; // касание манипулятора — обрывает текст
|
||||
// Эхо передачи для окна-терминала: знаки, которые УЖЕ ушли в эфир, и хвост,
|
||||
// который ещё стоит в очереди. Ведём под FLock, потому что читает их UI.
|
||||
FSent: string;
|
||||
FUnsent: string;
|
||||
FTrimTail: Boolean; // Backspace съел знак из уже разобранного текста
|
||||
// ---- рабочая копия (только поток генератора) ---------------------------
|
||||
FRate: Integer;
|
||||
FAmp: Double;
|
||||
@@ -170,6 +175,12 @@ type
|
||||
procedure SendText(const S: string);
|
||||
procedure AbortText;
|
||||
function Busy: Boolean;
|
||||
// Терминал: знаки, ушедшие в эфир с прошлого опроса (эхо своей передачи).
|
||||
function TakeSentText: string;
|
||||
// Терминал: что ещё стоит в очереди (набранное вперёд).
|
||||
function PendingText: string;
|
||||
// Стереть последний НЕ ушедший знак (Backspace в окне набора).
|
||||
function Backspace: Boolean;
|
||||
|
||||
// Вход манипулятора (поток опроса порта / GUI). Состояния лепестков сырые,
|
||||
// Reverse применяет сам генератор.
|
||||
@@ -357,6 +368,52 @@ begin
|
||||
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;
|
||||
@@ -612,6 +669,8 @@ begin
|
||||
FLock.Enter;
|
||||
try
|
||||
FBusyText := False;
|
||||
FUnsent := '';
|
||||
FTrimTail := False;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
@@ -625,7 +684,8 @@ function TCWLocalKeyer.TakeTextElement(out IsDot: Boolean): Boolean;
|
||||
var
|
||||
Ch: Char;
|
||||
Add: string;
|
||||
Drop: Boolean;
|
||||
Drop, Trim: Boolean;
|
||||
KeepLen: Integer;
|
||||
begin
|
||||
Result := False;
|
||||
IsDot := True;
|
||||
@@ -642,6 +702,9 @@ begin
|
||||
end;
|
||||
Add := FPending;
|
||||
FPending := '';
|
||||
Trim := FTrimTail;
|
||||
FTrimTail := False;
|
||||
KeepLen := FTextPos + Length(FUnsent);
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
@@ -650,6 +713,8 @@ begin
|
||||
ResetText;
|
||||
Exit;
|
||||
end;
|
||||
// Backspace дотянулся до уже разобранного текста — отсекаем хвост.
|
||||
if Trim and (Length(FText) > KeepLen) then SetLength(FText, KeepLen);
|
||||
if Add <> '' then FText := FText + Add;
|
||||
|
||||
// Ищем следующий элемент, пропуская пробелы и знаки не из таблицы.
|
||||
@@ -662,6 +727,16 @@ begin
|
||||
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.
|
||||
|
||||
+86
-1
@@ -37,6 +37,10 @@ type
|
||||
FBusy: Boolean; // идёт передача (под FLock)
|
||||
FWPM: Integer; // под FLock
|
||||
FWeight: Integer; // 33..66, 50 = симметрично (под FLock)
|
||||
// Эхо для окна-терминала: ушедшее в эфир и хвост очереди (под FLock).
|
||||
FSent: string;
|
||||
FUnsent: string;
|
||||
FTrimTail: Boolean; // Backspace дотянулся до уже взятого текста
|
||||
function TakeText: string;
|
||||
function Aborted: Boolean;
|
||||
procedure Key(Down: Boolean);
|
||||
@@ -53,6 +57,11 @@ type
|
||||
procedure AbortSending;
|
||||
procedure SetSpeed(WPM, Weight: Integer);
|
||||
function Busy: Boolean;
|
||||
// Терминал: знаки, ушедшие в эфир с прошлого опроса; хвост очереди; стереть
|
||||
// последний ненабранный знак. Смысл тот же, что у TCWLocalKeyer.
|
||||
function TakeSentText: string;
|
||||
function PendingText: string;
|
||||
function Backspace: Boolean;
|
||||
end;
|
||||
|
||||
// Код знака: строка из '.' и '-'. Пустая — знака нет в таблице (пропускаем,
|
||||
@@ -163,6 +172,49 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCWSender.TakeSentText: string;
|
||||
begin
|
||||
FLock.Enter;
|
||||
try
|
||||
Result := FSent;
|
||||
FSent := '';
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCWSender.PendingText: string;
|
||||
begin
|
||||
FLock.Enter;
|
||||
try
|
||||
Result := FUnsent + FPending;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCWSender.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
|
||||
SetLength(FUnsent, Length(FUnsent) - 1);
|
||||
FTrimTail := True;
|
||||
Result := True;
|
||||
end;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCWSender.TakeText: string;
|
||||
begin
|
||||
FLock.Enter;
|
||||
@@ -252,7 +304,8 @@ end;
|
||||
procedure TCWSender.Execute;
|
||||
var
|
||||
Text: string;
|
||||
i: Integer;
|
||||
i, KeepLen: Integer;
|
||||
Trim: Boolean;
|
||||
Deadline: QWord;
|
||||
begin
|
||||
while not Terminated do
|
||||
@@ -275,6 +328,31 @@ begin
|
||||
while i <= Length(Text) do
|
||||
begin
|
||||
if Terminated or Aborted then Break;
|
||||
// Backspace мог съесть хвост уже взятого текста — отсекаем.
|
||||
FLock.Enter;
|
||||
try
|
||||
Trim := FTrimTail;
|
||||
FTrimTail := False;
|
||||
KeepLen := i - 1 + Length(FUnsent);
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
if Trim then
|
||||
begin
|
||||
if KeepLen < i then Break; // стёрли всё впереди
|
||||
if Length(Text) > KeepLen then SetLength(Text, KeepLen);
|
||||
if i > Length(Text) then Break;
|
||||
end;
|
||||
// Эхо в окно-терминал: знак пошёл в эфир; хвост очереди — для строки
|
||||
// набора (там должно остаться только НЕ переданное).
|
||||
FLock.Enter;
|
||||
try
|
||||
FSent := FSent + Text[i];
|
||||
FUnsent := Copy(Text, i + 1, MaxInt);
|
||||
if Length(FSent) > 4096 then FSent := Copy(FSent, Length(FSent) - 4095, 4096);
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
SendChar(Text[i], Deadline);
|
||||
// Дописанное в очередь по ходу передачи подхватываем без паузы —
|
||||
// иначе поток допередал бы «старый» текст и уснул на 200 мс.
|
||||
@@ -284,6 +362,13 @@ begin
|
||||
finally
|
||||
Key(False); // ключ всегда отпущен, что бы ни случилось
|
||||
FLock.Enter;
|
||||
try
|
||||
FUnsent := '';
|
||||
FTrimTail := False;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
FLock.Enter;
|
||||
try
|
||||
FBusy := False;
|
||||
finally
|
||||
|
||||
@@ -0,0 +1,678 @@
|
||||
unit CWTerminalForm;
|
||||
|
||||
{ TCWTerminalForm — телеграфный терминал: лента связи + набор с клавиатуры.
|
||||
|
||||
Почему одно окно, а не два. В работе читаешь и отвечаешь одновременно, поэтому
|
||||
принятое декодером и своя передача идут ОДНОЙ лентой (своё — другим цветом),
|
||||
а строка набора висит под ней. Так устроены fldigi и CW-окна контест-логгеров,
|
||||
и по делу это единственная удобная раскладка.
|
||||
|
||||
Набор идёт В ЭФИР ПО МЕРЕ ПЕЧАТИ, а не по Enter: строка набора показывает
|
||||
ровно то, что ещё НЕ передано (очередь генератора), и знаки уходят из неё по
|
||||
мере отправки. Backspace стирает с хвоста очереди — то, что уже звучит,
|
||||
вернуть нельзя.
|
||||
|
||||
Ленту рисуем сами (TPaintBox), а не TMemo: нужен цвет по фрагментам (приём /
|
||||
своя передача) и постоянная дописка снизу без мигания. }
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Math,
|
||||
Forms, Controls, Graphics, StdCtrls, ExtCtrls, LCLType,
|
||||
FlatButton, FlatEdit, FlatSpinEdit, AppTheme, Settings, DpiUtils;
|
||||
|
||||
type
|
||||
TCWTermSend = procedure(const Text: string) of object;
|
||||
TCWTermFlag = procedure(Value: Boolean) of object;
|
||||
TCWTermKey = procedure(Dot, Dash: Boolean) of object;
|
||||
TCWTermSpeed = procedure(WPM: Integer) of object;
|
||||
|
||||
// Фрагмент ленты: текст одного происхождения подряд.
|
||||
TCWRun = record
|
||||
Text: string;
|
||||
IsTX: Boolean;
|
||||
end;
|
||||
|
||||
TCWTerminalForm = class(TForm)
|
||||
private
|
||||
FTheme: TAppTheme;
|
||||
FRuns: array of TCWRun;
|
||||
FLines: TStringList; // разложенная по ширине лента (текст)
|
||||
FLineTX: TStringList; // '1'/'0' на каждый знак строки — цвет
|
||||
FLog: TPaintBox;
|
||||
FInput: TFlatEdit;
|
||||
FBtnStop: TFlatButton;
|
||||
FBtnClear: TFlatButton;
|
||||
FBtnDec: TFlatButton;
|
||||
FBtnKbd: TFlatButton;
|
||||
FBtnClose: TFlatButton;
|
||||
FEdWPM: TFlatSpinEdit;
|
||||
FLblStatus: TLabel;
|
||||
FMacroBtns: array[0..CW_MSG_COUNT-1] of TFlatButton;
|
||||
FCW: TCWSettings;
|
||||
FUpdating: Boolean;
|
||||
FDecOn: Boolean;
|
||||
FKbdOn: Boolean;
|
||||
FKbdDot: Boolean;
|
||||
FKbdDash: Boolean;
|
||||
FCharW: Integer;
|
||||
FLineH: Integer;
|
||||
FOnSend: TCWTermSend;
|
||||
FOnAbort: TNotifyEvent;
|
||||
FOnBackspace:TNotifyEvent;
|
||||
FOnDecoder: TCWTermFlag;
|
||||
FOnKbdKey: TCWTermKey;
|
||||
FOnSpeed: TCWTermSpeed;
|
||||
FOnMacro: TNotifyEvent; // Sender.Tag = номер ячейки
|
||||
procedure BuildUI;
|
||||
procedure LogPaint(Sender: TObject);
|
||||
procedure LogResize(Sender: TObject);
|
||||
procedure RewrapAll;
|
||||
procedure AppendToWrap(const S: string; IsTX: Boolean);
|
||||
procedure StyleBtn(B: TFlatButton);
|
||||
procedure StopClick(Sender: TObject);
|
||||
procedure ClearClick(Sender: TObject);
|
||||
procedure DecClick(Sender: TObject);
|
||||
procedure KbdClick(Sender: TObject);
|
||||
procedure CloseClick(Sender: TObject);
|
||||
procedure MacroClick(Sender: TObject);
|
||||
procedure WPMChange(Sender: TObject);
|
||||
procedure FormUTF8Key(Sender: TObject; var UTF8Key: TUTF8Char);
|
||||
procedure FormKeyDownEx(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
procedure FormKeyUpEx(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
procedure PushKbdKey;
|
||||
procedure FocusInput;
|
||||
procedure FormLostFocus(Sender: TObject);
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure ApplyTheme(const T: TAppTheme);
|
||||
procedure LoadFrom(const C: TCWSettings);
|
||||
procedure DoShow; override;
|
||||
// Прибавка ленты (из ServiceCWDecoder хозяина).
|
||||
procedure AppendLog(const S: string; IsTX: Boolean);
|
||||
// Строка набора = очередь передачи; статус — скорость/расстройка/сигнал.
|
||||
procedure SetPending(const S: string);
|
||||
procedure SetStatus(const S: string);
|
||||
property OnSend: TCWTermSend read FOnSend write FOnSend;
|
||||
property OnAbort: TNotifyEvent read FOnAbort write FOnAbort;
|
||||
property OnBackspace: TNotifyEvent read FOnBackspace write FOnBackspace;
|
||||
property OnDecoder: TCWTermFlag read FOnDecoder write FOnDecoder;
|
||||
property OnKbdKey: TCWTermKey read FOnKbdKey write FOnKbdKey;
|
||||
property OnSpeed: TCWTermSpeed read FOnSpeed write FOnSpeed;
|
||||
property OnMacro: TNotifyEvent read FOnMacro write FOnMacro;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
{$IFDEF WINDOWS}
|
||||
UI_FONT = 'Segoe UI';
|
||||
MONO_FONT = 'Consolas';
|
||||
{$ELSE}
|
||||
UI_FONT = 'Sans';
|
||||
MONO_FONT = 'Monospace';
|
||||
{$ENDIF}
|
||||
FORM_W = 700;
|
||||
FORM_H = 460;
|
||||
PAD = 10;
|
||||
ROW_H = 26;
|
||||
MAX_LINES = 500;
|
||||
|
||||
constructor TCWTerminalForm.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited CreateNew(AOwner);
|
||||
FTheme := DarkTheme;
|
||||
FLines := TStringList.Create;
|
||||
FLineTX := TStringList.Create;
|
||||
TSettingsManager.DefaultCW(FCW);
|
||||
Scaled := False;
|
||||
Caption := 'CW Terminal';
|
||||
BorderStyle := bsSizeable;
|
||||
if AOwner is TCustomForm then
|
||||
begin
|
||||
Position := poOwnerFormCenter;
|
||||
// ★Держим окно ПОВЕРХ главного, пока его не закрыли: набор идёт вслепую по
|
||||
// ленте, и если терминал ныряет под главное окно от любого клика по спектру,
|
||||
// работать в нём невозможно. Через transient-родителя, а не fsStayOnTop:
|
||||
// так окно поднимается над своим приложением, но не лезет поверх чужих
|
||||
// (и это единственный способ, который корректно работает на Wayland).
|
||||
PopupMode := pmExplicit;
|
||||
PopupParent := TCustomForm(AOwner);
|
||||
end
|
||||
else
|
||||
Position := poScreenCenter;
|
||||
Width := DpiScale(FORM_W);
|
||||
Height := DpiScale(FORM_H);
|
||||
Constraints.MinWidth := DpiScale(520);
|
||||
Constraints.MinHeight := DpiScale(300);
|
||||
KeyPreview := True;
|
||||
OnUTF8KeyPress := @FormUTF8Key;
|
||||
OnKeyDown := @FormKeyDownEx;
|
||||
OnKeyUp := @FormKeyUpEx;
|
||||
// ★Отпускание клавиши приходит только сфокусированному окну. Ушёл фокус с
|
||||
// зажатым Ctrl (alt-tab, клик по главному окну) — и несущая осталась бы в
|
||||
// эфире навсегда. Снимаем ключ на любой потере фокуса и при скрытии окна.
|
||||
OnDeactivate := @FormLostFocus;
|
||||
OnHide := @FormLostFocus;
|
||||
BuildUI;
|
||||
ApplyTheme(DarkTheme);
|
||||
end;
|
||||
|
||||
destructor TCWTerminalForm.Destroy;
|
||||
begin
|
||||
FLines.Free;
|
||||
FLineTX.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TCWTerminalForm.BuildUI;
|
||||
var
|
||||
i, X: Integer;
|
||||
begin
|
||||
// ---- лента ---------------------------------------------------------------
|
||||
FLog := TPaintBox.Create(Self);
|
||||
FLog.Parent := Self;
|
||||
FLog.Align := alClient;
|
||||
FLog.BorderSpacing.Around := DpiScale(PAD);
|
||||
FLog.BorderSpacing.Bottom := DpiScale(PAD + 3 * ROW_H + 3 * 6);
|
||||
FLog.OnPaint := @LogPaint;
|
||||
FLog.OnResize := @LogResize;
|
||||
|
||||
// ---- строка набора -------------------------------------------------------
|
||||
FInput := TFlatEdit.Create(Self);
|
||||
FInput.Parent := Self;
|
||||
FInput.Anchors := [akLeft, akRight, akBottom];
|
||||
FInput.Font.Name := MONO_FONT;
|
||||
FInput.Font.Size := 10;
|
||||
// ★Обработчики ввода НЕ вешаем на поле: TFlatEdit вставляет знак сам в
|
||||
// UTF8KeyPress и гасит клавишу, поэтому его OnKeyPress не вызывается вовсе —
|
||||
// именно из-за этого набранное «исчезало», а в эфир не уходило. Весь ввод
|
||||
// ловим на форме (KeyPreview), а поле остаётся показывать очередь передачи.
|
||||
|
||||
// ---- нижние ряды ---------------------------------------------------------
|
||||
FBtnStop := TFlatButton.Create(Self);
|
||||
FBtnStop.Parent := Self;
|
||||
FBtnStop.Caption := 'Stop';
|
||||
FBtnStop.OnClick := @StopClick;
|
||||
FBtnStop.Anchors := [akLeft, akBottom];
|
||||
|
||||
FBtnClear := TFlatButton.Create(Self);
|
||||
FBtnClear.Parent := Self;
|
||||
FBtnClear.Caption := 'Clear';
|
||||
FBtnClear.OnClick := @ClearClick;
|
||||
FBtnClear.Anchors := [akLeft, akBottom];
|
||||
|
||||
FBtnDec := TFlatButton.Create(Self);
|
||||
FBtnDec.Parent := Self;
|
||||
FBtnDec.Caption := 'Decoder';
|
||||
FBtnDec.OnClick := @DecClick;
|
||||
FBtnDec.Anchors := [akLeft, akBottom];
|
||||
|
||||
FBtnKbd := TFlatButton.Create(Self);
|
||||
FBtnKbd.Parent := Self;
|
||||
FBtnKbd.Caption := 'Ctrl = key';
|
||||
FBtnKbd.OnClick := @KbdClick;
|
||||
FBtnKbd.Anchors := [akLeft, akBottom];
|
||||
|
||||
FEdWPM := TFlatSpinEdit.Create(Self);
|
||||
FEdWPM.Parent := Self;
|
||||
FEdWPM.MinValue := 5;
|
||||
FEdWPM.MaxValue := 60;
|
||||
FEdWPM.Value := 20;
|
||||
FEdWPM.OnChange := @WPMChange;
|
||||
FEdWPM.Anchors := [akLeft, akBottom];
|
||||
|
||||
FLblStatus := TLabel.Create(Self);
|
||||
FLblStatus.Parent := Self;
|
||||
FLblStatus.Font.Name := UI_FONT;
|
||||
FLblStatus.Font.Size := 8;
|
||||
FLblStatus.Anchors := [akLeft, akRight, akBottom];
|
||||
FLblStatus.AutoSize := False;
|
||||
|
||||
FBtnClose := TFlatButton.Create(Self);
|
||||
FBtnClose.Parent := Self;
|
||||
FBtnClose.Caption := 'Close';
|
||||
FBtnClose.OnClick := @CloseClick;
|
||||
FBtnClose.Anchors := [akRight, akBottom];
|
||||
|
||||
X := PAD;
|
||||
for i := 0 to CW_MSG_COUNT - 1 do
|
||||
begin
|
||||
FMacroBtns[i] := TFlatButton.Create(Self);
|
||||
FMacroBtns[i].Parent := Self;
|
||||
FMacroBtns[i].Caption := 'F' + IntToStr(i + 1);
|
||||
FMacroBtns[i].Tag := i;
|
||||
FMacroBtns[i].OnClick := @MacroClick;
|
||||
FMacroBtns[i].Anchors := [akLeft, akBottom];
|
||||
Inc(X, 46);
|
||||
end;
|
||||
LogResize(nil);
|
||||
end;
|
||||
|
||||
procedure TCWTerminalForm.LogResize(Sender: TObject);
|
||||
// Раскладка нижних рядов руками: якорей хватает по горизонтали, но ряды идут
|
||||
// снизу вверх, и считать их проще одной формулой, чем городить панели.
|
||||
var
|
||||
i, Y, X, W: Integer;
|
||||
begin
|
||||
if FInput = nil then Exit;
|
||||
W := ClientWidth;
|
||||
Y := ClientHeight - DpiScale(PAD) - DpiScale(ROW_H);
|
||||
// ряд 3 (низ): макросы + Close
|
||||
X := DpiScale(PAD);
|
||||
for i := 0 to CW_MSG_COUNT - 1 do
|
||||
begin
|
||||
FMacroBtns[i].SetBounds(X, Y, DpiScale(42), DpiScale(ROW_H));
|
||||
Inc(X, DpiScale(46));
|
||||
end;
|
||||
FBtnClose.SetBounds(W - DpiScale(PAD + 70), Y, DpiScale(70), DpiScale(ROW_H));
|
||||
// ряд 2: кнопки + скорость + статус
|
||||
Dec(Y, DpiScale(ROW_H + 6));
|
||||
X := DpiScale(PAD);
|
||||
FBtnStop.SetBounds(X, Y, DpiScale(60), DpiScale(ROW_H)); Inc(X, DpiScale(64));
|
||||
FBtnClear.SetBounds(X, Y, DpiScale(60), DpiScale(ROW_H)); Inc(X, DpiScale(64));
|
||||
FBtnDec.SetBounds(X, Y, DpiScale(80), DpiScale(ROW_H)); Inc(X, DpiScale(84));
|
||||
FBtnKbd.SetBounds(X, Y, DpiScale(90), DpiScale(ROW_H)); Inc(X, DpiScale(94));
|
||||
FEdWPM.SetBounds(X, Y, DpiScale(70), DpiScale(ROW_H)); Inc(X, DpiScale(78));
|
||||
FLblStatus.SetBounds(X, Y + DpiScale(6), W - X - DpiScale(PAD), DpiScale(18));
|
||||
// ряд 1: строка набора
|
||||
Dec(Y, DpiScale(ROW_H + 6));
|
||||
FInput.SetBounds(DpiScale(PAD), Y, W - DpiScale(2 * PAD), DpiScale(ROW_H));
|
||||
RewrapAll;
|
||||
if FLog <> nil then FLog.Invalidate;
|
||||
end;
|
||||
|
||||
{ ── лента ─────────────────────────────────────────────────────────────────── }
|
||||
|
||||
procedure TCWTerminalForm.AppendToWrap(const S: string; IsTX: Boolean);
|
||||
// Дописываем знаки в последнюю строку, перенося по ширине окна. Цвет храним
|
||||
// параллельной строкой флагов — так рисование не зависит от разбиения на
|
||||
// фрагменты и переносы получаются посимвольно точными.
|
||||
var
|
||||
i, Cols: Integer;
|
||||
Flag: Char;
|
||||
begin
|
||||
if S = '' then Exit;
|
||||
if FCharW <= 0 then FCharW := 8;
|
||||
Cols := Max(8, (FLog.Width - DpiScale(8)) div FCharW);
|
||||
if FLines.Count = 0 then
|
||||
begin
|
||||
FLines.Add('');
|
||||
FLineTX.Add('');
|
||||
end;
|
||||
if IsTX then Flag := '1' else Flag := '0';
|
||||
for i := 1 to Length(S) do
|
||||
begin
|
||||
if S[i] = #10 then
|
||||
begin
|
||||
FLines.Add(''); FLineTX.Add('');
|
||||
Continue;
|
||||
end;
|
||||
if Length(FLines[FLines.Count - 1]) >= Cols then
|
||||
begin
|
||||
FLines.Add(''); FLineTX.Add('');
|
||||
end;
|
||||
FLines[FLines.Count - 1] := FLines[FLines.Count - 1] + S[i];
|
||||
FLineTX[FLineTX.Count - 1] := FLineTX[FLineTX.Count - 1] + Flag;
|
||||
end;
|
||||
while FLines.Count > MAX_LINES do
|
||||
begin
|
||||
FLines.Delete(0);
|
||||
FLineTX.Delete(0);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCWTerminalForm.RewrapAll;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
if FLog = nil then Exit;
|
||||
FLines.Clear;
|
||||
FLineTX.Clear;
|
||||
for i := 0 to High(FRuns) do
|
||||
AppendToWrap(FRuns[i].Text, FRuns[i].IsTX);
|
||||
end;
|
||||
|
||||
procedure TCWTerminalForm.AppendLog(const S: string; IsTX: Boolean);
|
||||
var
|
||||
n: Integer;
|
||||
begin
|
||||
if S = '' then Exit;
|
||||
n := Length(FRuns);
|
||||
// Соседние фрагменты одного происхождения склеиваем — иначе массив распухнет
|
||||
// на каждый принятый знак.
|
||||
if (n > 0) and (FRuns[n-1].IsTX = IsTX) and (Length(FRuns[n-1].Text) < 4096) then
|
||||
FRuns[n-1].Text := FRuns[n-1].Text + S
|
||||
else
|
||||
begin
|
||||
SetLength(FRuns, n + 1);
|
||||
FRuns[n].Text := S;
|
||||
FRuns[n].IsTX := IsTX;
|
||||
end;
|
||||
// Держим историю ограниченной (окно не журнал связи).
|
||||
if Length(FRuns) > 400 then
|
||||
begin
|
||||
Move(FRuns[100], FRuns[0], (Length(FRuns) - 100) * SizeOf(TCWRun));
|
||||
SetLength(FRuns, Length(FRuns) - 100);
|
||||
RewrapAll;
|
||||
end
|
||||
else
|
||||
AppendToWrap(S, IsTX);
|
||||
FLog.Invalidate;
|
||||
end;
|
||||
|
||||
procedure TCWTerminalForm.LogPaint(Sender: TObject);
|
||||
var
|
||||
C: TCanvas;
|
||||
i, j, Y, X, First, Rows: Integer;
|
||||
L, F: string;
|
||||
begin
|
||||
C := FLog.Canvas;
|
||||
C.Brush.Color := FTheme.Panel;
|
||||
C.FillRect(0, 0, FLog.Width, FLog.Height);
|
||||
C.Pen.Color := FTheme.Border;
|
||||
C.Brush.Style := bsClear;
|
||||
C.Rectangle(0, 0, FLog.Width, FLog.Height);
|
||||
C.Font.Name := MONO_FONT;
|
||||
C.Font.Size := 10;
|
||||
if FLineH <= 0 then
|
||||
begin
|
||||
FLineH := C.TextHeight('Wg') + 2;
|
||||
FCharW := C.TextWidth('W');
|
||||
if FCharW <= 0 then FCharW := 8;
|
||||
end;
|
||||
Rows := Max(1, (FLog.Height - DpiScale(8)) div FLineH);
|
||||
First := Max(0, FLines.Count - Rows); // всегда показываем хвост ленты
|
||||
Y := DpiScale(4);
|
||||
for i := First to FLines.Count - 1 do
|
||||
begin
|
||||
L := FLines[i];
|
||||
F := FLineTX[i];
|
||||
X := DpiScale(4);
|
||||
for j := 1 to Length(L) do
|
||||
begin
|
||||
// Своя передача — акцентом, приём — обычным текстом. Разделять их
|
||||
// строками нельзя: в QSK они перемежаются посреди фразы.
|
||||
if (j <= Length(F)) and (F[j] = '1') then C.Font.Color := FTheme.BtnTextActive
|
||||
else C.Font.Color := FTheme.Text;
|
||||
C.TextOut(X, Y, L[j]);
|
||||
Inc(X, FCharW);
|
||||
end;
|
||||
Inc(Y, FLineH);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ ── управление ────────────────────────────────────────────────────────────── }
|
||||
|
||||
procedure TCWTerminalForm.SetPending(const S: string);
|
||||
begin
|
||||
if FInput = nil then Exit;
|
||||
if FInput.Text = S then Exit;
|
||||
FUpdating := True;
|
||||
try
|
||||
FInput.Text := S;
|
||||
FInput.CaretPos := MaxInt; // курсор всегда в конце очереди набора
|
||||
finally
|
||||
FUpdating := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCWTerminalForm.SetStatus(const S: string);
|
||||
begin
|
||||
if FLblStatus <> nil then FLblStatus.Caption := S;
|
||||
end;
|
||||
|
||||
procedure TCWTerminalForm.LoadFrom(const C: TCWSettings);
|
||||
var i: Integer;
|
||||
begin
|
||||
FCW := C;
|
||||
FUpdating := True;
|
||||
try
|
||||
if FEdWPM <> nil then FEdWPM.Value := EnsureRange(C.Speed, 5, 60);
|
||||
for i := 0 to CW_MSG_COUNT - 1 do
|
||||
if FMacroBtns[i] <> nil then
|
||||
begin
|
||||
FMacroBtns[i].Hint := C.Messages[i];
|
||||
FMacroBtns[i].ShowHint := C.Messages[i] <> '';
|
||||
end;
|
||||
FDecOn := C.Decoder;
|
||||
FKbdOn := C.KbdKey;
|
||||
finally
|
||||
FUpdating := False;
|
||||
end;
|
||||
ApplyTheme(FTheme); // состояние кнопок-переключателей рисуется цветом
|
||||
end;
|
||||
|
||||
procedure TCWTerminalForm.DoShow;
|
||||
begin
|
||||
inherited DoShow;
|
||||
// Набор — главное занятие в этом окне, курсор должен быть уже там.
|
||||
if FInput <> nil then FInput.SetFocus;
|
||||
end;
|
||||
|
||||
procedure TCWTerminalForm.FormUTF8Key(Sender: TObject; var UTF8Key: TUTF8Char);
|
||||
// ★Печать уходит в эфир СРАЗУ, посимвольно. Строка набора нами не редактируется:
|
||||
// её содержимое — очередь генератора, и она перезаписывается через SetPending по
|
||||
// мере передачи. Знак гасим, чтобы поле не вставило его ещё и от себя.
|
||||
var Key: Char;
|
||||
begin
|
||||
if UTF8Key = '' then Exit;
|
||||
if ActiveControl <> FInput then Exit; // печатаем только в строке набора
|
||||
Key := UTF8Key[1];
|
||||
UTF8Key := '';
|
||||
if Key < #32 then Exit;
|
||||
if Assigned(FOnSend) then FOnSend(UpCase(Key));
|
||||
// Показываем знак в очереди сразу, не дожидаясь таймера: иначе набор
|
||||
// ощущается «залипающим». Через 100 мс SetPending всё равно перепишет строку
|
||||
// настоящей очередью генератора.
|
||||
FUpdating := True;
|
||||
try
|
||||
FInput.Text := FInput.Text + UpCase(Key);
|
||||
FInput.CaretPos := MaxInt;
|
||||
finally
|
||||
FUpdating := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCWTerminalForm.FocusInput;
|
||||
// ★Клик по любой кнопке уводит фокус на неё, и печать после этого молча
|
||||
// перестаёт уходить в эфир (ввод ловится, только пока фокус в строке набора).
|
||||
// Поэтому после каждого действия возвращаем курсор туда.
|
||||
begin
|
||||
if (FInput <> nil) and FInput.CanFocus then FInput.SetFocus;
|
||||
end;
|
||||
|
||||
procedure TCWTerminalForm.PushKbdKey;
|
||||
begin
|
||||
if Assigned(FOnKbdKey) then FOnKbdKey(FKbdDot, FKbdDash);
|
||||
end;
|
||||
|
||||
procedure TCWTerminalForm.FormLostFocus(Sender: TObject);
|
||||
begin
|
||||
if FKbdDot or FKbdDash then
|
||||
begin
|
||||
FKbdDot := False;
|
||||
FKbdDash := False;
|
||||
PushKbdKey;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCWTerminalForm.FormKeyDownEx(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
begin
|
||||
// F1..F8 — те же ячейки памяти, что в главном окне.
|
||||
if (Key >= VK_F1) and (Key <= VK_F8) then
|
||||
begin
|
||||
if Assigned(FOnMacro) then
|
||||
begin
|
||||
FBtnStop.Tag := Key - VK_F1; // переиспользуем Tag как переносчик номера
|
||||
MacroClick(FBtnStop);
|
||||
end;
|
||||
Key := 0;
|
||||
Exit;
|
||||
end;
|
||||
// Правка очереди передачи — только пока фокус в строке набора. Поле не
|
||||
// редактируем сами: его содержимое задаёт генератор (SetPending), поэтому
|
||||
// клавиши правки гасим здесь, до контрола.
|
||||
if ActiveControl = FInput then
|
||||
case Key of
|
||||
VK_BACK:
|
||||
begin
|
||||
if Assigned(FOnBackspace) then FOnBackspace(Self);
|
||||
if FInput.Text <> '' then
|
||||
begin
|
||||
FUpdating := True;
|
||||
try
|
||||
FInput.Text := Copy(FInput.Text, 1, Length(FInput.Text) - 1);
|
||||
FInput.CaretPos := MaxInt;
|
||||
finally
|
||||
FUpdating := False;
|
||||
end;
|
||||
end;
|
||||
Key := 0;
|
||||
Exit;
|
||||
end;
|
||||
VK_ESCAPE:
|
||||
begin
|
||||
if Assigned(FOnAbort) then FOnAbort(Self);
|
||||
Key := 0;
|
||||
Exit;
|
||||
end;
|
||||
// Стрелки/Delete/Enter внутри очереди смысла не имеют: эфир ушёл вперёд.
|
||||
VK_RETURN, VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_DELETE, VK_HOME, VK_END:
|
||||
begin
|
||||
Key := 0;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
if not FKbdOn then Exit;
|
||||
// Ctrl = манипулятор. Левый — точка, правый — тире: при иамбике это полноценные
|
||||
// лепестки, при прямом ключе годится любой.
|
||||
if Key = VK_LCONTROL then begin FKbdDot := True; PushKbdKey; Key := 0; end
|
||||
else if Key = VK_RCONTROL then begin FKbdDash := True; PushKbdKey; Key := 0; end
|
||||
else if Key = VK_CONTROL then begin FKbdDot := True; PushKbdKey; Key := 0; end;
|
||||
end;
|
||||
|
||||
procedure TCWTerminalForm.FormKeyUpEx(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
begin
|
||||
if not FKbdOn then Exit;
|
||||
if Key = VK_LCONTROL then begin FKbdDot := False; PushKbdKey; Key := 0; end
|
||||
else if Key = VK_RCONTROL then begin FKbdDash := False; PushKbdKey; Key := 0; end
|
||||
else if Key = VK_CONTROL then
|
||||
begin
|
||||
FKbdDot := False; FKbdDash := False; PushKbdKey; Key := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCWTerminalForm.MacroClick(Sender: TObject);
|
||||
begin
|
||||
if Assigned(FOnMacro) then FOnMacro(Sender);
|
||||
FocusInput;
|
||||
end;
|
||||
|
||||
procedure TCWTerminalForm.StopClick(Sender: TObject);
|
||||
begin
|
||||
if Assigned(FOnAbort) then FOnAbort(Self);
|
||||
FocusInput;
|
||||
end;
|
||||
|
||||
procedure TCWTerminalForm.ClearClick(Sender: TObject);
|
||||
begin
|
||||
SetLength(FRuns, 0);
|
||||
FLines.Clear;
|
||||
FLineTX.Clear;
|
||||
FLog.Invalidate;
|
||||
FocusInput;
|
||||
end;
|
||||
|
||||
procedure TCWTerminalForm.DecClick(Sender: TObject);
|
||||
begin
|
||||
FDecOn := not FDecOn;
|
||||
if Assigned(FOnDecoder) then FOnDecoder(FDecOn);
|
||||
ApplyTheme(FTheme);
|
||||
FocusInput;
|
||||
end;
|
||||
|
||||
procedure TCWTerminalForm.KbdClick(Sender: TObject);
|
||||
begin
|
||||
FKbdOn := not FKbdOn;
|
||||
if not FKbdOn then
|
||||
begin
|
||||
FKbdDot := False; FKbdDash := False;
|
||||
PushKbdKey; // отпустить, если выключили с зажатой
|
||||
end;
|
||||
FCW.KbdKey := FKbdOn;
|
||||
ApplyTheme(FTheme);
|
||||
FocusInput;
|
||||
end;
|
||||
|
||||
procedure TCWTerminalForm.CloseClick(Sender: TObject);
|
||||
begin
|
||||
Hide;
|
||||
end;
|
||||
|
||||
procedure TCWTerminalForm.WPMChange(Sender: TObject);
|
||||
begin
|
||||
if FUpdating then Exit;
|
||||
if Assigned(FOnSpeed) then FOnSpeed(FEdWPM.Value);
|
||||
end;
|
||||
|
||||
procedure TCWTerminalForm.StyleBtn(B: TFlatButton);
|
||||
begin
|
||||
if B = nil then Exit;
|
||||
B.ClrNorm := FTheme.BtnNorm;
|
||||
B.ClrBorder := FTheme.BtnBorderNorm;
|
||||
B.ClrHot := FTheme.BtnHot;
|
||||
B.ClrActive := FTheme.BtnActive;
|
||||
B.ClrText := FTheme.BtnText;
|
||||
B.ClrTextAct := FTheme.BtnTextActive;
|
||||
B.Font.Name := UI_FONT;
|
||||
B.Font.Size := 9;
|
||||
B.Invalidate;
|
||||
end;
|
||||
|
||||
procedure TCWTerminalForm.ApplyTheme(const T: TAppTheme);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
FTheme := T;
|
||||
Color := T.BG;
|
||||
StyleBtn(FBtnStop);
|
||||
StyleBtn(FBtnClear);
|
||||
StyleBtn(FBtnDec);
|
||||
StyleBtn(FBtnKbd);
|
||||
StyleBtn(FBtnClose);
|
||||
for i := 0 to CW_MSG_COUNT - 1 do StyleBtn(FMacroBtns[i]);
|
||||
// Переключатели: включённое состояние — акцентной рамкой и текстом.
|
||||
if FBtnDec <> nil then
|
||||
begin
|
||||
if FDecOn then
|
||||
begin
|
||||
FBtnDec.ClrBorder := T.BtnTextActive;
|
||||
FBtnDec.ClrText := T.BtnTextActive;
|
||||
end;
|
||||
FBtnDec.Invalidate;
|
||||
end;
|
||||
if FBtnKbd <> nil then
|
||||
begin
|
||||
if FKbdOn then
|
||||
begin
|
||||
FBtnKbd.ClrBorder := T.BtnTextActive;
|
||||
FBtnKbd.ClrText := T.BtnTextActive;
|
||||
end;
|
||||
FBtnKbd.Invalidate;
|
||||
end;
|
||||
if FInput <> nil then FInput.SetAppTheme(T);
|
||||
if FEdWPM <> nil then FEdWPM.SetAppTheme(T);
|
||||
if FLblStatus <> nil then FLblStatus.Font.Color := T.TextDim;
|
||||
if FLog <> nil then FLog.Invalidate;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -71,6 +71,10 @@ type
|
||||
procedure SelectAll;
|
||||
|
||||
property Text: string read FText write SetText;
|
||||
// Позиция курсора (в знаках, не в байтах). Нужна тем, кто задаёт текст
|
||||
// программно: SetText курсор НЕ двигает — он лишь клампится в диапазон, и
|
||||
// при внешней подстановке текста оставался бы в начале строки.
|
||||
property CaretPos: Integer read FCaretPos write SetCaretPos;
|
||||
property TextHint: string read FTextHint write SetTextHint;
|
||||
property PasswordChar: Char read FPasswordChar write SetPasswordChar;
|
||||
property MaxLength: Integer read FMaxLength write SetMaxLength;
|
||||
|
||||
+125
-1
@@ -43,7 +43,7 @@ uses
|
||||
WinFirewall,
|
||||
BoardUtils, WisdomBuilder, UISync,
|
||||
FlatEdit, FMRepeater,
|
||||
ChannelStore, ChannelsForm, CWMessagesForm, BeaconScopeForm, DMRDecoder,
|
||||
ChannelStore, ChannelsForm, CWMessagesForm, CWTerminalForm, BeaconScopeForm, DMRDecoder,
|
||||
PowerInhibit,
|
||||
DeviceStore,
|
||||
RadioBackend, PlutoBackend,
|
||||
@@ -368,6 +368,7 @@ type
|
||||
FTXProfileDropDown: TFlatDropDown;
|
||||
FChannelsForm: TObject; // TChannelsForm (cast при использовании)
|
||||
FCWMsgForm: TObject; // TCWMessagesForm (память телеграфа)
|
||||
FCWTermForm: TObject; // TCWTerminalForm (лента + набор с клавиатуры)
|
||||
FBeaconScopeForm: TBeaconScopeForm; // окно констелляции маяка (ПКМ по BEACON)
|
||||
|
||||
// ---- Right panel ----
|
||||
@@ -473,6 +474,8 @@ type
|
||||
procedure FreqDispBChanged(Sender: TObject; NewFreq: Int64);
|
||||
procedure BtnBandClick(Sender: TObject);
|
||||
procedure BtnModeClick(Sender: TObject);
|
||||
procedure BtnModeMouseDown(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
procedure BtnFilterClick(Sender: TObject);
|
||||
procedure BtnFilterMouseDown(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
@@ -766,6 +769,14 @@ type
|
||||
procedure OnTXSettingsChange(const T: TTXSettings);
|
||||
procedure OnCWSettingsChange(const C: TCWSettings);
|
||||
procedure ShowCWMessages;
|
||||
procedure ShowCWTerminal;
|
||||
procedure ServiceCWTerminal; // таймер: разбор + обновление окна
|
||||
procedure OnCWLogAppend(const S: string; IsTX: Boolean);
|
||||
procedure OnCWTermBackspace(Sender: TObject);
|
||||
procedure OnCWTermDecoder(Value: Boolean);
|
||||
procedure OnCWTermKbdKey(Dot, Dash: Boolean);
|
||||
procedure OnCWTermSpeed(WPM: Integer);
|
||||
procedure OnCWTermMacro(Sender: TObject);
|
||||
procedure OnCWMessageSend(const Text: string);
|
||||
procedure OnCWMessageAbort(Sender: TObject);
|
||||
procedure FormKeyDownCW(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
@@ -2423,6 +2434,7 @@ begin
|
||||
LeftPanelButtonWidth(LEFT_W, 4, i mod 4),
|
||||
BTN_SM, BtnModeClick);
|
||||
B.Tag := i;
|
||||
B.OnMouseDown := BtnModeMouseDown; // ПКМ по CWL/CWU → терминал
|
||||
BtnMode[i] := B;
|
||||
StyleButton(B, i = FController.FMode);
|
||||
end;
|
||||
@@ -3414,6 +3426,7 @@ begin
|
||||
if FDeviceDialog <> nil then FDeviceDialog.SetTheme(T);
|
||||
if FChannelsForm <> nil then TChannelsForm(FChannelsForm).ApplyTheme(T);
|
||||
if FCWMsgForm <> nil then TCWMessagesForm(FCWMsgForm).ApplyTheme(T);
|
||||
if FCWTermForm <> nil then TCWTerminalForm(FCWTermForm).ApplyTheme(T);
|
||||
if FBeaconScopeForm <> nil then FBeaconScopeForm.ApplyTheme(T);
|
||||
FController.FSettings.SaveTheme(V);
|
||||
FController.FSettings.Save;
|
||||
@@ -3691,6 +3704,8 @@ begin
|
||||
// Телеграф: фронты «железо в эфире» (у Pluto HP-статуса нет — гнать индикацию
|
||||
// и отпускать реле T/R после выдержки больше некому).
|
||||
FController.ServiceCWKeyed;
|
||||
// Телеграф: разбор принятого в текст + окно-терминал + лента под спектром.
|
||||
ServiceCWTerminal;
|
||||
// PureSignal: state machine команд + auto-attenuate + опрос GetPSInfo
|
||||
// (no-op на бэкендах без PS; рендер кнопок/поповера через rfPureSignal).
|
||||
FController.PureSignalTick;
|
||||
@@ -5584,6 +5599,17 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMainForm.BtnModeMouseDown(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
// ПКМ по CWL/CWU открывает телеграфный терминал — по той же идиоме, что ПКМ по
|
||||
// кнопке фильтра открывает редактор фильтров. ЛКМ не трогаем: переключение
|
||||
// режима не должно тащить за собой окно.
|
||||
begin
|
||||
if Button <> mbRight then Exit;
|
||||
if not ((Sender as TFlatButton).Tag in [MODE_CWL, MODE_CWU]) then Exit;
|
||||
ShowCWTerminal;
|
||||
end;
|
||||
|
||||
procedure TMainForm.BtnFilterMouseDown(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
// ПКМ по кнопке фильтра открывает редактор на этом слоте (эталон Thetis:
|
||||
@@ -8169,6 +8195,96 @@ begin
|
||||
TCWMessagesForm(FCWMsgForm).Show;
|
||||
end;
|
||||
|
||||
procedure TMainForm.ShowCWTerminal;
|
||||
begin
|
||||
if FCWTermForm = nil then
|
||||
begin
|
||||
FCWTermForm := TCWTerminalForm.Create(Self);
|
||||
TCWTerminalForm(FCWTermForm).OnSend := OnCWMessageSend;
|
||||
TCWTerminalForm(FCWTermForm).OnAbort := OnCWMessageAbort;
|
||||
TCWTerminalForm(FCWTermForm).OnBackspace := OnCWTermBackspace;
|
||||
TCWTerminalForm(FCWTermForm).OnDecoder := OnCWTermDecoder;
|
||||
TCWTerminalForm(FCWTermForm).OnKbdKey := OnCWTermKbdKey;
|
||||
TCWTerminalForm(FCWTermForm).OnSpeed := OnCWTermSpeed;
|
||||
TCWTerminalForm(FCWTermForm).OnMacro := OnCWTermMacro;
|
||||
// Лента собирается в контроллере (там же эхо своей передачи) и приходит
|
||||
// сюда прибавками — окно только рисует.
|
||||
FController.OnCWLog := OnCWLogAppend;
|
||||
end;
|
||||
TCWTerminalForm(FCWTermForm).LoadFrom(FController.CWSettings);
|
||||
TCWTerminalForm(FCWTermForm).ApplyTheme(CurrentAppTheme);
|
||||
TCWTerminalForm(FCWTermForm).Show;
|
||||
end;
|
||||
|
||||
procedure TMainForm.OnCWLogAppend(const S: string; IsTX: Boolean);
|
||||
begin
|
||||
if FCWTermForm <> nil then TCWTerminalForm(FCWTermForm).AppendLog(S, IsTX);
|
||||
end;
|
||||
|
||||
procedure TMainForm.OnCWTermBackspace(Sender: TObject);
|
||||
begin
|
||||
FController.CWXBackspace;
|
||||
end;
|
||||
|
||||
procedure TMainForm.OnCWTermDecoder(Value: Boolean);
|
||||
begin
|
||||
FController.SetCWDecoder(Value);
|
||||
end;
|
||||
|
||||
procedure TMainForm.OnCWTermKbdKey(Dot, Dash: Boolean);
|
||||
begin
|
||||
FController.CWKeyboardKey(Dot, Dash);
|
||||
end;
|
||||
|
||||
procedure TMainForm.OnCWTermSpeed(WPM: Integer);
|
||||
var C: TCWSettings;
|
||||
begin
|
||||
C := FController.CWSettings;
|
||||
if C.Speed = WPM then Exit;
|
||||
C.Speed := WPM;
|
||||
FController.SetCWSettings(C);
|
||||
end;
|
||||
|
||||
procedure TMainForm.OnCWTermMacro(Sender: TObject);
|
||||
var Slot: Integer;
|
||||
begin
|
||||
Slot := TComponent(Sender).Tag;
|
||||
if (Slot < 0) or (Slot >= CW_MSG_COUNT) then Exit;
|
||||
if FController.CWSettings.Messages[Slot] = '' then Exit;
|
||||
FController.CWXSend(FController.CWSettings.Messages[Slot]);
|
||||
end;
|
||||
|
||||
procedure TMainForm.ServiceCWTerminal;
|
||||
// Таймер: разбор принятого аудио + обновление окна и ленты под спектром.
|
||||
// Разбор идёт ВСЕГДА, когда декодер включён, даже если окно закрыто: лента под
|
||||
// спектром живёт сама по себе.
|
||||
var
|
||||
St: string;
|
||||
begin
|
||||
FController.ServiceCWDecoder;
|
||||
if FCWTermForm <> nil then
|
||||
begin
|
||||
TCWTerminalForm(FCWTermForm).SetPending(FController.CWXPendingText);
|
||||
if FController.CWDecoderOn then
|
||||
begin
|
||||
St := Format('RX %d WPM', [FController.CWDecSpeedWPM]);
|
||||
if FController.CWDecToneOffsetHz <> 0 then
|
||||
St := St + Format(', tone %+d Hz', [FController.CWDecToneOffsetHz]);
|
||||
if not FController.CWDecSignal then St := St + ', no signal';
|
||||
end
|
||||
else
|
||||
St := 'decoder off';
|
||||
// Набор молча уходит в никуда, если телеграф не вооружён (не CW, запрет
|
||||
// передачи на бэнде или в слоте трансвертера) — говорим об этом прямо.
|
||||
if not FController.CWTXActive then St := St + ' | TX not armed';
|
||||
TCWTerminalForm(FCWTermForm).SetStatus(St);
|
||||
end;
|
||||
if FPans[0] <> nil then
|
||||
if FPans[0].SetCWStrip(FController.CWSettings.DecoderStrip and FController.CWDecoderOn,
|
||||
FController.CWLogTail(300)) then
|
||||
ResizeSpectrumPanels; // строка появилась/пропала — переложить пан
|
||||
end;
|
||||
|
||||
procedure TMainForm.OnCWMessageSend(const Text: string);
|
||||
begin
|
||||
FController.CWXSend(Text);
|
||||
@@ -8188,6 +8304,13 @@ procedure TMainForm.FormKeyDownCW(Sender: TObject; var Key: Word;
|
||||
var Slot: Integer;
|
||||
begin
|
||||
if Shift <> [] then Exit;
|
||||
// F9 — окно телеграфного терминала (лента приёма + набор с клавиатуры).
|
||||
if Key = VK_F9 then
|
||||
begin
|
||||
Key := 0;
|
||||
ShowCWTerminal;
|
||||
Exit;
|
||||
end;
|
||||
if (Key < VK_F1) or (Key > VK_F8) then Exit;
|
||||
if not (FController.ActiveTXMode in [MODE_CWL, MODE_CWU]) then Exit;
|
||||
Slot := Key - VK_F1;
|
||||
@@ -9124,6 +9247,7 @@ begin
|
||||
SF.OnTXChange := OnTXSettingsChange;
|
||||
SF.OnCWChange := OnCWSettingsChange;
|
||||
SF.OnCWMessagesOpen := ShowCWMessages;
|
||||
SF.OnCWTerminalOpen := ShowCWTerminal;
|
||||
SF.OnTXProfileSelect := OnTXProfileSelectFromSettings;
|
||||
SF.OnTXProfileAdd := OnTXProfileAddFromSettings;
|
||||
SF.OnTXProfileRename := OnTXProfileRenameFromSettings;
|
||||
|
||||
@@ -115,6 +115,14 @@ type
|
||||
FBtnAddPan: TFlatButton; // «⊞» в ряду пан/зума (только пан 0)
|
||||
FHeaderVisible: Boolean;
|
||||
FShowZoomRow: Boolean; // False у панов N>0 (пан-зум — этап 3.3+)
|
||||
// Бегущая лента расшифровки телеграфа под спектром (только пан 0). Своя
|
||||
// строка, а не окно: смотреть в эфир и читать расшифровку удобнее в одном
|
||||
// месте, а полноценный терминал открывается отдельно.
|
||||
FCWStripOn: Boolean;
|
||||
FCWStripText: string;
|
||||
FPbCWStrip: TPaintBox;
|
||||
FThemeBG: TColor;
|
||||
FThemeText: TColor;
|
||||
FOnPanClose: TNotifyEvent;
|
||||
FOnAddPan: TNotifyEvent;
|
||||
FAddPanWanted: Boolean; // хозяин: показывать «⊞» в ряду пан/зума
|
||||
@@ -152,6 +160,7 @@ type
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
procedure PanZoomDblClick(Sender: TObject);
|
||||
procedure PositionPanZoomBar(X0, BottomY, RW, H: Integer; AVisible: Boolean);
|
||||
procedure CWStripPaint(Sender: TObject);
|
||||
public
|
||||
// Обработчики мыши спектра/водопада и кликов зум-кнопок хозяина —
|
||||
// задать ДО вызова Build (Build подвешивает их на создаваемые контролы).
|
||||
@@ -245,6 +254,9 @@ type
|
||||
property BtnAddPan: TFlatButton read FBtnAddPan;
|
||||
// Ряд пан/зума: у панов N>0 скрыт (их зум — этап 3.3+).
|
||||
property ShowZoomRow: Boolean read FShowZoomRow write FShowZoomRow;
|
||||
// Лента расшифровки телеграфа: включить/выключить и обновить текст.
|
||||
// True — состояние видимости изменилось, хозяину нужно переразложить пан.
|
||||
function SetCWStrip(AOn: Boolean; const AText: string): Boolean;
|
||||
// «⊞» в ряду пан/зума (пан 0): показать/спрятать решает хозяин.
|
||||
property AddPanEnabled: Boolean read FAddPanWanted write FAddPanWanted;
|
||||
// «▦/▤» тумблер грид-раскладки (пан 0, виден при >=2 доп. панах).
|
||||
@@ -432,6 +444,12 @@ begin
|
||||
FPbPanZoom.OnMouseUp := PanZoomMouseUp;
|
||||
FPbPanZoom.OnDblClick := PanZoomDblClick;
|
||||
FZoomBar.PaintBox := FPbPanZoom;
|
||||
|
||||
// ---- Лента расшифровки телеграфа (пан 0, включается хозяином) ----
|
||||
FPbCWStrip := TPaintBox.Create(Self);
|
||||
FPbCWStrip.Parent := AParent;
|
||||
FPbCWStrip.OnPaint := CWStripPaint;
|
||||
FPbCWStrip.Visible := False;
|
||||
FBtnZoomOut := MakeFlatBtn(AParent, '−', 0, 0, 10, 10, ZoomOutClick);
|
||||
FBtnZoomDef := MakeFlatBtn(AParent, '⌂', 0, 0, 10, 10, ZoomDefClick);
|
||||
FBtnZoomIn := MakeFlatBtn(AParent, '+', 0, 0, 10, 10, ZoomInClick);
|
||||
@@ -501,6 +519,7 @@ begin
|
||||
FSplitter.Parent := NewParent;
|
||||
FPbWaterfall.Parent := NewParent;
|
||||
FPbPanZoom.Parent := NewParent;
|
||||
if FPbCWStrip <> nil then FPbCWStrip.Parent := NewParent;
|
||||
FBtnZoomOut.Parent := NewParent;
|
||||
FBtnZoomDef.Parent := NewParent;
|
||||
FBtnZoomIn.Parent := NewParent;
|
||||
@@ -668,6 +687,44 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPanafallPanel.SetCWStrip(AOn: Boolean; const AText: string): Boolean;
|
||||
// Хозяин зовёт с таймера. Раскладку трогаем только на смене видимости — текст
|
||||
// меняется по несколько знаков в секунду, и дёргать Layout на каждый знак
|
||||
// незачем.
|
||||
begin
|
||||
Result := AOn <> FCWStripOn;
|
||||
FCWStripOn := AOn;
|
||||
if AText <> FCWStripText then
|
||||
begin
|
||||
FCWStripText := AText;
|
||||
if (FPbCWStrip <> nil) and FPbCWStrip.Visible then FPbCWStrip.Invalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPanafallPanel.CWStripPaint(Sender: TObject);
|
||||
// Хвост расшифровки, вытянутый по ширине: сколько знаков влезло, столько и
|
||||
// показываем (лента, а не журнал — история живёт в окне терминала).
|
||||
var
|
||||
C: TCanvas;
|
||||
Cols, ChW: Integer;
|
||||
S: string;
|
||||
begin
|
||||
if FPbCWStrip = nil then Exit;
|
||||
C := FPbCWStrip.Canvas;
|
||||
C.Brush.Color := FThemeBG;
|
||||
C.FillRect(0, 0, FPbCWStrip.Width, FPbCWStrip.Height);
|
||||
C.Font.Name := {$IFDEF WINDOWS}'Consolas'{$ELSE}'Monospace'{$ENDIF};
|
||||
C.Font.Size := 9;
|
||||
C.Font.Color := FThemeText;
|
||||
C.Brush.Style := bsClear;
|
||||
ChW := C.TextWidth('W');
|
||||
if ChW <= 0 then ChW := 8;
|
||||
Cols := Max(1, (FPbCWStrip.Width - DpiScale(8)) div ChW);
|
||||
S := FCWStripText;
|
||||
if Length(S) > Cols then S := Copy(S, Length(S) - Cols + 1, Cols);
|
||||
C.TextOut(DpiScale(4), DpiScale(2), S);
|
||||
end;
|
||||
|
||||
procedure TPanafallPanel.PositionPanZoomBar(X0, BottomY, RW, H: Integer;
|
||||
AVisible: Boolean);
|
||||
var BtnW, Gap, StripW, X, NBtns: Integer; WantAdd, WantGrid: Boolean;
|
||||
@@ -725,6 +782,8 @@ begin
|
||||
if FHeaderVisible then Inc(Result, HEADER_H);
|
||||
if (AShowSpectrum or AShowWaterfall) and FShowZoomRow then
|
||||
Inc(Result, PANZOOM_H);
|
||||
if FCWStripOn and (AShowSpectrum or AShowWaterfall) then
|
||||
Inc(Result, DpiScale(20));
|
||||
if AShowSpectrum then Inc(Result, MIN_SH + RULER_H);
|
||||
if AShowWaterfall then
|
||||
begin
|
||||
@@ -746,6 +805,7 @@ var
|
||||
RULER_H: Integer;
|
||||
PANZOOM_H: Integer;
|
||||
HEADER_H: Integer;
|
||||
CWSTRIP_H: Integer;
|
||||
ShowPZ: Boolean;
|
||||
EffRatio: Double;
|
||||
begin
|
||||
@@ -784,6 +844,17 @@ begin
|
||||
ShowPZ := (AShowSpectrum or AShowWaterfall) and FShowZoomRow;
|
||||
PositionPanZoomBar(X0, RH - PANZOOM_H, RW, PANZOOM_H, ShowPZ);
|
||||
if ShowPZ then RH := RH - PANZOOM_H;
|
||||
// Лента расшифровки телеграфа — ещё одной строкой над рядом пан/зума.
|
||||
if FPbCWStrip <> nil then
|
||||
begin
|
||||
FPbCWStrip.Visible := FCWStripOn and (AShowSpectrum or AShowWaterfall);
|
||||
if FPbCWStrip.Visible then
|
||||
begin
|
||||
CWSTRIP_H := DpiScale(20);
|
||||
FPbCWStrip.SetBounds(X0, RH - CWSTRIP_H, RW, CWSTRIP_H);
|
||||
RH := RH - CWSTRIP_H;
|
||||
end;
|
||||
end;
|
||||
TopOff := ATopOffset + FStackTop;
|
||||
if FHeaderVisible then Inc(TopOff, HEADER_H);
|
||||
|
||||
@@ -1533,6 +1604,10 @@ end;
|
||||
procedure TPanafallPanel.SetFlagsTheme(const T: TAppTheme);
|
||||
var i: Integer;
|
||||
begin
|
||||
// Лента расшифровки рисуется своими руками — цвета держим здесь же.
|
||||
FThemeBG := T.Panel;
|
||||
FThemeText := T.Text;
|
||||
if (FPbCWStrip <> nil) and FPbCWStrip.Visible then FPbCWStrip.Invalidate;
|
||||
if Assigned(FMainFlag) then FMainFlag.SetTheme(T);
|
||||
for i := 0 to High(FSliceFlags) do
|
||||
if Assigned(FSliceFlags[i]) then FSliceFlags[i].SetTheme(T);
|
||||
|
||||
+194
-1
@@ -50,7 +50,8 @@ uses
|
||||
Classes, SysUtils, Math,
|
||||
HPSDRProtocol, HPSDRNetwork, RadioBackend, PlutoBackend, IIOBindings,
|
||||
WDSPEngine, AudioOutput, AudioInput, BeaconDecoder, BeaconFEC, DMRDecoder,
|
||||
Settings, ChannelStore, FMRepeater, BoardUtils, DeviceStore, CWMorse, CWKeyer;
|
||||
Settings, ChannelStore, FMRepeater, BoardUtils, DeviceStore, CWMorse, CWKeyer,
|
||||
CWDecoder;
|
||||
|
||||
// Панадаптеры (этап 3): потолок MAX_PANS живёт в WDSPEngine (общий для
|
||||
// движка/контроллера/UI). Фактический лимит бэкенда — Caps.MaxPans (Pluto=1).
|
||||
@@ -103,6 +104,11 @@ type
|
||||
// Сырьё спектра/водопада наружу (фронтенды рисуют). Вызывается из DSP-потока.
|
||||
TPixelDataEvent = procedure(const Pixels: array of Single; Count: Integer) of object;
|
||||
|
||||
// Лента телеграфа для окна-терминала: прибавка текста и чья она — принятая
|
||||
// декодером или эхо собственной передачи (окно красит их по-разному).
|
||||
// Зовётся из потока хозяина (ServiceCWDecoder), не из DSP.
|
||||
TCWLogEvent = procedure(const S: string; IsTX: Boolean) of object;
|
||||
|
||||
// Снимок состояния для синхронизации нового фронтенда (Arduino/Web на connect).
|
||||
TRadioSnapshot = record
|
||||
VfoA, VfoB, CenterFreq, SpanHz: Double;
|
||||
@@ -470,6 +476,15 @@ type
|
||||
// Локальный кейер вооружён — считается в SyncCWKeyer, читается пейсингом
|
||||
// частоты DUC (CWCarrierOffsetHz) и аттенюатором Pluto.
|
||||
FCWLocalArmed: Boolean;
|
||||
// ---- Декодер приёма (CWDecoder.pas) --------------------------------------
|
||||
// Создаётся лениво вместе с окном-терминалом. Кормится из OnDemodAudioReady
|
||||
// (до громкости и мьюта, без сайдтона), разбирается на таймере хозяина.
|
||||
FCWDec: TCWDecoder;
|
||||
// Лента расшифровки: последние знаки приёма (для полосы под спектром) и
|
||||
// счётчик, по которому потребители понимают, что появилось новое.
|
||||
FCWLogText: string;
|
||||
FCWLogSeq: Int64;
|
||||
FOnCWLog: TCWLogEvent;
|
||||
FAlexSettings: TAlexSettings;
|
||||
FOCSettings: TOCSettings; // OC Control (Open Collector, openHPSDR-only)
|
||||
// Антенные разъёмы AD936x (Pluto/LibreSDR) на диапазон/трансвертер.
|
||||
@@ -1006,6 +1021,27 @@ type
|
||||
procedure CWXSend(const Text: string);
|
||||
procedure CWXAbort;
|
||||
function CWXBusy: Boolean;
|
||||
// ---- Окно-терминал -----------------------------------------------------
|
||||
// Стереть последний НЕ ушедший в эфир знак (Backspace при наборе).
|
||||
function CWXBackspace: Boolean;
|
||||
// Что ещё стоит в очереди передачи (строка набора показывает именно это).
|
||||
function CWXPendingText: string;
|
||||
// Ключ с клавиатуры: при иамбике — лепестки, при прямом ключе — уровень.
|
||||
// На кейере прошивки лепестков нет (их читает FPGA со своего разъёма),
|
||||
// поэтому там клавиатура работает через бит CWX, то есть прямым ключом.
|
||||
procedure CWKeyboardKey(Dot, Dash: Boolean);
|
||||
// Разбор принимаемого телеграфа: включение и обслуживание (таймер хозяина).
|
||||
procedure SetCWDecoder(On_: Boolean);
|
||||
function CWDecoderOn: Boolean;
|
||||
procedure ServiceCWDecoder;
|
||||
// Последние знаки ленты (для полосы под спектром) и счётчик изменений.
|
||||
function CWLogTail(MaxChars: Integer): string;
|
||||
property CWLogSeq: Int64 read FCWLogSeq;
|
||||
// Оценка скорости корреспондента и расстройка тона (индикация в терминале).
|
||||
function CWDecSpeedWPM: Integer;
|
||||
function CWDecToneOffsetHz: Integer;
|
||||
function CWDecSignal: Boolean;
|
||||
property OnCWLog: TCWLogEvent read FOnCWLog write FOnCWLog;
|
||||
|
||||
// ---- PureSignal ----
|
||||
// Доступность PS у активного бэкенда/платы (Caps.HasPureSignal).
|
||||
@@ -1345,7 +1381,11 @@ begin
|
||||
FCWSender.AbortSending;
|
||||
FreeAndNil(FCWSender);
|
||||
end;
|
||||
if Assigned(FCWDec) then FCWDec.Enabled := False; // кольцо больше не кормим
|
||||
FreeEngines;
|
||||
// Декодер — ПОСЛЕ движка: его кольцо наполняет DSP-поток, и освобождать
|
||||
// объект, пока поток жив, нельзя.
|
||||
if Assigned(FCWDec) then FreeAndNil(FCWDec);
|
||||
FreeAndNil(FDeviceStore);
|
||||
FreeAndNil(FSettings);
|
||||
inherited Destroy;
|
||||
@@ -1728,6 +1768,14 @@ begin
|
||||
end
|
||||
else if Assigned(FDMRDec) and FDMRDec.Enabled then
|
||||
FDMRDec.SetEnabled(False);
|
||||
// ★Телеграфный декодер кормим отсюда же: здесь аудио идёт ДО громкости и
|
||||
// мьюта и БЕЗ программного сайдтона (он подмешивается позже, в OnAudioReady),
|
||||
// зато уже после узкого CW-фильтра — лучшего предетектора не найти.
|
||||
// На своей передаче молчим: в телеграфе приёмник намеренно жив, и собственный
|
||||
// сигнал (особенно в полном дуплексе Pluto) забил бы ленту своей же работой.
|
||||
if Assigned(FCWDec) and FCWDec.Enabled
|
||||
and (FMode in [MODE_CWL, MODE_CWU]) and (not RadioKeyed) then
|
||||
FCWDec.FeedAudio(Left, Count);
|
||||
end;
|
||||
|
||||
procedure TRadioController.OnDMRAudioReady(const PCM: array of Single;
|
||||
@@ -5902,6 +5950,19 @@ begin
|
||||
// запрет передачи, разбирает SyncCWKeyer — одна дверь на всё).
|
||||
PushCWLocalConfig;
|
||||
SyncCWKeyer;
|
||||
// Декодер слушает на том же pitch и стартует адаптацию со своей скорости.
|
||||
// Создаём лениво прямо здесь: настройки — единственная дверь, через которую
|
||||
// он включается (галка в настройках, кнопка в терминале, загрузка профиля).
|
||||
if FCWSettings.Decoder and (not Assigned(FCWDec)) then
|
||||
begin
|
||||
FCWDec := TCWDecoder.Create;
|
||||
FCWDec.SetSpeedHint(FCWSettings.Speed);
|
||||
end;
|
||||
if Assigned(FCWDec) then
|
||||
begin
|
||||
FCWDec.SetPitch(FCWSettings.Pitch);
|
||||
FCWDec.Enabled := FCWSettings.Decoder;
|
||||
end;
|
||||
// Тон TUN в телеграфе равен pitch (несущая обязана лечь на VFO, см. SetTune):
|
||||
// если крутят pitch прямо на настройке — обновляем живьём.
|
||||
if FTuning and FWDSPReady and Assigned(FDSPEngine)
|
||||
@@ -6136,6 +6197,126 @@ begin
|
||||
if Assigned(FCWLocal) then FCWLocal.AbortText;
|
||||
end;
|
||||
|
||||
function TRadioController.CWXBackspace: Boolean;
|
||||
begin
|
||||
if CWLocalSource then
|
||||
Result := Assigned(FCWLocal) and FCWLocal.Backspace
|
||||
else
|
||||
Result := Assigned(FCWSender) and FCWSender.Backspace;
|
||||
end;
|
||||
|
||||
function TRadioController.CWXPendingText: string;
|
||||
begin
|
||||
if CWLocalSource then
|
||||
begin
|
||||
if Assigned(FCWLocal) then Result := FCWLocal.PendingText else Result := '';
|
||||
end
|
||||
else
|
||||
begin
|
||||
if Assigned(FCWSender) then Result := FCWSender.PendingText else Result := '';
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRadioController.CWKeyboardKey(Dot, Dash: Boolean);
|
||||
// Манипулятор с клавиатуры. У локального генератора это те же лепестки, что с
|
||||
// COM-порта — включая иамбик. У кейера прошивки лепестков нет: их читает FPGA
|
||||
// со своего разъёма, а из программы доступен только бит CWX, то есть прямой
|
||||
// ключ (это же ограничение у Thetis).
|
||||
begin
|
||||
if not CWTXActive then
|
||||
begin
|
||||
// Разоружены (не CW, запрет передачи) — ключ обязан быть отпущен, иначе
|
||||
// несущая повиснет при выходе из режима с зажатой клавишей.
|
||||
if Assigned(FCWLocal) then FCWLocal.Paddle(False, False);
|
||||
CWXKeyEvent(False);
|
||||
Exit;
|
||||
end;
|
||||
if CWLocalSource then
|
||||
begin
|
||||
EnsureCWLocal;
|
||||
SyncCWKeyer;
|
||||
FCWLocal.Paddle(Dot, Dash);
|
||||
end
|
||||
else
|
||||
CWXKeyEvent(Dot or Dash);
|
||||
end;
|
||||
|
||||
procedure TRadioController.SetCWDecoder(On_: Boolean);
|
||||
begin
|
||||
FCWSettings.Decoder := On_;
|
||||
if On_ then
|
||||
begin
|
||||
if not Assigned(FCWDec) then FCWDec := TCWDecoder.Create;
|
||||
FCWDec.SetPitch(FCWSettings.Pitch);
|
||||
FCWDec.SetSpeedHint(FCWSettings.Speed); // старт адаптации со своей скорости
|
||||
FCWDec.Reset;
|
||||
FCWDec.Enabled := True;
|
||||
end
|
||||
else if Assigned(FCWDec) then
|
||||
FCWDec.Enabled := False;
|
||||
if FDevConnected and Assigned(FSettings) then
|
||||
begin
|
||||
FSettings.SaveCW(FDevMAC, FCWSettings);
|
||||
FSettings.Save;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TRadioController.CWDecoderOn: Boolean;
|
||||
begin
|
||||
Result := Assigned(FCWDec) and FCWDec.Enabled;
|
||||
end;
|
||||
|
||||
procedure TRadioController.ServiceCWDecoder;
|
||||
// Поток хозяина (таймер GUI / цикл демона): разбор накопленного аудио и сборка
|
||||
// ленты. Здесь же эхо собственной передачи — чтобы в окне была цельная лента
|
||||
// связи, а не только принятое.
|
||||
var
|
||||
S: string;
|
||||
|
||||
procedure Append(const Txt: string; IsTX: Boolean);
|
||||
begin
|
||||
if Txt = '' then Exit;
|
||||
FCWLogText := FCWLogText + Txt;
|
||||
if Length(FCWLogText) > 8192 then
|
||||
FCWLogText := Copy(FCWLogText, Length(FCWLogText) - 8191, 8192);
|
||||
Inc(FCWLogSeq, Length(Txt));
|
||||
if Assigned(FOnCWLog) then FOnCWLog(Txt, IsTX);
|
||||
end;
|
||||
|
||||
begin
|
||||
// Эхо передачи забираем всегда: терминал показывает свою работу и при
|
||||
// выключенном декодере.
|
||||
if Assigned(FCWLocal) then Append(FCWLocal.TakeSentText, True);
|
||||
if Assigned(FCWSender) then Append(FCWSender.TakeSentText, True);
|
||||
if not Assigned(FCWDec) then Exit;
|
||||
if not FCWDec.Enabled then Exit;
|
||||
FCWDec.Process;
|
||||
S := FCWDec.TakeText;
|
||||
Append(S, False);
|
||||
end;
|
||||
|
||||
function TRadioController.CWLogTail(MaxChars: Integer): string;
|
||||
begin
|
||||
if MaxChars <= 0 then Exit('');
|
||||
if Length(FCWLogText) <= MaxChars then Result := FCWLogText
|
||||
else Result := Copy(FCWLogText, Length(FCWLogText) - MaxChars + 1, MaxChars);
|
||||
end;
|
||||
|
||||
function TRadioController.CWDecSpeedWPM: Integer;
|
||||
begin
|
||||
if Assigned(FCWDec) then Result := FCWDec.SpeedWPM else Result := 0;
|
||||
end;
|
||||
|
||||
function TRadioController.CWDecToneOffsetHz: Integer;
|
||||
begin
|
||||
if Assigned(FCWDec) then Result := FCWDec.ToneOffsetHz else Result := 0;
|
||||
end;
|
||||
|
||||
function TRadioController.CWDecSignal: Boolean;
|
||||
begin
|
||||
Result := Assigned(FCWDec) and FCWDec.SignalPresent;
|
||||
end;
|
||||
|
||||
function TRadioController.MixSidetone(const Left, Right: array of Single;
|
||||
Count: Integer): Boolean;
|
||||
// DSP-поток. Генератор синуса на pitch с трапецеидальной огибающей — без неё
|
||||
@@ -6943,6 +7124,18 @@ begin
|
||||
FDSPEngine.SetCWPitch(FCWSettings.Pitch);
|
||||
FDSPEngine.SetCWSpeed(FCWSettings.Speed);
|
||||
end;
|
||||
// Декодер приёма — по настройке этого устройства (создаётся лениво).
|
||||
if FCWSettings.Decoder and (not Assigned(FCWDec)) then
|
||||
begin
|
||||
FCWDec := TCWDecoder.Create;
|
||||
FCWDec.SetSpeedHint(FCWSettings.Speed);
|
||||
end;
|
||||
if Assigned(FCWDec) then
|
||||
begin
|
||||
FCWDec.SetPitch(FCWSettings.Pitch);
|
||||
FCWDec.Reset;
|
||||
FCWDec.Enabled := FCWSettings.Decoder;
|
||||
end;
|
||||
FSettings.LoadAlex(FDevMAC, FAlexSettings);
|
||||
FSettings.LoadAnt936x(FDevMAC, FAnt936x);
|
||||
FNetwork.SetAlexConfig(FAlexSettings);
|
||||
|
||||
@@ -361,6 +361,10 @@ type
|
||||
KeyInvert: Boolean;
|
||||
KeyPowerDTR: Boolean;
|
||||
KeyPowerRTS: Boolean;
|
||||
// ---- Окно-терминал: набор с клавиатуры + декодер приёма ----------------
|
||||
Decoder: Boolean; // разбирать принимаемый телеграф в текст
|
||||
DecoderStrip: Boolean; // бегущая лента расшифровки под спектром
|
||||
KbdKey: Boolean; // Ctrl в окне терминала работает манипулятором
|
||||
end;
|
||||
|
||||
// ---- TX-профили (именованные снимки «как я звучу») ----------------------
|
||||
@@ -1821,6 +1825,9 @@ begin
|
||||
C.KeyInvert := False;
|
||||
C.KeyPowerDTR := True; // типовая распайка: ключ питается от DTR/RTS
|
||||
C.KeyPowerRTS := True;
|
||||
C.Decoder := True; // окно терминала без декодера бессмысленно
|
||||
C.DecoderStrip := False; // лента под спектром — по желанию
|
||||
C.KbdKey := False; // Ctrl-манипулятор включают осознанно
|
||||
// Заводские заготовки: типовой вызов, ответ и стандартные концовки.
|
||||
C.Messages[0] := 'CQ CQ DE ';
|
||||
C.Messages[1] := 'DE ';
|
||||
@@ -1867,6 +1874,9 @@ begin
|
||||
C.KeyInvert := JB(O,'key_invert', C.KeyInvert);
|
||||
C.KeyPowerDTR := JB(O,'key_power_dtr', C.KeyPowerDTR);
|
||||
C.KeyPowerRTS := JB(O,'key_power_rts', C.KeyPowerRTS);
|
||||
C.Decoder := JB(O,'decoder', C.Decoder);
|
||||
C.DecoderStrip := JB(O,'decoder_strip', C.DecoderStrip);
|
||||
C.KbdKey := JB(O,'kbd_key', C.KbdKey);
|
||||
for i := 0 to CW_MSG_COUNT - 1 do
|
||||
C.Messages[i] := Copy(JS(O, 'msg_' + IntToStr(i), C.Messages[i]), 1, 63);
|
||||
end;
|
||||
@@ -1900,6 +1910,9 @@ begin
|
||||
JW(O,'key_invert', C.KeyInvert);
|
||||
JW(O,'key_power_dtr', C.KeyPowerDTR);
|
||||
JW(O,'key_power_rts', C.KeyPowerRTS);
|
||||
JW(O,'decoder', C.Decoder);
|
||||
JW(O,'decoder_strip', C.DecoderStrip);
|
||||
JW(O,'kbd_key', C.KbdKey);
|
||||
for i := 0 to CW_MSG_COUNT - 1 do
|
||||
JWS(O, 'msg_' + IntToStr(i), C.Messages[i]);
|
||||
end;
|
||||
|
||||
+34
-16
@@ -61,6 +61,7 @@ type
|
||||
TOnTXSettingsChange = procedure(const T: TTXSettings) of object;
|
||||
TOnCWSettingsChange = procedure(const C: TCWSettings) of object;
|
||||
TOnCWMessagesOpen = procedure of object;
|
||||
TOnCWTerminalOpen = procedure of object;
|
||||
// TX-профили: выбор/переименование/удаление по индексу, создание — по имени.
|
||||
TOnTXProfileIdx = procedure(Idx: Integer) of object;
|
||||
TOnTXProfileName = procedure(const AName: string) of object;
|
||||
@@ -312,6 +313,8 @@ type
|
||||
FEdCWKeyPort: TFlatEdit;
|
||||
FCmbCWDotLine: TFlatComboBox;
|
||||
FCmbCWDashLine: TFlatComboBox;
|
||||
FChkCWDecoder: TFlatCheckBox;
|
||||
FChkCWDecStrip: TFlatCheckBox;
|
||||
FChkCWKeyInvert: TFlatCheckBox;
|
||||
FChkCWKeyDTR: TFlatCheckBox;
|
||||
FChkCWKeyRTS: TFlatCheckBox;
|
||||
@@ -479,6 +482,7 @@ type
|
||||
FOnTXChange: TOnTXSettingsChange;
|
||||
FOnCWChange: TOnCWSettingsChange;
|
||||
FOnCWMessagesOpen: TOnCWMessagesOpen;
|
||||
FOnCWTerminalOpen: TOnCWTerminalOpen;
|
||||
FOnTXProfileSelect: TOnTXProfileIdx;
|
||||
FOnTXProfileAdd: TOnTXProfileName;
|
||||
FOnTXProfileRename: TOnTXProfileIdxName;
|
||||
@@ -537,6 +541,7 @@ type
|
||||
procedure FireCWChange;
|
||||
procedure OnCWAnyChange(Sender: TObject);
|
||||
procedure BtnCWMessagesClick(Sender: TObject);
|
||||
procedure BtnCWTerminalClick(Sender: TObject);
|
||||
procedure OnMicJackChange(Sender: TObject);
|
||||
procedure UpdateMicJackVisibility;
|
||||
// Подвкладки и полоса профиля на странице Transmit
|
||||
@@ -720,6 +725,7 @@ type
|
||||
property OnTXChange: TOnTXSettingsChange read FOnTXChange write FOnTXChange;
|
||||
property OnCWChange: TOnCWSettingsChange read FOnCWChange write FOnCWChange;
|
||||
property OnCWMessagesOpen: TOnCWMessagesOpen read FOnCWMessagesOpen write FOnCWMessagesOpen;
|
||||
property OnCWTerminalOpen: TOnCWTerminalOpen read FOnCWTerminalOpen write FOnCWTerminalOpen;
|
||||
property OnTXProfileSelect: TOnTXProfileIdx read FOnTXProfileSelect write FOnTXProfileSelect;
|
||||
property OnTXProfileAdd: TOnTXProfileName read FOnTXProfileAdd write FOnTXProfileAdd;
|
||||
property OnTXProfileRename: TOnTXProfileIdxName read FOnTXProfileRename write FOnTXProfileRename;
|
||||
@@ -2056,15 +2062,16 @@ begin
|
||||
|
||||
// ---- CW: телеграфом в openHPSDR P2 управляет прошивка -------------------
|
||||
Inc(Y, 190 + 12);
|
||||
Grp := MakeGroupPanel(FTXSubPage[2], 'CW (telegraphy)', MARGIN, Y, GRP_W, 460);
|
||||
Grp := MakeGroupPanel(FTXSubPage[2], 'CW (telegraphy)', MARGIN, Y, GRP_W, 502);
|
||||
|
||||
MakeLbl(Grp, 'Keyer', PAD, R1 - 1, 50);
|
||||
FCmbCWKeyerSrc := MkCmbCW(Grp, PAD + 54, R1 - 6, 194);
|
||||
FCmbCWKeyerSrc.Items.AddStrings(['Radio firmware','Software (PC)','Off (MOX only)']);
|
||||
FCmbCWKeyerSrc.ItemIndex := 0;
|
||||
MkBtn(Grp, PAD + 260, R1 - 6, 110, 'Messages...', BtnCWMessagesClick);
|
||||
MakeLbl(Grp, 'Pitch (Hz)', PAD + 400, R1 - 1, 90);
|
||||
FEdCWPitch := MkSpinCW(Grp, PAD + 500, R1 - 6, 200, 1200, 600);
|
||||
MkBtn(Grp, PAD + 260, R1 - 6, 100, 'Messages...', BtnCWMessagesClick);
|
||||
MkBtn(Grp, PAD + 366, R1 - 6, 100, 'Terminal...', BtnCWTerminalClick);
|
||||
MakeLbl(Grp, 'Pitch (Hz)', PAD + 480, R1 - 1, 90);
|
||||
FEdCWPitch := MkSpinCW(Grp, PAD + 574, R1 - 6, 200, 1200, 600);
|
||||
|
||||
MakeLbl(Grp, 'Keyer mode', PAD, R1 + STEP + 5, LW);
|
||||
FCmbCWKeyerMode := MkCmbCW(Grp, CX, R1 + STEP, 200);
|
||||
@@ -2097,29 +2104,31 @@ begin
|
||||
MakeLbl(Grp, 'Carrier offset (Hz)', PAD, R1 + 5 * STEP + 5, LW);
|
||||
FEdCWOffset := MkSpinCW(Grp, CX, R1 + 5 * STEP, -1, 48000, 0);
|
||||
MakeLbl(Grp, '0 = auto, -1 = none (software keyer only)', PAD + 320, R1 + 5 * STEP + 5, 260);
|
||||
FChkCWDecoder := MkChkCW(Grp, PAD, R1 + 6 * STEP, 160, 'Decode RX');
|
||||
FChkCWDecStrip := MkChkCW(Grp, PAD + 176, R1 + 6 * STEP, 210, 'Text under spectrum');
|
||||
|
||||
FChkCWKeyPort := MkChkCW(Grp, PAD, R1 + 6 * STEP, 250, 'Paddle on serial port');
|
||||
FChkCWKeyPort := MkChkCW(Grp, PAD, R1 + 7 * STEP, 250, 'Paddle on serial port');
|
||||
FEdCWKeyPort := TFlatEdit.Create(Self);
|
||||
FEdCWKeyPort.Parent := Grp;
|
||||
FEdCWKeyPort.SetBounds(DpiScale(PAD + 260), DpiScale(R1 + 6 * STEP),
|
||||
FEdCWKeyPort.SetBounds(DpiScale(PAD + 260), DpiScale(R1 + 7 * STEP),
|
||||
DpiScale(220), DpiScale(BTN_H));
|
||||
FEdCWKeyPort.Color := CLR_INPUT;
|
||||
FEdCWKeyPort.Font.Color := CLR_INPUT_TEXT;
|
||||
FEdCWKeyPort.Font.Size := 9;
|
||||
FEdCWKeyPort.OnExit := OnCWAnyChange;
|
||||
MakeLbl(Grp, '/dev/ttyUSB0, COM3', PAD + 492, R1 + 6 * STEP + 5, 200);
|
||||
MakeLbl(Grp, '/dev/ttyUSB0, COM3', PAD + 492, R1 + 7 * STEP + 5, 200);
|
||||
|
||||
MakeLbl(Grp, 'Dot line', PAD, R1 + 7 * STEP + 5, 70);
|
||||
FCmbCWDotLine := MkCmbCW(Grp, PAD + 74, R1 + 7 * STEP, 90);
|
||||
MakeLbl(Grp, 'Dot line', PAD, R1 + 8 * STEP + 5, 70);
|
||||
FCmbCWDotLine := MkCmbCW(Grp, PAD + 74, R1 + 8 * STEP, 90);
|
||||
FCmbCWDotLine.Items.AddStrings(['CTS','DSR','DCD','RI']);
|
||||
FCmbCWDotLine.ItemIndex := 0;
|
||||
MakeLbl(Grp, 'Dash line', PAD + 176, R1 + 7 * STEP + 5, 74);
|
||||
FCmbCWDashLine := MkCmbCW(Grp, PAD + 254, R1 + 7 * STEP, 90);
|
||||
MakeLbl(Grp, 'Dash line', PAD + 176, R1 + 8 * STEP + 5, 74);
|
||||
FCmbCWDashLine := MkCmbCW(Grp, PAD + 254, R1 + 8 * STEP, 90);
|
||||
FCmbCWDashLine.Items.AddStrings(['CTS','DSR','DCD','RI']);
|
||||
FCmbCWDashLine.ItemIndex := 1;
|
||||
FChkCWKeyInvert := MkChkCW(Grp, PAD + 360, R1 + 7 * STEP, 90, 'Invert');
|
||||
FChkCWKeyDTR := MkChkCW(Grp, PAD + 456, R1 + 7 * STEP, 100, 'DTR power');
|
||||
FChkCWKeyRTS := MkChkCW(Grp, PAD + 562, R1 + 7 * STEP, 100, 'RTS power');
|
||||
FChkCWKeyInvert := MkChkCW(Grp, PAD + 360, R1 + 8 * STEP, 90, 'Invert');
|
||||
FChkCWKeyDTR := MkChkCW(Grp, PAD + 456, R1 + 8 * STEP, 100, 'DTR power');
|
||||
FChkCWKeyRTS := MkChkCW(Grp, PAD + 562, R1 + 8 * STEP, 100, 'RTS power');
|
||||
|
||||
TxNote(Grp, 'Firmware keyer: the radio produces dot and dash timing, so PC '
|
||||
+ 'load never affects it — the default where the hardware has one, and the '
|
||||
@@ -2130,9 +2139,9 @@ begin
|
||||
+ 'offset 0 means auto: zero on openHPSDR, 12 kHz on zero-IF hardware, '
|
||||
+ 'where LO leakage would otherwise sit right on the working frequency '
|
||||
+ 'between elements. The voice transmit chain is not started in CW at all.',
|
||||
R1 + 8 * STEP - 6, 92);
|
||||
R1 + 9 * STEP - 6, 92);
|
||||
|
||||
Inc(Y, 460 + 12);
|
||||
Inc(Y, 502 + 12);
|
||||
Grp := MakeGroupPanel(FTXSubPage[2], 'FM / CTCSS', MARGIN, Y, GRP_W, 250);
|
||||
|
||||
MakeLbl(Grp, 'FM deviation (Hz)', PAD, R1 + 5, LW);
|
||||
@@ -2355,6 +2364,8 @@ begin
|
||||
if FEdCWKeyPort <> nil then FCW.KeyPort := Copy(FEdCWKeyPort.Text, 1, 63);
|
||||
if FCmbCWDotLine <> nil then FCW.KeyDotLine := EnsureRange(FCmbCWDotLine.ItemIndex, 0, 3);
|
||||
if FCmbCWDashLine <> nil then FCW.KeyDashLine := EnsureRange(FCmbCWDashLine.ItemIndex, 0, 3);
|
||||
if FChkCWDecoder <> nil then FCW.Decoder := FChkCWDecoder.Checked;
|
||||
if FChkCWDecStrip <> nil then FCW.DecoderStrip := FChkCWDecStrip.Checked;
|
||||
if FChkCWKeyInvert <> nil then FCW.KeyInvert := FChkCWKeyInvert.Checked;
|
||||
if FChkCWKeyDTR <> nil then FCW.KeyPowerDTR := FChkCWKeyDTR.Checked;
|
||||
if FChkCWKeyRTS <> nil then FCW.KeyPowerRTS := FChkCWKeyRTS.Checked;
|
||||
@@ -2399,6 +2410,11 @@ begin
|
||||
if Assigned(FOnCWMessagesOpen) then FOnCWMessagesOpen;
|
||||
end;
|
||||
|
||||
procedure TSettingsForm.BtnCWTerminalClick(Sender: TObject);
|
||||
begin
|
||||
if Assigned(FOnCWTerminalOpen) then FOnCWTerminalOpen;
|
||||
end;
|
||||
|
||||
procedure TSettingsForm.LoadCWSettings(const C: TCWSettings);
|
||||
var Src: Integer;
|
||||
begin
|
||||
@@ -2434,6 +2450,8 @@ begin
|
||||
if FEdCWKeyPort <> nil then FEdCWKeyPort.Text := C.KeyPort;
|
||||
if FCmbCWDotLine <> nil then FCmbCWDotLine.ItemIndex := EnsureRange(C.KeyDotLine, 0, 3);
|
||||
if FCmbCWDashLine <> nil then FCmbCWDashLine.ItemIndex := EnsureRange(C.KeyDashLine, 0, 3);
|
||||
if FChkCWDecoder <> nil then FChkCWDecoder.Checked := C.Decoder;
|
||||
if FChkCWDecStrip <> nil then FChkCWDecStrip.Checked := C.DecoderStrip;
|
||||
if FChkCWKeyInvert <> nil then FChkCWKeyInvert.Checked := C.KeyInvert;
|
||||
if FChkCWKeyDTR <> nil then FChkCWKeyDTR.Checked := C.KeyPowerDTR;
|
||||
if FChkCWKeyRTS <> nil then FChkCWKeyRTS.Checked := C.KeyPowerRTS;
|
||||
|
||||
@@ -316,6 +316,14 @@
|
||||
<Filename Value="CWKeyer.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="CWDecoder.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="CWTerminalForm.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="CWMessagesForm.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
|
||||
Reference in New Issue
Block a user