////////////////////////////////////////////////////////////////////////////////
// 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:                                                                   //
// DAQ system events and some other routines to process events.               //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20020220 - Creation (uses CRW16) & test                                    //
// 20030330 - Struggle for safety (add some try/except checks)...             //
// 20230604 - Modified for FPC (A.K.)                                         //
////////////////////////////////////////////////////////////////////////////////

unit _crw_daqevnt; // DAQ events

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

{$WARN 5023 off : Unit "$1" not used in $2}

interface

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

 {
 *******************************************************************************
 Система CRW-DAQ является событийно-ориентированной системой.
 Каждый квант информации упаковывается в событие и затем проходит через
 диспетчер событий DispatchEvent, который сортирует данные и переправляет
 их в нужное место. Поэтому важно правильно упаковать событие.
 При упаковке события надо иметь в виду следующее:
 1.В начале надо правильно указать класс события What.
   What описывает класс события и строится из битовых флагов:
   evAnalog/Digital    - Бит указывает на то является событие цифровым или
                         аналоговым.
   evNormal/Important  - Событие нормальное или 'важное'. 'Важные' события
                         обрабатываются специальным образом.
   evNo/Compress       - Надо ли сжимать аналоговое событие при
                         диспетчеризации. Сжатие позволяет уменьшить размер
                         кривой путем некоторой потери точности.
   evNo/Spectral       - событие обычное или спектрометрическое.
                         Обычные события добавляют точку в конец кривой.
                         Спектрометрические события приращивают счет в канале.
                         См. далее.
   Для будущего следут учитывать, что 'нормальным' значением бита по
   умолчанию является ноль, то есть при добавлении новых битов надо
   делать так,чтобы 'нормальные'события обрабатывались без изменений.
 2.Chan описывает кому направлено событие - это фактически номер цифрового
   или аналогового выхода, на который будет передано это событие.
 3.Time описывает время, когда произошло событие. Обычно это время события
   от загрузки DAQ: Daq.Timer.LocalTime. В спектрометрии, где идет счет
   каналов и время не играет роли, может не заполняться.
 4.Data[0],Data[1] - данные.
   Для обычных событий используется Data[0], а Data[1] можно не заполнять.
   Для спектрометрии Data[0]-номер канала, Data[1]-приращение в канале.
 5.Поля What и Chan используются для переадресации события в методе
   DispatchEvent и поэтому с ними надо быть ОСОБЕННО аккуратным.
 6.Следует иметь в виду, что обычные события можно адресовать только
   динамическим кривым (у которых шаг приращения больше нуля),
   а спектрометрические - только статическим кривым (с нулевым шагом).
   Иначе генерируется ошибка диспетчеризации.
 *******************************************************************************
 }
type
 TDaqEvent = packed record                {тип описывает событие DAQ}
  What  : Cardinal;                       {тип события - смотри флаги evXXXX}
  Chan  : Cardinal;                       {координаты канала события}
  Time  : Double;                         {время по часам DAQ}
  Data  : packed array[0..1] of Double;   {данные}
 end;

function DaqEvent(What  : Cardinal;
                  Chan  : Cardinal;
                  Time  : Double;
                  Data0 : Double;
                  Data1 : Double = 0
                      ) : TDaqEvent;

 {
 *******************************************************************************
 Флаги поля TDaqEvent.What
 Флаги по умолчанию - нули - можно не указывать.
 *******************************************************************************
 }
const
 evAnalog      = $00000000; evDigital     = $00000001;
 evNormal      = $00000000; evImportant   = $00000002;
 evNoCompress  = $00000000; evCompress    = $00000004;
 evNoSpectral  = $00000000; evSpectral    = $00000008;

 {
 *******************************************************************************
 Этот объект используется для сжатия данных при диспетчеризации событий
 с флагом evCompress.
 Объект для сжатия данных - понижает точность числа для того, чтобы
 при диспетчеризации событий незначимые изменения данных не приводили
 бы к чрезмерному 'раздуванию' кривых.  За счет квантования по амплитуде
 размер кривых снижается (с некоторой контролируемой потерей точности).
 Задается две точности - абсолютная abstol и относительная reltol.
 Сжатие по абсолютной точности идет по формуле
  x = round( x / abstol ) * abstol
 Например, если abstol = 0.01, то округление будет до одной сотой.
 При сжатии по абсолютной точности квант амплитуды не зависит от
 числа и равен abstol, а относительная точность зависит от амплитуды.
 Сжатие по относительной точности работает по следующему алгоритму:
 a) Выделяем двоичные мантиссу и порядок (мантисса в интервале [1..2[)
 b) Сжимаем мантиссу с абсолютной точностью reltol
 c) Восстанавливаем порядок числа
 Например, если reltol = 0.01, то округление идет с точностью один процент.
 При сжатии по относительной точности квант амплитуды зависит от числа,
 а относительная точность не зависит и равна reltol.
 Если обе точности меньше или равны нулю, никакого сжатия нет.
 Если одна из точностей - ноль, то соответствующего ей сжатия нет.
 При наличии обоих точностей работает один из методов сжатия, а именно
 тот, который для данного числа дает наибольшее сжатие.
 Например, если abstol=0.001, reltol=0.01, то для чисел меньше чем
 abstol/reltol=0.1 работает абсолютное сжатие, а для чисел больше -
 относительное.
 Примечание:
 Объект специально не защищен в отношении многопоточности, так как в процессе
 измерений он не меняется и поэтому в защите не нуждается.
 *******************************************************************************
 }
type
 TDaqCompressor = class(TMasterObject)
 private
  myModel   : Cardinal;
  myAbsTol  : Extended;
  myAbsVal  : Extended;
  myRelTol  : Extended;
  myRelVal  : Extended;
  myThresh  : Extended;
  function    GetAbsTol:Extended;
  procedure   SetAbsTol(aAbsTol:Extended);
  function    GetRelTol:Extended;
  procedure   SetRelTol(aRelTol:Extended);
  procedure   Update(aAbsTol,aRelTol:Extended);
 public
  constructor Create(aAbsTol,aRelTol:Extended);
  property    AbsTol : Extended read GetAbsTol write SetAbsTol;
  property    RelTol : Extended read GetRelTol write SetRelTol;
  function    Compress(What:Extended):Extended;
 end;

function  NewDaqCompressor(aAbsTol,aRelTol:Extended):TDaqCompressor;
procedure Kill(var TheObject:TDaqCompressor); overload;

type
 PDaqCompressorArray = ^TDaqCompressorArray;
 TDaqCompressorArray = array[0..MaxInt div sizeof(TDaqCompressor)-1] of TDaqCompressor;

 {
 *******************************************************************************
 Базовый объект для сглаживания кривых для DAQ.
 Обьект должен интерполировать-экстраполировать кривую в заданной точке
 В данном объекте применяется сглаживание 'плавающим' МНК-полиномом
 с взвешиванием при помощи функции ядра (1-abs(x)^k1)^k2
 Window - полуширина окна сглаживания
 Power  - степень МНК-полинома
 K1,K2  - параметры описывают ядро (1-abs(x)^k1)^k2 для 'взвешивания' точек
 *******************************************************************************
 }
type
 TDaqSmoother = class(TMasterObject)
 private
  myWindow : Double;
  myPower  : Integer;
  myK1     : Integer;
  myK2     : Integer;
  function    GetWindow:Double;
  procedure   SetWindow(aWindow:Double);
  function    GetPower:Integer;
  procedure   SetPower(aPower:Integer);
  function    GetK1:Integer;
  procedure   SetK1(aK1:Integer);
  function    GetK2:Integer;
  procedure   SetK2(aK2:Integer);
 public
  constructor Create(aWindow:Double; aPower,aK1,aK2:Integer);
  property    Window : Double  read GetWindow write SetWindow;
  property    Power  : Integer read GetPower  write SetPower;
  property    K1     : Integer read GetK1     write SetK1;
  property    K2     : Integer read GetK2     write SetK2;
  function    Smooth(aCurve:TCurve; Where:Double):Double;
 end;

function  NewDaqSmoother(aWindow:Double; aPower,aK1,aK2:Integer):TDaqSmoother;
procedure Kill(var TheObject:TDaqSmoother); overload;

type
 PDaqSmootherArray=^TDaqSmootherArray;
 TDaqSmootherArray=array[0..MaxInt div sizeof(TDaqSmoother)-1] of TDaqSmoother;

implementation

 {
 *******************************************************************************
 DaqEvent implementation
 *******************************************************************************
 }
function DaqEvent(What  : Cardinal;
                  Chan  : Cardinal;
                  Time  : Double;
                  Data0 : Double;
                  Data1 : Double = 0
                      ) : TDaqEvent;
begin
 Result.What:=What;
 Result.Chan:=Chan;
 Result.Time:=Time;
 Result.Data[0]:=Data0;
 Result.Data[1]:=Data1;
end;

 {
 *******************************************************************************
 TDaqCompressor implementation
 *******************************************************************************
 }
constructor TDaqCompressor.Create(aAbsTol,aRelTol:Extended);
begin
 inherited Create;
 Update(aAbsTol,aRelTol);
end;

function  TDaqCompressor.GetAbsTol:Extended;
begin
 if Assigned(Self) then Result:=myAbsTol else Result:=0;
end;

procedure TDaqCompressor.SetAbsTol(aAbsTol:Extended);
begin
 if Assigned(Self) then Update(aAbsTol,RelTol);
end;

function  TDaqCompressor.GetRelTol:Extended;
begin
 if Assigned(Self) then Result:=myRelTol else Result:=0;
end;

procedure TDaqCompressor.SetRelTol(aRelTol:Extended);
begin
 if Assigned(Self) then Update(AbsTol,aRelTol);
end;

procedure TDaqCompressor.Update(aAbsTol,aRelTol:Extended);
begin
 if Assigned(Self) then begin
  if (aAbsTol<=0) and (aRelTol<=0) then begin {нет сжатия}
   myModel:=0;
   myAbsTol:=0;
   myAbsVal:=0;
   myRelTol:=0;
   myRelVal:=0;
   myThresh:=0;
  end else
  if (aRelTol<=0) then begin                  {сжатие по Abs}
   myModel:=1;
   myAbsTol:=aAbsTol;
   myAbsVal:=1/aAbsTol;
   myRelTol:=0;
   myRelVal:=0;
   myThresh:=0;
  end else
  if (aAbsTol<=0) then begin                  {сжатие по RelTol}
   myModel:=2;
   myAbsTol:=0;
   myAbsVal:=0;
   myRelTol:=aRelTol;
   myRelVal:=1/aRelTol;
   myThresh:=0;
  end else begin                              {сжатие по обоим}
   myModel:=3;
   myAbsTol:=aAbsTol;
   myAbsVal:=1/aAbsTol;
   myRelTol:=aRelTol;
   myRelVal:=1/aRelTol;
   myThresh:=aAbsTol/aRelTol;
  end;
 end;
end;

function  TDaqCompressor.Compress(What:Extended):Extended;
begin
 if Assigned(Self) then
 case myModel of
  1 : Result:=fabscompress(What,myAbsVal);
  2 : Result:=frelcompress(What,myRelVal);
  3 : if abs(What)<myThresh
      then Result:=fabscompress(What,myAbsVal)
      else Result:=frelcompress(What,myRelVal);
  else Result:=What;
 end else Result:=What;
end;

function  NewDaqCompressor(aAbsTol,aRelTol:Extended):TDaqCompressor;
begin
 Result:=nil;
 try
  Result:=TDaqCompressor.Create(aAbsTol,aRelTol);
 except
  on E:Exception do BugReport(E,nil,'NewDaqCompressor');
 end;
end;

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

 {
 *******************************************************************************
 TDaqSmoother implementation
 *******************************************************************************
 }
function    TDaqSmoother.GetWindow:Double;
begin
 if Assigned(Self) then Result:=myWindow else Result:=0;
end;

procedure   TDaqSmoother.SetWindow(aWindow:Double);
begin
 if Assigned(Self) then myWindow:=abs(aWindow);
end;

function    TDaqSmoother.GetPower:Integer;
begin
 if Assigned(Self) then Result:=myPower else Result:=0;
end;

procedure   TDaqSmoother.SetPower(aPower:Integer);
begin
 if Assigned(Self) then myPower:=max(-1,min(9,aPower));
end;

function    TDaqSmoother.GetK1:Integer;
begin
 if Assigned(Self) then Result:=myK1 else Result:=0;
end;

procedure   TDaqSmoother.SetK1(aK1:Integer);
begin
 if Assigned(Self) then myK1:=max(0,min(9,aK1));
end;

function    TDaqSmoother.GetK2:Integer;
begin
 if Assigned(Self) then Result:=myK2 else Result:=0;
end;

procedure   TDaqSmoother.SetK2(aK2:Integer);
begin
 if Assigned(Self) then myK2:=max(0,min(9,aK2));
end;

constructor TDaqSmoother.Create(aWindow:Double; aPower,aK1,aK2:Integer);
begin
 inherited Create;
 Window:=aWindow;
 Power:=aPower;
 K1:=aK1;
 K2:=aK2;
end;

function  TDaqSmoother.Smooth(aCurve:TCurve; Where:Double):Double;
begin
 if Assigned(Self)
 then Result:=aCurve.Smooth(Where, myWindow, myPower, myK1, myK2)
 else Result:=aCurve.Interpolate(Where);
end;

function  NewDaqSmoother(aWindow:Double; aPower,aK1,aK2:Integer):TDaqSmoother;
begin
 Result:=nil;
 try
  Result:=TDaqSmoother.Create(aWindow, aPower, aK1, aK2);
 except
  on E:Exception do BugReport(E,nil,'NewDaqSmoother');
 end;
end;

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

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

procedure Init_crw_daqevnt;
begin
end;

procedure Free_crw_daqevnt;
begin
end;

initialization

 Init_crw_daqevnt;

finalization

 Free_crw_daqevnt;

end.

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

