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

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

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// Application level utilities.                                               //
////////////////////////////////////////////////////////////////////////////////

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

unit _crw_apputils; //  Application utilities.

{$I _crw_sysdef}

{$IFDEF FPC}{$mode Delphi}{$ENDIF}{$H+}

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

interface

uses
_crw_sharemem, // NB: THIS UNIT MUST BE FIRST !!!
{$IFDEF UNIX} cthreads, dl, {$ENDIF}
{$IFDEF WINDOWS} windows, {$ENDIF}
sysutils, classes,
_crw_alloc;

 {
 *******************************************************************************
 TProcedureList is a list of procedure that may be execute altogether by single
 call of Execute. This procedure list useful for timer handlers, for example.
 *******************************************************************************
 }
type
 TProcedureList = class(TLatch)
 private
  myList    : TList;
 protected
  function    CheckOk:Boolean; override;
 public
  constructor Create;
  destructor  Destroy; override;
  function    HasAction(aAction:TProcedure):Boolean;
  procedure   Add(aAction:TProcedure; First:Boolean=false);
  procedure   Remove(aAction:TProcedure);
  function    Count:Integer;
  procedure   Execute;
  procedure   Clear;
 end;

function SecondActions:TProcedureList;  // Should call every second
function Tick55Actions:TProcedureList;  // Should call every 55 ms tick
function InitSubSystems:TProcedureList; // Should call after program start
function DoneSubSystems:TProcedureList; // Should call before program exit

 {
 *******************************************************************************
 TConfirmation is a list of functions that may be execute altogether by single
 call of Execute. Uses to confirm program exit, for example.
 *******************************************************************************
 }
type
 TConfirmation = function:boolean;
 TConfirmationList = class(TLatch)
 private
  myList    : TList;
 protected
  function    CheckOk:Boolean; override;
 public
  constructor Create;
  destructor  Destroy; override;
  procedure   Add(aAction:TConfirmation; First:Boolean=false);
  procedure   Remove(aAction:TConfirmation);
  function    Execute:Boolean;
  function    Count:Integer;
  procedure   Clear;
 end;

function ConfirmExitList:TConfirmationList; // Uses to confirm program exit.

implementation

 {
 *****************************
 TProcedureList implementation
 *****************************
 }
constructor TProcedureList.Create;
begin
 inherited Create;
 Exceptions:=false;
 myList:=TList.Create;
end;

destructor TProcedureList.Destroy;
begin
 Kill(myList);
 inherited Destroy;
end;

function TProcedureList.CheckOk:Boolean;
begin
 Result:=Assigned(myList);
end;

function TProcedureList.HasAction(aAction:TProcedure):Boolean;
begin
 Result:=false;
 if Ok then
 try
  Lock;
  try
   if Assigned(myList) and Assigned(aAction)
   then Result:=(myList.IndexOf(@aAction)>=0);
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'HasAction');
 end;
end;

procedure TProcedureList.Add(aAction:TProcedure; First:Boolean=false);
begin
 if Ok then
 try
  Lock;
  try
   if Assigned(myList) and Assigned(aAction) then
   if (myList.IndexOf(@aAction)<0) then begin
    if First then myList.Insert(0,@aAction) else myList.Add(@aAction);
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Add');
 end;
end;

procedure TProcedureList.Remove(aAction:TProcedure);
begin
 if Ok then
 try
  Lock;
  try
   if Assigned(myList) and Assigned(aAction) then
   if (myList.IndexOf(@aAction)>=0) then myList.Remove(@aAction);
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Remove');
 end;
end;

procedure TProcedureList.Execute;
var i:Integer; Action:TProcedure;
begin
 if Ok then
 try
  Lock;
  try
   i:=0;
   while (i<myList.Count) do begin
    Action:=myList[i];
    if Assigned(Action) then Action;
    Inc(i);
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Execute');
 end;
end;

procedure TProcedureList.Clear;
begin
 if Ok then
 try
  Lock;
  try
   myList.Clear;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Clear');
 end;
end;

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

 {
 *****************************
 TProcedureList implementation
 *****************************
 }
constructor TConfirmationList.Create;
begin
 inherited Create;
 Exceptions:=false;
 myList:=TList.Create;
end;

destructor TConfirmationList.Destroy;
begin
 Kill(myList);
 inherited Destroy;
end;

function TConfirmationList.CheckOk:Boolean;
begin
 Result:=Assigned(myList);
end;

procedure TConfirmationList.Add(aAction:TConfirmation; First:Boolean=false);
begin
 if Ok then
 try
  Lock;
  try
   if Assigned(myList) and Assigned(aAction) then
   if (myList.IndexOf(@aAction)<0) then begin
    if First then myList.Insert(0,@aAction) else myList.Add(@aAction);
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Add');
 end;
end;

procedure TConfirmationList.Remove(aAction:TConfirmation);
begin
 if Ok then
 try
  Lock;
  try
   if Assigned(myList) and Assigned(aAction) then
   if (myList.IndexOf(@aAction)>=0) then myList.Remove(@aAction);
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Remove');
 end;
end;

function TConfirmationList.Execute:Boolean;
var i:Integer; Action:TConfirmation;
begin
 Result:=true;
 if Ok then
 try
  Lock;
  try
   i:=0;
   while (i<myList.Count) do begin
    Action:=myList[i];
    if Assigned(Action) then Result:=Action;
    if not Result then Break;
    Inc(i);
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Execute');
 end;
end;

procedure TConfirmationList.Clear;
begin
 if Ok then
 try
  Lock;
  try
   myList.Clear;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Clear');
 end;
end;

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

const
 TheSecondActions   : TProcedureList    = nil;
 TheTick55Actions   : TProcedureList    = nil;
 TheInitSubSystems  : TProcedureList    = nil;
 TheDoneSubSystems  : TProcedureList    = nil;
 TheConfirmExitList : TConfirmationList = nil;

function SecondActions:TProcedureList;
begin
 if not Assigned(TheSecondActions) then begin
  TheSecondActions:=TProcedureList.Create;
  TheSecondActions.Master:=@TheSecondActions;
 end;
 Result:=TheSecondActions;
end;

function Tick55Actions:TProcedureList;
begin
 if not Assigned(TheTick55Actions) then begin
  TheTick55Actions:=TProcedureList.Create;
  TheTick55Actions.Master:=@TheTick55Actions;
 end;
 Result:=TheTick55Actions;
end;

function InitSubSystems:TProcedureList;
begin
 if not Assigned(TheInitSubSystems) then begin
  TheInitSubSystems:=TProcedureList.Create;
  TheInitSubSystems.Master:=@TheInitSubSystems;
 end;
 Result:=TheInitSubSystems;
end;

function DoneSubSystems:TProcedureList;
begin
 if not Assigned(TheDoneSubSystems) then begin
  TheDoneSubSystems:=TProcedureList.Create;
  TheDoneSubSystems.Master:=@TheDoneSubSystems;
 end;
 Result:=TheDoneSubSystems;
end;

function ConfirmExitList:TConfirmationList;
begin
 if not Assigned(TheConfirmExitList) then begin
  TheConfirmExitList:=TConfirmationList.Create;
  TheConfirmExitList.Master:=@TheConfirmExitList;
 end;
 Result:=TheConfirmExitList;
end;

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

procedure Init_crw_apputils;
begin
 SecondActions.Ok;
 Tick55Actions.Ok;
 InitSubSystems.Ok;
 DoneSubSystems.Ok;
 ConfirmExitList.Ok;
end;

procedure Free_crw_apputils;
begin
 Kill(TObject(TheSecondActions));
 Kill(TObject(TheTick55Actions));
 Kill(TObject(TheInitSubSystems));
 Kill(TObject(TheDoneSubSystems));
 Kill(TObject(TheConfirmExitList));
end;

initialization

 Init_crw_apputils;

finalization

 Free_crw_apputils;

end.

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

