unit DMRProtocol;

{
  Small, allocation-free DMR burst protocol layer.

  The CACH interleave and Hamming/Golay generator matrices are derived from
  dsd-fme (src/dmr_bs.c and src/fec.c). The original code is distributed
  under the ISC licence; see the dsd-fme source tree for its full notice.
}

{$IFDEF FPC}
  {$MODE Delphi}
{$ENDIF}

interface

uses
  SysUtils;

const
  DMR_PROTOCOL_BURST_DIBITS = 144;

type
  TDMRDibitBurst = array[0..DMR_PROTOCOL_BURST_DIBITS - 1] of Byte;
  TDMRBit7 = array[0..6] of Byte;
  TDMRBit20 = array[0..19] of Byte;

  TDMRCACH = record
    Valid: Boolean;
    CorrectedBits: Integer;
    AccessType: Boolean;
    Slot: Integer;
    LCSS: Integer;
  end;

  TDMRSlotType = record
    Valid: Boolean;
    CorrectedBits: Integer;
    ColorCode: Integer;
    DataType: Integer;
  end;

  TDMRBurstInfo = record
    CACH: TDMRCACH;
    SlotType: TDMRSlotType;
  end;

function DMRHamming74Encode(Value: Byte): TDMRBit7;
function DMRGolay208Encode(Value: Byte): TDMRBit20;
function DMRDecodeCACH(const Burst: TDMRDibitBurst; out CACH: TDMRCACH): Boolean;
function DMRDecodeSlotType(const Burst: TDMRDibitBurst;
  out SlotType: TDMRSlotType): Boolean;
procedure DMRParseBurst(const Burst: TDMRDibitBurst; out Info: TDMRBurstInfo);
function DMRDataTypeName(DataType: Integer): string;

implementation

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
  );

  HAMMING_7_4_G: array[0..3, 0..6] of Byte = (
    (1, 0, 0, 0, 1, 0, 1),
    (0, 1, 0, 0, 1, 1, 1),
    (0, 0, 1, 0, 1, 1, 0),
    (0, 0, 0, 1, 0, 1, 1)
  );

  GOLAY_20_8_G: array[0..7, 0..19] of Byte = (
    (1,0,0,0,0,0,0,0, 0,0,1,1,1,1,0,1,1,0,1,0),
    (0,1,0,0,0,0,0,0, 1,1,0,1,1,0,0,1,1,0,0,1),
    (0,0,1,0,0,0,0,0, 0,1,1,0,1,1,0,0,1,1,0,1),
    (0,0,0,1,0,0,0,0, 0,0,1,1,0,1,1,0,0,1,1,1),
    (0,0,0,0,1,0,0,0, 1,1,0,1,1,1,0,0,0,1,1,0),
    (0,0,0,0,0,1,0,0, 1,0,1,0,1,0,0,1,0,1,1,1),
    (0,0,0,0,0,0,1,0, 1,0,0,1,0,0,1,1,1,1,1,0),
    (0,0,0,0,0,0,0,1, 1,0,0,0,1,1,1,0,1,0,1,1)
  );

function DMRHamming74Encode(Value: Byte): TDMRBit7;
var
  i, j: Integer;
begin
  FillChar(Result, SizeOf(Result), 0);
  for i := 0 to 3 do
    if ((Value shr (3 - i)) and 1) <> 0 then
      for j := 0 to 6 do Result[j] := Result[j] xor HAMMING_7_4_G[i, j];
end;

function DMRGolay208Encode(Value: Byte): TDMRBit20;
var
  i, j: Integer;
begin
  FillChar(Result, SizeOf(Result), 0);
  for i := 0 to 7 do
    if ((Value shr (7 - i)) and 1) <> 0 then
      for j := 0 to 19 do Result[j] := Result[j] xor GOLAY_20_8_G[i, j];
end;

function DecodeHamming74(const Received: TDMRBit7; out Value: Byte;
  out Corrected: Integer): Boolean;
var
  Candidate: TDMRBit7;
  V, i, Distance, BestDistance: Integer;
begin
  Value := 0;
  BestDistance := 8;
  for V := 0 to 15 do
  begin
    Candidate := DMRHamming74Encode(V);
    Distance := 0;
    for i := 0 to 6 do Inc(Distance, Candidate[i] xor (Received[i] and 1));
    if Distance < BestDistance then
    begin
      BestDistance := Distance;
      Value := V;
    end;
  end;
  Corrected := BestDistance;
  Result := BestDistance <= 1;
end;

function DecodeGolay208(const Received: TDMRBit20; out Value: Byte;
  out Corrected: Integer): Boolean;
var
  Candidate: TDMRBit20;
  V, i, Distance, BestDistance: Integer;
begin
  Value := 0;
  BestDistance := 21;
  for V := 0 to 255 do
  begin
    Candidate := DMRGolay208Encode(V);
    Distance := 0;
    for i := 0 to 19 do Inc(Distance, Candidate[i] xor (Received[i] and 1));
    if Distance < BestDistance then
    begin
      BestDistance := Distance;
      Value := V;
      if Distance = 0 then Break;
    end;
  end;
  Corrected := BestDistance;
  Result := BestDistance <= 2;
end;

function DMRDecodeCACH(const Burst: TDMRDibitBurst; out CACH: TDMRCACH): Boolean;
var
  Deinterleaved: array[0..23] of Byte;
  TACT: TDMRBit7;
  Value: Byte;
  i: Integer;
begin
  FillChar(CACH, SizeOf(CACH), 0);
  FillChar(Deinterleaved, SizeOf(Deinterleaved), 0);
  for i := 0 to 11 do
  begin
    Deinterleaved[CACH_INTERLEAVE[2 * i]] := (Burst[i] shr 1) and 1;
    Deinterleaved[CACH_INTERLEAVE[2 * i + 1]] := Burst[i] and 1;
  end;
  for i := 0 to 6 do TACT[i] := Deinterleaved[i];
  CACH.Valid := DecodeHamming74(TACT, Value, CACH.CorrectedBits);
  if CACH.Valid then
  begin
    CACH.AccessType := (Value and 8) <> 0;
    CACH.Slot := (Value shr 2) and 1;
    CACH.LCSS := Value and 3;
  end;
  Result := CACH.Valid;
end;

function DMRDecodeSlotType(const Burst: TDMRDibitBurst;
  out SlotType: TDMRSlotType): Boolean;
var
  Bits: TDMRBit20;
  Value: Byte;
  i, k: Integer;
begin
  FillChar(SlotType, SizeOf(SlotType), 0);
  k := 0;
  for i := 61 to 65 do
  begin
    Bits[k] := (Burst[i] shr 1) and 1; Inc(k);
    Bits[k] := Burst[i] and 1; Inc(k);
  end;
  for i := 90 to 94 do
  begin
    Bits[k] := (Burst[i] shr 1) and 1; Inc(k);
    Bits[k] := Burst[i] and 1; Inc(k);
  end;
  SlotType.Valid := DecodeGolay208(Bits, Value, SlotType.CorrectedBits);
  if SlotType.Valid then
  begin
    SlotType.ColorCode := (Value shr 4) and $0F;
    SlotType.DataType := Value and $0F;
  end;
  Result := SlotType.Valid;
end;

procedure DMRParseBurst(const Burst: TDMRDibitBurst; out Info: TDMRBurstInfo);
begin
  FillChar(Info, SizeOf(Info), 0);
  DMRDecodeCACH(Burst, Info.CACH);
  DMRDecodeSlotType(Burst, Info.SlotType);
end;

function DMRDataTypeName(DataType: Integer): string;
begin
  case DataType of
    0: Result := 'PI header';
    1: Result := 'voice LC';
    2: Result := 'terminator LC';
    3: Result := 'CSBK';
    4: Result := 'MBC header';
    5: Result := 'MBC continuation';
    6: Result := 'data header';
    7: Result := 'rate 1/2 data';
    8: Result := 'rate 3/4 data';
    9: Result := 'idle';
    10: Result := 'rate 1 data';
    11: Result := 'unified single block';
  else
    Result := 'reserved ' + IntToStr(DataType);
  end;
end;

end.