unit AAPrgu;{Aminoacid analyzer program}
{
  (C) 2000 - 2001 Jindrich Jindrich, Pavel Pisa, PiKRON Ltd.

  Originators of the CHROMuLAN project:

  Jindrich Jindrich - http://www.jindrich.com
                      http://orgchem.natur.cuni.cz/Chromulan
                      software developer, project coordinator
  Pavel Pisa        - http://cmp.felk.cvut.cz/~pisa
                      embeded software developer
  PiKRON Ltd.       - http://www.pikron.com
                      project initiator, sponsor, instrument developer

  The CHROMuLAN project is distributed under the GNU General Public Licence.
  See file COPYING for details.

  Originators reserve the right to use and publish sources
  under different conditions too. If third party contributors
  do not accept this condition, they can delete this statement
  and only GNU license will apply.
}


interface
uses
  SysUtils, Classes, Timer,{ulanrecs.lst uldrtype}
  {v0.47}ActnList, Language, {/v0.47}
  ExeLogu,
  {v0.49}UlanType,{/v0.49}ULRecTyp, ULObju, ULFObju, ULObjUsru,
  AAPGType, AAPGObju,
  AAPLType, AAPLObju
  {v0.38}
  {$IFNDEF CONSOLE}
  , ULStringGrid
  {$ENDIF}
  {/v0.38}
  {v0.47}
  ,Msgu
  {/v0.47}
  {v0.49}
  ,Prgu
  {/v0.49}
  {v0.50}
  ,UlanGlob
  {/v0.50}

  ;

type
  TAAPrgLine = class;

  TAAPrg = class({v0.49}TPrg{/v0.49 TULObjUsr})
  private
    (*v0.49*)(*/v0.49
    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}
    {v0.47}{history.txt}
    FTimeSkipAction: TAction;
    procedure TimeSkip(Sender: TObject);
    {/v0.47}
    *)

  protected
    function GetAAPGObj: TAAPGObj;
    function ChildCreate(AChildObj: TULObj): TULObjUsr; override;
    class function GetClassRecID: TULRecID; override;
    (*v0.49*)
    (*v0.49
    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}
    {v0.47}
    procedure TimeSkipToActiveLine;
    procedure FirstMenuActionNeeded; override;{ulobju}
    {/v0.47}{ulantype}
    *)
    procedure ObjDefDirNeeded; override;

    procedure RecalculatePrgTimes; override;
    procedure RecalculateDurations; override;
    procedure CheckDefaultDurations;
    procedure AfterBrowseChildDelete; override;
  public

    (*v0.49*)(*v0.49
    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 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}
    *)
    property AAPG: TAAPGObj read GetAAPGObj;
  end;

  {v0.41}
  TAAPrgClass = class of TAAPrg;
  {/v0.41}

  TAAPrgLine = class({v0.49}TPrgLine{/v0.49 TULObjUsr})
  protected
    class function GetClassRecID: TULRecID;override;
    function GetAAPLObj: TAAPLObj;{prgu}
    {v0.49}
    function GetState: TPrgLineState; override;
    procedure SetState(AState: TPrgLineState); override;
    function GetPrgTime: TAcqTime; override;
    function ShouldStartEquil: boolean; override;
    {/v0.49}
    {v0.50}
    function GetPrgLineKind: TPrgLineKind; override;
    {/v0.50}
    function GetDuration: TAcqTime; override;

    procedure SetDuration(ADuration: TAcqTime);override;
    procedure SetPrgTime(APrgTime: TAcqTime);override;
  public
    property AAPL: TAAPLObj read GetAAPLObj;
  end;

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

implementation
{v0.50}
uses AAAu;
{/v0.50]

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

{ulobjusru}

(*v0.49*)(*/v0.49
{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);
{v0.47}{/v0.47
var
  o: TULObj;
  i: integer; }
begin
  {v0.47}
  if UserMode <> umSysOp then
    exit;
  TimeSkipToActiveLine;
  {/v0.47
  if not (AGrid is TULStringGrid) then
    exit;
  if not Active then
    exit;
  o := TULStringGrid(AGrid).CurChild;
  if o is TAAPLObj then begin
    if (UserMode = umSysOp) then begin
      i := round(TAAPLObj(o).PrgTime * 1000);
      ChangeTime(i);
    end;
  end;}
end;

{v0.47}
procedure TAAPrg.TimeSkipToActiveLine;
var
  o: TULObj;
  i: integer;
begin
  if not Active then
    exit;
  if ShowMessage(GetTxt({#}'Really skip the normal time sequence?'), smNoYes, 0) <> cmYes then
    exit;
  o := Obj.ActiveChild;
  if o is TAAPLObj then begin
    i := round(TAAPLObj(o).PrgTime * 1000);
    ChangeTime(i);
  end;
end;
{/v0.47}

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;
{v0.50}
procedure TAAPrg.ObjDefDirNeeded;
begin
  {aaau}
  if AAAIsOn then begin
    Obj.ObjDesc.DefDir := AAA.AO.PrgsDir;
  end else begin
    Obj.ObjDesc.DefDir := PrgDir;{ulanglob}
  end;
end;
{/v0.50}

{/v0.50}
(*v0.49*)(*/v0.49
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}

procedure TAAPrg.FirstMenuActionNeeded;
begin
  if Active then
  ActionUpdate(FTimeSkipAction, TimeSkip, GetTxt({#}'Time Skip To Active Line'));
end;

procedure TAAPrg.TimeSkip(Sender: TObject);
begin
  TimeSkipToActiveLine;
end;

*)

{ Just makes sure if somewhere are Durations = 0, set there reasonable values }
procedure TAAPrg.CheckDefaultDurations;
var
  i: integer;
  lpl, pl: TPrgLine;
  d, pt, lpt: TAcqTime;
begin
  Obj.DoChangeLock;
  try
    lpl := nil;
    Log(Format('CheckDefDur ChildCount %d', [ChildCount]));
    for i := 0 to ChildCount - 1 do begin
       pl := TPrgLine(Childs[i]);
       if lpl <> nil then begin
         pt := pl.PrgTime;
         lpt := lpl.PrgTime;
         d := pt - lpt;
         if lpl.Duration = 0 then begin
           Log(Format('i=%d lpt=%f pt=%f d=%f', [i, lpt, pt, d]));
           lpl.Duration := d;
           //lpl.Duration := pl.PrgTime - lpl.PrgTime;
         end;
       end;
       lpl := pl;
    end;
  finally
    Obj.DoChangeUnlock;
  end;
end;

procedure TAAPrg.RecalculatePrgTimes;
var
  i: integer;
  lpl, pl: TAAPrgLine;
  a: boolean;
begin
  if ChildCount = 0 then
    exit;
  ChildsUpdate;
  Obj.DoChangeLock;
  try
    a := TPrgLine(Childs[0]).AutoSort;
    TPrgLine(Childs[0]).AutoSort := false;
    try
      lpl := nil;
      CheckDefaultDurations;
      Log(Format('RecalcTimes ChildCount %d', [ChildCount]));
      for i := 0 to ChildCount - 1 do begin
         pl := TAAPrgLine(Childs[i]);
         if lpl <> nil then begin
           pl.PrgTime := lpl.PrgTime + lpl.Duration;
           Log(Format('i=%d: pl.t(%f) = lpl.t(%f) + lpl.d(%f)', [i, pl.PrgTime, lpl.PrgTime, lpl.Duration]));
         end;
         lpl := pl;
      end;
    finally
      TPrgLine(Childs[0]).AutoSort := a;
    end;
  finally
    Obj.DoChangeUnlock;
  end;
end;

procedure TAAPrg.AfterBrowseChildDelete;
begin
  RecalculateDurations;
end;

procedure TAAPrg.RecalculateDurations;
var
  i: integer;
  pl: TAAPrgLine;
  lpl: TAAPrgLine;
  a: boolean;
begin
  if ChildCount = 0 then
    exit;
  ChildsUpdate;
  Obj.DoChangeLock;
  try
    a := TPrgLine(Childs[0]).AutoSort;
    TPrgLine(Childs[0]).AutoSort := false;
    try
      CheckDefaultDurations;
      lpl := nil;
      Log(Format('RecalcDurations ChildCount %d', [ChildCount]));
      for i := 0 to ChildCount - 1 do begin
         pl := TAAPrgLine(Childs[i]);
         if lpl <> nil then begin
           lpl.Duration := pl.PrgTime - lpl.PrgTime;
           Log(Format('i=%d: lpl.d(%f) = pl.t(%f) - lpl.t(%f)', [i, lpl.Duration, pl.PrgTime, lpl.PrgTime]));
         end;
         lpl := pl;
      end;
      if lpl <> nil then
        lpl.Duration := 0;
    finally
      TPrgLine(Childs[0]).AutoSort := a;
    end;
  finally
    Obj.DoChangeUnlock;
  end;
end;

{/TAAPrg}

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

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


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

{v0.49}
function TAAPrgLine.GetState: TPrgLineState;
begin
  Result := AAPL.State;
end;

procedure TAAPrgLine.SetState(AState: TPrgLineState);
begin
  AAPL.State := AState;
end;

function TAAPrgLine.GetPrgTime: TAcqTime;
begin
  Result := AAPL.PrgTime;
end;

function TAAPrgLine.ShouldStartEquil: boolean;
begin
  Result := AAPL.Command = acStartEquil;
end;

{/v0.49}

{v0.50}
function TAAPrgLine.GetPrgLineKind: TPrgLineKind;
begin
  Result := plkTime;
end;
{/v0.50}

function TAAPrgLine.GetDuration: TAcqTime;
begin
  Result := AAPL.Duration;
end;

procedure TAAPrgLine.SetDuration(ADuration: TAcqTime);
begin
  AAPL.Duration := ADuration;
end;

procedure TAAPrgLine.SetPrgTime(APrgTime: TAcqTime);
begin
  AAPL.PrgTime := APrgTime;
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.
