unit SeqPrgu;{v0.49}
{
  (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.
}
{$I define.pas}
interface
uses
  SysUtils, Classes, ActnList,
  Timer, Language, Msgu, ExeLogu,
  ULRecTyp, ULObju, ULObjUsru, ULFObju,
  {$IFNDEF CONSOLE}
  ULStringGrid,
  {$ENDIF}
  UlanType,
  USPType, USPObju,
  {v0.50}
  USPTType, USPTObju,
  USPEType, USPEObju,
  USPDType, USPDObju,
  {/v0.50
  USPLType, USPLObju}
  Prgu
  {v0.50},
  {$IFDEF IFPS3}
  ULScript3u,
  {$ELSE}
  ULScriptu,
  {$ENDIF}

  UlanGlob, ULRecUtl{/v0.50}
  ;

type
  TSeqPrgLine = class;
  {v0.50}
  TSeqPrgTimeLine = class;
  TSeqPrgEventLine = class;
  TSeqPrgDeviceLine = class;
  {/v0.50}

  TSeqPrg = class(TPrg)
  private
    {FCurEventLineIndex: integer;}
    {v0.50}
    FSuspendedForEvent: boolean;
    FScript: TULScript;
    {v0.50}
    {v0.55}
    FRunningBeforeStartLines: boolean;
    {/v0.55}

    {v0.50}
    function GetScript: TULScript;
    {/v0.50}
    {v0.51}
    function GetSeqPrgLineCount: integer;
    function GetSeqPrgLine(Index:integer): TSeqPrgLine;
    {/v0.51}
  protected
    function GetUSPObj: TUSPObj;
    function ChildCreate(AChildObj: TULObj): TULObjUsr; override;
    class function GetClassRecID: TULRecID; override;
    {v0.50}
    procedure ObjDefDirNeeded; override;
    {procedure IncCurTimeLineIndex; virtual;}
      { Increments FCurTimeLineIndex, checks if the child IsTimeLine, if not
        increments again, until >= ChildCount }
    function PrgLineCount(plk: TPrgLineKind): integer;
    function PrgLineGet(plk: TPrgLineKind; AplkIndex: integer): TPrgLine;
    function EventLineFirst(var AIndex: integer): boolean;
    function EventLineNext(var AIndex: integer): boolean;
    function GetTimeLineCount: integer;
    function GetTimeLine(AplkIndex: integer): TSeqPrgTimeLine;
    function GetEventLineCount: integer;
    function GetEventLine(AplkIndex: integer): TSeqPrgEventLine;
    function GetDeviceLineCount: integer;
    function GetDeviceLine(AplkIndex: integer): TSeqPrgDeviceLine;
    function GetHasBeforeStartLines: boolean;
    function CountEventLines(pe: TPrgEvent): integer;
    procedure RunScriptLine(ALine: TSeqPrgLine);
      { called from Line.Run }
    procedure ObjUpdated; override;
    procedure SuspendForEvent;
    {v0.51}
    function SeqPrgLineFirst(plk: TPrgLineKind; pe: TPrgEvent;
      var AIndex: integer): boolean;
    function SeqPrgLineNext(plk: TPrgLineKind; pe: TPrgEvent;
      var AIndex: integer): boolean;
    {v0.51pi}
    {/v051pi
    procedure RunLines(plk: TPrgLineKind; pe: TPrgEvent);}
    {/v0.51}
    {/v0.50}
  public
    {v0.51pi}
    procedure RunLines(plk: TPrgLineKind; pe: TPrgEvent);
    {/v051pi}
    {v0.50}
    destructor Destroy; override;
    {procedure RunEventLines(pe: TPrgEvent);}
    procedure Resume; override;
    {/v0.50}
    {v0.51}
    function Start: boolean; override;
    procedure DoBeforeStart;
    {/v0.51}
    {v0.52}
    procedure Suspend;override;
    {/v0.52}


    property USP: TUSPObj read GetUSPObj;

    {v0.50}
    property EventLineCount: integer read GetEventLineCount;
    property EventLines[AplkIndex: integer]: TSeqPrgEventLine read GetEventLine;
    property TimeLineCount: integer read GetTimeLineCount;
    property TimeLines[AplkIndex: integer]: TSeqPrgTimeLine read GetTimeLine;
    property DeviceLineCount: integer read GetDeviceLineCount;
    property DeviceLines[AplkIndex: integer]: TSeqPrgDeviceLine read GetDeviceLine;

    property SeqPrgLines[AIndex: integer]: TSeqPrgLine read GetSeqPrgLine;
    property SeqPrgLineCount: integer read GetSeqPrgLineCount;

    property HasBeforeStartLines: boolean read GetHasBeforeStartLines;
    property Script: TULScript read GetScript;
    property SuspendedForEvent: boolean read FSuspendedForEvent;
    {/v0.50}
    {v0.55}
    property RunningBeforeStartLines: boolean read FRunningBeforeStartLines;
    {/v0.55}
  end;
  TSeqPrgClass = class of TSeqPrg;

  TSeqPrgLine = class(TPrgLine)
  protected
    function GetPrgEvent:TPrgEvent; virtual;
  public
    procedure RunScript;
    procedure FieldDefDirNeeded(AField: TULObjField);override;

    property PrgEvent: TPrgEvent read GetPrgEvent;
  end;

  TSeqPrgTimeLine = class(TSeqPrgLine)
  protected
    class function GetClassRecID: TULRecID;override;
    function GetUSPTObj: TUSPTObj;
    function GetState: TPrgLineState; override;
    procedure SetState(AState: TPrgLineState); override;
    function GetPrgTime: TAcqTime; override;
    function ShouldStartEquil: boolean; override;
    {v0.50}
    function GetPrgLineKind: TPrgLineKind; override;
    {/v0.50}
  {/v0.50}
  public
    property USPT: TUSPTObj read GetUSPTObj;
  end;

  {v0.50}
  TSeqPrgEventLine = class(TSeqPrgLine)
  protected
    {v0.51}
    function GetPrgEvent: TPrgEvent; override;
    {/v0.51}
    class function GetClassRecID: TULRecID;override;
    function GetUSPEObj: TUSPEObj;
    function GetState: TPrgLineState; override;
    procedure SetState(AState: TPrgLineState); override;
    function GetPrgTime: TAcqTime; override;
    function ShouldStartEquil: boolean; override;
    function GetPrgLineKind: TPrgLineKind; override;
  public
    property USPE: TUSPEObj read GetUSPEObj;
  end;

  TSeqPrgDeviceLine = class(TSeqPrgLine)
  protected
    class function GetClassRecID: TULRecID;override;
    function GetUSPDObj: TUSPDObj;
    function GetState: TPrgLineState; override;
    procedure SetState(AState: TPrgLineState); override;
    function GetPrgTime: TAcqTime; override;
    function ShouldStartEquil: boolean; override;
    function GetPrgLineKind: TPrgLineKind; override;
  public
    property USPD: TUSPDObj read GetUSPDObj;
  end;
  {/v0.50}

function SeqPrgBrowserOpen(const AFileName: shortstring; AMode: TOpenMode): boolean;

implementation
{v0.52}
uses
  Processoru;
{/v0.52}
{seqprgtodevu}

{TSeqPrg}
class function TSeqPrg.GetClassRecID: TULRecID;
begin
  Result := USPID;
end;

function TSeqPrg.GetUSPObj: TUSPObj;
begin
  Result := TUSPObj(Obj);
end;

function TSeqPrg.ChildCreate(AChildObj: TULObj): TULObjUsr;
var id: TULRecID;
begin
  if AChildObj = nil then
    id := USPTID
  else
    id := AChildObj.RecID;
  {v0.50}
  case id of
    USPTID: Result := TSeqPrgTimeLine.Create(Self, AChildObj, id);
    USPEID: Result := TSeqPrgEventLine.Create(Self, AChildObj, id);
    USPDID: Result := TSeqPrgDeviceLine.Create(Self, AChildObj, id);
  else
    SetResult(urUnknownChildRecID, ULRecIDToStrStrip(id));
    Result := nil;{to satisfy compiler}
  end;
  {/v0.50
  Result := TSeqPrgTimeLine.Create(Self, AChildObj, id);}
end;

{v0.50}
procedure TSeqPrg.ObjDefDirNeeded;
begin
  Obj.ObjDesc.DefDir := PrgDir;{ulanglob}
end;

{procedure TSeqPrg.IncCurTimeLineIndex;
begin
  repeat
    inc(FCurTimeLineIndex);
    if FCurTimeLineIndex >= ChildCount then
      break;
    if TPrgLine(Childs[FCurTimeLineIndex]).IsTimeLine then
      break;
  until false;
end;}

function TSeqPrg.PrgLineCount(plk: TPrgLineKind): integer;
var i: integer;
begin
  Result := 0;
  if PrgLineFirst(plk, i) then
  repeat
    inc(Result);
  until not PrgLineNext(plk, i);
end;

function TSeqPrg.PrgLineGet(plk: TPrgLineKind; AplkIndex: integer): TPrgLine;
var cnt, i: integer;
begin
  Result := nil;
  cnt := 0 ;
  if PrgLineFirst(plk, i) then
  repeat
    if cnt = APLKIndex then begin
      Result := TPrgLine(Childs[i]);
      break;
    end;
    inc(cnt)
  until not PrgLineNext(plk, i);
end;

function TSeqPrg.EventLineFirst(var AIndex: integer): boolean;
begin
  Result := PrgLineFirst(plkEvent, AIndex);
end;

function TSeqPrg.EventLineNext(var AIndex: integer): boolean;
begin
  Result := PrgLineNext(plkEvent, AIndex);
end;

function TSeqPrg.GetTimeLineCount: integer;
begin
  Result := PrgLineCount(plkTime);
end;

function TSeqPrg.GetTimeLine(AplkIndex: integer): TSeqPrgTimeLine;
begin
  Result := TSeqPrgTimeLine(PrgLineGet(plkTime, AplkIndex));
end;

function TSeqPrg.GetEventLineCount: integer;
begin
  Result := PrgLineCount(plkEvent);
end;

function TSeqPrg.GetEventLine(AplkIndex: integer): TSeqPrgEventLine;
begin
  Result := TSeqPrgEventLine(PrgLineGet(plkEvent, AplkIndex));
end;

function TSeqPrg.GetDeviceLineCount: integer;
begin
  Result := PrgLineCount(plkDevice);{ulantype}
end;

function TSeqPrg.GetDeviceLine(AplkIndex: integer): TSeqPrgDeviceLine;
begin
  Result := TSeqPrgDeviceLine(PrgLineGet(plkDevice, AplkIndex));
end;

function TSeqPrg.GetHasBeforeStartLines: boolean;
begin
  Result := CountEventLines(peBeforeStart) > 0;
end;

function TSeqPrg.CountEventLines(pe: TPrgEvent): integer;
var
  i: integer;
  p: TPrgLine;
begin
  Result := 0;
  for i := 0 to ChildCount - 1 do begin
    p := TPrgLine(Childs[i]);
    if p.PrgLineKind = plkEvent then begin
      if p is TSeqPrgEventLine then begin
        if TSeqPrgEventLine(p).USPE.PrgEvent = pe then
          inc(Result);
      end;
    end;
  end;
end;

{procedure TSeqPrg.RunEventLines(pe: TPrgEvent);
var
  i: integer;
  e: TSeqPrgEventLine;
begin
  for i := 0 to EventLineCount - 1 do begin
    e := EventLines[i];
    if e.USPE.PrgEvent = pe then
      e.RunScript;
  end;
end;}

function TSeqPrg.GetScript: TULScript;
begin
  if FScript = nil then begin
    FScript := TULScript.Create(nil, Self);
  end;
  Result := FScript;
end;

procedure TSeqPrg.RunScriptLine(ALine: TSeqPrgLine);
var cmd: string;
begin
  cmd := '';
  if ALine is TSeqPrgTimeLine then with ALine as TSeqPrgTimeLine do begin
    if trim(USPT.Script) <> '' then begin
      cmd := trim(USPT.Script + ' ' + USPT.Param1 + ' ' + USPT.Param2 + ' ' + USPT.Param3);
    end;
  end else if ALine is TSeqPrgEventLine then with ALine as TSeqPrgEventLine do begin
   {uspttype}
    if trim(USPE.Script) <> '' then begin
      cmd := trim(USPE.Script + ' ' + USPE.Param1 + ' ' + USPE.Param2 + ' ' + USPE.Param3);
    end;
  end;
  if cmd <> '' then begin
    Log('SeqPrgRunCmd: ' + cmd);
    Script.RunCommandLine(cmd);
  end;
end;

destructor TSeqPrg.Destroy;
begin
  FScript.Free;
  inherited;
end;

procedure TSeqPrg.SuspendForEvent;
begin
  {v0.52}
  Log('Suspending for event ' + USP.WaitingFor);
  {/v0.52}
  Suspend;
  FSuspendedForEvent := true;
end;

procedure TSeqPrg.Resume;
begin
  inherited;
  {v0.52}
  if FSuspendedForEvent then begin
    Log('Resuming upon event ' + USP.WaitingFor);
  end else begin
    Log('Resuming');
  end;
  {/v0.52}
  FSuspendedForEvent := false;
  USP.WaitingFor := '';
end;

procedure TSeqPrg.ObjUpdated;
begin
  {v0.52}
  inherited;
  {/v0.52}
  if (USP.WaitingFor <> '') then begin
    if (not SuspendedForEvent) then
      SuspendForEvent;
  end else begin
    if SuspendedForEvent then
      Resume;
  end;
end;
{/v0.50}

{v0.51}
function TSeqPrg.SeqPrgLineFirst(plk: TPrgLineKind; pe: TPrgEvent;
  var AIndex: integer): boolean;
begin
  AIndex := -1;
  Result := SeqPrgLineNext(plk, pe, AIndex);
end;

function TSeqPrg.SeqPrgLineNext(plk: TPrgLineKind; pe: TPrgEvent;
  var AIndex: integer): boolean;
begin
  Result := false;
  repeat
    inc(AIndex);
    if AIndex >= SeqPrgLineCount then
      break;
    with SeqPrgLines[AIndex] do begin
      if (PrgLineKind = plk) and (PrgEvent = pe) then begin
        Result := true;
        break;
      end;
    end;
  until false;
end;

function TSeqPrg.GetSeqPrgLineCount: integer;
begin
  Result := ChildCount;
end;

function TSeqPrg.GetSeqPrgLine(Index: integer): TSeqPrgLine;
begin
  Result := TSeqPrgLine(Childs[Index]);
end;

{v0.51}
function TSeqPrg.Start: boolean;
begin
  {v0.55}
  DoBeforeStart;{can call suspend, so call before inerited Start}
  Result := inherited Start;
  {/v0.55
  Result := inherited Start;
  if Result then
    DoBeforeStart;}
end;

procedure TSeqPrg.DoBeforeStart;
begin
  {v0.55}
  if FRunningBeforeStartLines then
    exit;
  FRunningBeforeStartLines := true;
  try
  {/v0.55}
  RunLines(plkEvent, peBeforeStart);
  {v0.55}
  finally
    FRunningBeforeStartLines := false;
  end;
  {/v0.55}
end;

procedure TSeqPrg.RunLines(plk: TPrgLineKind; pe: TPrgEvent);
var i:integer;
begin
  if SeqPrgLineFirst(plk, pe, i) then
  repeat
    SeqPrgLines[i].RunScript;
  until not SeqPrgLineNext(plk, pe, i);
end;
{/v0.51}


{v0.52}
procedure TSeqPrg.Suspend;
begin
  inherited;
  if ULObjOwner is TProcessor then with ULObjOwner as TProcessor do
    SequenceState := sesWaiting;{will get to that state only if running}
end;
{/v0.52}

{/TSeqPrg.}

{v0.50}
{TSeqPrgLine.}
{v0.51}
function TSeqPrgLine.GetPrgEvent;
begin
  Result := peNone;
end;
{/v0.51}

procedure TSeqPrgLine.RunScript;
begin
  TSeqPrg(ULObjOwner).RunScriptLine(Self);
end;

procedure TSeqPrgLine.FieldDefDirNeeded(AField: TULObjField);
begin
  if AField <> nil then
    AField.FldDesc.DefDir := ScriptsDir;{ulanglob}
end;
{/TSeqPrgLine.}
{/v0.50}

{TSeqPrgTimeLine}
class function TSeqPrgTimeLine.GetClassRecID: TULRecID;
begin
  Result := USPTID;
end;

function TSeqPrgTimeLine.GetUSPTObj: TUSPTObj;
begin
  Result := TUSPTObj(Obj);
end;

function TSeqPrgTimeLine.GetState: TPrgLineState;
begin
  Result := USPT.State;
end;

procedure TSeqPrgTimeLine.SetState(AState: TPrgLineState);
begin
  USPT.State := AState;
end;

function TSeqPrgTimeLine.GetPrgTime: TAcqTime;
begin
  Result := USPT.PrgTime;
end;

function TSeqPrgTimeLine.ShouldStartEquil: boolean;
begin
  Result := USPT.Command = scStartEquil;
end;

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


{TSeqPrgEventLine}
class function TSeqPrgEventLine.GetClassRecID: TULRecID;
begin
  Result := USPEID;
end;

function TSeqPrgEventLine.GetUSPEObj: TUSPEObj;
begin
  Result := TUSPEObj(Obj);
end;

function TSeqPrgEventLine.GetState: TPrgLineState;
begin
  Result := USPE.State;
end;

procedure TSeqPrgEventLine.SetState(AState: TPrgLineState);
begin
  USPE.State := AState;
end;

function TSeqPrgEventLine.GetPrgTime: TAcqTime;
begin
  Result := 0;{USPT.PrgTime;}
end;

function TSeqPrgEventLine.ShouldStartEquil: boolean;
begin
  Result := false;
end;

function TSeqPrgEventLine.GetPrgLineKind: TPrgLineKind;
begin
  Result := plkEvent;
end;

{v0.51}
function TSeqPrgEventLine.GetPrgEvent;
begin
  Result := USPE.PrgEvent;
end;
{/v0.51}

{/TSeqPrgEventLine.}

{TSeqPrgDeviceLine}
class function TSeqPrgDeviceLine.GetClassRecID: TULRecID;
begin
  Result := USPDID;
end;

function TSeqPrgDeviceLine.GetUSPDObj: TUSPDObj;
begin
  Result := TUSPDObj(Obj);
end;

function TSeqPrgDeviceLine.GetState: TPrgLineState;
begin
  Result := USPD.State;
end;

procedure TSeqPrgDeviceLine.SetState(AState: TPrgLineState);
begin
  USPD.State := AState;
end;

function TSeqPrgDeviceLine.GetPrgTime: TAcqTime;
begin
  Result := USPD.PrgTime;
end;

function TSeqPrgDeviceLine.ShouldStartEquil: boolean;
begin
  Result := false;
end;

function TSeqPrgDeviceLine.GetPrgLineKind: TPrgLineKind;
begin
  Result := plkDevice;
end;
{/TSeqPrgDeviceLine}
{/v0.50}

function SeqPrgBrowserOpen(const AFileName: shortstring; AMode: TOpenMode): boolean;
begin
  Result := ULObjUsrBrowserOpen(TSeqPrg, USPID, AFileName, AMode) <> nil;
end;

initialization
  RegisterClasses([TSeqPrg, TSeqPrgTimeLine, TSeqPrgEventLine]);
end.
