Sordie.co.uk

libsassy/libSassy.Tasks.pas

Raw

{(
 )) libSassy.Tasks
((    Task management
 ))
((  Copyright  Sordie Aranka Solomon-Smith 2015-2017
 ))
((  This work is made available under the terms of the Creative Commons
 )) Attribution-NonCommercial-ShareAlike 3.0 Unported license
((  http://creativecommons.org/licenses/by-nc-sa/3.0/
 )}

unit libSassy.Tasks;

interface

uses
  libSassy.Arrays,
  libSassy.Interfaces;

type
{$REGION 'Forwards'}
  TJob = class;
{$ENDREGION}

{$REGION 'TTask'}
  TTask = class(TInterface)
  private
    fJob:  TJob;
    fLock: Integer;

    fInterval: Integer;
    fICount:   Integer;

    procedure SetJob(Value: TJob);
  public
    constructor Create;
    destructor  Destroy; override;

    procedure Reset; virtual;

    function Execute(const Delta: Extended): Boolean; virtual;
    function Update (const Delta: Extended): Boolean; virtual;

    function Yield(const Delta: Extended = 1.0): Boolean;

    property Job: TJob read fJob write SetJob;

    property Lock: Integer read fLock;

    property Interval: Integer read fInterval write fInterval;
  end;
{$ENDREGION}

{$REGION 'TTaskMethod'}
  TTaskMethodRef = reference to function(const Delta: Extended): Boolean;

  TTaskMethod = class(TTask)
  private
    fMethod: TTaskMethodRef;
  public
    constructor Create(AMethod: TTaskMethodRef);

    function Update(const Delta: Extended): Boolean; override;
  end;
{$ENDREGION}

{$REGION 'TJob'}
  TJob = class(TTask)
  private
    fTasks: TArray<TTask>;

    fRunning: Integer;
    function GetRunning: Boolean; inline;
  public
    constructor Create;
    destructor  Destroy; override;

    function Update(const Delta: Extended): Boolean; override;

    function AddTask   (Task: TTask; AInterval: Integer = -1): Boolean;
    function RemoveTask(Task: TTask): Boolean;

    procedure ClearTasks;

    property Running: Boolean read GetRunning;
  end;
{$ENDREGION}

implementation

{$REGION 'TTask'}
procedure TTask.SetJob;
begin
  if fJob <> nil then
    fJob.RemoveTask(Self);

  Value.AddTask(Self);
end;

constructor TTask.Create;
begin
  inherited Create;

  fJob  := nil;
  fLock := 0;

  fInterval := 1;

  Reset;
end;

destructor TTask.Destroy;
begin
  if fJob <> nil then
    fJob.fTasks.Remove(Self);

  inherited;
end;

procedure TTask.Reset;
begin
  fICount := 0;
end;

function TTask.Execute;
begin
  if fLock > 0 then Exit(True);

  inc(fICount);
  if fICount >= fInterval then
  begin
    fICount := 0;
    Result  := Update(Delta);
  end
  else
    Result := True;
end;

function TTask.Update;
begin
  Result := True;
end;

function TTask.Yield;
begin
  if (fJob = nil) or (not fJob.Running) then Exit(False);

  inc(fLock);
  try
    Result := fJob.Execute(Delta);
  finally
    dec(fLock);
  end;
end;
{$ENDREGION}

{$REGION 'TTaskMethod'}
constructor TTaskMethod.Create;
begin
  inherited Create;

  fMethod := AMethod;
end;

function TTaskMethod.Update;
begin
  Result := fMethod(Delta);
end;
{$ENDREGION}

{$REGION 'TJob'}
function TJob.GetRunning;
begin
  Result := fRunning > 0;
end;

constructor TJob.Create;
begin
  inherited Create;

  fTasks := TArray<TTask>.Create;

  fRunning := 0;
end;

destructor TJob.Destroy;
begin
  ClearTasks;
  fTasks.Free;

  inherited;
end;

function TJob.Update;
var
  i: Integer;
begin
  for i := fTasks.Count - 1 downto 0 do
    if not fTasks[i].Execute(Delta) then
      fTasks[i].Free;

  Result := fTasks.Count > 0;
end;

function TJob.AddTask;
begin
  if Running then Exit(False);

  Result := not fTasks.Exists(Task);

  if Result then
  begin
    if AInterval <> -1 then
      Task.Interval := AInterval;

    Task.fJob := Self;
    fTasks.Add(Task, 0);
  end;
end;

function TJob.RemoveTask;
begin
  if Running then Exit(False);

  Result := fTasks.Exists(Task);

  if Result then
  begin
    Task.fJob := nil;
    fTasks.Remove(Task);
  end;
end;

procedure TJob.ClearTasks;
var
  i: Integer;
begin
  for i := fTasks.Count - 1 downto 0 do
    fTasks[i].Free;
end;
{$ENDREGION}

end.