program dmr_protocol_test;

{$MODE Delphi}

uses
  SysUtils, DMRProtocol;

const
  CACH_INTERLEAVE: array[0..23] of Byte = (
     0,  7,  8,  9,  1, 10,
    11, 12,  2, 13, 14, 15,
     3, 16,  4, 17, 18, 19,
     5, 20, 21, 22,  6, 23
  );

procedure PutCACH(var Burst: TDMRDibitBurst; Value: Byte);
var
  Code: TDMRBit7;
  Deinterleaved, Transmitted: array[0..23] of Byte;
  i: Integer;
begin
  FillChar(Deinterleaved, SizeOf(Deinterleaved), 0);
  Code := DMRHamming74Encode(Value);
  for i := 0 to 6 do Deinterleaved[i] := Code[i];
  for i := 0 to 23 do Transmitted[i] := Deinterleaved[CACH_INTERLEAVE[i]];
  for i := 0 to 11 do
    Burst[i] := (Transmitted[2 * i] shl 1) or Transmitted[2 * i + 1];
end;

procedure PutSlotType(var Burst: TDMRDibitBurst; Value: Byte);
var
  Code: TDMRBit20;
  i, k: Integer;
begin
  Code := DMRGolay208Encode(Value);
  k := 0;
  for i := 61 to 65 do
  begin
    Burst[i] := (Code[k] shl 1) or Code[k + 1];
    Inc(k, 2);
  end;
  for i := 90 to 94 do
  begin
    Burst[i] := (Code[k] shl 1) or Code[k + 1];
    Inc(k, 2);
  end;
end;

procedure Check(Condition: Boolean; const Message_: string);
begin
  if not Condition then
  begin
    WriteLn(Message_);
    Halt(1);
  end;
end;

procedure PutUInt(var Bits: TDMRBit96; Start, Count: Integer; Value: LongWord);
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
    Bits[Start + i] := (Value shr (Count - 1 - i)) and 1;
end;

procedure XorPayloadByte(var Bits: TDMRBit96; ByteIndex: Integer; Value: Byte);
var
  i: Integer;
begin
  for i := 0 to 7 do
    Bits[ByteIndex * 8 + i] := Bits[ByteIndex * 8 + i] xor
      ((Value shr (7 - i)) and 1);
end;

var
  Burst: TDMRDibitBurst;
  Info: TDMRBurstInfo;
  Payload: TDMRBit96;
  Frames: TDMRAMBEFrames;
  VoiceDibits: array[0..107] of Byte;
  i: Integer;
begin
  FillChar(Burst, SizeOf(Burst), 0);
  // TACT: AT=1, slot=1 (TS2), LCSS=2. Slot Type: CC=9, data header=6.
  PutCACH(Burst, $0E);
  PutSlotType(Burst, $96);
  DMRParseBurst(Burst, Info);
  Check(Info.CACH.Valid, 'valid CACH rejected');
  Check(Info.CACH.AccessType and (Info.CACH.Slot = 1) and
        (Info.CACH.LCSS = 2), 'TACT fields decoded incorrectly');
  Check(Info.SlotType.Valid, 'valid Slot Type rejected');
  Check((Info.SlotType.ColorCode = 9) and (Info.SlotType.DataType = 6),
        'Slot Type fields decoded incorrectly');

  // Hamming(7,4) corrects one bit and Golay(20,8) corrects two.
  Burst[0] := Burst[0] xor 2;
  Burst[61] := Burst[61] xor 2;
  Burst[92] := Burst[92] xor 1;
  DMRParseBurst(Burst, Info);
  Check(Info.CACH.Valid and (Info.CACH.CorrectedBits = 1),
        'CACH one-bit correction failed');
  Check(Info.CACH.AccessType and (Info.CACH.Slot = 1) and
        (Info.CACH.LCSS = 2), 'corrected TACT fields are wrong');
  Check(Info.SlotType.Valid and (Info.SlotType.CorrectedBits = 2),
        'Slot Type two-bit correction failed');
  Check((Info.SlotType.ColorCode = 9) and (Info.SlotType.DataType = 6),
        'corrected Slot Type fields are wrong');

  // A third Slot Type error exceeds the guaranteed correction radius.
  Burst[94] := Burst[94] xor 1;
  DMRParseBurst(Burst, Info);
  Check(not Info.SlotType.Valid, 'uncorrectable Slot Type accepted');

  // Full Link Control is carried in a BPTC(196,96) voice LC header.
  FillChar(Payload, SizeOf(Payload), 0);
  PutUInt(Payload, 2, 6, 0);       // group voice channel user LC
  PutUInt(Payload, 8, 8, 0);       // standard feature set
  PutUInt(Payload, 16, 8, $21);    // service options
  PutUInt(Payload, 24, 24, 12345); // target/talkgroup
  PutUInt(Payload, 48, 24, 678901);// source radio
  DMRFullLCSetParity(Payload, 1);
  DMRBPTC19696Encode(Payload, Burst);
  PutCACH(Burst, $04);             // TS2, LCSS=0
  PutSlotType(Burst, $91);         // CC9, voice LC header
  DMRParseBurst(Burst, Info);
  Check(Info.BPTCValid, 'valid BPTC(196,96) rejected');
  for i := 0 to High(Payload) do
    Check(Info.Payload96[i] = Payload[i], 'BPTC payload mismatch at bit ' +
      IntToStr(i));
  Check(Info.LinkControl.Decoded and (Info.LinkControl.Opcode = 0) and
        (Info.LinkControl.FeatureSetID = 0) and
        (Info.LinkControl.ServiceOptions = $21) and
        (Info.LinkControl.TargetID = 12345) and
        (Info.LinkControl.SourceID = 678901), 'Full LC fields decoded incorrectly');

  // Product-code row/column correction recovers an isolated air-interface bit.
  Burst[20] := Burst[20] xor 2;
  DMRParseBurst(Burst, Info);
  Check(Info.BPTCValid and Info.LinkControl.Decoded and
        (Info.LinkControl.TargetID = 12345) and
        (Info.LinkControl.SourceID = 678901), 'BPTC one-bit correction failed');

  // The outer RS(12,9) code repairs one damaged byte after clean BPTC decode.
  XorPayloadByte(Payload, 2, $5A);
  DMRBPTC19696Encode(Payload, Burst);
  PutCACH(Burst, $04);
  PutSlotType(Burst, $91);
  DMRParseBurst(Burst, Info);
  Check(Info.LinkControl.Decoded and
        (Info.LinkControl.RSCorrectedBytes = 1) and
        (Info.LinkControl.ServiceOptions = $21), 'Full LC RS correction failed');

  // Two damaged RS symbols exceed the RS(12,9) correction radius.
  XorPayloadByte(Payload, 3, $A5);
  DMRBPTC19696Encode(Payload, Burst);
  PutSlotType(Burst, $91);
  DMRParseBurst(Burst, Info);
  Check(not Info.LinkControl.Decoded, 'invalid Full LC RS checksum accepted');

  // Three AMBE frames occupy 36 + 18/18 + 36 dibits around the centre sync.
  FillChar(Burst, SizeOf(Burst), 0);
  for i := 12 to 65 do Burst[i] := (i * 3 + 1) and 3;
  for i := 90 to 143 do Burst[i] := (i * 3 + 2) and 3;
  for i := 0 to 53 do VoiceDibits[i] := Burst[12 + i];
  for i := 0 to 53 do VoiceDibits[54 + i] := Burst[90 + i];
  DMRExtractAMBEFrames(Burst, Frames);
  for i := 12 to 65 do Burst[i] := 0;
  for i := 90 to 143 do Burst[i] := 0;
  DMRInsertAMBEFrames(Frames, Burst);
  for i := 0 to 53 do Check(Burst[12 + i] = VoiceDibits[i],
    'AMBE frame 1/2 interleave mismatch');
  for i := 0 to 53 do Check(Burst[90 + i] = VoiceDibits[54 + i],
    'AMBE frame 2/3 interleave mismatch');

  WriteLn('DMR protocol, FEC, Full LC and AMBE extraction tests passed');
end.