ew8bak/ewsdr
1
0
Fork 0
mirror of https://git.vladimir.cc/vladimir/ewsdr.git synced 2026-08-25 20:37:33 +00:00
Code Issues Packages Projects Releases Wiki Activity

feat(cw): терминал телеграфа — набор с клавиатуры и декодер приёма

Browse Source 
Окно (ПКМ по 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:
ew8bak
2026-08-10 21:28:48 +03:00
co-authored by Claude Opus 5
parent 25fbf10212
commit b02b68aa6a
11 changed files with 1755 additions and 20 deletions
Download Patch File Download Diff File Expand all files Collapse all files
CWDecoder.pas
+462
View File
@@ -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.
CWKeyer.pas
+76 -1
View File
@@ -99,6 +99,11 @@ type
FDashIn: Boolean; FDashIn: Boolean;
FStraightIn:Boolean; // прямой ключ отдельным источником FStraightIn:Boolean; // прямой ключ отдельным источником
FTouched: Boolean; // касание манипулятора — обрывает текст FTouched: Boolean; // касание манипулятора — обрывает текст
// Эхо передачи для окна-терминала: знаки, которые УЖЕ ушли в эфир, и хвост,
// который ещё стоит в очереди. Ведём под FLock, потому что читает их UI.
FSent: string;
FUnsent: string;
FTrimTail: Boolean; // Backspace съел знак из уже разобранного текста
// ---- рабочая копия (только поток генератора) --------------------------- // ---- рабочая копия (только поток генератора) ---------------------------
FRate: Integer; FRate: Integer;
FAmp: Double; FAmp: Double;
@@ -170,6 +175,12 @@ type
procedure SendText(const S: string); procedure SendText(const S: string);
procedure AbortText; procedure AbortText;
function Busy: Boolean; function Busy: Boolean;
// Терминал: знаки, ушедшие в эфир с прошлого опроса (эхо своей передачи).
function TakeSentText: string;
// Терминал: что ещё стоит в очереди (набранное вперёд).
function PendingText: string;
// Стереть последний НЕ ушедший знак (Backspace в окне набора).
function Backspace: Boolean;
// Вход манипулятора (поток опроса порта / GUI). Состояния лепестков сырые, // Вход манипулятора (поток опроса порта / GUI). Состояния лепестков сырые,
// Reverse применяет сам генератор. // Reverse применяет сам генератор.
@@ -357,6 +368,52 @@ begin
end; end;
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); procedure TCWLocalKeyer.Paddle(Dot, Dash: Boolean);
begin begin
FLock.Enter; FLock.Enter;
@@ -612,6 +669,8 @@ begin
FLock.Enter; FLock.Enter;
try try
FBusyText := False; FBusyText := False;
FUnsent := '';
FTrimTail := False;
finally finally
FLock.Leave; FLock.Leave;
end; end;
@@ -625,7 +684,8 @@ function TCWLocalKeyer.TakeTextElement(out IsDot: Boolean): Boolean;
var var
Ch: Char; Ch: Char;
Add: string; Add: string;
Drop: Boolean; Drop, Trim: Boolean;
KeepLen: Integer;
begin begin
Result := False; Result := False;
IsDot := True; IsDot := True;
@@ -642,6 +702,9 @@ begin
end; end;
Add := FPending; Add := FPending;
FPending := ''; FPending := '';
Trim := FTrimTail;
FTrimTail := False;
KeepLen := FTextPos + Length(FUnsent);
finally finally
FLock.Leave; FLock.Leave;
end; end;
@@ -650,6 +713,8 @@ begin
ResetText; ResetText;
Exit; Exit;
end; end;
// Backspace дотянулся до уже разобранного текста — отсекаем хвост.
if Trim and (Length(FText) > KeepLen) then SetLength(FText, KeepLen);
if Add <> '' then FText := FText + Add; if Add <> '' then FText := FText + Add;
// Ищем следующий элемент, пропуская пробелы и знаки не из таблицы. // Ищем следующий элемент, пропуская пробелы и знаки не из таблицы.
@@ -662,6 +727,16 @@ begin
end; end;
Inc(FTextPos); Inc(FTextPos);
Ch := FText[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 if Ch = ' ' then
begin begin
// 3 точки уже отданы после прошлого знака — добираем до 7. // 3 точки уже отданы после прошлого знака — добираем до 7.
CWMorse.pas
+86 -1
View File
@@ -37,6 +37,10 @@ type
FBusy: Boolean; // идёт передача (под FLock) FBusy: Boolean; // идёт передача (под FLock)
FWPM: Integer; // под FLock FWPM: Integer; // под FLock
FWeight: Integer; // 33..66, 50 = симметрично (под FLock) FWeight: Integer; // 33..66, 50 = симметрично (под FLock)
// Эхо для окна-терминала: ушедшее в эфир и хвост очереди (под FLock).
FSent: string;
FUnsent: string;
FTrimTail: Boolean; // Backspace дотянулся до уже взятого текста
function TakeText: string; function TakeText: string;
function Aborted: Boolean; function Aborted: Boolean;
procedure Key(Down: Boolean); procedure Key(Down: Boolean);
@@ -53,6 +57,11 @@ type
procedure AbortSending; procedure AbortSending;
procedure SetSpeed(WPM, Weight: Integer); procedure SetSpeed(WPM, Weight: Integer);
function Busy: Boolean; function Busy: Boolean;
// Терминал: знаки, ушедшие в эфир с прошлого опроса; хвост очереди; стереть
// последний ненабранный знак. Смысл тот же, что у TCWLocalKeyer.
function TakeSentText: string;
function PendingText: string;
function Backspace: Boolean;
end; end;
// Код знака: строка из '.' и '-'. Пустая — знака нет в таблице (пропускаем, // Код знака: строка из '.' и '-'. Пустая — знака нет в таблице (пропускаем,
@@ -163,6 +172,49 @@ begin
end; end;
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; function TCWSender.TakeText: string;
begin begin
FLock.Enter; FLock.Enter;
@@ -252,7 +304,8 @@ end;
procedure TCWSender.Execute; procedure TCWSender.Execute;
var var
Text: string; Text: string;
i: Integer; i, KeepLen: Integer;
Trim: Boolean;
Deadline: QWord; Deadline: QWord;
begin begin
while not Terminated do while not Terminated do
@@ -275,6 +328,31 @@ begin
while i <= Length(Text) do while i <= Length(Text) do
begin begin
if Terminated or Aborted then Break; 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); SendChar(Text[i], Deadline);
// Дописанное в очередь по ходу передачи подхватываем без паузы — // Дописанное в очередь по ходу передачи подхватываем без паузы —
// иначе поток допередал бы «старый» текст и уснул на 200 мс. // иначе поток допередал бы «старый» текст и уснул на 200 мс.
@@ -284,6 +362,13 @@ begin
finally finally
Key(False); // ключ всегда отпущен, что бы ни случилось Key(False); // ключ всегда отпущен, что бы ни случилось
FLock.Enter; FLock.Enter;
try
FUnsent := '';
FTrimTail := False;
finally
FLock.Leave;
end;
FLock.Enter;
try try
FBusy := False; FBusy := False;
finally finally
CWTerminalForm.pas
+678
View File
@@ -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.
FlatEdit.pas
+4
View File
@@ -71,6 +71,10 @@ type
procedure SelectAll; procedure SelectAll;
property Text: string read FText write SetText; property Text: string read FText write SetText;
// Позиция курсора (в знаках, не в байтах). Нужна тем, кто задаёт текст
// программно: SetText курсор НЕ двигает — он лишь клампится в диапазон, и
// при внешней подстановке текста оставался бы в начале строки.
property CaretPos: Integer read FCaretPos write SetCaretPos;
property TextHint: string read FTextHint write SetTextHint; property TextHint: string read FTextHint write SetTextHint;
property PasswordChar: Char read FPasswordChar write SetPasswordChar; property PasswordChar: Char read FPasswordChar write SetPasswordChar;
property MaxLength: Integer read FMaxLength write SetMaxLength; property MaxLength: Integer read FMaxLength write SetMaxLength;
MainForm.pas
+125 -1
View File
@@ -43,7 +43,7 @@ uses
WinFirewall, WinFirewall,
BoardUtils, WisdomBuilder, UISync, BoardUtils, WisdomBuilder, UISync,
FlatEdit, FMRepeater, FlatEdit, FMRepeater,
ChannelStore, ChannelsForm, CWMessagesForm, BeaconScopeForm, DMRDecoder, ChannelStore, ChannelsForm, CWMessagesForm, CWTerminalForm, BeaconScopeForm, DMRDecoder,
PowerInhibit, PowerInhibit,
DeviceStore, DeviceStore,
RadioBackend, PlutoBackend, RadioBackend, PlutoBackend,
@@ -368,6 +368,7 @@ type
FTXProfileDropDown: TFlatDropDown; FTXProfileDropDown: TFlatDropDown;
FChannelsForm: TObject; // TChannelsForm (cast при использовании) FChannelsForm: TObject; // TChannelsForm (cast при использовании)
FCWMsgForm: TObject; // TCWMessagesForm (память телеграфа) FCWMsgForm: TObject; // TCWMessagesForm (память телеграфа)
FCWTermForm: TObject; // TCWTerminalForm (лента + набор с клавиатуры)
FBeaconScopeForm: TBeaconScopeForm; // окно констелляции маяка (ПКМ по BEACON) FBeaconScopeForm: TBeaconScopeForm; // окно констелляции маяка (ПКМ по BEACON)
// ---- Right panel ---- // ---- Right panel ----
@@ -473,6 +474,8 @@ type
procedure FreqDispBChanged(Sender: TObject; NewFreq: Int64); procedure FreqDispBChanged(Sender: TObject; NewFreq: Int64);
procedure BtnBandClick(Sender: TObject); procedure BtnBandClick(Sender: TObject);
procedure BtnModeClick(Sender: TObject); procedure BtnModeClick(Sender: TObject);
procedure BtnModeMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure BtnFilterClick(Sender: TObject); procedure BtnFilterClick(Sender: TObject);
procedure BtnFilterMouseDown(Sender: TObject; Button: TMouseButton; procedure BtnFilterMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); Shift: TShiftState; X, Y: Integer);
@@ -766,6 +769,14 @@ type
procedure OnTXSettingsChange(const T: TTXSettings); procedure OnTXSettingsChange(const T: TTXSettings);
procedure OnCWSettingsChange(const C: TCWSettings); procedure OnCWSettingsChange(const C: TCWSettings);
procedure ShowCWMessages; 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 OnCWMessageSend(const Text: string);
procedure OnCWMessageAbort(Sender: TObject); procedure OnCWMessageAbort(Sender: TObject);
procedure FormKeyDownCW(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormKeyDownCW(Sender: TObject; var Key: Word; Shift: TShiftState);
@@ -2423,6 +2434,7 @@ begin
LeftPanelButtonWidth(LEFT_W, 4, i mod 4), LeftPanelButtonWidth(LEFT_W, 4, i mod 4),
BTN_SM, BtnModeClick); BTN_SM, BtnModeClick);
B.Tag := i; B.Tag := i;
B.OnMouseDown := BtnModeMouseDown; // ПКМ по CWL/CWU → терминал
BtnMode[i] := B; BtnMode[i] := B;
StyleButton(B, i = FController.FMode); StyleButton(B, i = FController.FMode);
end; end;
@@ -3414,6 +3426,7 @@ begin
if FDeviceDialog <> nil then FDeviceDialog.SetTheme(T); if FDeviceDialog <> nil then FDeviceDialog.SetTheme(T);
if FChannelsForm <> nil then TChannelsForm(FChannelsForm).ApplyTheme(T); if FChannelsForm <> nil then TChannelsForm(FChannelsForm).ApplyTheme(T);
if FCWMsgForm <> nil then TCWMessagesForm(FCWMsgForm).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); if FBeaconScopeForm <> nil then FBeaconScopeForm.ApplyTheme(T);
FController.FSettings.SaveTheme(V); FController.FSettings.SaveTheme(V);
FController.FSettings.Save; FController.FSettings.Save;
@@ -3691,6 +3704,8 @@ begin
// Телеграф: фронты «железо в эфире» (у Pluto HP-статуса нет — гнать индикацию // Телеграф: фронты «железо в эфире» (у Pluto HP-статуса нет — гнать индикацию
// и отпускать реле T/R после выдержки больше некому). // и отпускать реле T/R после выдержки больше некому).
FController.ServiceCWKeyed; FController.ServiceCWKeyed;
// Телеграф: разбор принятого в текст + окно-терминал + лента под спектром.
ServiceCWTerminal;
// PureSignal: state machine команд + auto-attenuate + опрос GetPSInfo // PureSignal: state machine команд + auto-attenuate + опрос GetPSInfo
// (no-op на бэкендах без PS; рендер кнопок/поповера через rfPureSignal). // (no-op на бэкендах без PS; рендер кнопок/поповера через rfPureSignal).
FController.PureSignalTick; FController.PureSignalTick;
@@ -5584,6 +5599,17 @@ begin
end; end;
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; procedure TMainForm.BtnFilterMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); Shift: TShiftState; X, Y: Integer);
// ПКМ по кнопке фильтра открывает редактор на этом слоте (эталон Thetis: // ПКМ по кнопке фильтра открывает редактор на этом слоте (эталон Thetis:
@@ -8169,6 +8195,96 @@ begin
TCWMessagesForm(FCWMsgForm).Show; TCWMessagesForm(FCWMsgForm).Show;
end; 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); procedure TMainForm.OnCWMessageSend(const Text: string);
begin begin
FController.CWXSend(Text); FController.CWXSend(Text);
@@ -8188,6 +8304,13 @@ procedure TMainForm.FormKeyDownCW(Sender: TObject; var Key: Word;
var Slot: Integer; var Slot: Integer;
begin begin
if Shift <> [] then Exit; 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 (Key < VK_F1) or (Key > VK_F8) then Exit;
if not (FController.ActiveTXMode in [MODE_CWL, MODE_CWU]) then Exit; if not (FController.ActiveTXMode in [MODE_CWL, MODE_CWU]) then Exit;
Slot := Key - VK_F1; Slot := Key - VK_F1;
@@ -9124,6 +9247,7 @@ begin
SF.OnTXChange := OnTXSettingsChange; SF.OnTXChange := OnTXSettingsChange;
SF.OnCWChange := OnCWSettingsChange; SF.OnCWChange := OnCWSettingsChange;
SF.OnCWMessagesOpen := ShowCWMessages; SF.OnCWMessagesOpen := ShowCWMessages;
SF.OnCWTerminalOpen := ShowCWTerminal;
SF.OnTXProfileSelect := OnTXProfileSelectFromSettings; SF.OnTXProfileSelect := OnTXProfileSelectFromSettings;
SF.OnTXProfileAdd := OnTXProfileAddFromSettings; SF.OnTXProfileAdd := OnTXProfileAddFromSettings;
SF.OnTXProfileRename := OnTXProfileRenameFromSettings; SF.OnTXProfileRename := OnTXProfileRenameFromSettings;
PanafallPanel.pas
+75
View File
@@ -115,6 +115,14 @@ type
FBtnAddPan: TFlatButton; // «⊞» в ряду пан/зума (только пан 0) FBtnAddPan: TFlatButton; // «⊞» в ряду пан/зума (только пан 0)
FHeaderVisible: Boolean; FHeaderVisible: Boolean;
FShowZoomRow: Boolean; // False у панов N>0 (пан-зум — этап 3.3+) FShowZoomRow: Boolean; // False у панов N>0 (пан-зум — этап 3.3+)
// Бегущая лента расшифровки телеграфа под спектром (только пан 0). Своя
// строка, а не окно: смотреть в эфир и читать расшифровку удобнее в одном
// месте, а полноценный терминал открывается отдельно.
FCWStripOn: Boolean;
FCWStripText: string;
FPbCWStrip: TPaintBox;
FThemeBG: TColor;
FThemeText: TColor;
FOnPanClose: TNotifyEvent; FOnPanClose: TNotifyEvent;
FOnAddPan: TNotifyEvent; FOnAddPan: TNotifyEvent;
FAddPanWanted: Boolean; // хозяин: показывать «⊞» в ряду пан/зума FAddPanWanted: Boolean; // хозяин: показывать «⊞» в ряду пан/зума
@@ -152,6 +160,7 @@ type
Shift: TShiftState; X, Y: Integer); Shift: TShiftState; X, Y: Integer);
procedure PanZoomDblClick(Sender: TObject); procedure PanZoomDblClick(Sender: TObject);
procedure PositionPanZoomBar(X0, BottomY, RW, H: Integer; AVisible: Boolean); procedure PositionPanZoomBar(X0, BottomY, RW, H: Integer; AVisible: Boolean);
procedure CWStripPaint(Sender: TObject);
public public
// Обработчики мыши спектра/водопада и кликов зум-кнопок хозяина — // Обработчики мыши спектра/водопада и кликов зум-кнопок хозяина —
// задать ДО вызова Build (Build подвешивает их на создаваемые контролы). // задать ДО вызова Build (Build подвешивает их на создаваемые контролы).
@@ -245,6 +254,9 @@ type
property BtnAddPan: TFlatButton read FBtnAddPan; property BtnAddPan: TFlatButton read FBtnAddPan;
// Ряд пан/зума: у панов N>0 скрыт (их зум — этап 3.3+). // Ряд пан/зума: у панов N>0 скрыт (их зум — этап 3.3+).
property ShowZoomRow: Boolean read FShowZoomRow write FShowZoomRow; property ShowZoomRow: Boolean read FShowZoomRow write FShowZoomRow;
// Лента расшифровки телеграфа: включить/выключить и обновить текст.
// True — состояние видимости изменилось, хозяину нужно переразложить пан.
function SetCWStrip(AOn: Boolean; const AText: string): Boolean;
// «⊞» в ряду пан/зума (пан 0): показать/спрятать решает хозяин. // «⊞» в ряду пан/зума (пан 0): показать/спрятать решает хозяин.
property AddPanEnabled: Boolean read FAddPanWanted write FAddPanWanted; property AddPanEnabled: Boolean read FAddPanWanted write FAddPanWanted;
// «▦/▤» тумблер грид-раскладки (пан 0, виден при >=2 доп. панах). // «▦/▤» тумблер грид-раскладки (пан 0, виден при >=2 доп. панах).
@@ -432,6 +444,12 @@ begin
FPbPanZoom.OnMouseUp := PanZoomMouseUp; FPbPanZoom.OnMouseUp := PanZoomMouseUp;
FPbPanZoom.OnDblClick := PanZoomDblClick; FPbPanZoom.OnDblClick := PanZoomDblClick;
FZoomBar.PaintBox := FPbPanZoom; 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); FBtnZoomOut := MakeFlatBtn(AParent, '−', 0, 0, 10, 10, ZoomOutClick);
FBtnZoomDef := MakeFlatBtn(AParent, '⌂', 0, 0, 10, 10, ZoomDefClick); FBtnZoomDef := MakeFlatBtn(AParent, '⌂', 0, 0, 10, 10, ZoomDefClick);
FBtnZoomIn := MakeFlatBtn(AParent, '+', 0, 0, 10, 10, ZoomInClick); FBtnZoomIn := MakeFlatBtn(AParent, '+', 0, 0, 10, 10, ZoomInClick);
@@ -501,6 +519,7 @@ begin
FSplitter.Parent := NewParent; FSplitter.Parent := NewParent;
FPbWaterfall.Parent := NewParent; FPbWaterfall.Parent := NewParent;
FPbPanZoom.Parent := NewParent; FPbPanZoom.Parent := NewParent;
if FPbCWStrip <> nil then FPbCWStrip.Parent := NewParent;
FBtnZoomOut.Parent := NewParent; FBtnZoomOut.Parent := NewParent;
FBtnZoomDef.Parent := NewParent; FBtnZoomDef.Parent := NewParent;
FBtnZoomIn.Parent := NewParent; FBtnZoomIn.Parent := NewParent;
@@ -668,6 +687,44 @@ begin
end; end;
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; procedure TPanafallPanel.PositionPanZoomBar(X0, BottomY, RW, H: Integer;
AVisible: Boolean); AVisible: Boolean);
var BtnW, Gap, StripW, X, NBtns: Integer; WantAdd, WantGrid: Boolean; var BtnW, Gap, StripW, X, NBtns: Integer; WantAdd, WantGrid: Boolean;
@@ -725,6 +782,8 @@ begin
if FHeaderVisible then Inc(Result, HEADER_H); if FHeaderVisible then Inc(Result, HEADER_H);
if (AShowSpectrum or AShowWaterfall) and FShowZoomRow then if (AShowSpectrum or AShowWaterfall) and FShowZoomRow then
Inc(Result, PANZOOM_H); 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 AShowSpectrum then Inc(Result, MIN_SH + RULER_H);
if AShowWaterfall then if AShowWaterfall then
begin begin
@@ -746,6 +805,7 @@ var
RULER_H: Integer; RULER_H: Integer;
PANZOOM_H: Integer; PANZOOM_H: Integer;
HEADER_H: Integer; HEADER_H: Integer;
CWSTRIP_H: Integer;
ShowPZ: Boolean; ShowPZ: Boolean;
EffRatio: Double; EffRatio: Double;
begin begin
@@ -784,6 +844,17 @@ begin
ShowPZ := (AShowSpectrum or AShowWaterfall) and FShowZoomRow; ShowPZ := (AShowSpectrum or AShowWaterfall) and FShowZoomRow;
PositionPanZoomBar(X0, RH - PANZOOM_H, RW, PANZOOM_H, ShowPZ); PositionPanZoomBar(X0, RH - PANZOOM_H, RW, PANZOOM_H, ShowPZ);
if ShowPZ then RH := RH - PANZOOM_H; 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; TopOff := ATopOffset + FStackTop;
if FHeaderVisible then Inc(TopOff, HEADER_H); if FHeaderVisible then Inc(TopOff, HEADER_H);
@@ -1533,6 +1604,10 @@ end;
procedure TPanafallPanel.SetFlagsTheme(const T: TAppTheme); procedure TPanafallPanel.SetFlagsTheme(const T: TAppTheme);
var i: Integer; var i: Integer;
begin begin
// Лента расшифровки рисуется своими руками — цвета держим здесь же.
FThemeBG := T.Panel;
FThemeText := T.Text;
if (FPbCWStrip <> nil) and FPbCWStrip.Visible then FPbCWStrip.Invalidate;
if Assigned(FMainFlag) then FMainFlag.SetTheme(T); if Assigned(FMainFlag) then FMainFlag.SetTheme(T);
for i := 0 to High(FSliceFlags) do for i := 0 to High(FSliceFlags) do
if Assigned(FSliceFlags[i]) then FSliceFlags[i].SetTheme(T); if Assigned(FSliceFlags[i]) then FSliceFlags[i].SetTheme(T);
RadioController.pas
+194 -1
View File
@@ -50,7 +50,8 @@ uses
Classes, SysUtils, Math, Classes, SysUtils, Math,
HPSDRProtocol, HPSDRNetwork, RadioBackend, PlutoBackend, IIOBindings, HPSDRProtocol, HPSDRNetwork, RadioBackend, PlutoBackend, IIOBindings,
WDSPEngine, AudioOutput, AudioInput, BeaconDecoder, BeaconFEC, DMRDecoder, 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 (общий для // Панадаптеры (этап 3): потолок MAX_PANS живёт в WDSPEngine (общий для
// движка/контроллера/UI). Фактический лимит бэкенда — Caps.MaxPans (Pluto=1). // движка/контроллера/UI). Фактический лимит бэкенда — Caps.MaxPans (Pluto=1).
@@ -103,6 +104,11 @@ type
// Сырьё спектра/водопада наружу (фронтенды рисуют). Вызывается из DSP-потока. // Сырьё спектра/водопада наружу (фронтенды рисуют). Вызывается из DSP-потока.
TPixelDataEvent = procedure(const Pixels: array of Single; Count: Integer) of object; 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). // Снимок состояния для синхронизации нового фронтенда (Arduino/Web на connect).
TRadioSnapshot = record TRadioSnapshot = record
VfoA, VfoB, CenterFreq, SpanHz: Double; VfoA, VfoB, CenterFreq, SpanHz: Double;
@@ -470,6 +476,15 @@ type
// Локальный кейер вооружён — считается в SyncCWKeyer, читается пейсингом // Локальный кейер вооружён — считается в SyncCWKeyer, читается пейсингом
// частоты DUC (CWCarrierOffsetHz) и аттенюатором Pluto. // частоты DUC (CWCarrierOffsetHz) и аттенюатором Pluto.
FCWLocalArmed: Boolean; FCWLocalArmed: Boolean;
// ---- Декодер приёма (CWDecoder.pas) --------------------------------------
// Создаётся лениво вместе с окном-терминалом. Кормится из OnDemodAudioReady
// (до громкости и мьюта, без сайдтона), разбирается на таймере хозяина.
FCWDec: TCWDecoder;
// Лента расшифровки: последние знаки приёма (для полосы под спектром) и
// счётчик, по которому потребители понимают, что появилось новое.
FCWLogText: string;
FCWLogSeq: Int64;
FOnCWLog: TCWLogEvent;
FAlexSettings: TAlexSettings; FAlexSettings: TAlexSettings;
FOCSettings: TOCSettings; // OC Control (Open Collector, openHPSDR-only) FOCSettings: TOCSettings; // OC Control (Open Collector, openHPSDR-only)
// Антенные разъёмы AD936x (Pluto/LibreSDR) на диапазон/трансвертер. // Антенные разъёмы AD936x (Pluto/LibreSDR) на диапазон/трансвертер.
@@ -1006,6 +1021,27 @@ type
procedure CWXSend(const Text: string); procedure CWXSend(const Text: string);
procedure CWXAbort; procedure CWXAbort;
function CWXBusy: Boolean; 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 ---- // ---- PureSignal ----
// Доступность PS у активного бэкенда/платы (Caps.HasPureSignal). // Доступность PS у активного бэкенда/платы (Caps.HasPureSignal).
@@ -1345,7 +1381,11 @@ begin
FCWSender.AbortSending; FCWSender.AbortSending;
FreeAndNil(FCWSender); FreeAndNil(FCWSender);
end; end;
if Assigned(FCWDec) then FCWDec.Enabled := False; // кольцо больше не кормим
FreeEngines; FreeEngines;
// Декодер — ПОСЛЕ движка: его кольцо наполняет DSP-поток, и освобождать
// объект, пока поток жив, нельзя.
if Assigned(FCWDec) then FreeAndNil(FCWDec);
FreeAndNil(FDeviceStore); FreeAndNil(FDeviceStore);
FreeAndNil(FSettings); FreeAndNil(FSettings);
inherited Destroy; inherited Destroy;
@@ -1728,6 +1768,14 @@ begin
end end
else if Assigned(FDMRDec) and FDMRDec.Enabled then else if Assigned(FDMRDec) and FDMRDec.Enabled then
FDMRDec.SetEnabled(False); 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; end;
procedure TRadioController.OnDMRAudioReady(const PCM: array of Single; procedure TRadioController.OnDMRAudioReady(const PCM: array of Single;
@@ -5902,6 +5950,19 @@ begin
// запрет передачи, разбирает SyncCWKeyer — одна дверь на всё). // запрет передачи, разбирает SyncCWKeyer — одна дверь на всё).
PushCWLocalConfig; PushCWLocalConfig;
SyncCWKeyer; 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): // Тон TUN в телеграфе равен pitch (несущая обязана лечь на VFO, см. SetTune):
// если крутят pitch прямо на настройке — обновляем живьём. // если крутят pitch прямо на настройке — обновляем живьём.
if FTuning and FWDSPReady and Assigned(FDSPEngine) if FTuning and FWDSPReady and Assigned(FDSPEngine)
@@ -6136,6 +6197,126 @@ begin
if Assigned(FCWLocal) then FCWLocal.AbortText; if Assigned(FCWLocal) then FCWLocal.AbortText;
end; 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; function TRadioController.MixSidetone(const Left, Right: array of Single;
Count: Integer): Boolean; Count: Integer): Boolean;
// DSP-поток. Генератор синуса на pitch с трапецеидальной огибающей — без неё // DSP-поток. Генератор синуса на pitch с трапецеидальной огибающей — без неё
@@ -6943,6 +7124,18 @@ begin
FDSPEngine.SetCWPitch(FCWSettings.Pitch); FDSPEngine.SetCWPitch(FCWSettings.Pitch);
FDSPEngine.SetCWSpeed(FCWSettings.Speed); FDSPEngine.SetCWSpeed(FCWSettings.Speed);
end; 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.LoadAlex(FDevMAC, FAlexSettings);
FSettings.LoadAnt936x(FDevMAC, FAnt936x); FSettings.LoadAnt936x(FDevMAC, FAnt936x);
FNetwork.SetAlexConfig(FAlexSettings); FNetwork.SetAlexConfig(FAlexSettings);
Settings.pas
+13
View File
@@ -361,6 +361,10 @@ type
KeyInvert: Boolean; KeyInvert: Boolean;
KeyPowerDTR: Boolean; KeyPowerDTR: Boolean;
KeyPowerRTS: Boolean; KeyPowerRTS: Boolean;
// ---- Окно-терминал: набор с клавиатуры + декодер приёма ----------------
Decoder: Boolean; // разбирать принимаемый телеграф в текст
DecoderStrip: Boolean; // бегущая лента расшифровки под спектром
KbdKey: Boolean; // Ctrl в окне терминала работает манипулятором
end; end;
// ---- TX-профили (именованные снимки «как я звучу») ---------------------- // ---- TX-профили (именованные снимки «как я звучу») ----------------------
@@ -1821,6 +1825,9 @@ begin
C.KeyInvert := False; C.KeyInvert := False;
C.KeyPowerDTR := True; // типовая распайка: ключ питается от DTR/RTS C.KeyPowerDTR := True; // типовая распайка: ключ питается от DTR/RTS
C.KeyPowerRTS := True; C.KeyPowerRTS := True;
C.Decoder := True; // окно терминала без декодера бессмысленно
C.DecoderStrip := False; // лента под спектром — по желанию
C.KbdKey := False; // Ctrl-манипулятор включают осознанно
// Заводские заготовки: типовой вызов, ответ и стандартные концовки. // Заводские заготовки: типовой вызов, ответ и стандартные концовки.
C.Messages[0] := 'CQ CQ DE '; C.Messages[0] := 'CQ CQ DE ';
C.Messages[1] := 'DE '; C.Messages[1] := 'DE ';
@@ -1867,6 +1874,9 @@ begin
C.KeyInvert := JB(O,'key_invert', C.KeyInvert); C.KeyInvert := JB(O,'key_invert', C.KeyInvert);
C.KeyPowerDTR := JB(O,'key_power_dtr', C.KeyPowerDTR); C.KeyPowerDTR := JB(O,'key_power_dtr', C.KeyPowerDTR);
C.KeyPowerRTS := JB(O,'key_power_rts', C.KeyPowerRTS); 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 for i := 0 to CW_MSG_COUNT - 1 do
C.Messages[i] := Copy(JS(O, 'msg_' + IntToStr(i), C.Messages[i]), 1, 63); C.Messages[i] := Copy(JS(O, 'msg_' + IntToStr(i), C.Messages[i]), 1, 63);
end; end;
@@ -1900,6 +1910,9 @@ begin
JW(O,'key_invert', C.KeyInvert); JW(O,'key_invert', C.KeyInvert);
JW(O,'key_power_dtr', C.KeyPowerDTR); JW(O,'key_power_dtr', C.KeyPowerDTR);
JW(O,'key_power_rts', C.KeyPowerRTS); 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 for i := 0 to CW_MSG_COUNT - 1 do
JWS(O, 'msg_' + IntToStr(i), C.Messages[i]); JWS(O, 'msg_' + IntToStr(i), C.Messages[i]);
end; end;
SettingsForm.pas
+34 -16
View File
@@ -61,6 +61,7 @@ type
TOnTXSettingsChange = procedure(const T: TTXSettings) of object; TOnTXSettingsChange = procedure(const T: TTXSettings) of object;
TOnCWSettingsChange = procedure(const C: TCWSettings) of object; TOnCWSettingsChange = procedure(const C: TCWSettings) of object;
TOnCWMessagesOpen = procedure of object; TOnCWMessagesOpen = procedure of object;
TOnCWTerminalOpen = procedure of object;
// TX-профили: выбор/переименование/удаление по индексу, создание — по имени. // TX-профили: выбор/переименование/удаление по индексу, создание — по имени.
TOnTXProfileIdx = procedure(Idx: Integer) of object; TOnTXProfileIdx = procedure(Idx: Integer) of object;
TOnTXProfileName = procedure(const AName: string) of object; TOnTXProfileName = procedure(const AName: string) of object;
@@ -312,6 +313,8 @@ type
FEdCWKeyPort: TFlatEdit; FEdCWKeyPort: TFlatEdit;
FCmbCWDotLine: TFlatComboBox; FCmbCWDotLine: TFlatComboBox;
FCmbCWDashLine: TFlatComboBox; FCmbCWDashLine: TFlatComboBox;
FChkCWDecoder: TFlatCheckBox;
FChkCWDecStrip: TFlatCheckBox;
FChkCWKeyInvert: TFlatCheckBox; FChkCWKeyInvert: TFlatCheckBox;
FChkCWKeyDTR: TFlatCheckBox; FChkCWKeyDTR: TFlatCheckBox;
FChkCWKeyRTS: TFlatCheckBox; FChkCWKeyRTS: TFlatCheckBox;
@@ -479,6 +482,7 @@ type
FOnTXChange: TOnTXSettingsChange; FOnTXChange: TOnTXSettingsChange;
FOnCWChange: TOnCWSettingsChange; FOnCWChange: TOnCWSettingsChange;
FOnCWMessagesOpen: TOnCWMessagesOpen; FOnCWMessagesOpen: TOnCWMessagesOpen;
FOnCWTerminalOpen: TOnCWTerminalOpen;
FOnTXProfileSelect: TOnTXProfileIdx; FOnTXProfileSelect: TOnTXProfileIdx;
FOnTXProfileAdd: TOnTXProfileName; FOnTXProfileAdd: TOnTXProfileName;
FOnTXProfileRename: TOnTXProfileIdxName; FOnTXProfileRename: TOnTXProfileIdxName;
@@ -537,6 +541,7 @@ type
procedure FireCWChange; procedure FireCWChange;
procedure OnCWAnyChange(Sender: TObject); procedure OnCWAnyChange(Sender: TObject);
procedure BtnCWMessagesClick(Sender: TObject); procedure BtnCWMessagesClick(Sender: TObject);
procedure BtnCWTerminalClick(Sender: TObject);
procedure OnMicJackChange(Sender: TObject); procedure OnMicJackChange(Sender: TObject);
procedure UpdateMicJackVisibility; procedure UpdateMicJackVisibility;
// Подвкладки и полоса профиля на странице Transmit // Подвкладки и полоса профиля на странице Transmit
@@ -720,6 +725,7 @@ type
property OnTXChange: TOnTXSettingsChange read FOnTXChange write FOnTXChange; property OnTXChange: TOnTXSettingsChange read FOnTXChange write FOnTXChange;
property OnCWChange: TOnCWSettingsChange read FOnCWChange write FOnCWChange; property OnCWChange: TOnCWSettingsChange read FOnCWChange write FOnCWChange;
property OnCWMessagesOpen: TOnCWMessagesOpen read FOnCWMessagesOpen write FOnCWMessagesOpen; property OnCWMessagesOpen: TOnCWMessagesOpen read FOnCWMessagesOpen write FOnCWMessagesOpen;
property OnCWTerminalOpen: TOnCWTerminalOpen read FOnCWTerminalOpen write FOnCWTerminalOpen;
property OnTXProfileSelect: TOnTXProfileIdx read FOnTXProfileSelect write FOnTXProfileSelect; property OnTXProfileSelect: TOnTXProfileIdx read FOnTXProfileSelect write FOnTXProfileSelect;
property OnTXProfileAdd: TOnTXProfileName read FOnTXProfileAdd write FOnTXProfileAdd; property OnTXProfileAdd: TOnTXProfileName read FOnTXProfileAdd write FOnTXProfileAdd;
property OnTXProfileRename: TOnTXProfileIdxName read FOnTXProfileRename write FOnTXProfileRename; property OnTXProfileRename: TOnTXProfileIdxName read FOnTXProfileRename write FOnTXProfileRename;
@@ -2056,15 +2062,16 @@ begin
// ---- CW: телеграфом в openHPSDR P2 управляет прошивка ------------------- // ---- CW: телеграфом в openHPSDR P2 управляет прошивка -------------------
Inc(Y, 190 + 12); 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); MakeLbl(Grp, 'Keyer', PAD, R1 - 1, 50);
FCmbCWKeyerSrc := MkCmbCW(Grp, PAD + 54, R1 - 6, 194); FCmbCWKeyerSrc := MkCmbCW(Grp, PAD + 54, R1 - 6, 194);
FCmbCWKeyerSrc.Items.AddStrings(['Radio firmware','Software (PC)','Off (MOX only)']); FCmbCWKeyerSrc.Items.AddStrings(['Radio firmware','Software (PC)','Off (MOX only)']);
FCmbCWKeyerSrc.ItemIndex := 0; FCmbCWKeyerSrc.ItemIndex := 0;
MkBtn(Grp, PAD + 260, R1 - 6, 110, 'Messages...', BtnCWMessagesClick); MkBtn(Grp, PAD + 260, R1 - 6, 100, 'Messages...', BtnCWMessagesClick);
MakeLbl(Grp, 'Pitch (Hz)', PAD + 400, R1 - 1, 90); MkBtn(Grp, PAD + 366, R1 - 6, 100, 'Terminal...', BtnCWTerminalClick);
FEdCWPitch := MkSpinCW(Grp, PAD + 500, R1 - 6, 200, 1200, 600); 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); MakeLbl(Grp, 'Keyer mode', PAD, R1 + STEP + 5, LW);
FCmbCWKeyerMode := MkCmbCW(Grp, CX, R1 + STEP, 200); FCmbCWKeyerMode := MkCmbCW(Grp, CX, R1 + STEP, 200);
@@ -2097,29 +2104,31 @@ begin
MakeLbl(Grp, 'Carrier offset (Hz)', PAD, R1 + 5 * STEP + 5, LW); MakeLbl(Grp, 'Carrier offset (Hz)', PAD, R1 + 5 * STEP + 5, LW);
FEdCWOffset := MkSpinCW(Grp, CX, R1 + 5 * STEP, -1, 48000, 0); 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); 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 := TFlatEdit.Create(Self);
FEdCWKeyPort.Parent := Grp; 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)); DpiScale(220), DpiScale(BTN_H));
FEdCWKeyPort.Color := CLR_INPUT; FEdCWKeyPort.Color := CLR_INPUT;
FEdCWKeyPort.Font.Color := CLR_INPUT_TEXT; FEdCWKeyPort.Font.Color := CLR_INPUT_TEXT;
FEdCWKeyPort.Font.Size := 9; FEdCWKeyPort.Font.Size := 9;
FEdCWKeyPort.OnExit := OnCWAnyChange; 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); MakeLbl(Grp, 'Dot line', PAD, R1 + 8 * STEP + 5, 70);
FCmbCWDotLine := MkCmbCW(Grp, PAD + 74, R1 + 7 * STEP, 90); FCmbCWDotLine := MkCmbCW(Grp, PAD + 74, R1 + 8 * STEP, 90);
FCmbCWDotLine.Items.AddStrings(['CTS','DSR','DCD','RI']); FCmbCWDotLine.Items.AddStrings(['CTS','DSR','DCD','RI']);
FCmbCWDotLine.ItemIndex := 0; FCmbCWDotLine.ItemIndex := 0;
MakeLbl(Grp, 'Dash line', PAD + 176, R1 + 7 * STEP + 5, 74); MakeLbl(Grp, 'Dash line', PAD + 176, R1 + 8 * STEP + 5, 74);
FCmbCWDashLine := MkCmbCW(Grp, PAD + 254, R1 + 7 * STEP, 90); FCmbCWDashLine := MkCmbCW(Grp, PAD + 254, R1 + 8 * STEP, 90);
FCmbCWDashLine.Items.AddStrings(['CTS','DSR','DCD','RI']); FCmbCWDashLine.Items.AddStrings(['CTS','DSR','DCD','RI']);
FCmbCWDashLine.ItemIndex := 1; FCmbCWDashLine.ItemIndex := 1;
FChkCWKeyInvert := MkChkCW(Grp, PAD + 360, R1 + 7 * STEP, 90, 'Invert'); FChkCWKeyInvert := MkChkCW(Grp, PAD + 360, R1 + 8 * STEP, 90, 'Invert');
FChkCWKeyDTR := MkChkCW(Grp, PAD + 456, R1 + 7 * STEP, 100, 'DTR power'); FChkCWKeyDTR := MkChkCW(Grp, PAD + 456, R1 + 8 * STEP, 100, 'DTR power');
FChkCWKeyRTS := MkChkCW(Grp, PAD + 562, R1 + 7 * STEP, 100, 'RTS 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 ' 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 ' + '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, ' + 'offset 0 means auto: zero on openHPSDR, 12 kHz on zero-IF hardware, '
+ 'where LO leakage would otherwise sit right on the working frequency ' + 'where LO leakage would otherwise sit right on the working frequency '
+ 'between elements. The voice transmit chain is not started in CW at all.', + '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); Grp := MakeGroupPanel(FTXSubPage[2], 'FM / CTCSS', MARGIN, Y, GRP_W, 250);
MakeLbl(Grp, 'FM deviation (Hz)', PAD, R1 + 5, LW); 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 FEdCWKeyPort <> nil then FCW.KeyPort := Copy(FEdCWKeyPort.Text, 1, 63);
if FCmbCWDotLine <> nil then FCW.KeyDotLine := EnsureRange(FCmbCWDotLine.ItemIndex, 0, 3); if FCmbCWDotLine <> nil then FCW.KeyDotLine := EnsureRange(FCmbCWDotLine.ItemIndex, 0, 3);
if FCmbCWDashLine <> nil then FCW.KeyDashLine := EnsureRange(FCmbCWDashLine.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 FChkCWKeyInvert <> nil then FCW.KeyInvert := FChkCWKeyInvert.Checked;
if FChkCWKeyDTR <> nil then FCW.KeyPowerDTR := FChkCWKeyDTR.Checked; if FChkCWKeyDTR <> nil then FCW.KeyPowerDTR := FChkCWKeyDTR.Checked;
if FChkCWKeyRTS <> nil then FCW.KeyPowerRTS := FChkCWKeyRTS.Checked; if FChkCWKeyRTS <> nil then FCW.KeyPowerRTS := FChkCWKeyRTS.Checked;
@@ -2399,6 +2410,11 @@ begin
if Assigned(FOnCWMessagesOpen) then FOnCWMessagesOpen; if Assigned(FOnCWMessagesOpen) then FOnCWMessagesOpen;
end; end;
procedure TSettingsForm.BtnCWTerminalClick(Sender: TObject);
begin
if Assigned(FOnCWTerminalOpen) then FOnCWTerminalOpen;
end;
procedure TSettingsForm.LoadCWSettings(const C: TCWSettings); procedure TSettingsForm.LoadCWSettings(const C: TCWSettings);
var Src: Integer; var Src: Integer;
begin begin
@@ -2434,6 +2450,8 @@ begin
if FEdCWKeyPort <> nil then FEdCWKeyPort.Text := C.KeyPort; if FEdCWKeyPort <> nil then FEdCWKeyPort.Text := C.KeyPort;
if FCmbCWDotLine <> nil then FCmbCWDotLine.ItemIndex := EnsureRange(C.KeyDotLine, 0, 3); if FCmbCWDotLine <> nil then FCmbCWDotLine.ItemIndex := EnsureRange(C.KeyDotLine, 0, 3);
if FCmbCWDashLine <> nil then FCmbCWDashLine.ItemIndex := EnsureRange(C.KeyDashLine, 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 FChkCWKeyInvert <> nil then FChkCWKeyInvert.Checked := C.KeyInvert;
if FChkCWKeyDTR <> nil then FChkCWKeyDTR.Checked := C.KeyPowerDTR; if FChkCWKeyDTR <> nil then FChkCWKeyDTR.Checked := C.KeyPowerDTR;
if FChkCWKeyRTS <> nil then FChkCWKeyRTS.Checked := C.KeyPowerRTS; if FChkCWKeyRTS <> nil then FChkCWKeyRTS.Checked := C.KeyPowerRTS;
ewsdr.lpi
+8
View File
@@ -316,6 +316,14 @@
<Filename Value="CWKeyer.pas"/> <Filename Value="CWKeyer.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
</Unit> </Unit>
<Unit>
<Filename Value="CWDecoder.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="CWTerminalForm.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit> <Unit>
<Filename Value="CWMessagesForm.pas"/> <Filename Value="CWMessagesForm.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>