unit Process;

{==========================================================}
{                                                          }
{  unit Process                        12/11/2002          }
{                                                          }
{  Simulator rize jednoducheho techno procesu              }
{                                                          }
{                                                          }
{  (C)2002, SofCon, Stresovicka 49, 160 00 Praha 6         }
{           Petr Cernin                                    }
{                                                          }
{==========================================================}

{ Tato jednotka je simulator rizeni jednoducheho technologickeho
  procesu pro ucely prikladu HTTP serveru. Tento proces meri
  3 teploty a 3 tlaky a je ovladan 2 regulatory A a B }

interface

{$I SETS.INC} { Nastaveni podmineneho prekladu }

type

  { Merene tlaky }

  TProcPressure =
  record
    P1 : Integer;               { Tlak v miste 1                       }
    P2 : Integer;               { Tlak v miste 2                       }
    P3 : Integer;               { Tlak v miste 3                       }
  end;

  { Merene teploty }

  TProcTemperature =
  record
    T1 : Integer;               { Teplota v miste 1                    }
    T2 : Integer;               { Teplota v miste 2                    }
    T3 : Integer;               { Teplota v miste 3                    }
  end;

  { Stav procesu }

  TProcState =
  record
    Pressure    : TProcPressure;
    Temperature : TProcTemperature;
  end;

  { Parametry regulatoru }

  TProcRegulator =
  record
    P : Real;                   { Proporcionalni slozka   }
    I : Real;                   { Integracni slozka       }
    D : Real;                   { Derivacni slozka        }
  end;

  { Parametry procesu }

  TProcParams =
  record
    RegulatorA  : TProcRegulator;
    RegulatorB  : TProcRegulator;
  end;

  { Polozka archivu }

  TProcArchiveItem =
  record
    Time  : Longint;            { Cas zapisu do archivu   }
    Value : string[80];         { Text zaznamu            }
  end;

  { Struktura archivu }

  TProcArchive =
  record
    Head     : Integer;         { Celo fronty             }
    Count    : Integer;         { Pocet polozek           }
    Items    : array[0..127] of TProcArchiveItem;
  end;


var

  ProcState  : TProcState;      { Stav procesu            }
  ProcParams : TProcParams;     { Parametry procesu       }
  ProcArchive  : TProcArchive;  { Archiv procesu          }
  ProcStep     : Integer;       { Aktualni stav procesu   }

{-----------------------------
{ StartProcess
{---
{ Spusteni simulatoru rizeni technologickeho procesu
{ StopFlag je odkaz na promennou, jejiz nastaveni na True zpusobi
{ ukonceni cinnosti procesu serveru.
{---
{ Tuto funkci je potreba zavolat pri vytvareni procesu aplikace napr.
{ v tele hlavniho podprogramu.
}

procedure StartProcess( var StopFlag: Boolean );

{-----------------------------
{ ArchAddItem
{---
{ Pridani polozky do archivu
{---
}

procedure ArchAddItem( const AValue: string );


{-----------------------------
{ ArchGetItem
{---
{ Ziskani polozky s danym indexem z archivu
{---
}

function  ArchGetItem( Idx: Integer; var ATime: Longint;
                       var AValue: string ): Boolean;

{-----------------------------
{ ArchClear
{---
{ Vymazani obsahu archivu
{---
}

procedure ArchClear;


implementation

uses
  Dos,
{$ifdef VerMC}
  RtcTime,
{$endif}
  NumToStr,
  Kernel;

const

  cProcStackSize = 4096;  { Velikost zasobniku procesu        }
  cProcStatPri   = 120;   { Staticka priorita procesu         }
  cProcDynPri    = 254;   { Dynamicka priorita procesu        }
  cProcWaitCount = 1;     { Pocet waitu mezi dve tiky procesu }


{-----------------------------
{ ArchClear
{---
{ Vymazani obsahu archivu
{---
}

procedure ArchClear;
begin
  ProcArchive.Head     := 0;
  ProcArchive.Count    := 0;
end;

{-----------------------------
{ ArchAddItem
{---
{ Pridani polozky do archivu
{---
}

procedure ArchAddItem( const AValue: string );

  function GetCurTime: Longint;
  var
    D      : DateTime;
    Temp   : Word;
    Result : Longint;
  begin
    GetDate( D.Year, D.Month, D.Day, Temp );
    GetTime( D.Hour, D.Min, D.Sec, Temp );
    PackTime( D, Result );
    GetCurTime := Result
  end;

begin
  with ProcArchive.Items[ ProcArchive.Head ] do
  begin
    Time := GetCurTime;
    Value := AValue;
  end;

  if ProcArchive.Head = High( ProcArchive.Items ) then
  begin
    ProcArchive.Head := 0;
  end
  else
    Inc( ProcArchive.Head );

  if ProcArchive.Count <= High( ProcArchive.Items ) then
  begin
    Inc( ProcArchive.Count );
  end;
end;

{-----------------------------
{ ArchGetItem
{---
{ Ziskani polozky s danym indexem z archivu
{---
}

function ArchGetItem( Idx: Integer; var ATime: Longint; var AValue: string ): Boolean;
begin
  ArchGetItem := False;

  if Idx < 0 then
  begin
    if - Idx <= ProcArchive.Count then
    begin
      Inc( Idx, ProcArchive.Head );
      if Idx < 0 then Inc( Idx, High( ProcArchive.Items ) + 1 );
    end
    else
      Exit;
  end
  else begin

    if Idx < ProcArchive.Count then
    begin
      Inc( Idx, ProcArchive.Head - (ProcArchive.Count - 1));
      if Idx < 0 then Inc( Idx, High( ProcArchive.Items ) + 1 );
      if Idx > High( ProcArchive.Items ) then
      begin
        Dec( Idx, High( ProcArchive.Items) + 1 );
      end;
    end
    else
      Exit;
  end;

  ArchGetItem := True;

  with ProcArchive.Items[ Idx ] do
  begin
    ATime := Time;
    AValue := Value;
  end;

end;

{-----------------------------
{ ProcInit
{---
{ Inicializace stavu a parametru rizeni technologickeho procesu
{---
}

procedure ProcInit;
begin
  { Pocatecni nastaveni tlaku }
  with ProcState.Pressure do
  begin
    P1 := 1000;
    P2 := 1500;
    P3 := 2000;
  end;

  { Pocatecni nastaveni teplot }
  with ProcState.Temperature do
  begin
    T1 := 75;
    T2 := 100;
    T3 := 125;
  end;

  { Nastaveni parametru regulatoru A }
  with ProcParams.RegulatorA do
  begin
    P := 0.1;
    I := 0.01;
    D := 0.001;
  end;

  { Nastaveni parametru regulatoru B }
  with ProcParams.RegulatorB do
  begin
    P := 0.5;
    I := 0.05;
    D := 0.005;
  end;

  { Vymazani archivu }
  ArchClear;
end;


{-----------------------------
{ ProcTick
{---
{ Provedeni jednoho kroku simulatoru tehchnologickeho procesu
{---
}

procedure ProcTick;

  function Func( Step: Integer; Factor: Real; Min, Max: Integer ): Integer;
  begin
    Func := Trunc( Min + Sin( Step * Factor / 100 ) * (Max - Min) );
  end;

begin

  with ProcState.Pressure do
  begin
    P1 := Func( ProcStep, 1, 1000, 2000 );
    P2 := Func( ProcStep, 2, 1500, 2000 );
    P3 := Func( ProcStep, 3, 2000, 2500 );
  end;

  with ProcState.Temperature do
  begin
    T1 := Func( ProcStep, 1.5, 30, 80 );
    T2 := Func( ProcStep, 2, 160, 200 );
    T3 := Func( ProcStep, 3, 2000, 2100 );
  end;


  if Random(1000) < 10 then
  begin
    LockKernel;

    with ProcState.Temperature do
    begin
      ArchAddItem(   'T1=' + IntegerStrDec( T1, 0) +
                   '  T2=' + IntegerStrDec( T2, 0) +
                   '  T3=' + IntegerStrDec( T3, 0) );
    end;
    UnlockKernel;
  end;


  ProcStep := (ProcStep + 1) mod 100;
end;


{-----------------------------
{ StartProcess
{---
{ Spusteni simulatoru rizeni technologickeho procesu
{ StopFlag je odkaz na promennou, jejiz nastaveni na True zpusobi
{ ukonceni cinnosti procesu serveru.
{---
{ Tuto funkci je potreba zavolat pri vytvareni procesu aplikace napr.
{ v tele hlavniho podprogramu.
}

procedure StartProcess( var StopFlag: Boolean );
begin
  ProcInit;
  Start( 'Process', cProcStackSize, cProcStatPri, cProcDynPri); Exit;
  repeat
    ProcTick;
    Wait( cProcWaitCount );
  until StopFlag;
end;

end.