unit CoreDataMessages;

interface

uses
	SysUtils;

type
	TDataItem = class;
	TDataItemClass = class of TDataItem;

	TDID = Word;
	TPDID = ^TDID;

	TMID = Byte;
	TPMID = ^TMID;

	TClassDID = record
		C: TDataItemClass;
		DID: TDID;
	end;

	TDIDTable = class
	protected
		RegisteredDID: array of TClassDID;
	public
		procedure RegisterDID(NewDID: TDID; NewDIClass: TDataItemClass); virtual;
		procedure UnregisterDID(OldDID: TDID);
		function DetectDIClass(FromDID: TDID): TDataItemClass;
	end;

	TDataItem = class
	public
		constructor Create; virtual;
	protected
		fDID: TDID;
	public
		property DID: TDID read fDID;

		procedure LoadFromString(S: AnsiString); virtual;
		function SaveToString: AnsiString; virtual;
		class function OKReplyType: TDataItemClass; virtual;
	protected
		function CalcPayload: AnsiString; virtual;
		procedure SetPayload(NewPayload: AnsiString); virtual;
		procedure MinPayloadExcept(PayloadLen: Integer; MinLen: Integer); virtual;
	end;

	TRawDataItem = class(TDataItem)
	protected
		fPayload: AnsiString;
	public
		property DID write fDID;
		property Payload: AnsiString read fPayload write SetPayload;
	protected
		function CalcPayload: AnsiString; override;
		procedure SetPayload(NewPayload: AnsiString); override;
	end;

	TMessageItem = class
	public
		constructor Create;
		constructor CreateFromString(S: AnsiString; DIDTable: TDIDTable = nil);
		destructor Destroy; override;
	public
		MID: TMID;

		procedure LoadFromString(S: AnsiString; DIDTable: TDIDTable = nil); virtual;
		function SaveToString: AnsiString; virtual;
	protected
		fDataItem: array of TDataItem;

		function GetDataItem(Index: Integer): TDataItem; virtual;
	public
		property DataItem[Index: Integer]: TDataItem read GetDataItem;
		function DataItemCount: Integer; virtual;
		procedure AddDataItem(NewDataItem: TDataItem); virtual;
		function AddNewDataItem(NewDataItemClass: TDataItemClass): TDataItem; virtual;
		function DeleteDataItem(Index: Integer): TDataItem; virtual;
		procedure ClearDataItems; virtual;
	end;

var
	MISODIDTable: TDIDTable;
	MOSIDIDTable: TDIDTable;

function BytesFromStr(S: AnsiString): TBytes;

procedure RegisterCommandReplyPairDID(NewDID: TDID; NewCommandDIClass, NewReplyDIClass: TDataItemClass);
procedure UnregisterCommandReplyPairDID(OldDID: TDID);
function ExtractRegisteredDataItem(var FromStr: AnsiString; DIDTable: TDIDTable = nil): TDataItem;
function ExtractDataItemStr(var FromStr: AnsiString): AnsiString;
function ExtractRegisteredMessageItem(var FromStr: AnsiString; DIDTable: TDIDTable = nil): TMessageItem;
function ExtractMessageItemStr(var FromStr: AnsiString): AnsiString;



implementation

function IntAsStr(I: Byte): AnsiString; overload;
begin
	SetString(Result, PAnsiChar(@I), SizeOf(I));
end;

function IntAsStr(I: Word): AnsiString; overload;
begin
	SetString(Result, PAnsiChar(@I), SizeOf(I));
end;

function IntAsStr(I: LongWord): AnsiString; overload;
begin
	SetString(Result, PAnsiChar(@I), SizeOf(I));
end;

function IntAsStr(I: UInt64): AnsiString; overload;
begin
	SetString(Result, PAnsiChar(@I), SizeOf(I));
end;

function StrToLStr(S: AnsiString): AnsiString;
var
	L: LongWord;

begin
	L := Length(S);
	SetString(Result, PAnsiChar(@L), 4);
	Result := Result + S;
end;

function ExtractLStr(var S: AnsiString): AnsiString;
var
	L: LongWord;

begin
	L := PLongWord(@S[1])^;
	Result := Copy(S, 5, L);
	S := Copy(S, L + 5, MAXINT);
end;

function StrToLStr16(S: AnsiString): AnsiString;
var
	L: Word;

begin
	L := Length(S);
	SetString(Result, PAnsiChar(@L), 2);
	Result := Result + S;
end;

function ExtractLStr16(var S: AnsiString): AnsiString;
var
	L: Word;

begin
	L := PWord(@S[1])^;
	Result := Copy(S, 3, L);
	S := Copy(S, L + 3, MAXINT);
end;

{$IFDEF WIN32}
function CalcChecksumRaw(pS: PAnsiChar; L: LongWord): Byte;
asm
	//Rearrange params to more-useful order.
	MOV ECX, EDX
	MOV EDX, EAX
	//AL is Result.
	XOR AL, AL
	//For each char in S.
	TEST ECX, ECX
	JZ @Done
	@NextCh:
		//Sum into Result.
		ADD AL, [EDX]
		INC EDX
	LOOP @NextCh
	@Done:
end;
{$ENDIF}
{$IFDEF WIN64}
function CalcChecksumRaw(pS: PAnsiChar; L: LongWord): Byte;
asm
	//Rearrange params to more-useful order.
	MOV RDX, RCX
	MOV RCX, RAX
	//AL is Result.
	XOR AL, AL
	//For each char in S.
	TEST RCX, RCX
	JZ @Done
	@NextCh:
		//Sum into Result.
		ADD AL, [RDX]
		INC RDX
	LOOP @NextCh
	@Done:
end;
{$ENDIF}

procedure AddChecksum(var S: AnsiString; bInvert: Boolean);
var
	Checksum: Byte;

begin
	Checksum := CalcChecksumRaw(@S[1], Length(S));

	if bInvert then Checksum := 256 - Checksum;

	S := S + AnsiChar(Checksum);
end;

function bExtractChecksum(var S: AnsiString; bInvert: Boolean): Boolean;
var
	TarChecksum, GotChecksum: Byte;

begin
	TarChecksum := Byte(S[Length(S)]);
	S := Copy(S, 1, Length(S) - 1);

	GotChecksum := CalcChecksumRaw(@S[1], Length(S));
	{
	GotChecksum := 0;
	for I := 1 to Length(S) do
		Inc(GotChecksum, Byte(S[I]))
	;
	}

	if bInvert then GotChecksum := 256 - GotChecksum;

	Result := GotChecksum = TarChecksum;
end;



function BytesFromStr(S: AnsiString): TBytes;
var
	iCh: Integer;

begin
	SetLength(Result, Length(S));
	for iCh := 0 to High(Result) do Result[iCh] := Byte(S[1 + iCh]);

	//This is just for dropping breakpoints on.
	if Length(Result) <> 0 then Result[0] := Result[0];
end;

procedure RegisterCommandReplyPairDID(NewDID: TDID; NewCommandDIClass, NewReplyDIClass: TDataItemClass);
begin
	MOSIDIDTable.RegisterDID(NewDID, NewCommandDIClass);
	MISODIDTable.RegisterDID(NewDID, NewReplyDIClass);
end;

procedure UnregisterCommandReplyPairDID(OldDID: TDID);
begin
	MOSIDIDTable.UnregisterDID(OldDID);
	MISODIDTable.UnregisterDID(OldDID);
end;

function ExtractRegisteredDataItem(var FromStr: AnsiString; DIDTable: TDIDTable = nil): TDataItem;
var
	DIStr: AnsiString;
	NewDID: TDID;
	NewDIClass: TDataItemClass;

begin
	Result := nil;

	DIStr := ExtractDataItemStr(FromStr);

	if DIStr = '' then Exit;

	NewDID := TPDID(@DIStr[1])^;

	if DIDTable <> nil then
		NewDIClass := DIDTable.DetectDIClass(NewDID)
	else
		NewDIClass := TRawDataItem;
	;

	Result := NewDIClass.Create;
	try
		Result.LoadFromString(DIStr);
	except
		FreeAndNil(Result);
		raise;
	end;
end;

function ExtractDataItemStr(var FromStr: AnsiString): AnsiString;
var
	L: Word;

begin
	Result := '';

	if Length(FromStr) < 4 then Exit;

	L := PWord(@FromStr[3])^;
	if Length(FromStr) < 4 + L then Exit;

	Result := Copy(FromStr, 1, 4 + L);
	FromStr := Copy(FromStr, 5 + L, MAXINT);
end;

function ExtractRegisteredMessageItem(var FromStr: AnsiString; DIDTable: TDIDTable = nil): TMessageItem;
var
	MsgStr: AnsiString;

begin
	Result := nil;

	MsgStr := ExtractMessageItemStr(FromStr);

	if MsgStr = '' then Exit;

	Result := TMessageItem.Create;
	try
		Result.LoadFromString(MsgStr, DIDTable);
	except
		FreeAndNil(Result);
		raise;
	end;
end;

function ExtractMessageItemStr(var FromStr: AnsiString): AnsiString;
var
	L: LongWord;

begin
	Result := '';

	if Length(FromStr) < 6 then Exit;

	L := PLongWord(@FromStr[2])^;
	if LongWord(Length(FromStr)) < 6 + L then Exit;
	Result := Copy(FromStr, 1, 6+L);
	FromStr := Copy(FromStr, 1 + 6+L, MAXINT);
end;

{ TDIDTable }

function TDIDTable.DetectDIClass(FromDID: TDID): TDataItemClass;
var
	iRDI: Integer;

begin
	Result := TRawDataItem;
	for iRDI := 0 to High(RegisteredDID) do
		if RegisteredDID[iRDI].DID = FromDID then begin
			Result := RegisteredDID[iRDI].C;
			Break;
		end
	;
end;

procedure TDIDTable.RegisterDID(NewDID: TDID; NewDIClass: TDataItemClass);
var
	iRDI: Integer;

begin
	iRDI := Length(RegisteredDID);
	SetLength(RegisteredDID, iRDI + 1);
	RegisteredDID[iRDI].DID := NewDID;
	RegisteredDID[iRDI].C := NewDIClass;
end;

procedure TDIDTable.UnregisterDID(OldDID: TDID);
var
	hRDI, iRDI: Integer;

begin
	hRDI := High(RegisteredDID);
	for iRDI := hRDI downto 0 do
		if RegisteredDID[iRDI].DID = OldDID then begin
			if iRDI < hRDI then RegisteredDID[iRDI] := RegisteredDID[hRDI];
			SetLength(RegisteredDID, hRDI);
			Dec(hRDI);
		end
	;
end;

{ TDataItem }

function TDataItem.CalcPayload: AnsiString;
begin
	Result := '';
end;

constructor TDataItem.Create;
begin end;

procedure TDataItem.LoadFromString(S: AnsiString);
var
	L: Word;

begin
	if Length(S) < 4 then raise Exception.Create(IntToStr(Length(S)) + 'B string too short for a data item.');

	L := PWord(@S[3])^;
	if Length(S) < 4 + L then raise Exception.Create(IntToStr(Length(S)) + 'B string too short for a data item holding ' + IntToStr(L) + 'B.');

	fDID := TPDID(@S[1])^;
	SetPayload(Copy(S, 5, L));
end;

procedure TDataItem.MinPayloadExcept(PayloadLen: Integer; MinLen: Integer);
var
	BadStrDesc: String;

begin
	if PayloadLen < MinLen then begin
		if PayloadLen = 0 then
			BadStrDesc := 'empty'
		else
			BadStrDesc := 'too-small'
		;
		raise Exception.Create('Attempted to set ' + ClassName + ' payload with ' + BadStrDesc + ' string.');
	end;
end;

class function TDataItem.OKReplyType: TDataItemClass;
begin
	Result := Self;
end;

function TDataItem.SaveToString: AnsiString;
begin
	Result := IntAsStr(DID) + StrToLStr16(CalcPayload);
end;

procedure TDataItem.SetPayload(NewPayload: AnsiString);
begin end;

{ TRawDataItem }

function TRawDataItem.CalcPayload: AnsiString;
begin
	Result := fPayload;
end;

procedure TRawDataItem.SetPayload(NewPayload: AnsiString);
begin
	fPayload := NewPayload;
end;

{ TMessageItem }

procedure TMessageItem.AddDataItem(NewDataItem: TDataItem);
var
	iDI: Integer;

begin
	iDI := Length(fDataItem);
	SetLength(fDataItem, iDI + 1);
	fDataItem[iDI] := NewDataItem;
end;

function TMessageItem.AddNewDataItem(NewDataItemClass: TDataItemClass): TDataItem;
begin
	Result := NewDataItemClass.Create;
	AddDataItem(Result);
end;

procedure TMessageItem.ClearDataItems;
var
	iDI: Integer;

begin
	for iDI := 0 to High(fDataItem) do try
		fDataItem[iDI].Free
	except
	end;
	SetLength(fDataItem, 0);
end;

constructor TMessageItem.Create;
begin
	MID := TMID('M');
end;

constructor TMessageItem.CreateFromString(S: AnsiString; DIDTable: TDIDTable);
begin
	LoadFromString(S, DIDTable);
end;

function TMessageItem.DeleteDataItem(Index: Integer): TDataItem;
var
	HighIndex: Integer;

begin
	HighIndex := High(fDataItem);
	if Index > HighIndex then raise ERangeError.Create('DataItem index ' + IntToStr(Index) +' out of bounds.');

	Result := fDataItem[Index];
	if Index < HighIndex then
		Move(fDataItem[Index + 1], fDataItem[Index], (HighIndex - Index)*SizeOf(fDataItem[Index]))
	;
	SetLength(fDataItem, HighIndex);
end;

destructor TMessageItem.Destroy;
begin
	ClearDataItems;

	inherited;
end;

function TMessageItem.GetDataItem(Index: Integer): TDataItem;
begin
	Result := fDataItem[Index];
end;

function TMessageItem.DataItemCount: Integer;
begin
	Result := Length(fDataItem);
end;

procedure TMessageItem.LoadFromString(S: AnsiString; DIDTable: TDIDTable = nil);
var
	NewMID: TMID;
	L: LongWord;
	DI: TDataItem;

begin
	if Length(S) < 6 then raise Exception.Create(IntToStr(Length(S)) + 'B string too short for a message.');

	L := PLongWord(@S[2])^;
	if LongWord(Length(S)) < 6 + L then raise Exception.Create(IntToStr(Length(S)) + 'B string too short for a message holding ' + IntToStr(L) + 'B.');
	if LongWord(Length(S)) > 6 + L then S := Copy(S, 1, 6 + L);

	if not bExtractChecksum(S, True) then raise Exception.Create('Bad checksum.');

	NewMID := TPMID(@S[1])^;
	S := Copy(S, 6, L); //S is now the payload.

	ClearDataItems;

	MID := NewMID;
	while S <> '' do begin
		DI := ExtractRegisteredDataItem(S, DIDTable);
		if DI = nil then Break;

		AddDataItem(DI);
	end;
end;

function TMessageItem.SaveToString: AnsiString;
var
	iDI: Integer;

begin
	Result := '';
	for iDI := 0 to High(fDataItem) do
		Result := Result + fDataItem[iDI].SaveToString
	;

	Result := IntAsStr(MID) + StrToLStr(Result);
	AddChecksum(Result, True);
end;

initialization
	MISODIDTable := TDIDTable.Create;
	MOSIDIDTable := TDIDTable.Create;
finalization
	FreeAndNil(MISODIDTable);
	FreeAndNil(MOSIDIDTable);
end.
