////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// Code To/From Name Map class TCodeNameMap. Thread safe.                     //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20260327 - Created by A.K.                                                 //
////////////////////////////////////////////////////////////////////////////////

unit _crw_cnmap; //  Code To/From Name Map class.

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, math,
 _crw_alloc, _crw_ef, _crw_rtc, _crw_str, _crw_hl, _crw_dynar;

 {
 TCodeNameMap is thread safe Code To/From Name mapper class.
 For example, program constants as Code-Name-Value triples.
 Assume one-to-one Code-Name correspondence.
 NB: The Name string must be printable (no control chars).
 Performance (Win32, CPU i7-4700MQ@2.40GHz):
 > TCodeNameMap.TestBenchmark(1000,1000):
 > Test 1000 items, 0 error(s) found
 > Test HasCode 1000 ms, 3410681 loops, 0.293 mks/call
 > Test HasName 1000 ms, 4716059 loops, 0.212 mks/call
 > Test NameByCode 1000 ms, 3218793 loops, 0.311 mks/call
 > Test CodeByName 1016 ms, 4724227 loops, 0.215 mks/call
 > Test DataByName 1015 ms, 4598594 loops, 0.221 mks/call
 > Test TimeByName 1000 ms, 2000037 loops, 0.500 mks/call
 }
type
 TCodeNameMap = class(TLatch)
 private
  myMap : THashList;
  myNames : TStringList;
  function  GetCount:Integer;
  function  GetNamesText:LongString;
  function  GetCodes(i:Integer):Integer;
  function  GetNames(i:Integer):LongString;
  function  GetParamByCode(aCode:Integer):LongString;
  procedure SetParamByCode(aCode:Integer; const aParam:LongString);
  function  GetParamByName(const aName:LongString):LongString;
  procedure SetParamByName(const aName,aParam:LongString);
  function  GetDataByCode(aCode:Integer):Double;
  procedure SetDataByCode(aCode:Integer; aData:Double);
  function  GetDataByName(const aName:LongString):Double;
  procedure SetDataByName(const aName:LongString; aData:Double);
  function  GetLinkByCode(aCode:Integer):Integer;
  procedure SetLinkByCode(aCode,aLink:Integer);
  function  GetLinkByName(const aName:LongString):Integer;
  procedure SetLinkByName(const aName:LongString; aLink:Integer);
  function  GetTimeByCode(aCode:Integer):Double;
  procedure SetTimeByCode(aCode:Integer; aTime:Double);
  function  GetTimeByName(const aName:LongString):Double;
  procedure SetTimeByName(const aName:LongString; aTime:Double);
 public
  constructor Create(aCaseSensitive:Boolean=False);
  destructor  Destroy; override;
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
 public
  property  Count            : Integer    read GetCount;
  property  Codes[i:Integer] : Integer    read GetCodes;
  property  Names[i:Integer] : LongString read GetNames;
  property  NamesText        : LongString read GetNamesText;
 public //  Add Code-Name map with addon options
  function  AddMap(aCode:Integer; const aName:LongString;
                   const aParam:LongString=''; aData:Double=0;
                   aLink:Integer=0; aTime:Double=0):Boolean;
 public //  Check Code/Name exists
  function  HasCode(aCode:Integer):Boolean;
  function  HasName(const aName:LongString):Boolean;
 public //  Main Code-Name mapping
  function  NameByCode(aCode:Integer; const Def:LongString=''):LongString;
  function  CodeByName(const aName:LongString; Def:Integer=0):Integer;
 public //  Addon options associated with mapping
  property  ParamByCode[C:Integer]:LongString    read GetParamByCode write SetParamByCode;
  property  ParamByName[N:LongString]:LongString read GetParamByName write SetParamByName;
  property  DataByCode[C:Integer]:Double         read GetDataByCode  write SetDataByCode;
  property  DataByName[N:LongString]:Double      read GetDataByName  write SetDataByName;
  property  LinkByCode[C:Integer]:Integer        read GetLinkByCode  write SetLinkByCode;
  property  LinkByName[N:LongString]:Integer     read GetLinkByName  write SetLinkByName;
  property  TimeByCode[C:Integer]:Double         read GetTimeByCode  write SetTimeByCode;
  property  TimeByName[N:LongString]:Double      read GetTimeByName  write SetTimeByName;
 public //  Helper functions
  class function KeyOfCode(aCode:Integer):LongString;
  class function ValidName(const aName:LongString):Boolean;
  class function TestBenchmark(aDelay:Integer=1000; n:Integer=1000):LongString;
 end;

function NewCodeNameMap(aCaseSensitive:Boolean=False):TCodeNameMap;
procedure Kill(var TheObject:TCodeNameMap); overload;

function FullCodeNameMapList:TObjectStorage;

implementation

//////////////////////////////
// TCodeNameMap implementation
//////////////////////////////

constructor TCodeNameMap.Create(aCaseSensitive:Boolean=False);
begin
 inherited Create;
 myMap:=NewHashList(aCaseSensitive,HashList_DefaultHasher);
 myMap.Master:=@myMap;
 myNames:=TStringList.Create;
 myNames.UseLocale:=False;
end;

destructor TCodeNameMap.Destroy;
begin
 Kill(myNames);
 Kill(myMap);
 inherited;
end;

procedure TCodeNameMap.AfterConstruction;
begin
 inherited;
 FullCodeNameMapList.Add(Self);
end;

procedure TCodeNameMap.BeforeDestruction;
begin
 FullCodeNameMapList.Remove(Self);
 inherited;
end;

const                 // KeyOfCode & ValidName spaces must be separated
 KeyMarker=ASCII_ETX; // Non-printable char to separate key/name spaces

class function TCodeNameMap.KeyOfCode(aCode:Integer):LongString;
const Easy:Boolean=False;
begin
 Result:='';
 if Easy then begin
  // Easy but slower version:
  Result:=IntToStr(aCode)+KeyMarker;
 end else begin
  // It works some faster:
  System.Str(aCode,Result);
  Result+=KeyMarker;
 end;
end;

class function TCodeNameMap.ValidName(const aName:LongString):Boolean;
begin
 Result:=(aName<>'') and (Pos(KeyMarker,aName)<=0);
end;

function TCodeNameMap.AddMap(aCode:Integer; const aName:LongString;
                             const aParam:LongString=''; aData:Double=0;
                             aLink:Integer=0; aTime:Double=0):Boolean;
begin
 Result:=False;
 if Assigned(Self) then
 if ValidName(aName) then
 try
   Lock;
   try
    if not HasCode(aCode) then
    if not HasName(aName) then begin
     myMap.KeyedLinks[aName]:=aCode;
     myMap.KeyedParams[KeyOfCode(aCode)]:=aName;
     if (aParam<>'') then ParamByName[aName]:=aParam;
     if (aData<>0) then DataByName[aName]:=aData;
     if (aLink<>0) then LinkByCode[aCode]:=aLink;
     if (aTime<>0) then TimeByCode[aCode]:=aTime;
     myNames.AddObject(aName,PtrIntToPointer(aCode));
     Result:=True;
    end;
   finally
    Unlock;
   end;
 except
  on E:Exception do BugReport(E,Self,'AddMap');
 end;
end;

function TCodeNameMap.GetCount:Integer;
begin
 Result:=0;
 if Assigned(Self) then
 try
   Lock;
   try
    Result:=myNames.Count;
   finally
    Unlock;
   end;
 except
  on E:Exception do BugReport(E,Self,'GetCount');
 end;
end;

function TCodeNameMap.GetCodes(i:Integer):Integer;
begin
 Result:=0;
 if Assigned(Self) then
 try
   Lock;
   try
    if InRange(i,0,myNames.Count-1)
    then Result:=PointerToPtrInt(myNames.Objects[i]);
   finally
    Unlock;
   end;
 except
  on E:Exception do BugReport(E,Self,'GetCodes');
 end;
end;

function TCodeNameMap.GetNames(i:Integer):LongString;
begin
 Result:='';
 if Assigned(Self) then
 try
   Lock;
   try
    if InRange(i,0,myNames.Count-1)
    then Result:=myNames.Strings[i];
   finally
    Unlock;
   end;
 except
  on E:Exception do BugReport(E,Self,'GetNames');
 end;
end;

function TCodeNameMap.GetNamesText:LongString;
begin
 Result:='';
 if Assigned(Self) then
 try
   Lock;
   try
    Result:=myNames.Text;
   finally
    Unlock;
   end;
 except
  on E:Exception do BugReport(E,Self,'GetNamesText');
 end;
end;

function TCodeNameMap.HasCode(aCode:Integer):Boolean;
begin
 Result:=False;
 if Assigned(Self) then
 try
   Lock;
   try
    Result:=(myMap.IndexOf(KeyOfCode(aCode))>=0);
   finally
    Unlock;
   end;
 except
  on E:Exception do BugReport(E,Self,'HasCode');
 end;
end;

function TCodeNameMap.HasName(const aName:LongString):Boolean;
begin
 Result:=False;
 if Assigned(Self) then
 if ValidName(aName) then
 try
   Lock;
   try
    Result:=(myMap.IndexOf(aName)>=0);
   finally
    Unlock;
   end;
 except
  on E:Exception do BugReport(E,Self,'HasName');
 end;
end;

function TCodeNameMap.NameByCode(aCode:Integer; const Def:LongString=''):LongString;
begin
 Result:=Def;
 if Assigned(Self) then
 try
   Lock;
   try
    Result:=myMap.KeyedParams[KeyOfCode(aCode)];
   finally
    Unlock;
   end;
 except
  on E:Exception do BugReport(E,Self,'NameByCode');
 end;
end;

function TCodeNameMap.CodeByName(const aName:LongString; Def:Integer=0):Integer;
begin
 Result:=Def;
 if Assigned(Self) then
 if ValidName(aName) then
 try
   Lock;
   try
    Result:=myMap.KeyedLinks[aName];
   finally
    Unlock;
   end;
 except
  on E:Exception do BugReport(E,Self,'CodeByName');
 end;
end;

function TCodeNameMap.GetParamByCode(aCode:Integer):LongString;
begin
 Result:='';
 if Assigned(Self)
 then Result:=GetParamByName(NameByCode(aCode));
end;

procedure TCodeNameMap.SetParamByCode(aCode:Integer; const aParam:LongString);
begin
 if Assigned(Self)
 then SetParamByName(NameByCode(aCode),aParam);
end;

function TCodeNameMap.GetParamByName(const aName:LongString):LongString;
begin
 Result:='';
 if Assigned(Self) then
 if ValidName(aName) then
 try
   Lock;
   try
    Result:=myMap.KeyedParams[aName];
   finally
    Unlock;
   end;
 except
  on E:Exception do BugReport(E,Self,'GetParamByName');
 end;
end;

procedure TCodeNameMap.SetParamByName(const aName,aParam:LongString);
begin
 if Assigned(Self) then
 if ValidName(aName) then
 try
   Lock;
   try
    myMap.KeyedParams[aName]:=aParam;
   finally
    Unlock;
   end;
 except
  on E:Exception do BugReport(E,Self,'SetParamByName');
 end;
end;

function TCodeNameMap.GetDataByCode(aCode:Integer):Double;
begin
 Result:=0;
 if Assigned(Self)
 then Result:=GetDataByName(NameByCode(aCode));
end;

procedure TCodeNameMap.SetDataByCode(aCode:Integer; aData:Double);
begin
 if Assigned(Self)
 then SetDataByName(NameByCode(aCode),aData);
end;

function TCodeNameMap.GetDataByName(const aName:LongString):Double;
begin
 Result:=0;
 if Assigned(Self) then
 if ValidName(aName) then
 try
   Lock;
   try
    Result:=myMap.KeyedDatas[aName];
   finally
    Unlock;
   end;
 except
  on E:Exception do BugReport(E,Self,'GetDataByName');
 end;
end;

procedure TCodeNameMap.SetDataByName(const aName:LongString; aData:Double);
begin
 if Assigned(Self) then
 if ValidName(aName) then
 try
   Lock;
   try
    myMap.KeyedDatas[aName]:=aData;
   finally
    Unlock;
   end;
 except
  on E:Exception do BugReport(E,Self,'SetDataByName');
 end;
end;

function TCodeNameMap.GetLinkByCode(aCode:Integer):Integer;
begin
 Result:=0;
 if Assigned(Self) then
 try
   Lock;
   try
    Result:=myMap.KeyedLinks[KeyOfCode(aCode)];
   finally
    Unlock;
   end;
 except
  on E:Exception do BugReport(E,Self,'GetLinkByCode');
 end;
end;

procedure TCodeNameMap.SetLinkByCode(aCode,aLink:Integer);
begin
 if Assigned(Self) then
 try
   Lock;
   try
    myMap.KeyedLinks[KeyOfCode(aCode)]:=aLink;
   finally
    Unlock;
   end;
 except
  on E:Exception do BugReport(E,Self,'SetLinkByCode');
 end;
end;

function TCodeNameMap.GetLinkByName(const aName:LongString):Integer;
begin
 Result:=0;
 if Assigned(Self)
 then Result:=GetLinkByCode(CodeByName(aName));
end;

procedure TCodeNameMap.SetLinkByName(const aName:LongString; aLink:Integer);
begin
 if Assigned(Self)
 then SetLinkByCode(CodeByName(aName),aLink);
end;

function TCodeNameMap.GetTimeByCode(aCode:Integer):Double;
begin
 Result:=0;
 if Assigned(Self) then
 try
   Lock;
   try
    Result:=myMap.KeyedDatas[KeyOfCode(aCode)];
   finally
    Unlock;
   end;
 except
  on E:Exception do BugReport(E,Self,'GetTimeByCode');
 end;
end;

procedure TCodeNameMap.SetTimeByCode(aCode:Integer; aTime:Double);
begin
 if Assigned(Self) then
 try
   Lock;
   try
    myMap.KeyedDatas[KeyOfCode(aCode)]:=aTime;
   finally
    Unlock;
   end;
 except
  on E:Exception do BugReport(E,Self,'SetTimeByCode');
 end;
end;

function TCodeNameMap.GetTimeByName(const aName:LongString):Double;
begin
 Result:=0;
 if Assigned(Self)
 then Result:=GetTimeByCode(CodeByName(aName));
end;

procedure TCodeNameMap.SetTimeByName(const aName:LongString; aTime:Double);
begin
 if Assigned(Self)
 then SetTimeByCode(CodeByName(aName),aTime);
end;

class function TCodeNameMap.TestBenchmark(aDelay:Integer=1000; n:Integer=1000):LongString;
var Lines:TStringList; i,ne,it:Integer; ms:QWord; s:LongString; mks,dv:Double;
var Mapper:TCodeNameMap;
 function StrId(i:Integer):LongString;
 begin
  Result:='StringIdentifier'+IntToStr(i);
 end;
begin
 Lines:=TStringList.Create;
 try
  Mapper:=NewCodeNameMap;
  if Assigned(Mapper) then with Mapper do
  try
   ne:=0; it:=0; s:='';
   for i:=1 to n do AddMap(i,StrId(i),StrId(i)+EOL,i+1*n,i+2*n,i+3*n);
   for i:=1 to n do if (HasCode(i)<>True) then inc(ne);
   for i:=1 to n do if (HasName(StrId(i))<>True) then inc(ne);
   for i:=1 to n do if (NameByCode(i)<>StrId(i)) then inc(ne);
   for i:=1 to n do if (CodeByName(StrId(i))<>i) then inc(ne);
   for i:=1 to n do if (ParamByName[StrId(i)]<>StrId(i)+EOL) then inc(ne);
   for i:=1 to n do if (DataByName[StrId(i)]<>i+1*n) then inc(ne);
   for i:=1 to n do if (LinkByName[StrId(i)]<>i+2*n) then inc(ne);
   for i:=1 to n do if (TimeByName[StrId(i)]<>i+3*n) then inc(ne);
   Lines.Add(Format('TCodeNameMap.TestBenchmark(%d,%d):',[aDelay,n]));
   Lines.Add(Format('Test %d items, %d error(s) found',[n,ne]));
   // Bench HasCode
   ms:=GetTickCount64; it:=0;
   while (GetTickCount64<ms+aDelay) do begin
    HasCode(n shr 1);
    inc(it);
   end;
   ms:=GetTickCount64-ms; mks:=1e3*ms/Max(1,it);
   Lines.Add(Format('Test HasCode %d ms, %d loops, %1.3f mks/call',[ms,it,mks]));
   // Bench HasName
   ms:=GetTickCount64; it:=0; s:=StrId(n shr 1);
   while (GetTickCount64<ms+aDelay) do begin
    HasName(s);
    inc(it);
   end;
   ms:=GetTickCount64-ms; mks:=1e3*ms/Max(1,it);
   Lines.Add(Format('Test HasName %d ms, %d loops, %1.3f mks/call',[ms,it,mks]));
   // Bench NameByCode
   ms:=GetTickCount64; it:=0;
   while (GetTickCount64<ms+aDelay) do begin
    s:=NameByCode(n shr 1); s:='';
    inc(it);
   end;
   ms:=GetTickCount64-ms; mks:=1e3*ms/Max(1,it);
   Lines.Add(Format('Test NameByCode %d ms, %d loops, %1.3f mks/call',[ms,it,mks]));
   // Bench CodeByName
   ms:=GetTickCount64; it:=0; s:=StrId(n shr 1);
   while (GetTickCount64<ms+aDelay) do begin
    CodeByName(s);
    inc(it);
   end;
   ms:=GetTickCount64-ms; mks:=1e3*ms/Max(1,it);
   Lines.Add(Format('Test CodeByName %d ms, %d loops, %1.3f mks/call',[ms,it,mks]));
   // Bench DataByName
   ms:=GetTickCount64; it:=0; s:=StrId(n shr 1);
   while (GetTickCount64<ms+aDelay) do begin
    dv:=DataByName[s]; dv:=0;
    inc(it);
   end;
   ms:=GetTickCount64-ms; mks:=1e3*ms/Max(1,it);
   Lines.Add(Format('Test DataByName %d ms, %d loops, %1.3f mks/call',[ms,it,mks]));
   // Bench TimeByName
   ms:=GetTickCount64; it:=0; s:=StrId(n shr 1);
   while (GetTickCount64<ms+aDelay) do begin
    dv:=TimeByName[s]; dv:=0;
    inc(it);
   end;
   ms:=GetTickCount64-ms; mks:=1e3*ms/Max(1,it);
   Lines.Add(Format('Test TimeByName %d ms, %d loops, %1.3f mks/call',[ms,it,mks]));
   FakeNop(dv);
   ///////////////////
   Result:=Lines.Text;
  finally
   Kill(Mapper);
  end;
 finally
  Kill(Lines);
 end;
end;

function NewCodeNameMap(aCaseSensitive:Boolean=False):TCodeNameMap;
begin
 Result:=TCodeNameMap.Create(aCaseSensitive);
end;

procedure Kill(var TheObject:TCodeNameMap); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

/////////////////////////////////////
// FullCodeNameMapList implementation
/////////////////////////////////////

const
 TheFullCodeNameMapList:TObjectStorage=nil;

function FullCodeNameMapList:TObjectStorage;
begin
 if not Assigned(TheFullCodeNameMapList) then begin
  TheFullCodeNameMapList:=NewObjectStorage(False);
  TheFullCodeNameMapList.Master:=@TheFullCodeNameMapList;
  TheFullCodeNameMapList.OwnsObjects:=False;
 end;
 Result:=TheFullCodeNameMapList;
end;

procedure InitFullCodeNameMapList;
begin
 FullCodeNameMapList.Ok;
end;

procedure FreeFullCodeNameMapList;
begin
 Kill(TheFullCodeNameMapList);
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_cnmap;
begin
 InitFullCodeNameMapList;
end;

procedure Free_crw_cnmap;
begin
 FreeFullCodeNameMapList;
end;

initialization

 Init_crw_cnmap;

finalization

 Free_crw_cnmap;

end.

//////////////
// END OF FILE
//////////////

