////////////////////////////////////////////////////////////////////////////////
// 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:                                                                   //
// Application level utilities.                                               //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20230702 - Created by A.K.                                                 //
// 20240603 - OnIdleActions                                                   //
// 20240627 - ExeLevel,MaxLevel (to avoid recursion problems)                 //
////////////////////////////////////////////////////////////////////////////////

unit _crw_apputils; //  Application utilities.

{$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;

 {
 *******************************************************************************
 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;
 private
  myExeLevel : SizeInt;
  myMaxLevel : SizeInt;
  function    GetExeLevel:SizeInt;
  function    GetMaxLevel:SizeInt;
  procedure   SetMaxLevel(aLevel:SizeInt);
 public
  property    ExeLevel:SizeInt read GetExeLevel;
  property    MaxLevel:SizeInt read GetMaxLevel write SetMaxLevel;
 end;

function SecondActions:TProcedureList;  // Should call every second
function Tick55Actions:TProcedureList;  // Should call every 55 ms tick
function OnIdleActions:TProcedureList;  // Should call in Application.OnIdle
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;
 myExeLevel:=0;
 myMaxLevel:=1;
end;

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

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

function TProcedureList.GetExeLevel:SizeInt;
begin
 if Assigned(Self) then Result:=myExeLevel else Result:=0;
end;

function TProcedureList.GetMaxLevel:SizeInt;
begin
 if Assigned(Self) then Result:=myMaxLevel else Result:=0;
end;

procedure TProcedureList.SetMaxLevel(aLevel:SizeInt);
begin
 if Assigned(Self) then myMaxLevel:=aLevel;
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
   Inc(myExeLevel); // Execution level to avoid recursions
   if (myExeLevel<=myMaxLevel) or (myMaxLevel<=0) then begin
    i:=0;
    while (i<myList.Count) do begin
     Action:=myList[i];
     if Assigned(Action) then Action;
     Inc(i);
    end;
   end;
  finally
   Dec(myExeLevel);
   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;
 TheOnIdleActions   : 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 OnIdleActions:TProcedureList;
begin
 if not Assigned(TheOnIdleActions) then begin
  TheOnIdleActions:=TProcedureList.Create;
  TheOnIdleActions.Master:=@TheOnIdleActions;
 end;
 Result:=TheOnIdleActions;
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;
 OnIdleActions.Ok;
 InitSubSystems.Ok;
 DoneSubSystems.Ok;
 ConfirmExitList.Ok;
end;

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

initialization

 Init_crw_apputils;

finalization

 Free_crw_apputils;

end.

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

