From b02b68aa6a592283851ea5c65bd86caf08c6b72a Mon Sep 17 00:00:00 2001 From: Vladimir Date: Mon, 10 Aug 2026 21:28:48 +0300 Subject: [PATCH] =?UTF-8?q?feat(cw):=20=D1=82=D0=B5=D1=80=D0=BC=D0=B8?= =?UTF-8?q?=D0=BD=D0=B0=D0=BB=20=D1=82=D0=B5=D0=BB=D0=B5=D0=B3=D1=80=D0=B0?= =?UTF-8?q?=D1=84=D0=B0=20=E2=80=94=20=D0=BD=D0=B0=D0=B1=D0=BE=D1=80=20?= =?UTF-8?q?=D1=81=20=D0=BA=D0=BB=D0=B0=D0=B2=D0=B8=D0=B0=D1=82=D1=83=D1=80?= =?UTF-8?q?=D1=8B=20=D0=B8=20=D0=B4=D0=B5=D0=BA=D0=BE=D0=B4=D0=B5=D1=80=20?= =?UTF-8?q?=D0=BF=D1=80=D0=B8=D1=91=D0=BC=D0=B0?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Окно (ПКМ по 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 --- CWDecoder.pas | 462 ++++++++++++++++++++++++++++++ CWKeyer.pas | 77 ++++- CWMorse.pas | 87 +++++- CWTerminalForm.pas | 678 ++++++++++++++++++++++++++++++++++++++++++++ FlatEdit.pas | 4 + MainForm.pas | 126 +++++++- PanafallPanel.pas | 75 +++++ RadioController.pas | 195 ++++++++++++- Settings.pas | 13 + SettingsForm.pas | 50 ++-- ewsdr.lpi | 8 + 11 files changed, 1755 insertions(+), 20 deletions(-) create mode 100644 CWDecoder.pas create mode 100644 CWTerminalForm.pas diff --git a/CWDecoder.pas b/CWDecoder.pas new file mode 100644 index 0000000..5478f61 --- /dev/null +++ b/CWDecoder.pas @@ -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 := '' + else if Code = '-.--.' then Result := '' + else if Code = '.-...' then Result := '' + else if Code = '........' then Result := ''; +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. diff --git a/CWKeyer.pas b/CWKeyer.pas index 9e8f285..b37b502 100644 --- a/CWKeyer.pas +++ b/CWKeyer.pas @@ -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. diff --git a/CWMorse.pas b/CWMorse.pas index 81b6f6f..dd6f027 100644 --- a/CWMorse.pas +++ b/CWMorse.pas @@ -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 diff --git a/CWTerminalForm.pas b/CWTerminalForm.pas new file mode 100644 index 0000000..095a57c --- /dev/null +++ b/CWTerminalForm.pas @@ -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. diff --git a/FlatEdit.pas b/FlatEdit.pas index 12a2856..936ad67 100644 --- a/FlatEdit.pas +++ b/FlatEdit.pas @@ -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; diff --git a/MainForm.pas b/MainForm.pas index 9cc119e..6bc5b07 100644 --- a/MainForm.pas +++ b/MainForm.pas @@ -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; diff --git a/PanafallPanel.pas b/PanafallPanel.pas index c0676cd..c93be98 100644 --- a/PanafallPanel.pas +++ b/PanafallPanel.pas @@ -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); diff --git a/RadioController.pas b/RadioController.pas index 5091c9d..27fd9b9 100644 --- a/RadioController.pas +++ b/RadioController.pas @@ -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); diff --git a/Settings.pas b/Settings.pas index 0249bd7..d2af3f8 100644 --- a/Settings.pas +++ b/Settings.pas @@ -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; diff --git a/SettingsForm.pas b/SettingsForm.pas index 50b2962..b7d7cbf 100644 --- a/SettingsForm.pas +++ b/SettingsForm.pas @@ -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; diff --git a/ewsdr.lpi b/ewsdr.lpi index 66045c3..28fef8b 100644 --- a/ewsdr.lpi +++ b/ewsdr.lpi @@ -316,6 +316,14 @@ + + + + + + + +