{
    This file is part of Chentrah,
    Copyright (C) 2004-2012 Anton Rzheshevski (chebmaster@mail.ru).

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see http://www.gnu.org/licenses/

 **********************************************************************

    This file contains the basic library of classes based on chepersy.

 **********************************************************************}

{$include mo_globaldefs.h}


unit mo_classes;
interface
  uses SysUtils, chepersy, mo_hub, typinfo;

const
  VOLATILE_BIT = 30;
  VOLATILE_MASK = $20000000;

type
  TManagedObject = class(chepersy.TManagedObject)
  private
    function _GetVolatile(): boolean;
    procedure _SetVolatile(v: boolean);
  public
    function SortOrder: fixed32; virtual; //by default returns zero. Used by TSortedList.
    property Volatile: boolean read _GetVolatile write _SetVolatile; //volatile instances don't get saved.
  end;
  CManagedObject = class of TManagedObject;

  TPreservableLink =  class(TManagedObject)
  private
    SessionGUID: TResourceHash;
    o: ptruint;
    procedure UpdateHash;
    function _GetObj(): TmanagedObject;
    procedure _SetObj(obj: TmanagedObject);
  public
    property Obj: TManagedObject read _GetObj write _SetObj;
  end;


  TArrayofManagedObjects = array of TManagedObject;

  TSortedList = class(TManagedObject)
  private
    A: TArrayofManagedObjects;
    function _ReadData(i: integer): TManagedObject;
    function _GetLast: TManagedObject;
    function _GetCount: integer;
    function _GetHigh: integer;
  public
    procedure Sort();
    procedure AfterLoading(); override;
    procedure RegisterFields; override;
    procedure Prune; //removes NIL and scraped elements
    function ExtractFirst: TManagedObject;
    function Pop: TManagedObject;
    function Add(item:  TManagedObject): integer;
    function Remove(i: integer): TManagedObject;
    property Data[index: integer]: TManagedObject  read _ReadData; default;
    property Count: integer read _GetCount;
    property High: integer read _GetHigh;
    property Last: TManagedObject read _GetLast;
  end;

  TBackgroundTaskStatus = (bts_scheduled, bts_completed, bts_started, bts_volatile);
  TBackgroundTaskStatusSet = set of TBackgroundTaskStatus;
  TBackgroundTask = class(TManagedObject)
  private
    fStatus: TBackgroundTaskStatusSet;
    function ShouldTerminate: boolean;
    procedure RemoveFromList;
  public
    constructor Create;
    procedure AfterLoading; override;
    procedure RegisterFields; override;
    procedure Scrape; override; //additionally removes itself from the list
    property Status: TBackgroundTaskStatusSet read fStatus;
    function Execute: boolean; virtual; abstract;
  end;

implementation
  uses mo_module, mo_threads;

function TManagedObject.SortOrder: fixed32;
begin
  Result.i:= 0;
end;

function TSortedList.Add(item: TManagedObject): integer;
var
  i, iHole: integer;
  so: fixed32;
begin
  //  http://en.wikipedia.org/wiki/Insertion_sort
  i:= length(A);
  SetLength(A, i + 1);
  so:= item.SortOrder;
  iHole:= i;
  while (iHole > 0) and (A[iHole - 1].SortOrder > so) do begin
    A[iHole] := A[iHole - 1];
    dec(iHole);
  end;
  A[iHole]:= item; //to avoid unnecessary writing. A good algorithm is a dead... I mean, a cache-friendly algorithm.
end;

procedure TSortedList.Sort();
var
  item: TManagedObject;
  i, iHole: integer;
  so: fixed32;
begin
  //  http://en.wikipedia.org/wiki/Insertion_sort
  for i:=0 to length(A) - 1 do begin
    item:= A[i];
    so:= item.SortOrder;
    iHole:= i;
    while (iHole > 0) and (A[iHole - 1].SortOrder > so) do begin
      A[iHole] := A[iHole - 1];
      dec(iHole);
    end;
    if (iHole <> i) then A[iHole]:= item; //to avoid unnecessary writing. A good algorithm is a dead... I mean, a cache-friendly algorithm.
  end;
end;

function TSortedList.ExtractFirst: TManagedObject;
begin
  if Self.High < 0 then exit(nil);
  Result:= Remove(0);
end;

function TSortedList._GetLast: TManagedObject;
begin
  Result:= A[High];
end;


function TSortedList.Pop: TManagedObject;
begin
  Result:= A[High];
  SetLength(A, length(A) - 1);
end;

function TSortedList.Remove(i: integer): TManagedObject;
var j: integer;
begin
  for j:= i to High - 1 do A[j]:= A[j + 1];
  SetLength(A, length(A) - 1);
end;



procedure TSortedList.AfterLoading();
begin
  inherited;
  Prune;
end;

procedure TSortedList.Prune();
var i,j,k,maxl: integer;
begin
  i:=0;
  maxl:= length(A);
  while (i < maxl) do begin
    j:= i;
    while (i < length(A)) and (not Assigned(A[i]) or A[i].Scraped) do inc(i);
    if (i <> j) then begin
      for k:=0 to (maxl - i - j) do A[j + k]:= A[i + k];
      maxl-= (i - j)
    end
    else i+= 1;
  end;
  if maxl <> length(A) then SetLength(a, maxl);
end;

function TSortedList._ReadData(i: integer): TManagedObject;
begin
  Result:= A[i];
end;

function TSortedList._GetCount: integer;
begin
  Result:= length(A);
end;

function TSortedList._GetHigh: integer;
begin
  Result:= system.high(A);
end;

procedure TSortedList.RegisterFields;
begin
  RegClass(TManagedObject);
  RegType(typeinfo(TArrayofManagedObjects), typeinfo(TManagedObject));
  inherited;
  ListFields(['A', @A, typeinfo(TArrayofManagedObjects)]);
end;

function TManagedObject._GetVolatile(): boolean;
begin
  Result:= (Self.CpsMask and VOLATILE_MASK) > 0;
end;

procedure TManagedObject._SetVolatile(v: boolean);
begin
  if v then Self.CpsMask:= Self.CpsMask or VOLATILE_MASK
       else  Self.CpsMask:= Self.CpsMask and not dword(VOLATILE_MASK);

end;

procedure TPreservableLink.UpdateHash;
begin
  GenHash(@SessionGUID);
  AfterEfCheck;
end;

function TPreservableLink._GetObj(): TmanagedObject;
begin
  if SessionGUID <> gv_SessionHash then o:= 0;
  Result:= TManagedObject(pointer(o));
end;

procedure TPreservableLink._SetObj(obj: TmanagedObject);
begin
  TManagedObject(pointer(o)):= obj;
  SessionGUID:= gv_SessionHash;
end;


//fStatus: TBackgroundTaskStatusSet;(bts_completed, bts_started, bts_volatile)
function TBackgroundTask.ShouldTerminate: boolean;
begin
  Result:= Threadmanager.StopRequested;
end;

constructor TBackgroundTask.Create;
begin
  fStatus:= [];
  inherited;
  Module.BackgroundTasks.Add(Self);
end;


procedure TBackgroundTask.RemoveFromList;
var i: integer;
begin
  for i:= 0 to Module.BackgroundTasks.High do
    if (Self = Module.BackgroundTasks[i]) then begin
      Module.BackgroundTasks.Remove(i);
      Exit;
    end;
end;

procedure TBackgroundTask.AfterLoading;
begin
  if bts_volatile in fStatus then self.RemoveFromList;
end;


procedure TBackgroundTask.RegisterFields;
begin
  RegType(typeinfo(TBackgroundTaskStatusSet));
  inherited;
  ListFields([@fStatus, 'status', typeinfo(TBackgroundTaskStatusSet)]);
end;

procedure TBackgroundTask.Scrape;
begin
  RemoveFromList;
  inherited;
end;





end.
