feat(dmr): add diagnostic capture probes

This commit is contained in:
2026-07-14 19:09:35 +03:00
parent 70486d901b
commit 39b4627c2b
9 changed files with 662 additions and 3 deletions
+1
View File
@@ -109,6 +109,7 @@ PROJECT_NOTES_FOR_CLAUDE.md
*.app/
dist/
/build/
wdspWisdom00
*.log
ewsdr
+10
View File
@@ -14,3 +14,13 @@ fpc -Fu. -FE/tmp tests/dmr_protocol_test.pas
/tmp/dmr_protocol_test
fpc -Fu. -FE/tmp tests/dmr_frontend_test.pas
LD_LIBRARY_PATH=build/dmr /tmp/dmr_frontend_test
fpc -Fu. -FE/tmp tests/dmr_diagnostics_test.pas
/tmp/dmr_diagnostics_test
# Replay a captured 48 kHz discriminator stream through the DMR decoder
fpc -Fu. -FE/tmp tools/dmr_replay.pas
/tmp/dmr_replay /tmp/ewsdr-dmr-*.demod_f32le
# Convert exact 24-bit network IQ to GNU Radio/inspectrum complex float32
fpc -FE/tmp tools/iq24be_to_cf32.pas
/tmp/iq24be_to_cf32 /tmp/ewsdr-dmr-*.iq24be
+45 -1
View File
@@ -31,6 +31,7 @@ const
type
TDMRAudioEvent = procedure(const PCM: array of Single; Count: Integer) of object;
TDMRBurstEvent = procedure(const Dibits: array of Byte; Count: Integer) of object;
TDMRSyncKind = (
dskNone,
@@ -68,6 +69,11 @@ type
SelectedSlot: Integer;
VoiceFrameCount: QWord;
VoiceErrorCount: QWord;
BestSyncDistance: Integer;
BestSyncPhase: Integer;
BestCandidateKind: TDMRSyncKind;
SymbolOuterLevel: Single;
SignalMean: Single;
end;
TDMRDecoder = class;
@@ -121,8 +127,12 @@ type
FLastSelectedVoiceTick: QWord;
FVoiceFrameCount, FVoiceErrorCount: QWord;
FOnAudio: TDMRAudioEvent;
FOnBurst: TDMRBurstEvent;
FBurstCount: QWord;
FRMSSq: Double;
FSignalMean: Double;
FBestSyncDistance, FBestSyncPhase: Integer;
FBestCandidateKind: TDMRSyncKind;
FSyncKind: TDMRSyncKind;
FInputInverted: Boolean;
@@ -152,6 +162,7 @@ type
class function SyncKindName(Kind: TDMRSyncKind): string; static;
property Enabled: Boolean read FEnabled;
property OnAudio: TDMRAudioEvent read FOnAudio write FOnAudio;
property OnBurst: TDMRBurstEvent read FOnBurst write FOnBurst;
end;
implementation
@@ -191,6 +202,17 @@ begin
end;
end;
function PopCount24(V: LongWord): Integer;
begin
V := V and DMR_SYNC_MASK;
Result := 0;
while V <> 0 do
begin
V := V and (V - 1);
Inc(Result);
end;
end;
constructor TDMRDecoderThread.Create(AOwner: TDMRDecoder);
begin
inherited Create(True);
@@ -300,6 +322,10 @@ begin
FWindowSum := 0;
FSampleNo := 0;
FRMSSq := 0;
FSignalMean := 0;
FBestSyncDistance := 25;
FBestSyncPhase := -1;
FBestCandidateKind := dskNone;
FStatusLock.Enter;
try
FSyncKind := dskNone;
@@ -379,6 +405,7 @@ var
Sym: Double;
begin
FRMSSq := FRMSSq + 0.001 * (S * S - FRMSSq);
FSignalMean := FSignalMean + 0.001 * (S - FSignalMean);
FWindowSum := FWindowSum - FSampleWindow[FWindowPos] + S;
FSampleWindow[FWindowPos] := S;
FWindowPos := (FWindowPos + 1) mod DMR_SAMPLES_PER_SYM;
@@ -395,7 +422,7 @@ end;
procedure TDMRDecoder.ProcessSymbol(Phase: Integer; Symbol: Double);
var
i: Integer;
i, Distance: Integer;
Pat: LongWord;
Dibit: Byte;
V: Double;
@@ -430,6 +457,16 @@ begin
for i := 0 to High(SYNC_TEXT) do
begin
Pat := SyncBits(SYNC_TEXT[i]);
if FHistoryCount[Phase] >= 24 then
begin
Distance := PopCount24(FSyncShift[Phase] xor Pat);
if Distance < FBestSyncDistance then
begin
FBestSyncDistance := Distance;
FBestSyncPhase := Phase;
FBestCandidateKind := SYNC_KIND[i];
end;
end;
if FSyncShift[Phase] = Pat then
begin
NoteSync(Phase, SYNC_KIND[i], FInputInverted);
@@ -478,6 +515,7 @@ procedure TDMRDecoder.CompleteBurst;
begin
Move(FCurrentBurst[0], FLastBurst[0], SizeOf(FLastBurst));
DMRParseBurst(FLastBurst, FLastBurstInfo);
if Assigned(FOnBurst) then FOnBurst(FLastBurst, Length(FLastBurst));
if FLastBurstInfo.SlotType.Valid and
(FSyncKind in [dskBSData, dskMSData, dskDirectTS1Data,
dskDirectTS2Data]) then
@@ -644,6 +682,12 @@ begin
S.SelectedSlot := FSelectedSlot;
S.VoiceFrameCount := FVoiceFrameCount;
S.VoiceErrorCount := FVoiceErrorCount;
S.BestSyncDistance := FBestSyncDistance;
S.BestSyncPhase := FBestSyncPhase;
S.BestCandidateKind := FBestCandidateKind;
if FBestSyncPhase >= 0 then
S.SymbolOuterLevel := FOuterLevel[FBestSyncPhase];
S.SignalMean := FSignalMean;
finally
FStatusLock.Leave;
end;
+342
View File
@@ -0,0 +1,342 @@
unit DMRDiagnostics;
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
interface
uses
Classes, SysUtils, SyncObjs;
type
TDMRDiagnosticCapture = class;
TDMRDumpWriter = class(TThread)
private
FOwner: TDMRDiagnosticCapture;
protected
procedure Execute; override;
public
constructor Create(AOwner: TDMRDiagnosticCapture);
end;
TDMRDiagnosticCapture = class
private
FLock: TCriticalSection;
FWake: PRTLEvent;
FThread: TDMRDumpWriter;
FAccepting: Boolean;
FDeadline: QWord;
FBasePath: string;
FIQ, FDemod, FBursts: TBytes;
FIQRead, FIQWrite, FDemodRead, FDemodWrite: Integer;
FBurstRead, FBurstWrite: Integer;
FIQDropped, FDemodDropped, FBurstDropped: QWord;
FIQStream, FDemodStream, FBurstStream: TFileStream;
function RingWrite(var Ring: TBytes; var ReadPos, WritePos: Integer;
Source: Pointer; Count: Integer; var Dropped: QWord): Boolean;
function RingRead(var Ring: TBytes; var ReadPos, WritePos: Integer;
Dest: Pointer; MaxCount: Integer): Integer;
function RingsEmpty: Boolean;
procedure WriterExecute;
procedure CloseStreams;
procedure WriteStats;
public
constructor Create;
destructor Destroy; override;
function Start(DurationSeconds: Integer; SampleRate: Integer;
CenterHz, VfoHz: Double; const Directory: string = ''): string;
procedure Stop;
procedure FeedIQ24BE(const Data: array of Byte; Count: Integer);
procedure FeedDemod(const Left, Right: array of Single; Count: Integer);
procedure FeedBurst(const Dibits: array of Byte; Count: Integer);
function Active: Boolean;
property BasePath: string read FBasePath;
end;
implementation
const
IQ_RING_BYTES = 32 * 1024 * 1024;
DEMOD_RING_BYTES = 4 * 1024 * 1024;
BURST_RING_BYTES = 1024 * 1024;
WRITER_BLOCK_BYTES = 256 * 1024;
constructor TDMRDumpWriter.Create(AOwner: TDMRDiagnosticCapture);
begin
inherited Create(True);
FreeOnTerminate := False;
FOwner := AOwner;
end;
procedure TDMRDumpWriter.Execute;
begin
FOwner.WriterExecute;
end;
constructor TDMRDiagnosticCapture.Create;
begin
inherited Create;
FLock := TCriticalSection.Create;
FWake := RTLEventCreate;
SetLength(FIQ, IQ_RING_BYTES);
SetLength(FDemod, DEMOD_RING_BYTES);
SetLength(FBursts, BURST_RING_BYTES);
end;
destructor TDMRDiagnosticCapture.Destroy;
begin
Stop;
SetLength(FIQ, 0);
SetLength(FDemod, 0);
SetLength(FBursts, 0);
RTLEventDestroy(FWake);
FLock.Free;
inherited Destroy;
end;
function TDMRDiagnosticCapture.RingWrite(var Ring: TBytes;
var ReadPos, WritePos: Integer; Source: Pointer; Count: Integer;
var Dropped: QWord): Boolean;
var
FreeBytes, First: Integer;
begin
Result := False;
if (Source = nil) or (Count <= 0) or (Length(Ring) = 0) then Exit;
if WritePos >= ReadPos then FreeBytes := Length(Ring) - (WritePos - ReadPos) - 1
else FreeBytes := ReadPos - WritePos - 1;
if Count > FreeBytes then
begin
Inc(Dropped, Count);
Exit;
end;
First := Count;
if First > Length(Ring) - WritePos then First := Length(Ring) - WritePos;
Move(Source^, Ring[WritePos], First);
if Count > First then
Move(PByte(Source)[First], Ring[0], Count - First);
WritePos := (WritePos + Count) mod Length(Ring);
Result := True;
end;
function TDMRDiagnosticCapture.RingRead(var Ring: TBytes;
var ReadPos, WritePos: Integer; Dest: Pointer; MaxCount: Integer): Integer;
var
Available, First: Integer;
begin
Result := 0;
if (Dest = nil) or (MaxCount <= 0) then Exit;
if WritePos >= ReadPos then Available := WritePos - ReadPos
else Available := Length(Ring) - ReadPos + WritePos;
Result := Available;
if Result > MaxCount then Result := MaxCount;
First := Result;
if First > Length(Ring) - ReadPos then First := Length(Ring) - ReadPos;
if First > 0 then Move(Ring[ReadPos], Dest^, First);
if Result > First then Move(Ring[0], PByte(Dest)[First], Result - First);
ReadPos := (ReadPos + Result) mod Length(Ring);
end;
function TDMRDiagnosticCapture.RingsEmpty: Boolean;
begin
Result := (FIQRead = FIQWrite) and (FDemodRead = FDemodWrite) and
(FBurstRead = FBurstWrite);
end;
procedure TDMRDiagnosticCapture.CloseStreams;
begin
FreeAndNil(FIQStream);
FreeAndNil(FDemodStream);
FreeAndNil(FBurstStream);
end;
procedure TDMRDiagnosticCapture.WriteStats;
var
Stats: TStringList;
begin
if FBasePath = '' then Exit;
Stats := TStringList.Create;
try
Stats.Add(Format('iq_dropped_bytes=%d', [FIQDropped]));
Stats.Add(Format('demod_dropped_bytes=%d', [FDemodDropped]));
Stats.Add(Format('burst_dropped_bytes=%d', [FBurstDropped]));
Stats.SaveToFile(FBasePath + '.stats.txt');
finally
Stats.Free;
end;
end;
function TDMRDiagnosticCapture.Start(DurationSeconds: Integer;
SampleRate: Integer; CenterHz, VfoHz: Double; const Directory: string): string;
var
Dir, Stamp: string;
Meta: TStringList;
begin
Stop;
if DurationSeconds < 1 then DurationSeconds := 1;
if Directory <> '' then Dir := IncludeTrailingPathDelimiter(Directory)
else Dir := IncludeTrailingPathDelimiter(GetTempDir(False));
ForceDirectories(Dir);
Stamp := FormatDateTime('yyyymmdd-hhnnss-zzz', Now);
FBasePath := Dir + 'ewsdr-dmr-' + Stamp;
FIQStream := TFileStream.Create(FBasePath + '.iq24be', fmCreate);
FDemodStream := TFileStream.Create(FBasePath + '.demod_f32le', fmCreate);
FBurstStream := TFileStream.Create(FBasePath + '.bursts_u8', fmCreate);
Meta := TStringList.Create;
try
Meta.Add('{');
Meta.Add(' "format": "EWSDR DMR diagnostic capture v1",');
Meta.Add(' "iq_format": "interleaved signed 24-bit big-endian I,Q",');
Meta.Add(' "demod_format": "mono float32 little-endian, 48000 Hz",');
Meta.Add(' "burst_format": "144 uint8 dibits per record",');
Meta.Add(Format(' "iq_sample_rate": %d,', [SampleRate]));
Meta.Add(Format(' "center_hz": %.0f,', [CenterHz]));
Meta.Add(Format(' "vfo_hz": %.0f,', [VfoHz]));
Meta.Add(Format(' "duration_seconds": %d', [DurationSeconds]));
Meta.Add('}');
Meta.SaveToFile(FBasePath + '.json');
finally
Meta.Free;
end;
FLock.Enter;
try
FIQRead := 0; FIQWrite := 0;
FDemodRead := 0; FDemodWrite := 0;
FBurstRead := 0; FBurstWrite := 0;
FIQDropped := 0; FDemodDropped := 0; FBurstDropped := 0;
FDeadline := GetTickCount64 + QWord(DurationSeconds) * 1000;
FAccepting := True;
finally
FLock.Leave;
end;
FThread := TDMRDumpWriter.Create(Self);
FThread.Start;
Result := FBasePath;
end;
procedure TDMRDiagnosticCapture.Stop;
begin
if FThread = nil then
begin
CloseStreams;
Exit;
end;
FLock.Enter;
try
FAccepting := False;
finally
FLock.Leave;
end;
RTLEventSetEvent(FWake);
FThread.WaitFor;
FreeAndNil(FThread);
CloseStreams;
WriteStats;
end;
procedure TDMRDiagnosticCapture.WriterExecute;
var
IQBuf, DemodBuf, BurstBuf: TBytes;
NIQ, NDemod, NBurst: Integer;
AcceptingNow, EmptyNow: Boolean;
begin
SetLength(IQBuf, WRITER_BLOCK_BYTES);
SetLength(DemodBuf, WRITER_BLOCK_BYTES);
SetLength(BurstBuf, WRITER_BLOCK_BYTES);
repeat
FLock.Enter;
try
if FAccepting and (GetTickCount64 >= FDeadline) then FAccepting := False;
NIQ := RingRead(FIQ, FIQRead, FIQWrite, @IQBuf[0], Length(IQBuf));
NDemod := RingRead(FDemod, FDemodRead, FDemodWrite,
@DemodBuf[0], Length(DemodBuf));
NBurst := RingRead(FBursts, FBurstRead, FBurstWrite,
@BurstBuf[0], Length(BurstBuf));
AcceptingNow := FAccepting;
EmptyNow := RingsEmpty;
finally
FLock.Leave;
end;
if NIQ > 0 then FIQStream.WriteBuffer(IQBuf[0], NIQ);
if NDemod > 0 then FDemodStream.WriteBuffer(DemodBuf[0], NDemod);
if NBurst > 0 then FBurstStream.WriteBuffer(BurstBuf[0], NBurst);
if (NIQ = 0) and (NDemod = 0) and (NBurst = 0) and AcceptingNow then
RTLEventWaitFor(FWake, 100);
until (not AcceptingNow) and EmptyNow;
CloseStreams;
WriteStats;
end;
procedure TDMRDiagnosticCapture.FeedIQ24BE(const Data: array of Byte;
Count: Integer);
var
Wrote: Boolean;
begin
if Count > Length(Data) then Count := Length(Data);
if Count <= 0 then Exit;
FLock.Enter;
try
if not FAccepting then Exit;
Wrote := RingWrite(FIQ, FIQRead, FIQWrite, @Data[0], Count, FIQDropped);
finally
FLock.Leave;
end;
if Wrote then RTLEventSetEvent(FWake);
end;
procedure TDMRDiagnosticCapture.FeedDemod(const Left, Right: array of Single;
Count: Integer);
var
Mono: array[0..2047] of Single;
i, N: Integer;
Wrote: Boolean;
begin
N := Count;
if N > Length(Left) then N := Length(Left);
if N > Length(Right) then N := Length(Right);
if N > Length(Mono) then N := Length(Mono);
if N <= 0 then Exit;
for i := 0 to N - 1 do Mono[i] := 0.5 * (Left[i] + Right[i]);
FLock.Enter;
try
if not FAccepting then Exit;
Wrote := RingWrite(FDemod, FDemodRead, FDemodWrite, @Mono[0],
N * SizeOf(Single), FDemodDropped);
finally
FLock.Leave;
end;
if Wrote then RTLEventSetEvent(FWake);
end;
procedure TDMRDiagnosticCapture.FeedBurst(const Dibits: array of Byte;
Count: Integer);
var
Wrote: Boolean;
begin
if Count > Length(Dibits) then Count := Length(Dibits);
if Count <= 0 then Exit;
FLock.Enter;
try
if not FAccepting then Exit;
Wrote := RingWrite(FBursts, FBurstRead, FBurstWrite, @Dibits[0], Count,
FBurstDropped);
finally
FLock.Leave;
end;
if Wrote then RTLEventSetEvent(FWake);
end;
function TDMRDiagnosticCapture.Active: Boolean;
begin
FLock.Enter;
try
Result := FAccepting;
finally
FLock.Leave;
end;
end;
end.
+16 -2
View File
@@ -3591,7 +3591,8 @@ var
begin
if not FController.GetDMRStatus(S) then Exit('DMR unavailable');
if not S.Enabled then Exit('DMR off');
if not S.Synced then Exit(Format('DMR sync... %.3f', [S.SignalRMS]));
if not S.Synced then
Exit(Format('DMR sync d%d %.3f', [S.BestSyncDistance, S.SignalRMS]));
if S.Inverted then Inv := ' INV' else Inv := '';
Details := '';
if S.LinkControlValid then Details := Format(' TS%d', [S.LCSlot + 1])
@@ -4930,10 +4931,23 @@ begin
end;
procedure TMainForm.BtnModeClick(Sender: TObject);
var
Mode: Integer;
Path: string;
begin
Mode := (Sender as TFlatButton).Tag;
if (Mode = MODE_DMR) and (FController.FMode = MODE_DMR) then
begin
Path := FController.StartDMRDiagnostics(15);
if Path <> '' then
ShowMessage('DMR diagnostic capture started for 15 seconds.' +
LineEnding + 'Transmit from the radio now.' + LineEnding + LineEnding +
'Files: ' + Path + '.*');
Exit;
end;
// Логика (FMode, дефолтный фильтр, DSP SetMode/TUN/ApplyModeFilter, band cache)
// — в контроллере; рендер кнопок/фильтра/спектра — в OnControllerState(rfMode).
FController.SetMode((Sender as TFlatButton).Tag);
FController.SetMode(Mode);
end;
procedure TMainForm.BtnFilterClick(Sender: TObject);
+39
View File
@@ -50,6 +50,7 @@ uses
Classes, SysUtils, Math,
HPSDRProtocol, HPSDRNetwork, RadioBackend, PlutoBackend, IIOBindings,
WDSPEngine, AudioOutput, AudioInput, BeaconDecoder, BeaconFEC, DMRDecoder,
DMRDiagnostics,
Settings, ChannelStore, FMRepeater, BoardUtils, DeviceStore;
// Панадаптеры (этап 3): потолок MAX_PANS живёт в WDSPEngine (общий для
@@ -251,6 +252,7 @@ type
// ---- DMR 4FSK receive decoder ----
FDMRDec: TDMRDecoder; // 48 kHz FM discriminator -> DMR worker
FDMRDiag: TDMRDiagnosticCapture; // bounded async IQ/demod/burst recorder
// ---- Аудио / TX ----
FVolume: Integer; // громкость RX
@@ -406,6 +408,7 @@ type
procedure OnAudioReady(const Left, Right: array of Single; Count: Integer);
procedure OnDemodAudioReady(const Left, Right: array of Single; Count: Integer);
procedure OnDMRAudioReady(const PCM: array of Single; Count: Integer);
procedure OnDMRBurstReady(const Dibits: array of Byte; Count: Integer);
procedure OnSpectrumReady(const Pixels: array of Single; Count: Integer);
procedure OnWaterfallReady(const Pixels: array of Single; Count: Integer);
procedure OnMicPacket(const Data: TMicDataPacket);
@@ -676,6 +679,9 @@ type
function GetBeaconScope(out S: TBeaconScope): Boolean;
function GetBeaconFrame(out Frame: TBeaconFrame; out RSErrors: Integer): Boolean;
function GetDMRStatus(out S: TDMRStatus): Boolean;
function StartDMRDiagnostics(DurationSeconds: Integer = 15): string;
procedure StopDMRDiagnostics;
function DMRDiagnosticsActive: Boolean;
// Отображение / приём
procedure SetCTun(On_: Boolean);
@@ -851,8 +857,10 @@ begin
FDSPEngine.SetBeaconDecoder(FBeaconDec);
// DMR front-end owns a worker thread. It stays idle until MODE_DMR is active.
FDMRDiag := TDMRDiagnosticCapture.Create;
FDMRDec := TDMRDecoder.Create;
FDMRDec.OnAudio := OnDMRAudioReady;
FDMRDec.OnBurst := OnDMRBurstReady;
// Audio out/in — объекты создаём сейчас, Open вызывается позже (после показа
// формы / при подключении устройства).
@@ -869,8 +877,10 @@ begin
begin
FDMRDec.SetEnabled(False);
FDMRDec.OnAudio := nil;
FDMRDec.OnBurst := nil;
FreeAndNil(FDMRDec);
end;
FreeAndNil(FDMRDiag);
if Assigned(FNetwork) then
begin
if FNetwork.Connected then FNetwork.Disconnect;
@@ -982,6 +992,9 @@ begin
SamplesPerFrame := (Integer(Data.SamplesPerFrame[0]) shl 8) or
Integer(Data.SamplesPerFrame[1]);
if SamplesPerFrame <= 0 then SamplesPerFrame := 238; // fallback
if (DDCIndex = FActiveDDC) and (FMode = MODE_DMR) and
Assigned(FDMRDiag) and FDMRDiag.Active then
FDMRDiag.FeedIQ24BE(Data.IQData, SamplesPerFrame * 6);
if DDCIndex = FActiveDDC then
FDSPEngine.PushDDCPacket(Data.IQData, 0, SamplesPerFrame)
else if (DDCIndex >= 0) and (DDCIndex < MAX_DDCS)
@@ -1187,6 +1200,8 @@ begin
if not Assigned(FDMRDec) then Exit;
if FMode = MODE_DMR then
begin
if Assigned(FDMRDiag) and FDMRDiag.Active then
FDMRDiag.FeedDemod(Left, Right, Count);
if not FDMRDec.Enabled then FDMRDec.SetEnabled(True);
FDMRDec.FeedAudio(Left, Right, Count);
end
@@ -1194,6 +1209,13 @@ begin
FDMRDec.SetEnabled(False);
end;
procedure TRadioController.OnDMRBurstReady(const Dibits: array of Byte;
Count: Integer);
begin
if Assigned(FDMRDiag) and FDMRDiag.Active then
FDMRDiag.FeedBurst(Dibits, Count);
end;
procedure TRadioController.OnDMRAudioReady(const PCM: array of Single;
Count: Integer);
// DMR worker thread, 8 kHz mono from mbelib. Linear 6x interpolation brings
@@ -2233,6 +2255,23 @@ begin
else FillChar(S, SizeOf(S), 0);
end;
function TRadioController.StartDMRDiagnostics(DurationSeconds: Integer): string;
begin
if not Assigned(FDMRDiag) then Exit('');
Result := FDMRDiag.Start(DurationSeconds, FSampleRate, FCenterFreq,
ActiveVfoHz);
end;
procedure TRadioController.StopDMRDiagnostics;
begin
if Assigned(FDMRDiag) then FDMRDiag.Stop;
end;
function TRadioController.DMRDiagnosticsActive: Boolean;
begin
Result := Assigned(FDMRDiag) and FDMRDiag.Active;
end;
// Кромки полосы под режим/полосу (единый расчёт для главного канала и слайсов).
class procedure TRadioController.FilterEdgesFor(Mode, BW: Integer; out Lo, Hi: Integer);
var Half: Integer;
+65
View File
@@ -0,0 +1,65 @@
program dmr_diagnostics_test;
{$MODE Delphi}
uses
{$IFDEF UNIX}cthreads,{$ENDIF}
Classes, SysUtils, DMRDiagnostics;
procedure Check(Condition: Boolean; const Message_: string);
begin
if not Condition then
begin
WriteLn(Message_);
Halt(1);
end;
end;
function SizeOfFile(const Name: string): Int64;
var
S: TFileStream;
begin
S := TFileStream.Create(Name, fmOpenRead or fmShareDenyNone);
try
Result := S.Size;
finally
S.Free;
end;
end;
var
D: TDMRDiagnosticCapture;
IQ: array[0..11] of Byte;
L, R: array[0..1] of Single;
Burst: array[0..143] of Byte;
Base: string;
i: Integer;
begin
for i := 0 to High(IQ) do IQ[i] := i;
L[0] := 0.25; L[1] := -0.5;
R[0] := 0.75; R[1] := 0.5;
for i := 0 to High(Burst) do Burst[i] := i and 3;
D := TDMRDiagnosticCapture.Create;
try
Base := D.Start(2, 192000, 145500000, 145500000);
D.FeedIQ24BE(IQ, Length(IQ));
D.FeedDemod(L, R, Length(L));
D.FeedBurst(Burst, Length(Burst));
D.Stop;
Check(SizeOfFile(Base + '.iq24be') = Length(IQ), 'IQ dump size mismatch');
Check(SizeOfFile(Base + '.demod_f32le') =
Length(L) * SizeOf(Single), 'demod dump size mismatch');
Check(SizeOfFile(Base + '.bursts_u8') = Length(Burst),
'burst dump size mismatch');
Check(FileExists(Base + '.json'), 'metadata was not written');
Check(FileExists(Base + '.stats.txt'), 'drop statistics were not written');
DeleteFile(Base + '.iq24be');
DeleteFile(Base + '.demod_f32le');
DeleteFile(Base + '.bursts_u8');
DeleteFile(Base + '.json');
DeleteFile(Base + '.stats.txt');
WriteLn('DMR diagnostic capture test passed');
finally
D.Free;
end;
end.
+86
View File
@@ -0,0 +1,86 @@
program dmr_replay;
{$MODE Delphi}
uses
{$IFDEF UNIX}cthreads,{$ENDIF}
Classes, SysUtils, DMRDecoder;
type
TBurstCounter = class
public
Count: QWord;
procedure BurstReady(const Dibits: array of Byte; DibitCount: Integer);
end;
procedure TBurstCounter.BurstReady(const Dibits: array of Byte;
DibitCount: Integer);
begin
if DibitCount = DMR_BURST_DIBITS then Inc(Count);
end;
procedure Usage;
begin
WriteLn('Usage: dmr_replay <capture.demod_f32le> [--invert]');
Halt(2);
end;
var
Stream: TFileStream;
Decoder: TDMRDecoder;
Counter: TBurstCounter;
Samples, Right: array[0..2047] of Single;
Status: TDMRStatus;
BytesRead, N, i: Integer;
TotalSamples: QWord;
Invert: Boolean;
begin
if ParamCount < 1 then Usage;
Invert := (ParamCount >= 2) and (ParamStr(2) = '--invert');
Stream := TFileStream.Create(ParamStr(1), fmOpenRead or fmShareDenyNone);
Counter := TBurstCounter.Create;
Decoder := TDMRDecoder.Create;
try
Decoder.OnBurst := Counter.BurstReady;
Decoder.SetInverted(Invert);
Decoder.SetEnabled(True);
TotalSamples := 0;
repeat
BytesRead := Stream.Read(Samples[0], SizeOf(Samples));
N := BytesRead div SizeOf(Single);
if N <= 0 then Break;
for i := 0 to N - 1 do Right[i] := Samples[i];
Decoder.FeedAudio(Samples, Right, N);
Inc(TotalSamples, N);
// Keep the bounded realtime ring from becoming the replay bottleneck.
Sleep(2);
until BytesRead < SizeOf(Samples);
Sleep(500);
Decoder.GetStatus(Status);
WriteLn('file=', ParamStr(1));
WriteLn('seconds=', FormatFloat('0.000', TotalSamples / DMR_INPUT_RATE));
WriteLn('invert=', Invert);
WriteLn('rms=', FormatFloat('0.000000', Status.SignalRMS));
WriteLn('sync_count=', Status.SyncCount);
WriteLn('best_sync_distance=', Status.BestSyncDistance);
WriteLn('best_sync_phase=', Status.BestSyncPhase);
WriteLn('best_candidate=',
TDMRDecoder.SyncKindName(Status.BestCandidateKind));
WriteLn('symbol_outer_level=',
FormatFloat('0.000000', Status.SymbolOuterLevel));
WriteLn('dc_mean=', FormatFloat('0.000000', Status.SignalMean));
WriteLn('last_sync=', TDMRDecoder.SyncKindName(Status.SyncKind));
WriteLn('bursts=', Counter.Count);
WriteLn('dropped_samples=', Status.DroppedSamples);
if Status.CACHValid then WriteLn('timeslot=', Status.Slot + 1);
if Status.SlotTypeValid then
WriteLn('color_code=', Status.ColorCode, ' data_type=', Status.DataType);
if Status.LinkControlValid then
WriteLn('lc_slot=', Status.LCSlot + 1, ' target=', Status.TargetID,
' source=', Status.SourceID, ' service_options=', Status.ServiceOptions);
finally
Decoder.Free;
Counter.Free;
Stream.Free;
end;
end.
+58
View File
@@ -0,0 +1,58 @@
program iq24be_to_cf32;
{$MODE Delphi}
uses
Classes, SysUtils;
const
PAIRS_PER_BLOCK = 8192;
SCALE = 1.0 / 8388608.0;
var
Input, Output: TFileStream;
Raw: array[0..PAIRS_PER_BLOCK * 6 - 1] of Byte;
IQ: array[0..PAIRS_PER_BLOCK * 2 - 1] of Single;
InputName, OutputName: string;
BytesRead, Pairs, i, p: Integer;
I24, Q24: LongInt;
TotalPairs: QWord;
begin
if ParamCount < 1 then
begin
WriteLn('Usage: iq24be_to_cf32 <capture.iq24be> [output.cf32le]');
Halt(2);
end;
InputName := ParamStr(1);
if ParamCount >= 2 then OutputName := ParamStr(2)
else OutputName := ChangeFileExt(InputName, '.cf32le');
Input := TFileStream.Create(InputName, fmOpenRead or fmShareDenyNone);
Output := TFileStream.Create(OutputName, fmCreate);
try
TotalPairs := 0;
repeat
BytesRead := Input.Read(Raw[0], SizeOf(Raw));
Pairs := BytesRead div 6;
p := 0;
for i := 0 to Pairs - 1 do
begin
I24 := (LongInt(Raw[p]) shl 16) or (LongInt(Raw[p + 1]) shl 8) or
LongInt(Raw[p + 2]);
Q24 := (LongInt(Raw[p + 3]) shl 16) or (LongInt(Raw[p + 4]) shl 8) or
LongInt(Raw[p + 5]);
if (I24 and $800000) <> 0 then I24 := I24 or LongInt($FF000000);
if (Q24 and $800000) <> 0 then Q24 := Q24 or LongInt($FF000000);
IQ[i * 2] := I24 * SCALE;
IQ[i * 2 + 1] := Q24 * SCALE;
Inc(p, 6);
end;
if Pairs > 0 then Output.WriteBuffer(IQ[0], Pairs * 2 * SizeOf(Single));
Inc(TotalPairs, Pairs);
until BytesRead < SizeOf(Raw);
WriteLn('output=', OutputName);
WriteLn('iq_pairs=', TotalPairs);
finally
Output.Free;
Input.Free;
end;
end.