unit CWKeyer; {$mode objfpc}{$H+} // --------------------------------------------------------------------------- // Локальный (программный) телеграфный генератор + вход манипулятора. // // ЗАЧЕМ. У openHPSDR P2 манипуляцию делает кейер в FPGA: PC отдаёт ему // скорость/вес (DUC Specific байты 5..13), а точки/тире формирует прошивка — // джиттера PC там нет вовсе, и это остаётся путём по умолчанию. У Pluto/ // LibreSDR такого кейера НЕТ: это голый AD936x, в эфир идёт ровно то, что мы // сами положили в поток IQ. Значит телеграф там обязан формироваться здесь. // Эталон — pihpsdr: src/iambic.c (автомат) + cw_shape_buffer в transmitter.c // (огибающая прямо в TX-буфере, мимо WDSP). // // ПОЧЕМУ МИМО WDSP. Голосовой TXA в телеграфе не запускается вообще (в WDSP // режим TXA_CWL — буквально ветка SSB), да и PostGen-тон не умеет огибающей. // Поэтому генератор отдаёт готовые IQ-пары прямо в бэкенд: несущая = комплексная // экспонента на OffsetHz с косинусной («приподнятый косинус») огибающей. // // ТАЙМИНГИ ЖИВУТ В СЭМПЛАХ, а не в миллисекундах. Точка на 40 WPM — 30 мс; // отмеряй её Sleep-ами, и планировщик ОС растянул бы её на единицы мс, отчего // знак «плывёт». В сэмплах длительность точна по определению — ошибиться может // только ТЕМП ВЫДАЧИ блоков, а его сглаживает FIFO бэкенда (держим в нём запас // CW_PREFILL_MS). // // СЕССИЯ. Между посылками несущей нет, но реле T/R, LO передатчика и аттенюатор // дёргать на каждую точку нельзя. Поэтому генератор работает сессиями: первое // замыкание поднимает передачу (OnSession(True)), дальше идут элементы, и через // hang после последнего передача снимается. Внутри сессии манипуляция — чисто // цифровая, в огибающей. // // САЙДТОН. Огибающая пишется в кольцо на аудио-rate; аудиотракт её вычитывает // и умножает на свой синус (PullSidetone). Так тон точен ДЛЯ ЛЮБОГО источника — // и для текста, и для иамбика, — в отличие от пути с кейером в прошивке, где // PC знает лишь состояние лепестков. // --------------------------------------------------------------------------- interface uses Classes, SysUtils, SyncObjs, Math, SerialPort, CWMorse; const CW_SIDETONE_RATE = 48000; // rate огибающей сайдтона (аудиотракт PC) CW_IQ_BLOCK = 240; // пар в блоке = ровно DUC IQ пакет openHPSDR // Запас в FIFO бэкенда, он же латентность РЧ. Нижняя планка задана ЖЕЛЕЗОМ: // TX-поток Pluto наполняет буфер целиком (16384 пары ≈ 28 мс на 576 ksps) и // добивает нулями всё, чего в FIFO не хватило — то есть при меньшем запасе // посылка получила бы дыры. Сайдтон этой латентности не наследует: его отставание // отдельно ограничено CW_ST_MAX_LAG_MS. CW_PREFILL_MS = 60; CW_ST_MAX_LAG_MS = 20; // потолок отставания сайдтона от манипуляции type // Режим манипулятора. Прямой ключ = уровень на линии, иамбик = автомат по // двум лепесткам (A — без памяти, B — с памятью задетого элемента). TCWLocalMode = (clmStraight, clmIambicA, clmIambicB); // Линии модемного разъёма, которыми читается манипулятор. TCWKeyLine = (cklCTS, cklDSR, cklCD, cklRI); // IQ-пары (interleaved I,Q) в конвенции WDSP: РЧ = гетеродин + f. TCWIQEvent = procedure(const Buf: array of Double; Count: Integer) of object; // Начало/конец сессии передачи: PTT, реле T/R, антенна, аттенюатор. TCWSessionEvent = procedure(Active: Boolean) of object; // «Ключ живой» — дёргается на каждом выданном блоке (индикация/выдержка). TCWTickEvent = procedure of object; TCWLocalConfig = record Rate: Integer; // sample rate потока IQ (TX rate движка) OffsetHz: Double; // сдвиг несущей от гетеродина (уход от утечки LO) Amplitude: Double; // 0..1 — цифровой уровень несущей WPM: Integer; Weight: Integer; // 33..66 (50 = точка равна паузе) RampMS: Integer; // форма фронта посылки Mode: TCWLocalMode; Reverse: Boolean; // поменять лепестки местами Strict: Boolean; // строгие интервалы (см. RunSession) BreakIn: Boolean; // сессия сама поднимает передачу HangMS: Integer; // сколько держать передачу после последнего элемента RFDelayMS: Integer; // пауза после подъёма передачи до первой посылки Sidetone: Boolean; // писать огибающую в кольцо сайдтона end; { Генератор. Один поток: решает, что передавать, и сам же рисует IQ. } TCWLocalKeyer = class(TThread) private FLock: TCriticalSection; FSTLock: TCriticalSection; FWake: TEvent; // ---- вход (под FLock) -------------------------------------------------- FCfg: TCWLocalConfig; FArmed: Boolean; FPending: string; // очередь текста FAbortReq: Boolean; FBusyText: Boolean; FDotIn: Boolean; // лепесток «точка» (сырой, до Reverse) FDashIn: Boolean; FStraightIn:Boolean; // прямой ключ отдельным источником FTouched: Boolean; // касание манипулятора — обрывает текст // Эхо передачи для окна-терминала: знаки, которые УЖЕ ушли в эфир, и хвост, // который ещё стоит в очереди. Ведём под FLock, потому что читает их UI. FSent: string; FUnsent: string; FTrimTail: Boolean; // Backspace съел знак из уже разобранного текста // ---- рабочая копия (только поток генератора) --------------------------- FRate: Integer; FAmp: Double; FDit: Int64; // длительности в сэмплах FMark: Int64; FGap: Int64; FRamp: Int64; FHang: Int64; FRFDelay: Integer; FMode: TCWLocalMode; FReverse: Boolean; FStrict: Boolean; FSidetoneOn:Boolean; FCosStep: Double; // поворот фазора на сэмпл FSinStep: Double; FPhI: Double; // текущий фазор FPhQ: Double; FPhCnt: Integer; // счётчик до перенормировки FEnvPos: Int64; // позиция в рампе 0..FRamp FBuf: array of Double; FBufCnt: Integer; FEmitted: Int64; // сэмплов с начала сессии (пейсинг) FT0: QWord; FSTAcc: Integer; // делитель rate → CW_SIDETONE_RATE FSTRing: array of Single; FSTHead: Integer; FSTTail: Integer; // ---- разбор текста (только поток) -------------------------------------- FText: string; FTextPos: Integer; FCode: string; // код текущего знака ('.' и '-') FCodePos: Integer; FLeadGap: Int64; // пауза ПЕРЕД следующим элементом (межсловная) FTailGap: Int64; // добор паузы ПОСЛЕ элемента (межзнаковая) // ---- иамбик (только поток) --------------------------------------------- FLastDot: Boolean; FDotMem: Boolean; FDashMem: Boolean; FSeenDot: Boolean; // лепесток задет во время элемента (режим B) FSeenDash: Boolean; // ---- события ----------------------------------------------------------- FOnIQ: TCWIQEvent; FOnSession: TCWSessionEvent; FOnTick: TCWTickEvent; function Snapshot: Boolean; // конфиг → рабочие поля; False = не вооружён function MsToSamples(Ms: Integer): Int64; procedure Flush; procedure Pace; procedure Emit(KeyOn: Boolean; N: Int64; Watch: Boolean); procedure PushSidetone(E: Double); procedure ReadPaddles(out Dot, Dash: Boolean); function WorkPending: Boolean; function TakeTextElement(out IsDot: Boolean): Boolean; function TakeIambicElement(out IsDot: Boolean): Boolean; procedure ResetText; procedure RunSession; protected procedure Execute; override; public constructor Create; destructor Destroy; override; procedure Configure(const C: TCWLocalConfig); // Вооружение: снятие мгновенно обрывает передачу и отпускает ключ. procedure SetArmed(Value: Boolean); function Armed: Boolean; procedure SendText(const S: string); procedure AbortText; function Busy: Boolean; // Терминал: знаки, ушедшие в эфир с прошлого опроса (эхо своей передачи). function TakeSentText: string; // Терминал: что ещё стоит в очереди (набранное вперёд). function PendingText: string; // Стереть последний НЕ ушедший знак (Backspace в окне набора). function Backspace: Boolean; // Вход манипулятора (поток опроса порта / GUI). Состояния лепестков сырые, // Reverse применяет сам генератор. procedure Paddle(Dot, Dash: Boolean); procedure StraightKey(Down: Boolean); // Аудиотракт: вычитать до N отсчётов огибающей (0..1). Возвращает сколько // реально отдано — остальное вызывающий доигрывает спадом. function PullSidetone(var Buf: array of Single; N: Integer): Integer; property OnIQ: TCWIQEvent read FOnIQ write FOnIQ; property OnSession: TCWSessionEvent read FOnSession write FOnSession; property OnTick: TCWTickEvent read FOnTick write FOnTick; end; TCWKeyPortConfig = record Enabled: Boolean; Port: string; DotLine: TCWKeyLine; DashLine: TCWKeyLine; Invert: Boolean; // ключ замыкает линию в «0» (инверсный интерфейс) PowerDTR: Boolean; // поднять DTR (питание/общий провод ключа) PowerRTS: Boolean; end; TCWKeyPortEvent = procedure(Dot, Dash: Boolean) of object; { Опрос манипулятора на модемных линиях COM/USB-serial: DTR/RTS питают ключ, CTS/DSR/DCD/RI читаются как лепестки. Так же делают Thetis (cwkeyer.cs), hamlib и fldigi — это единственный вход ключа, доступный на любом железе. } TCWKeyPort = class(TThread) private FLock: TCriticalSection; FCfg: TCWKeyPortConfig; FDirty: Boolean; // конфиг сменился — переоткрыть FHandle: TSerialHandle; FLastErr: string; FOnKey: TCWKeyPortEvent; FPrevDot: Boolean; FPrevDash: Boolean; function ReadLine(L: TCWKeyLine): Boolean; procedure ClosePort; function OpenPort(const C: TCWKeyPortConfig): Boolean; procedure SetErr(const S: string); procedure Release; protected procedure Execute; override; public constructor Create; destructor Destroy; override; procedure Configure(const C: TCWKeyPortConfig); function LastError: string; property OnKey: TCWKeyPortEvent read FOnKey write FOnKey; end; implementation const DIT_MS_AT_1WPM = 1200; // стандарт PARIS ST_RING_MS = 250; // глубина кольца сайдтона { ── TCWLocalKeyer ─────────────────────────────────────────────────────────── } constructor TCWLocalKeyer.Create; begin FLock := TCriticalSection.Create; FSTLock := TCriticalSection.Create; FWake := TEvent.Create(nil, False, False, ''); FCfg.Rate := 192000; FCfg.Amplitude := 0.99; FCfg.WPM := 20; FCfg.Weight := 50; FCfg.RampMS := 9; FCfg.Mode := clmIambicB; FCfg.BreakIn := True; FCfg.HangMS := 300; FRate := FCfg.Rate; FCodePos := 1; SetLength(FBuf, CW_IQ_BLOCK * 2); SetLength(FSTRing, (CW_SIDETONE_RATE * ST_RING_MS) div 1000); FreeOnTerminate := False; inherited Create(False); end; destructor TCWLocalKeyer.Destroy; begin Terminate; SetArmed(False); FWake.SetEvent; WaitFor; FWake.Free; FSTLock.Free; FLock.Free; inherited Destroy; end; procedure TCWLocalKeyer.Configure(const C: TCWLocalConfig); begin FLock.Enter; try FCfg := C; if FCfg.Rate < 8000 then FCfg.Rate := 8000; if FCfg.WPM < 5 then FCfg.WPM := 5; if FCfg.WPM > 60 then FCfg.WPM := 60; if FCfg.Weight < 33 then FCfg.Weight := 33; if FCfg.Weight > 66 then FCfg.Weight := 66; if FCfg.RampMS < 0 then FCfg.RampMS := 0; if FCfg.RampMS > 20 then FCfg.RampMS := 20; if FCfg.HangMS < 0 then FCfg.HangMS := 0; if FCfg.RFDelayMS < 0 then FCfg.RFDelayMS := 0; if FCfg.Amplitude < 0 then FCfg.Amplitude := 0; if FCfg.Amplitude > 1 then FCfg.Amplitude := 1; finally FLock.Leave; end; end; procedure TCWLocalKeyer.SetArmed(Value: Boolean); begin FLock.Enter; try if FArmed = Value then Exit; FArmed := Value; if not Value then begin // Разоружение — это «передавать нельзя» (ушли из CW, зашли в RX-only слот // трансвертера, встали на бэнд с DoNotTx). Всё бросаем немедленно. FPending := ''; FAbortReq := True; FDotIn := False; FDashIn := False; FStraightIn := False; end; finally FLock.Leave; end; FWake.SetEvent; end; function TCWLocalKeyer.Armed: Boolean; begin FLock.Enter; try Result := FArmed; finally FLock.Leave; end; end; procedure TCWLocalKeyer.SendText(const S: string); begin if S = '' then Exit; FLock.Enter; try if not FArmed then Exit; FAbortReq := False; FTouched := False; FPending := FPending + S; FBusyText := True; finally FLock.Leave; end; FWake.SetEvent; end; procedure TCWLocalKeyer.AbortText; begin FLock.Enter; try FPending := ''; FAbortReq := True; finally FLock.Leave; end; FWake.SetEvent; end; function TCWLocalKeyer.Busy: Boolean; begin FLock.Enter; try Result := FBusyText or (FPending <> ''); finally FLock.Leave; end; end; 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; try if (Dot and not FDotIn) or (Dash and not FDashIn) then FTouched := True; FDotIn := Dot; FDashIn := Dash; finally FLock.Leave; end; if Dot or Dash then FWake.SetEvent; end; procedure TCWLocalKeyer.StraightKey(Down: Boolean); begin FLock.Enter; try if Down and not FStraightIn then FTouched := True; FStraightIn := Down; finally FLock.Leave; end; if Down then FWake.SetEvent; end; function TCWLocalKeyer.PullSidetone(var Buf: array of Single; N: Integer): Integer; var Avail, MaxLag: Integer; begin Result := 0; if N <= 0 then Exit; FSTLock.Enter; try // Генератор идёт впереди эфира на CW_PREFILL_MS, и весь этот запас оседал бы // в кольце — сайдтон отставал бы от руки на всю латентность РЧ. Лишнее // пролистываем: в начале сессии это тишина (окно RF delay), а дальше темпы // равны и листать уже нечего. Avail := FSTHead - FSTTail; if Avail < 0 then Inc(Avail, Length(FSTRing)); MaxLag := N + (CW_SIDETONE_RATE * CW_ST_MAX_LAG_MS) div 1000; if Avail > MaxLag then FSTTail := (FSTTail + (Avail - MaxLag)) mod Length(FSTRing); while (Result < N) and (FSTTail <> FSTHead) do begin Buf[Result] := FSTRing[FSTTail]; FSTTail := (FSTTail + 1) mod Length(FSTRing); Inc(Result); end; finally FSTLock.Leave; end; end; procedure TCWLocalKeyer.PushSidetone(E: Double); var NextH: Integer; begin FSTLock.Enter; try NextH := (FSTHead + 1) mod Length(FSTRing); if NextH = FSTTail then // Переполнение: аудиотракт молчит или отстал — держим ХВОСТ, иначе // сайдтон уезжал бы по времени от манипуляции. FSTTail := (FSTTail + 1) mod Length(FSTRing); FSTRing[FSTHead] := E; FSTHead := NextH; finally FSTLock.Leave; end; end; function TCWLocalKeyer.MsToSamples(Ms: Integer): Int64; begin if Ms <= 0 then Exit(0); Result := (Int64(FRate) * Ms) div 1000; end; function TCWLocalKeyer.Snapshot: Boolean; // Копия конфига в рабочие поля. Зовётся на каждом элементе — скорость/вес можно // крутить прямо во время передачи. var C: TCWLocalConfig; Th: Double; begin FLock.Enter; try C := FCfg; Result := FArmed; finally FLock.Leave; end; FRate := C.Rate; FAmp := C.Amplitude; FMode := C.Mode; FReverse := C.Reverse; FStrict := C.Strict; FSidetoneOn := C.Sidetone; FRFDelay := C.RFDelayMS; FDit := (Int64(FRate) * DIT_MS_AT_1WPM) div (Int64(C.WPM) * 1000); // Вес: 50 = точка равна паузе. Выше — посылки длиннее за счёт пауз ВНУТРИ // знака; межзнаковые интервалы остаются стандартными (иначе плывёт темп). FMark := (FDit * C.Weight) div 50; FGap := (FDit * (100 - C.Weight)) div 50; if FMark < 1 then FMark := 1; if FGap < 1 then FGap := 1; FRamp := (Int64(FRate) * C.RampMS) div 1000; if FRamp * 2 > FMark then FRamp := FMark div 2; // рампа не длиннее посылки if FRamp < 0 then FRamp := 0; FHang := MsToSamples(C.HangMS); Th := 2.0 * Pi * C.OffsetHz / FRate; FCosStep := Cos(Th); FSinStep := Sin(Th); end; procedure TCWLocalKeyer.Flush; begin if FBufCnt <= 0 then Exit; if Assigned(FOnIQ) then FOnIQ(FBuf, FBufCnt); FBufCnt := 0; if Assigned(FOnTick) then FOnTick; end; procedure TCWLocalKeyer.Pace; // Держим в FIFO бэкенда запас CW_PREFILL_MS: продюсер идёт по часам PC, а // потребитель — по радиоклоку. Больше запас — больше латентность РЧ и сайдтона, // меньше — риск подсоса нулей посреди посылки. var Target, Elapsed: Int64; begin Target := (FEmitted * 1000) div FRate - CW_PREFILL_MS; if Target <= 0 then Exit; repeat if Terminated then Exit; Elapsed := Int64(GetTickCount64 - FT0); if Elapsed >= Target then Exit; Sleep(1); until False; end; procedure TCWLocalKeyer.Emit(KeyOn: Boolean; N: Int64; Watch: Boolean); // Рисует N сэмплов при заданном состоянии ключа. Огибающая живёт МЕЖДУ // вызовами (FEnvPos): посылка = Emit(True, mark) поднимает фронт в первые FRamp // сэмплов, пауза = Emit(False, gap) роняет его в свои первые FRamp. Так точка // длится ровно mark по уровню 50%, а щелчка нет ни на одном фронте. var i: Int64; E, A, NI, NQ, Nrm: Double; Dot, Dash: Boolean; begin i := 0; while i < N do begin if Terminated then Exit; if KeyOn then begin if FEnvPos < FRamp then Inc(FEnvPos) else FEnvPos := FRamp; end else if FEnvPos > 0 then Dec(FEnvPos); if FRamp > 0 then E := 0.5 * (1.0 - Cos(Pi * FEnvPos / FRamp)) else if KeyOn then E := 1.0 else E := 0.0; A := FAmp * E; if (FSinStep <> 0.0) or (FCosStep <> 1.0) then begin // Поворот фазора вместо Sin/Cos на каждый сэмпл (192к вызовов в секунду). NI := FPhI * FCosStep - FPhQ * FSinStep; NQ := FPhI * FSinStep + FPhQ * FCosStep; FPhI := NI; FPhQ := NQ; Inc(FPhCnt); if FPhCnt >= 1024 then begin FPhCnt := 0; Nrm := Sqrt(FPhI * FPhI + FPhQ * FPhQ); if Nrm > 0 then begin FPhI := FPhI / Nrm; FPhQ := FPhQ / Nrm; end else begin FPhI := 1.0; FPhQ := 0.0; end; end; FBuf[FBufCnt * 2] := A * FPhI; FBuf[FBufCnt * 2 + 1] := A * FPhQ; end else begin FBuf[FBufCnt * 2] := A; // нулевой сдвиг — несущая прямо на DUC FBuf[FBufCnt * 2 + 1] := 0.0; end; Inc(FBufCnt); if FSidetoneOn then begin Inc(FSTAcc, CW_SIDETONE_RATE); if FSTAcc >= FRate then begin Dec(FSTAcc, FRate); PushSidetone(E); end; end; if FBufCnt >= CW_IQ_BLOCK then begin Flush; Pace; // Лепестки во время элемента — память режима B (см. RunSession). if Watch then begin ReadPaddles(Dot, Dash); if Dot then FSeenDot := True; if Dash then FSeenDash := True; end; end; Inc(i); Inc(FEmitted); end; end; procedure TCWLocalKeyer.ReadPaddles(out Dot, Dash: Boolean); var D, H: Boolean; begin FLock.Enter; try D := FDotIn; H := FDashIn; finally FLock.Leave; end; if FReverse then begin Dot := H; Dash := D; end else begin Dot := D; Dash := H; end; end; function TCWLocalKeyer.WorkPending: Boolean; begin FLock.Enter; try Result := FArmed and ((FPending <> '') or FDotIn or FDashIn or FStraightIn); finally FLock.Leave; end; end; procedure TCWLocalKeyer.ResetText; begin FText := ''; FTextPos := 0; FCode := ''; FCodePos := 1; FLeadGap := 0; FTailGap := 0; FLock.Enter; try FBusyText := False; FUnsent := ''; FTrimTail := False; finally FLock.Leave; end; end; function TCWLocalKeyer.TakeTextElement(out IsDot: Boolean): Boolean; // Очередной элемент передаваемого текста. Раскладка пауз та же, что у кейера // прошивки: 1 точка между элементами знака, 3 между знаками, 7 между словами. // Межсловная пауза копится в FLeadGap (отдаётся ПЕРЕД элементом), межзнаковая — // в FTailGap (после). var Ch: Char; Add: string; Drop, Trim: Boolean; KeepLen: Integer; begin Result := False; IsDot := True; FTailGap := 0; FLock.Enter; try Drop := FAbortReq or FTouched; if Drop then begin FPending := ''; FAbortReq := False; FTouched := False; end; Add := FPending; FPending := ''; Trim := FTrimTail; FTrimTail := False; KeepLen := FTextPos + Length(FUnsent); finally FLock.Leave; end; if Drop then begin ResetText; Exit; end; // Backspace дотянулся до уже разобранного текста — отсекаем хвост. if Trim and (Length(FText) > KeepLen) then SetLength(FText, KeepLen); if Add <> '' then FText := FText + Add; // Ищем следующий элемент, пропуская пробелы и знаки не из таблицы. while FCodePos > Length(FCode) do begin if FTextPos >= Length(FText) then begin ResetText; Exit; end; Inc(FTextPos); Ch := FText[FTextPos]; // Эхо: знак пошёл в эфир — отдаём его окну-терминалу, а хвост очереди // обновляем, чтобы строка набора показывала только ненабранное. 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. Inc(FLeadGap, 4 * FDit); Continue; end; FCode := MorseCode(Ch); FCodePos := 1; end; IsDot := FCode[FCodePos] = '.'; Result := True; Inc(FCodePos); // Последний элемент знака — добираем межзнаковый интервал до 3 точек. if FCodePos > Length(FCode) then FTailGap := 2 * FDit; FLock.Enter; try FBusyText := True; finally FLock.Leave; end; end; function TCWLocalKeyer.TakeIambicElement(out IsDot: Boolean): Boolean; // Автомат иамбика (логика pihpsdr src/iambic.c в терминах элементов): // * зажаты оба лепестка — элементы чередуются (иначе точка «съедала» бы тире); // * режим B — лепесток, задетый ВО ВРЕМЯ элемента, запоминается и отыгрывается // следующим; режим A памяти не имеет (в этом и вся разница); // * strict spacing — лепестки во время межэлементной паузы не запоминаются: // ритм задаёт кейер, а не рука. var Dot, Dash: Boolean; begin ReadPaddles(Dot, Dash); Result := True; if Dot and Dash then IsDot := not FLastDot else if Dot then IsDot := True else if Dash then IsDot := False else if FDotMem then IsDot := True else if FDashMem then IsDot := False else Result := False; if Result then begin FDotMem := False; FDashMem := False; FLastDot := IsDot; end; end; procedure TCWLocalKeyer.RunSession; // Одна сессия передачи: подъём T/R → элементы → hang → снятие T/R. var Idle: Int64; Chunk: Int64; IsDot: Boolean; Level: Boolean; Got: Boolean; Dot, Dash: Boolean; Br: Boolean; begin if not Snapshot then Exit; FLock.Enter; try Br := FCfg.BreakIn; finally FLock.Leave; end; FEnvPos := 0; FEmitted := 0; FBufCnt := 0; FSTAcc := 0; FPhI := 1.0; FPhQ := 0.0; FPhCnt := 0; FDotMem := False; FDashMem := False; FSeenDot := False; FSeenDash := False; FSTLock.Enter; try FSTHead := 0; FSTTail := 0; // старую огибающую в кольце не доигрываем finally FSTLock.Leave; end; if Br and Assigned(FOnSession) then FOnSession(True); FT0 := GetTickCount64; try // Окно на реле T/R, LO передатчика и аттенюатор: без него первая точка // ушла бы в ещё приёмную обвязку. Emit(False, MsToSamples(FRFDelay), False); Idle := 0; while not Terminated do begin if not Snapshot then Break; // разоружили посреди передачи FLock.Enter; try Level := FStraightIn; finally FLock.Leave; end; if FMode = clmStraight then begin ReadPaddles(Dot, Dash); Level := Level or Dot or Dash; // прямой ключ на любом лепестке end; // Прямой ключ — следуем за уровнем: длительность задаёт рука, наше дело // форма фронта. Квант 2 мс = задержка реакции на отпускание. if Level then begin Emit(True, MsToSamples(2), False); Idle := 0; Continue; end; // Текст имеет приоритет над манипулятором; касание лепестка его обрывает // (это ловит сам TakeTextElement по FTouched). Got := TakeTextElement(IsDot); if (not Got) and (FMode <> clmStraight) then Got := TakeIambicElement(IsDot); if Got then begin if FLeadGap > 0 then begin Emit(False, FLeadGap, not FStrict); FLeadGap := 0; end; FSeenDot := False; FSeenDash := False; if IsDot then Emit(True, FMark, True) else Emit(True, 3 * FMark, True); Emit(False, FGap, not FStrict); if FTailGap > 0 then begin Emit(False, FTailGap, not FStrict); FTailGap := 0; end; if FMode = clmIambicB then begin if IsDot and FSeenDash then FDashMem := True; if (not IsDot) and FSeenDot then FDotMem := True; end; Idle := 0; Continue; end; // Передавать нечего: держим передачу hang, потом закрываем сессию. Chunk := MsToSamples(4); if Chunk < 1 then Chunk := 1; Emit(False, Chunk, False); Inc(Idle, Chunk); if Idle >= FHang then Break; end; // Добить спад огибающей — сессия не должна обрываться щелчком. if FEnvPos > 0 then Emit(False, FRamp + 1, False); // ★Хвост тишины на всю глубину предзаполнения: конец сессии сбрасывает // очередь IQ в бэкенде, и без него в мусор ушёл бы ЕЩЁ НЕ СЫГРАННЫЙ спад // последней посылки (то есть щелчок в эфир). При hang > 0 хвост и так // тишина, но полагаться на настройку тут нельзя. Emit(False, MsToSamples(CW_PREFILL_MS + 5), False); Flush; finally if Br and Assigned(FOnSession) then FOnSession(False); end; end; procedure TCWLocalKeyer.Execute; begin while not Terminated do begin if not WorkPending then begin FWake.WaitFor(100); Continue; end; RunSession; end; end; { ── TCWKeyPort ────────────────────────────────────────────────────────────── } constructor TCWKeyPort.Create; begin FLock := TCriticalSection.Create; FHandle := SER_INVALID_HANDLE; FreeOnTerminate := False; inherited Create(False); end; destructor TCWKeyPort.Destroy; begin Terminate; WaitFor; ClosePort; FLock.Free; inherited Destroy; end; procedure TCWKeyPort.Configure(const C: TCWKeyPortConfig); begin FLock.Enter; try if (FCfg.Enabled = C.Enabled) and (FCfg.Port = C.Port) and (FCfg.DotLine = C.DotLine) and (FCfg.DashLine = C.DashLine) and (FCfg.Invert = C.Invert) and (FCfg.PowerDTR = C.PowerDTR) and (FCfg.PowerRTS = C.PowerRTS) then Exit; FCfg := C; FDirty := True; finally FLock.Leave; end; end; function TCWKeyPort.LastError: string; begin FLock.Enter; try Result := FLastErr; finally FLock.Leave; end; end; procedure TCWKeyPort.SetErr(const S: string); begin FLock.Enter; try FLastErr := S; finally FLock.Leave; end; end; procedure TCWKeyPort.Release; // Отпустить ключ: порт закрылся/выключили — генератор не должен остаться с // «зажатым» лепестком, иначе несущая повиснет в эфире. begin if (FPrevDot or FPrevDash) and Assigned(FOnKey) then FOnKey(False, False); FPrevDot := False; FPrevDash := False; end; procedure TCWKeyPort.ClosePort; begin if SerValid(FHandle) then begin SerSetDTR(FHandle, False); SerSetRTS(FHandle, False); SerClose(FHandle); end; FHandle := SER_INVALID_HANDLE; end; function TCWKeyPort.OpenPort(const C: TCWKeyPortConfig): Boolean; begin Result := False; if C.Port = '' then Exit; FHandle := SerOpen(C.Port); if not SerValid(FHandle) then begin FHandle := SER_INVALID_HANDLE; SetErr('cannot open ' + C.Port); Exit; end; // Скорость/формат манипулятору безразличны (данные не идут), но порт должен // быть настроен — иначе часть драйверов не отдаёт модемные линии. SerSetParams(FHandle, 9600, 8, NoneParity, 1, []); SerSetDTR(FHandle, C.PowerDTR); SerSetRTS(FHandle, C.PowerRTS); SetErr(''); Result := True; end; function TCWKeyPort.ReadLine(L: TCWKeyLine): Boolean; begin case L of cklDSR: Result := SerGetDSR(FHandle); cklCD: Result := SerGetCD(FHandle); cklRI: Result := SerGetRI(FHandle); else Result := SerGetCTS(FHandle); end; end; procedure TCWKeyPort.Execute; var C: TCWKeyPortConfig; Dot, Dash: Boolean; Retry: QWord; NeedReopen: Boolean; begin Retry := 0; while not Terminated do begin FLock.Enter; try C := FCfg; NeedReopen := FDirty; FDirty := False; finally FLock.Leave; end; if NeedReopen then begin Release; ClosePort; Retry := 0; end; if not C.Enabled then begin if SerValid(FHandle) then begin Release; ClosePort; end; Sleep(100); Continue; end; if not SerValid(FHandle) then begin // Переоткрытие раз в 2 с: адаптер могли воткнуть уже после старта. if GetTickCount64 < Retry then begin Sleep(100); Continue; end; Retry := GetTickCount64 + 2000; if not OpenPort(C) then begin Sleep(100); Continue; end; end; Dot := ReadLine(C.DotLine); Dash := ReadLine(C.DashLine); if C.Invert then begin Dot := not Dot; Dash := not Dash; end; if (Dot <> FPrevDot) or (Dash <> FPrevDash) then begin FPrevDot := Dot; FPrevDash := Dash; if Assigned(FOnKey) then FOnKey(Dot, Dash); end; Sleep(1); end; Release; end; end.