unit AAPrgu;
{Aminoacid analyzer program}

interface
uses
  SysUtils, Classes, Timer,{ulanrecs.lst uldrtype}
  ExeLogu,
  ULRecTyp, ULObju, ULFObju, ULObjUsru,
  AAPGType, AAPGObju,
  AAPLType, AAPLObju
  {v0.38}
  , ULStringGrid
  {/v0.38};

type
  TAAPrgLine = class;

  TAAPrg = class(TULObjUsr)
  private
    FIndex: integer;
      { index of current program line - beeing checked periodically
        (by LineReady call), if its time came, LineReady returns true
        and changes FIndex to the next one, if no more lines, set
        Running to false }
    FStartTime: integer;
      { mstime at Start call [ms], 0 if not started }
    FTime: integer;
      { calculated in LineReady call as (mstime - FStartTime) }
    FNextLineTime: integer;
    FRunning: boolean;
    FEquil: boolean;
      { equilibrating? (started by StartEquil and not finished the cycle) }
    FEquilOffset: integer;
      { time in ms, of the StartEquil command (will be substracted during
        Equil run from prgline.prtime) }
    FActive: boolean;
      { is the program ready to run or running? (selected for active sample?) }
    {v0.38}
    FStartTimeChanged: boolean;
    {/v0.38}
    {v0.41}
    FSuspendStartTime: integer; { <> 0 if in suspended state }
    FSuspendTotalTime: integer; { sum of all suspended periods }
    {/v0.41}

  protected
    function GetAAPGObj: TAAPGObj;
    function ChildCreate(AChildObj: TULObj): TULObjUsr; override;
    function GetRecID: TULRecID; override;
    procedure ClassFieldsCreate; override;
    function CurLineTime: integer;
    {v0.25}
    function GetTotalSecTime: integer;
      { return time of last program line in seconds }
    {/v0.25}
    {v0.38}
    procedure SetActive(OnOff: boolean);
    procedure ULGridCreated(AGrid: TULStringGrid); override;
    procedure DoAfterCreate; override;
    procedure DoOnDblClick(AGrid: TObject);
    {/v0.38}
  public
    destructor Destroy; override;
    function Start: boolean;
      { starts normal run (no equilibration) }
    function StartEquil(var ATimeDif: integer): boolean;
      { starts at StartEquil line, goes to end and then restarts automatically
        (and clears the FEquil flag); TimeDif sets to the time if the StartEquil
        line (it will be then used in AAAu as FUsrStateTimeOffset, i.e. added
        to the StateStartTime, i.e. the time will be shown as if the program
        started from the beginning) }
    function LineReady(var ALine: TAAPrgLine;{v0.38}var {/v0.38} AStartTime: integer): boolean;
      { checks if there is a time for next line to execute.
        if AStartTime specified (i.e. <> 0; = mstime of the program start),
        then the programs FStartTime will be adjusted to it }
    {v0.38}
    procedure ChangeTime(ATime: integer);
      { forcing new time in ms (relative to start, manual, will adjust StartTime }
    {/v0.38}
    {v0.41}
    procedure Suspend;
    procedure Resume;
    {/v0.41}

    property AAPG: TAAPGObj read GetAAPGObj;
    property Running: boolean read FRunning;
    property Equil: boolean read FEquil;
    property Time: integer read FTime;
    property EquilOffset: integer read FEquilOffset;
    {v0.25}
    property TotalSecTime: integer read GetTotalSecTime;
    {/v0.25}
    {v0.38}
    property Active: boolean read FActive write SetActive;
    {/v0.38}
  end;
  {v0.41}
  TAAPrgClass = class of TAAPrg;
  {/v0.41}

  TAAPrgLine = class(TULObjUsr)
  protected
    function GetRecID: TULRecID;override;
    {function ChildCreate(AChildObj: TULObj): TULObjUsr;}
    function GetAAPLObj: TAAPLObj;
  public
    property AAPL: TAAPLObj read GetAAPLObj;
  end;

{v0.41}
function AAPrgBrowserOpen(const AFileName: shortstring; AMode: TOpenMode): boolean;
{/v0.41}

implementation

{TAAPrg}
function TAAPrg.GetRecID: TULRecID;
begin
  Result := AAPGID;
end;

{ulobjusru}

{v0.38}
procedure TAAPrg.DoAfterCreate;
begin
{  Obj.SetFlag(rfEditModal, false);
  Obj.SetFlag(rfBrowseModal, false);
  Obj.SetFlag(rfUsingColors, true);
  Obj.SetFlag(rfAskForSave, true);}
end;

procedure TAAPrg.DoOnDblClick(AGrid: TObject);
var
  o: TULObj;
  i: integer;
begin
  if not (AGrid is TULStringGrid) then
    exit;
  if not Active then
    exit;
  o := TULStringGrid(AGrid).CurChild;{aaplobju}
  if o is TAAPLObj then begin
    if (UserMode = umSysOp) then begin
      i := round(TAAPLObj(o).PrgTime * 1000);
      ChangeTime(i);{aapltype}
    end;
  end;
end;

procedure TAAPrg.ChangeTime(ATime: integer);
var dif: integer;
begin
  dif := ATime - FTime;
  if dif > 0 then begin
    FStartTime := FStartTime - dif;
    FStartTimeChanged := true;
  end;
end;

{/v0.38}

procedure TAAPrg.ClassFieldsCreate;
begin
  inherited;
  FIndex := -1;
  {v0.38}
  Obj.SetFlag(rfEditModal, false);
  Obj.SetFlag(rfBrowseModal, false);
  Obj.SetFlag(rfUsingColors, true);
  Obj.SetFlag(rfAskForSave, true);
  {/v0.38}
end;

function TAAPrg.GetAAPGObj: TAAPGObj;
begin
  Result := TAAPGObj(Obj);
end;

function TAAPrg.ChildCreate(AChildObj: TULObj): TULObjUsr;
var id: TULRecID;
begin
  if AChildObj = nil then
    id := AAPLID
  else
    id := AChildObj.RecID;
  Result := TAAPrgLine.Create(Self, AChildObj, id);
end;

function TAAPrg.CurLineTime: integer;
begin
  Result := round(TAAPrgLine(Childs[FIndex]).AAPL.PrgTime * 1000);
end;

function TAAPrg.StartEquil(var ATimeDif: integer): boolean;
var
  i: integer;
  pl: TAAPrgLine;

  procedure DoOK;
  begin
    FRunning := true;
    FEquil := true;
    FStartTime := mstime;
    ATimeDif := CurLineTime;
    FEquilOffset := ATimeDif;
    FNextLineTime := 0;{round(TAAPrgLine(Childs[FIndex]).AAPL.PrgTime * 1000);}
  end;

begin
  Result := false;
  for i := 0 to ChildCount - 1 do begin
    pl := TAAPrgLine(Childs[i]);
    if pl.AAPL.Command = acStartEquil then begin
      FIndex := i;
      DoOK;
      Result := true;
      exit;
    end {v0.38} else begin
      pl.AAPL.State := plsSkipped;
    end {/v0.38};
  end;
  if ChildCount = 0 then begin
    ExeLog.Log('PRG.StartEquil - no program lines.');
    {ExeLog.Log('PRG.StartEquil - no StartEquil command found.');}
  end else begin
    FIndex := 0;
    DoOK;
    Result := true;
  end;
end; {ulobju}

function TAAPrg.Start: boolean;
begin
  Result := false;
  FEquil := false;
  FEquilOffset := 0;
  if ChildCount > 0 then begin
    FIndex := 0;
    FStartTime := mstime;
    FRunning := true;
    FNextLineTime := CurLineTime;{round(TAAPrgLine(Childs[FIndex]).AAPL.PrgTime * 1000)};
    Result := true;
  end; {xstringgrid}
end;

function TAAPrg.LineReady(var ALine: TAAPrgLine; {v0.38}var {/v0.38}AStartTime: integer): boolean;
begin
  Result := false;
  {v0.25}
  {v0.38}
  if FStartTimeChanged then begin
    AStartTime := FStartTime;
    FStartTimeChanged := false;
  end else
  {/v0.38}
  begin
    if AStartTime <> 0 then begin
      FStartTime := AStartTime;
    end;
  end;
  {v0.41}
  if FSuspendStartTime <> 0 then begin
    FTime := FSuspendStartTime - FStartTime;
  end else begin
    FTime := mstime - FStartTime - FSuspendTotalTime;
  end;
  {/v0.41
  FTime := mstime - FStartTime;}
  {/v0.25}
  if not FRunning then
    exit;
  {/v0.25}{/v0.25
  if AStartTime <> 0 then
    FStartTime := AStartTime;
  FTime := mstime - FStartTime;}
  if FTime >= FNextLineTime then begin
    ALine := TAAPrgLine(Childs[FIndex]);
    {v0.38}
    if FIndex > 0 then begin
      TAAPrgLine(Childs[FIndex - 1]).AAPL.State := plsDone;
        { should be set to this state by the caller of LineReady method,
          whan finished with using ALine; here just to make it sure }
    end;
    ALine.AAPL.State := plsRunning;
    {/v0.38}
    Result := true;
    inc(FIndex);
    if FIndex >= ChildCount then begin
      FRunning := false;
      FIndex := -1;
    end else begin
      FNextLineTime := CurLineTime{round(TAAPrgLine(Childs[FIndex]).AAPL.PrgTime * 1000)} - FEquilOffset;
    end;
  end;
end;

destructor TAAPrg.Destroy;
begin
  {v0.38}
  Active := false;
  {/v0.38}
  inherited Destroy;
end;

function TAAPrg.GetTotalSecTime: integer;
begin
  Result := 0;
  if ChildCount > 0 then begin
    Result := round(TAAPrgLine(Childs[ChildCount - 1]).AAPL.PrgTime);{aapltype}
  end;
end;

{v0.38}
procedure TAAPrg.SetActive(OnOff: boolean);
var
  i: integer;             {aapgtype}
begin
  if FActive = OnOff then
    exit;
  Obj.DoChangeLock;
  try
    if OnOff then begin
      for i := 0 to ChildCount - 1 do begin
        TAAPrgLine(Childs[i]).AAPL.State := plsWaiting;
      end;
    end else begin
      for i := 0 to ChildCount - 1 do begin
        TAAPrgLine(Childs[i]).AAPL.State := plsNone;
      end;
    end;
    FActive := OnOff;
  finally
    Obj.DoChangeUnlock;
  end;
end;

procedure TAAPrg.ULGridCreated(AGrid: TULStringGrid);
begin
  if Active then begin
    AGrid.EditEnabled := false;
    AGrid.OnDblClick := DoOnDblClick;
  end;
end;

{/v0.38}

{v0.41}
procedure TAAPrg.Suspend;
begin
  FSuspendStartTime := mstime;
{  FSuspendTotalTime: integer;}
end;

procedure TAAPrg.Resume;
begin
  if FSuspendStartTime = 0 then
    exit;
  inc(FSuspendTotalTime , mstime - FSuspendStartTime);
  FSuspendStartTime := 0;
end;
{/v0.41}


{/TAAPrg}

{TAAPrgLine}
function TAAPrgLine.GetRecID: TULRecID;
begin
  Result := AAPLID;
end;

{function TAAPrgLine.ChildCreate(AChildObj: TULObj): TULObjUsr;
begin
  Result := nil;
end;}


function TAAPrgLine.GetAAPLObj: TAAPLObj;
begin
  Result := TAAPLObj(Obj);
end;
{/TAAPrgLine}

{v0.41}
function AAPrgBrowserOpen(const AFileName: shortstring; AMode: TOpenMode): boolean;
begin
  Result := ULObjUsrBrowserOpen(TAAPrg, AAPGID, AFileName, AMode) <> nil;
end;
{/v0.41}{ulobjusru}

{v0.24}
initialization {methodu instrumentu}
  RegisterClasses([TAAPrg, TAAPrgLine]);
{/v0.24}
end.
