utils/uutlFilter.pas

unit uutlFilter;

{$mode objfpc}{$H+}
{$IFDEF UTL_NESTED_PROCVARS}
  {$modeswitch nestedprocvars}
{$ENDIF}

interface

uses
  Classes, SysUtils,
  uutlInterfaces;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlFilterEvent<T>  = function(constref i: T): Boolean;
  generic TutlFilterEventO<T> = function(constref i: T): Boolean of object;
  {$IFDEF UTL_NESTED_PROCVARS}
  generic TutlFilterEventN<T> = function(constref i: T): Boolean is nested;
  {$ENDIF}

  generic TutlCallbackFilter<T> = class(
    TInterfacedObject,
    specialize IutlFilter<T>)

  private type
    TFilterEventType = (fetNormal, fetObject, fetNested);

  public type
    TFilterEvent  = specialize TutlFilterEvent<T>;
    TFilterEventO = specialize TutlFilterEventO<T>;
    {$IFDEF UTL_NESTED_PROCVARS}
    TFilterEventN = specialize TutlFilterEventN<T>;
    {$ENDIF}

  strict private
    fType: TFilterEventType;
    fEvent: TFilterEvent;
    fEventO: TFilterEventO;
    {$IFDEF UTL_NESTED_PROCVARS}
    fEventN: TFilterEventN;
    {$ENDIF}

  public
    function Filter(constref i: T): Boolean;

    constructor Create(constref aEvent: TFilterEvent); overload;
    constructor Create(constref aEvent: TFilterEventO); overload;
    {$IFDEF UTL_NESTED_PROCVARS}
    constructor Create(constref aEvent: TFilterEventN); overload;
    {$ENDIF}
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlSelectEvent <Tin, Tout> = function(constref i: Tin): Tout;
  generic TutlSelectEventO<Tin, Tout> = function(constref i: Tin): Tout of object;
  {$IFDEF UTL_NESTED_PROCVARS}
  generic TutlSelectEventN<Tin, Tout> = function(constref i: Tin): Tout is nested;
  {$ENDIF}

  generic TutlCallbackSelector<Tin, Tout> = class(
    TInterfacedObject,
    specialize IutlSelector<Tin, Tout>)

  private type
    TSelectEventType = (setNormal, setObject, setNested);

  public type
    TSelectEvent  = specialize TutlSelectEvent <Tin, Tout>;
    TSelectEventO = specialize TutlSelectEventO<Tin, Tout>;
    {$IFDEF UTL_NESTED_PROCVARS}
    TSelectEventN = specialize TutlSelectEventN<Tin, Tout>;
    {$ENDIF}

  strict private
    fType: TSelectEventType;
    fEvent: TSelectEvent;
    fEventO: TSelectEventO;
    {$IFDEF UTL_NESTED_PROCVARS}
    fEventN: TSelectEventN;
    {$ENDIF}

  public
    function Select(constref i: Tin): Tout;

    constructor Create(constref aEvent: TSelectEvent); overload;
    constructor Create(constref aEvent: TSelectEventO); overload;
    {$IFDEF UTL_NESTED_PROCVARS}
    constructor Create(constref aEvent: TSelectEventN); overload;
    {$ENDIF}
  end;

implementation

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCallbackFilter/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCallbackFilter.Filter(constref i: T): Boolean;
begin
  result := false;
  case fType of
    fetNormal: result := fEvent (i);
    fetObject: result := fEventO(i);
    {$IFDEF UTL_NESTED_PROCVARS}
    fetNested: result := fEventN(i);
    {$ENDIF}
  else
    raise Exception.Create('invalid or unknown callback type');
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCallbackFilter.Create(constref aEvent: TFilterEvent);
begin
  inherited Create;
  fType  := fetNormal;
  fEvent := aEvent;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCallbackFilter.Create(constref aEvent: TFilterEventO);
begin
  inherited Create;
  fType   := fetObject;
  fEventO := aEvent;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$IFDEF UTL_NESTED_PROCVARS}
constructor TutlCallbackFilter.Create(constref aEvent: TFilterEventN);
begin
  inherited Create;
  fType   := fetNested;
  fEventN := aEvent;
end;
{$ENDIF}

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCallbackSelector///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCallbackSelector.Select(constref i: Tin): Tout;
begin
  case fType of
    setNormal: result := fEvent (i);
    setObject: result := fEventO(i);
    {$IFDEF UTL_NESTED_PROCVARS}
    setNested: result := fEventN(i);
    {$ENDIF}
  else
    raise Exception.Create('invalid or unknown callback type');
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCallbackSelector.Create(constref aEvent: TSelectEvent);
begin
  inherited Create;
  fType  := setNormal;
  fEvent := aEvent;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCallbackSelector.Create(constref aEvent: TSelectEventO);
begin
  inherited Create;
  fType   := setObject;
  fEventO := aEvent;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$IFDEF UTL_NESTED_PROCVARS}
constructor TutlCallbackSelector.Create(constref aEvent: TSelectEventN);
begin
  inherited Create;
  fType   := setNested;
  fEventN := aEvent;
end;
{$ENDIF}

end.