diff --git a/CWSST.pas b/CWSST.pas index 51da02b..51bb077 100644 --- a/CWSST.pas +++ b/CWSST.pas @@ -117,6 +117,8 @@ constructor TCWSST.Create; inherited Create; CWSSTList:= TObjectList.Create; Comparer := TComparer.Construct(TCWSSTRec.compareCall); + + BFarnsworthEnabled := true; end; destructor TCWSST.Destroy; diff --git a/Contest.pas b/Contest.pas index eb79b3f..591ca11 100644 --- a/Contest.pas +++ b/Contest.pas @@ -20,6 +20,8 @@ TContest = class procedure SwapFilters; protected + BFarnsworthEnabled : Boolean; // enables Farnsworth timing (e.g. SST Contest) + constructor Create; function IsReloadRequired(const AUserCallsign : String) : boolean; procedure SetLastLoadCallsign(const AUserCallsign : String); @@ -48,6 +50,7 @@ TContest = class function OnSetMyCall(const AUserCallsign : string; out err : string) : boolean; virtual; function OnContestPrepareToStart(const AUserCallsign: string; const ASentExchange : string) : Boolean; virtual; + function IsFarnsworthAllowed : Boolean; function GetSentExchTypes( const AStationKind : TStationKind; const AMyCallsign : string) : TExchTypes; @@ -108,6 +111,7 @@ constructor TContest.Create; Agc.AgcEnabled := true; NoActivityCnt :=0; LastLoadCallsign := ''; + BFarnsworthEnabled := false; Init; end; @@ -131,6 +135,7 @@ procedure TContest.Init; Stations.Clear; BlockNumber := 0; LastLoadCallsign := ''; + BFarnsworthEnabled := false; end; @@ -153,6 +158,18 @@ procedure TContest.SetLastLoadCallsign(const AUserCallsign : String); end; +{ + Farnsworth timing is supported by certain contests only (initially the + K1USN SST Contest). Derived contests will set BFarnworthEnabled in their + TContest.Create() method. +} +function TContest.IsFarnsworthAllowed : Boolean; +begin + Result := BFarnsworthEnabled; +end; + + + { GetStationInfo() returns station's DXCC information. diff --git a/DxOper.pas b/DxOper.pas index 33ba19a..101c934 100644 --- a/DxOper.pas +++ b/DxOper.pas @@ -32,7 +32,7 @@ TDxOperator = class State: TOperatorState; function GetSendDelay: integer; function GetReplyTimeout: integer; - function GetWpm: integer; + function GetWpm(out AWpmC : integer) : integer; function GetNR: integer; function GetName: string; procedure MsgReceived(AMsg: TStationMessages); @@ -65,7 +65,7 @@ function TDxOperator.GetSendDelay: integer; Result := SecondsToBlocks(0.1 + 0.5*Random); end; -function TDxOperator.GetWpm: integer; +function TDxOperator.GetWpm(out AWpmC : integer): integer; var mean, limit: Single; begin @@ -81,6 +81,16 @@ function TDxOperator.GetWpm: integer; end else { use Random value, [Wpm-Min,Wpm+Max] } Result := Round(Ini.Wpm - MinRxWpm + (MinRxWpm + MaxRxWpm) * Random); + + // optionally force all stations to use same speed (debugging and timing) + if Ini.AllStationsWpmS > 10 then + Result := Ini.AllStationsWpmS; + + // Allow Farnsworth timing for certain contests + if Tst.IsFarnsworthAllowed() and (Result < Ini.FarnsworthCharRate) then + AWpmC := Ini.FarnsworthCharRate + else + AWpmC := Result; end; function TDxOperator.GetNR: integer; diff --git a/DxStn.pas b/DxStn.pas index 7b922f6..0946242 100644 --- a/DxStn.pas +++ b/DxStn.pas @@ -56,7 +56,8 @@ constructor TDxStation.CreateStation; Oper.SetState(osNeedPrevEnd); NrWithError := Ini.Lids and (Random < 0.1); - WpmS := Oper.GetWpm; + // DX's speed, {WpmS,WpmC}, is set once at creation time + WpmS := Oper.GetWpm(WpmC); // DX's sent exchange types depends on kind-of-station and their callsign SentExchTypes := Tst.GetSentExchTypes(skDxStation, MyCall); diff --git a/Ini.pas b/Ini.pas index 82512dc..34cdaba 100644 --- a/Ini.pas +++ b/Ini.pas @@ -202,6 +202,8 @@ TContestDefinition = record CompDuration: integer = 60; SaveWav: boolean = false; + FarnsworthCharRate: integer = 25; + AllStationsWpmS: integer = 0; // force all stations to this Wpm CallsFromKeyer: boolean = false; F8: string = ''; @@ -309,11 +311,13 @@ procedure FromIni; SaveWav := ReadBool(SEC_STN, 'SaveWav', SaveWav); // [Settings] + FarnsworthCharRate := ReadInteger(SEC_SET, 'FarnsworthCharacterRate', FarnsworthCharRate); // [Debug] DebugExchSettings := ReadBool(SEC_DBG, 'DebugExchSettings', DebugExchSettings); DebugCwDecoder := ReadBool(SEC_DBG, 'DebugCwDecoder', DebugCwDecoder); DebugGhosting := ReadBool(SEC_DBG, 'DebugGhosting', DebugGhosting); + AllStationsWpmS := ReadInteger(SEC_DBG, 'AllStationsWpmS', AllStationsWpmS); F8 := ReadString(SEC_DBG, 'F8', F8); finally Free; @@ -379,6 +383,8 @@ procedure ToIni; WriteInteger(SEC_STN, 'SelfMonVolume', V); WriteBool(SEC_STN, 'SaveWav', SaveWav); + + WriteInteger(SEC_SET, 'MinFarnsworthWpmC', FarnsworthCharRate); finally Free; end; diff --git a/Log.pas b/Log.pas index 254b470..a51f7f3 100644 --- a/Log.pas +++ b/Log.pas @@ -19,6 +19,7 @@ procedure CheckErr; //procedure PaintHisto; procedure ShowRate; procedure ScoreTableSetTitle(const ACol1, ACol2, ACol3, ACol4, ACol5, ACol6, ACol7 :string); +procedure ScoreTableScaleWidth(const ACol : integer; const AScaleWidth : Single); procedure ScoreTableInsert(const ACol1, ACol2, ACol3, ACol4, ACol5, ACol6, ACol7 :string); procedure ScoreTableUpdateCheck; function FormatScore(const AScore: integer):string; @@ -38,7 +39,7 @@ TQso = record Nr, TrueNr: integer; Exch1, TrueExch1: string; // exchange 1 (e.g. 3A, OpName) Exch2, TrueExch2: string; // exchange 2 (e.g. OR, CWOPSNum) - TrueWpm: integer; // WPM of sending DxStn (reported in log) + TrueWpm: string; // WPM of sending DxStn (reported in log) Pfx: string; // extracted call prefix MultStr: string; // contest-specific multiplier (e.g. Pfx, dxcc) Points: integer; // points for this QSO @@ -185,6 +186,23 @@ procedure ScoreTableSetTitle(const ACol1, ACol2, ACol3, ACol4, ACol5, ACol6, ACo SetCaption(6, ACol7); end; +{ + Adjust the Log Table column width by AScaleWidth scaling factor. + This scaling number is multiplied by the original column width from the UI. + Typical usage is to increase the width of a column for a given contest. + For example, the SST contest will increase the column width from 3 to 5 + characters by using 'ScoreTableScaleWidth(6, 5.0/3)' or to increase width + by 40% use 'ScoreTableScaleWidth(6, 1.4)'. + This method can also be used to set the column width to zero if desired. + Note that whenever a new contest is started, the column widths are restored + to their original column widths. +} +procedure ScoreTableScaleWidth(const ACol : integer; const AScaleWidth : Single); +begin + assert(LogColWidthInitialized, 'must be called after ScoreTableSetTitle'); + MainForm.ListView2.Column[ACol].Width:= Ceil(AScaleWidth * LogColWidths[ACol]); +end; + procedure ScoreTableInsert(const ACol1, ACol2, ACol3, ACol4, ACol5, ACol6, ACol7 :string); begin with MainForm.ListView2.Items.Add do begin @@ -248,7 +266,12 @@ procedure Clear; scCwt: ScoreTableSetTitle('UTC', 'Call', 'Name', 'Exch', '', 'Chk', 'Wpm'); scSst: - ScoreTableSetTitle('UTC', 'Call', 'Name', 'Exch', '', 'Chk', 'Wpm'); + begin + ScoreTableSetTitle('UTC', 'Call', 'Name', 'Exch', '', 'Chk', ' Wpm'); + ScoreTableScaleWidth(3, 0.75); // shrink Exch column + ScoreTableScaleWidth(5, 1.2); // expand Chk column for 'NAME' error + ScoreTableScaleWidth(6, 1.4); // expand Wpm column for 22/25 Farnsworth + end; scFieldDay: ScoreTableSetTitle('UTC', 'Call', 'Class', 'Section', 'Pref', 'Chk', 'Wpm'); scNaQp: @@ -258,7 +281,10 @@ procedure Clear; scArrlDx: ScoreTableSetTitle('UTC', 'Call', 'Recv', 'Sent', 'Pref', 'Chk', 'Wpm'); scAcag: + begin ScoreTableSetTitle('UTC', 'Call', 'Recv', 'Sent', 'City', 'Chk', 'Wpm'); + ScoreTableScaleWidth(4, 1.2); // expand City column for wide numbers + end; else ScoreTableSetTitle('UTC', 'Call', 'Recv', 'Sent', 'Pref', 'Chk', 'Wpm'); end; @@ -616,7 +642,7 @@ procedure SaveQso; with Tst.Stations[i] as TDxStation do if (MyCall = Qso.Call) then begin - Qso.TrueWpm := Wpm; + Qso.TrueWpm := WpmAsText(); Break; end; @@ -654,46 +680,51 @@ procedure LastQsoToScreen; with QsoList[High(QsoList)] do begin // Adding a contest: LastQsoToScreen, add last qso to Score Table case Ini.SimContest of - scCwt, scSst: + scCwt: + ScoreTableInsert(FormatDateTime('hh:nn:ss', t), Call + , Exch1 + , Exch2 + , Pfx, Err, format('%3s', [TrueWpm])); + scSst: ScoreTableInsert(FormatDateTime('hh:nn:ss', t), Call , Exch1 , Exch2 - , Pfx, Err, format('%.2d', [TrueWpm])); + , Pfx, Err, format('%5s', [TrueWpm])); scFieldDay: ScoreTableInsert(FormatDateTime('hh:nn:ss', t), Call , Exch1 , Exch2 - , Pfx, Err, format('%.2d', [TrueWpm])); + , Pfx, Err, format('%3s', [TrueWpm])); scNaQp: ScoreTableInsert(FormatDateTime('hh:nn:ss', t), Call , Exch1 , Exch2 - , Pfx, Err, format('%.2d', [TrueWpm])); + , Pfx, Err, format('%3s', [TrueWpm])); scWpx, scHst: ScoreTableInsert(FormatDateTime('hh:nn:ss', t), Call , format('%.3d %.4d', [Rst, Nr]) , format('%.3d %.4d', [Tst.Me.Rst, Tst.Me.NR]) - , Pfx, Err, format('%.3d', [TrueWpm])); + , Pfx, Err, format('%3s', [TrueWpm])); scCQWW: ScoreTableInsert(FormatDateTime('hh:nn:ss', t), Call , format('%.3d %4d', [Rst, NR]) , format('%.3s %4d', [Tst.Me.Exch1, Tst.Me.NR]) // log my sent RST - , Pfx, Err, format('%.3d', [TrueWpm])); + , Pfx, Err, format('%3s', [TrueWpm])); scArrlDx: ScoreTableInsert(FormatDateTime('hh:nn:ss', t), Call , format('%.3d %4s', [Rst, Exch2]) , format('%.3s %4s', [Tst.Me.Exch1, Tst.Me.Exch2]) // log my sent RST - , Pfx, Err, format('%.2d', [TrueWpm])); + , Pfx, Err, format('%3s', [TrueWpm])); scAllJa: ScoreTableInsert(FormatDateTime('hh:nn:ss', t), Call , format('%.3d %4s', [Rst, Exch2]) , format('%.3s %4s', [Tst.Me.Exch1, Tst.Me.Exch2]) // log my sent RST - , MultStr, Err, format('%.2d', [TrueWpm])); + , MultStr, Err, format('%3s', [TrueWpm])); scAcag: ScoreTableInsert(FormatDateTime('hh:nn:ss', t), Call , format('%.3d %4s', [Rst, Exch2]) , format('%.3s %4s', [Tst.Me.Exch1, Tst.Me.Exch2]) // log my sent RST - , MultStr, Err, format('%.2d', [TrueWpm])); + , MultStr, Err, format('%3s', [TrueWpm])); else assert(false, 'missing case'); end; diff --git a/Main.pas b/Main.pas index 302ff1c..4e67822 100644 --- a/Main.pas +++ b/Main.pas @@ -423,7 +423,7 @@ implementation uses ARRL, ARRLFD, NAQP, CWOPS, CQWW, CQWPX, ARRLDX, CWSST, ALLJA, ACAG, - MorseKey, CallLst, + MorseKey, FarnsKeyer, CallLst, SysUtils, ShellApi, Crc32, Idhttp, Math, IniFiles, Dialogs, System.UITypes, TypInfo, ScoreDlg, Log, PerlRegEx, StrUtils; @@ -477,9 +477,7 @@ procedure TMainForm.FormCreate(Sender: TObject); BDebugExchSettings := CDebugExchSettings or Ini.DebugExchSettings; BDebugCwDecoder := CDebugCwDecoder or Ini.DebugCwDecoder; - MakeKeyer; - Keyer.Rate := DEFAULTRATE; - Keyer.BufSize := Ini.BufSize; + MakeKeyer(DEFAULTRATE, Ini.BufSize); // create a derived TContest of the appropriate type SetContest(Ini.SimContest); @@ -965,6 +963,13 @@ procedure TMainForm.SetContest(AContestNum: TSimContest); // create new contest Tst := CreateContest(AContestNum); + // load original or Farnsworth Keyer + FreeAndNil(Keyer); + if SimContest in [scSST] then + Keyer := TFarnsKeyer.Create(DEFAULTRATE, Ini.BufSize) + else + Keyer := TKeyer.Create(DEFAULTRATE, Ini.BufSize); + // the following will initialize simulation-specific data owned by contest. // (moved here from Ini.FromIni) begin diff --git a/MorseRunner.dpr b/MorseRunner.dpr index 93cb8c6..a2607d8 100644 --- a/MorseRunner.dpr +++ b/MorseRunner.dpr @@ -9,6 +9,7 @@ uses Ini in 'Ini.pas', Station in 'Station.pas', MorseKey in 'VCL\MorseKey.pas', + FarnsKeyer in 'VCL\FarnsKeyer.pas', StnColl in 'StnColl.pas', DxStn in 'DxStn.pas', MyStn in 'MyStn.pas', diff --git a/MorseRunner.dproj b/MorseRunner.dproj index 9dce010..db3a3c3 100644 --- a/MorseRunner.dproj +++ b/MorseRunner.dproj @@ -124,6 +124,7 @@ + diff --git a/MyStn.pas b/MyStn.pas index 2dd30a4..5cc4c29 100644 --- a/MyStn.pas +++ b/MyStn.pas @@ -60,6 +60,7 @@ procedure TMyStation.Init; RST := 599; Pitch := Ini.Pitch; WpmS := Ini.Wpm; + WpmC := WpmS; Amplitude := 300000; // invalidate SentExchTypes. Will be set by Tst.OnSetMyCall(). @@ -78,7 +79,12 @@ procedure TMyStation.Init; } procedure TMyStation.SetWpm(const AWpmS : integer); begin - WpmS := AWpmS; // set via UI + if Ini.AllStationsWpmS > 0 + then WpmS := Ini.AllStationsWpmS + else WpmS := AWpmS; // set via UI + if Tst.IsFarnsworthAllowed() and (Ini.FarnsworthCharRate > WpmS) + then WpmC := Ini.FarnsworthCharRate + else WpmC := WpmS; end; @@ -186,7 +192,7 @@ function TMyStation.UpdateCallInMessage(ACall: string): boolean; if Result then begin //create new envelope - Keyer.WpmS := Wpm; + Keyer.SetWpm(Self.WpmS, Self.WpmC); Keyer.MorseMsg := Keyer.Encode(ACall); NewEnvelope := Keyer.Envelope; for i:=0 to High(NewEnvelope) do diff --git a/QrmStn.pas b/QrmStn.pas index 6a80131..1530406 100644 --- a/QrmStn.pas +++ b/QrmStn.pas @@ -36,6 +36,7 @@ constructor TQrmStation.CreateStation; Amplitude := 5000 + 25000 * Random; Pitch := Round(RndGaussLim(0, 300)); WpmS := 30 + Random(20); + WpmC := WpmS; // DX's sent exchange types depends on kind-of-station and their callsign SentExchTypes:= Tst.GetSentExchTypes(skDxStation, MyCall); diff --git a/Station.pas b/Station.pas index 6e46f0a..9d6793e 100644 --- a/Station.pas +++ b/Station.pas @@ -55,6 +55,7 @@ TStation = class (TCollectionItem) public Amplitude: Single; WpmS: integer; // Words per minute, sending speed (set by UI) + WpmC: integer; // Words per minute, character speed (set via .INI) Envelope: TSingleArray; // this station's digitized Envelope being sent State: TStationState; @@ -90,6 +91,8 @@ TStation = class (TCollectionItem) procedure SendText(AMsg: string); virtual; procedure SendMorse(AMorse: string); + function WpmAsText : string; + property Pitch: integer read FPitch write SetPitch; property Bfo: Single read GetBfo; end; @@ -143,6 +146,7 @@ function TStation.GetBfo: Single; end; +// returns the next block of 512 samples from this station's current Envelope. function TStation.GetBlock: TSingleArray; begin Result := Copy(Envelope, SendPos, Ini.BufSize); @@ -246,7 +250,7 @@ procedure TStation.SendMorse(AMorse: string); FBfo := 0; end; - Keyer.WpmS := WpmS; + Keyer.SetWpm(Self.WpmS, Self.WpmC); Keyer.MorseMsg := AMorse; Envelope := Keyer.Envelope; for i:=0 to High(Envelope) do @@ -348,5 +352,14 @@ function TStation.NrAsText: string; end; end; + +function TStation.WpmAsText : string; +begin + if WpmS < WpmC then + Result:= Format('%d/%d', [WpmS, WpmC]) + else + Result:= Format('%3d', [WpmS]); +end; + end. diff --git a/VCL/FarnsKeyer.pas b/VCL/FarnsKeyer.pas new file mode 100644 index 0000000..fe716dc --- /dev/null +++ b/VCL/FarnsKeyer.pas @@ -0,0 +1,333 @@ +//------------------------------------------------------------------------------ +//This Source Code Form is subject to the terms of the Mozilla Public +//License, v. 2.0. If a copy of the MPL was not distributed with this +//file, You can obtain one at http://mozilla.org/MPL/2.0/. +//------------------------------------------------------------------------------ +unit FarnsKeyer; + +interface + +uses + SndTypes, MorseKey; + + +type + TFarnsKeyer = class(TKeyer) + protected + function GetEnvelope: TSingleArray; override; + procedure LoadMorseTable; + + public + constructor Create(ARate, ABufSize : integer); + function Encode(Txt: string): string; override; + end; + + +implementation + +uses + SysUtils, Classes, MorseTbl, Math; + + +{ TFarnsKeyer } + +constructor TFarnsKeyer.Create(ARate, ABufSize : integer); +begin + inherited Create(ARate, ABufSize); + LoadMorseTable; +end; + + +{ + Load MorseTable with the dit/dash representation of each character + followed by a trailing intra-character marker ('^'). + A: '.-^' + B: '-...^' + C: '-.-.^' + ... + Z: '--..^' +} +procedure TFarnsKeyer.LoadMorseTable; +var + i: integer; + S: string; + Ch: Char; +begin + for i:=0 to High(MorseTable) do + begin + S := MorseTable[i]; + if S[2] <> '[' then + Continue; + Ch := S[1]; + Morse[Ch] := Copy(S, 3, Pos(']', S)-3) + '^'; + end; +end; + + +{ + Encode() + + In order to correct apply the Farnsworth timing, we need to clearly + distinguish inter-character, inter-word, and inter-message markers. + Each of these markers will require special treatment while generating + the CW samples. + + The approach will be to insert special characters to represent each marker. + We will add '^' as inter-character marker and convert all occurances of + '^ ' to '_' for inter-word marker. + + Approach: + - add '^' as the inter-character marker when creating the Morse lookup table. + A: '.-^' + B: '-...^' + C: '-.-.^' + ... + Z: '--..^' + As an example, 'CQ CQ' becomes: + 'CQ CQ' -> '-.-.^--.-^ -.-.^--.-^' + - convert all '^ ' occurances to '_'. + 'CQ CQ' -> '-.-.^--.-_-.-.^--.-^' + - replace trailing '^$' with '~' to end of each encoded message. + 'CQ CQ' -> '-.-.^--.-_-.-.^--.-~' + + Timing: + '^' - 3U @ Farnsworth adjusted inter-char/word rate + '_' - 5U or 7U @ Farnsworth adjusted inter-char/word rate + '~' - 5U or 7U @ Farnsworth adjusted inter-char/word rate + Example (continued) + 'CQ CQ' -> '-.-.^--.-_-.-.^--.-~' + 3 7 3 7 + Our implementation is using 5U inter-word and inter-message spacing, thus: + 'CQ CQ' -> '-.-.^--.-_-.-.^--.-~' + 3 5 3 5 + + Subsequent messages: + - when subsequent messages are appended (by independent SendMsg() calls), + the new message is appended to to the existing MsgText string using + a space (' '). + - callsigns sent by the current MR user are handled by TMyStation.SendText() + by breaking up the callsign in a separate so-called Pieces. These pieces + are then sent sequentially and not appended into a single message string. + Thus ';<#>' (sent by successive function keys) becomes: + 'K7S;5NN TT1' -> '-.-^--...^...~' ; '.....^-.^-.^ -^-^.----^' + -> '-.-^--...^...~' ; '.....^-.^-._-^-^.----~' + 3 3 7 3 3 7 3 3 7 + '?';'?' -> '..--..^' ; '..--..^' + -> '..--..~' ; '..--..~' + -> '..--..~' ; '..--..~' + 7 7 + + Timing summary: + - all '^' occurances - inter-character spacing with 3U @ Farns adjusted time + - all '_' occurances - inter-word spacing with 5U @ Farns adjusted time + - all ' ' occurances - additional inter-word spacing with 5U spacing + - all '~' occurances - inter-word spacing with 5U @ Farns adjusted time +} +function TFarnsKeyer.Encode(Txt: string): string; +var + i: integer; +begin + Result := ''; + for i:=1 to Length(Txt) do + if CharInSet(Txt[i], [' ', '_']) then + Result := Result + ' ' + else + Result := Result + Morse[Txt[i]]; + + // apply rules + Result := Result.Replace('^ ', '_', [rfReplaceAll]); // inter-word marker ('_') + {while true do begin + i := Result.IndexOf('~'); + if (i = 0) or (i = Length(Result)) then break; + Result[i] := '_'; + end;} + if Result.EndsWith('^') then + Result[Length(Result)] := '~'; // inter-message marker ('~') +end; + + +{ + GetEnvelope() + + Returns a TSingleArray containing the samples representing the current + MsgText. If Farnsworth spacing is enabled, additional inter-character + and inter-word spacing will be been applied. + + The following articles discuss the timing equations used in this + implementation. + - https://morsecode.world/international/timing.html + - https://www.arrl.org/files/file/Technology/x9004008.pdf +} +function TFarnsKeyer.GetEnvelope: TSingleArray; +const + InterCharSpacing : integer = 3; // 3U inter-char, 5U inter-word spacing + InterWordSpacing : integer = 5; // 5U inter-word spacing (matches original) + InterMsgSpacing : integer = 4; // 4U inter-message spacing (plus loop time) +var + UnitCnt, Len, i, p: integer; + Farnsworth: Boolean; + AdjustCnt: integer; // units added for inter-character and inter-word spacing + DelayPerWord: Single; + SamplesInUnit: integer; + SamplesInAdjustUnit: integer; // samples per inter-character and inter-word unit + + procedure AddRampOn; + begin + Move(RampOn[0], Result[p], RampLen * SizeOf(Single)); + Inc(p, Length(RampOn)); + end; + + procedure AddRampOff; + begin + Move(RampOff[0], Result[p], RampLen * SizeOf(Single)); + Inc(p, Length(RampOff)); + end; + + { Add "Dur" units of standard-width 1-value (On) to the output stream. } + procedure AddOn(Dur: integer); + var + i: integer; + begin + for i:=0 to Dur * SamplesInUnit - RampLen - 1 do Result[p+i] := 1; + Inc(p, Dur * SamplesInUnit - RampLen); + end; + + { + Add 'Dur' units of standard-width 0-value (Off) to the output stream. + The argument ARampLen allows the RampLen width of the prior RampOff() + to be subtracted while advancing the pointer 'Dur' units. + + Dur - desired duration in units + ARampLen - number of samples representing the RampOff length + } + procedure AddOff(Dur: integer; ARampLen: integer = 0); + begin + Inc(p, Dur * SamplesInUnit - ARampLen); + end; + + { + AdjustSpace() will convert a trailing standard-width intra-character space + with a Farnsworth-width inter-character space. + + This is called for one of inter-character ('^'), inter-word ('_'), or + inter-message spacing '(~)'. + This should only be called after a character is streamed with AddOff(). + Remember that the last character has advanced the pointer, p, by RampLen + samples and was counted at WpmC (character speed). + } + procedure AdjustSpace(Dur : Integer); + begin + Inc(p, (Dur-1) * SamplesInUnit); + if Farnsworth then + Inc(p, Dur * (SamplesInAdjustUnit - SamplesInUnit)); + end; + + { + Add additional space between characters (' ') without compensating + for a prior space being sent. + } + procedure AddSpace(Dur: integer); + begin + if Farnsworth then + Inc(p, Dur * SamplesInAdjustUnit) + else + Inc(p, Dur * SamplesInUnit); + end; + + // this procedure will increment both the standard-width UnitCnt and the + // Farnsworth-adjusted AdjustCnt units. + procedure IncAdjust(Dur: integer; Prior: integer = 0); + begin + assert(Prior <= 0); // Prior is an optional negative value + if Farnsworth then + begin + Inc(UnitCnt, Prior); + Inc(AdjustCnt, Dur); // consider SpaceCnt instead of AdjustCnt? + end + else + Inc(UnitCnt, Dur+Prior); + end; + +begin + assert(WpmS > 0, 'must init using SetWpm()'); + + UnitCnt := 0; // intra-character spaces + AdjustCnt := 0; // inter-character and inter-word spaces (Farnsworth timing) + + //setup Farnsworth timing adjustments + DelayPerWord := 0.0; + SamplesInAdjustUnit := 0; + Farnsworth := WpmS <= WpmC; + if Farnsworth then + begin + { + Farnsworth timing uses a different inter-character and inter-word + spacing. Timing equations are discussed in these two articles: + - https://morsecode.world/international/timing.html + - https://www.arrl.org/files/file/Technology/x9004008.pdf + + The delay equation is based on the word 'PARIS ', there are 19U of + Farnsworth spacing, including 7 units representing the trailing space. + Based on the above papers, the time of the farnsworth spacing for these + 19 units of inter-character spacing is defined as: + DelayPerWord (19 units of spacing) + = (50 units (1 word) at WpmS) - (31 character units at WpmC) + DelayPerWord := 50*(60/50)/WpmS - 31*60/WpmC/50; + DelayPerWord := 60/WpmS - 31*60/WpmC/50; + + However, since we are using inter-word spacing of 5U instead of 7U, + these equations must be modified by changing the number of spacing + units being sent. To change the 19U of Farnsworth delay spacing to 17U, + we will reduce the total 50U to 48U as represented by + (43+InterWordSpacing). With this substitution, the delay timing + equation becomes: + DelayPerWord ((12+InterWordSpacing) units of spacing) + = (1 word at WpmS) - (31 character units at WpmC) + DelayPerWord := 60/WpmS - 31*60/WpmC/50; + DelayPerWord := 60/WpmS - 31*60/WpmC/48; + DelayPerWord := 60/WpmS - 31*60/WpmC/(43+InterWordSpacing); + + samples = time * samples/sec + } + DelayPerWord := 60/WpmS - 31*60/WpmC/(43+InterWordSpacing); + SamplesInAdjustUnit := Round(DelayPerWord * Rate / (12+InterWordSpacing)); + end + else + WpmC := WpmS; + + //count standard and delay units + for i:=1 to Length(MorseMsg) do + case MorseMsg[i] of + '.': Inc(UnitCnt, 2); // 1 unit dit followed by 1 unit spacing + '-': Inc(UnitCnt, 4); // 3 unit dash followed by 1 unit spacing + '^': IncAdjust(InterCharSpacing, -1); // inter-char spacing (3U - 1U prior) + ' ': IncAdjust(InterWordSpacing, 0); // inter-word spacing (5U) + '_': IncAdjust(InterWordSpacing, -1); // inter-word spacing (5U - 1U prior) + '~': IncAdjust(InterMsgSpacing, -1); // inter-msg spacing (4U - 1U prior) + end; + + //calc buffer size + SamplesInUnit := Round(60 * Rate / WpmC / (43+InterWordSpacing)); + TrueEnvelopeLen := UnitCnt * SamplesInUnit + // units at WpmC + AdjustCnt * SamplesInAdjustUnit; // units at WpmS + Len := BufSize * Ceil(TrueEnvelopeLen / BufSize); + Result := nil; + SetLength(Result, Len); + + //fill buffer + p := 0; + for i:=1 to Length(MorseMsg) do + case MorseMsg[i] of + '.': begin AddRampOn; AddOn(1); AddRampOff; AddOff(1, RampLen); end; + '-': begin AddRampOn; AddOn(3); AddRampOff; AddOff(1, RampLen); end; + '^': AdjustSpace(InterCharSpacing); // inter-char spacing (3U less 1U applied) + ' ': AddSpace(InterWordSpacing); // inter-word spacing (5U) + '_': AdjustSpace(InterWordSpacing); // inter-word spacing (5U less 1U applied) + '~': AdjustSpace(InterMsgSpacing); // inter-msg spacing (4U less 1U applied) + end; + assert(p = TrueEnvelopeLen); +end; + + +end. + diff --git a/VCL/MorseKey.pas b/VCL/MorseKey.pas index 949681b..91d9a22 100644 --- a/VCL/MorseKey.pas +++ b/VCL/MorseKey.pas @@ -8,39 +8,44 @@ interface uses - SysUtils, Classes, SndTypes, MorseTbl, Math; //, Ini + SndTypes; type TKeyer = class - private + protected Morse: array[Char] of string; RampLen: integer; RampOn, RampOff: TSingleArray; FRiseTime: Single; - function GetEnvelope: TSingleArray; + // Farnsworth speed s/c (e.g. 5/18). specified as (WpmS/WpmC) + WpmS: integer; // sending speed (set by UI) + WpmC: integer; // character speed (set via .INI file, default=25wpm) + + function GetEnvelope: TSingleArray; virtual; procedure LoadMorseTable; procedure MakeRamp; function BlackmanHarrisKernel(x: Single): Single; function BlackmanHarrisStepResponse(Len: integer): TSingleArray; procedure SetRiseTime(const Value: Single); - public - WpmS: integer; // sending speed - Ts (set by UI) + +public BufSize: integer; Rate: integer; MorseMsg: string; TrueEnvelopeLen: integer; - constructor Create; - function Encode(Txt: string): string; + constructor Create(ARate, ABufSize : integer); + procedure SetWpm(const AWpmS : integer; const AWpmC : integer = 0); + function Encode(Txt: string): string; virtual; property RiseTime: Single read FRiseTime write SetRiseTime; property Envelope: TSingleArray read GetEnvelope; end; -procedure MakeKeyer; +procedure MakeKeyer(ARate : integer = 11025; ABufSize : integer = 512); procedure DestroyKeyer; var @@ -49,27 +54,33 @@ procedure DestroyKeyer; implementation -procedure MakeKeyer; +uses + SysUtils, Classes, MorseTbl, Math; + +procedure MakeKeyer(ARate, ABufSize : integer); begin - Keyer := TKeyer.Create; + Keyer := TKeyer.Create(ARate, ABufSize); end; procedure DestroyKeyer; begin - Keyer.Free; + FreeAndNil(Keyer); end; { TKeyer } -constructor TKeyer.Create; +constructor TKeyer.Create(ARate, ABufSize : integer); begin LoadMorseTable; - Rate := 11025; + Rate := ARate; + BufSize := ABufSize; RiseTime := 0.005; //RiseTime := 1.0 / (2.7 * Rate); // debugging with 1 step rise/fall time + WpmS := 0; + WpmC := 0; end; @@ -80,6 +91,13 @@ procedure TKeyer.SetRiseTime(const Value: Single); end; +procedure TKeyer.SetWpm(const AWpmS : integer; const AWpmC : integer = 0); +begin + WpmS := AWpmS; + WpmC := AWpmC; +end; + + procedure TKeyer.LoadMorseTable; var i: integer; @@ -213,7 +231,7 @@ function TKeyer.GetEnvelope: TSingleArray; begin - assert(WpmS > 0, 'WpmS not initialized'); + assert(WpmS > 0, 'must init using SetWpm()'); //count units UnitCnt := 0;