unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    btn1: TButton;
    btn2: TButton;
    btn3: TButton;
    cbb1: TComboBox;
    cbb2: TComboBox;
    cbb3: TComboBox;
    cbb4: TComboBox;
    lbl1: TLabel;
    pnl1: TPanel;
    lbl2: TLabel;
    lbl3: TLabel;
    lbl4: TLabel;
    lbl5: TLabel;
    lbl6: TLabel;
    lbl7: TLabel;
    lbl8: TLabel;
    edt1: TEdit;
    shp1: TShape;
    shp2: TShape;
    lbl9: TLabel;
    lbl10: TLabel;
    lbl11: TLabel;
    lbl12: TLabel;
    procedure btn1Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure btn3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

// ====================================================================
//  СЕГМЕНТ ОПИСАНИЙ СТРУКТУРЫ ДАННЫХ
// ====================================================================
// Максимальные индексы таблиц переходов и входных сигналов
const MaxNumR = 4;  // Число строк или состояний
const MaxNumC = 4;  // Число столбцов или входных сигналов

// Описание сигнала
type TXValue = integer;

// Описание таблицы - вектора входных сигналов
type TXAr = array[1..MaxNumC] of TXValue;

// Описание интерфейса процедур выходных воздействий
type TYProc  = procedure (pAData : Pointer);

// Описание совмещенной таблицы маски, переходов и выходов
type TATab   = array[1..MaxNumR, 1..MaxNumC] of
      record
       NS  : integer;    // Индекс перехода в новое состояние
       YP  : TYProc;     // Процедура вызываемая в новом состоянии
     end;
// --------------------------------------------------------------------
//  Описание системы данных для конечного автомата
type TAData = record
     XAr : TXAr;         // Вектор входных сигналов
     IX     : integer;   // Индекс сигнала, который вызвал переход
     CS     : integer;   // Индекс текущего состояния
     ATab   : TATab;     // Таблица переходов
end;

// ====================================================================
//
// ====================================================================
// Процедура 1 имитации выходного воздействия
procedure YPR1(pAData : Pointer);
var wStr   : string;
begin
   with TAData(pAData^)do
   begin
      wStr := 'Переход в начальное состояние';
      ShowMessage(wStr);
   end;
end;

// --------------------------------------------------------------------
// Процедура 2 имитации выходного воздействия
procedure YPR2(pAData : Pointer);
var wStr   : string;
begin
   with TAData(pAData^)do
   begin
      wStr := 'Переход в состояние: ' + IntToStr(CS) + #13#10;
      wStr := wStr + 'по сигналу X' + IntToStr(IX);
      wStr := wStr + ' с значением: ' + IntToStr(XAr[IX]);
      ShowMessage(wStr);
   end;
end;

// ====================================================================
//   ТАБЛИЦА ПЕРЕХОДОВ, МАСОК, ВЫХОДОВ 
// ====================================================================
// NS - Номер состояния для перехода, если 0, то такой переход заблокирован (замаскирован)
// YP - Имя процедуры выходного воздействия, если nil, то тереход без вызова процедуры

const DefATab : TATab =
(
 ((NS:2; YP:YPR2), (NS:0; YP:nil),  (NS:0; YP:nil),  (NS:0; YP:nil) ),  // S1
 ((NS:0; YP:nil),  (NS:0; YP:nil),  (NS:3; YP:YPR2), (NS:0; YP:nil) ),  // S2
 ((NS:0; YP:nil),  (NS:2; YP:YPR2), (NS:0; YP:nil),  (NS:4; YP:YPR2)),  // S3
 ((NS:0; YP:nil),  (NS:1; YP:YPR1), (NS:0; YP:nil),  (NS:0; YP:nil) )   // S4
);

// ====================================================================
//  ОПИСАНИЕ КЛАССА TAutomat
// ====================================================================

type TAutomat = class(TObject)
private
  // Система данных объекта
  AData : TAData;
public
  // Создание объекта
  constructor Create(RqATab : TATab);
  // Выполнение автомата
  procedure RunAutomat (RqXAr : TXAr);
  // Чтение текущего состояния объекта
  property GetCurrStat : Integer read AData.CS;
end;

// --------------------------------------------------------------------
// Выделение памяти объекту.
// Очистка вектора входных сигналов в объекте.
// Копирование внешней таблицы переходов, масок, выходов во таблицу объекта.

constructor TAutomat.Create(RqATab : TATab);
var wR, wC : Integer;
begin
  inherited Create();
  with AData do
  begin
      CS := Low(ATab);
      for wC := Low(XAr) to High(XAr) do
      begin
         XAr[wC] := 0;
         for wR := Low(ATab) to High(ATab) do ATab[wR,wC] := RqATab[wR,wC];
       end;
  end;
end;

// --------------------------------------------------------------------
// Копирование входных сигналов из внешней среды.
// Сканирование входных сигналов для поиска ненулевого
// и не заблокированного сигнала.
// Выполнение перехода по найденному сигнаду или выход если сигнал не найден.
// Выполнение процедуры выхода, если она определена.

procedure TAutomat.RunAutomat(RqXAr : TXAr);
var wInd   : Integer;
    wFound : Boolean;
    wPR    : TYProc;
    wP     : Pointer;
begin
  with AData do
  begin
      for wInd := Low(XAr) to High(XAr) do XAr[wInd] := RqXAr[wInd];
      wFound := False;
      // Приоритетный поиск сигнала
      for wInd := Low(XAr) to High(XAr) do
      begin
        if (AData.XAr[wInd] > 0) and (AData.ATab[CS,wInd].NS > 0)
        then begin
          IX := wInd;
          wFound := True;
          Break;
        end;
      end;
      if wFound
      then begin
        // Выполнение перехода по найденному сигнаду
        wPR := ATab[CS,IX].YP;
        CS := ATab[CS,IX].NS;
        if Assigned(wPR)
        then begin
          // Выполнение процедуры выхода, если она определена
          wP  := Addr(AData);
          wPR(wP);
        end;
      end;
  end;
end;

// ====================================================================
//  КОНЕЦ ОПИСАНИЯ КЛАССА TAutomat
// ====================================================================


// ====================================================================
//  НАЧАЛО СЕГМЕНТА ВНЕШНЕЙ СРЕДЫ ДЛЯ РАБОТЫ С ОЪЕКТОМ
// ====================================================================

// Вектор входных сигналов
var XArr    : TXAr;
// Ссылка на объект автомата
var AUTOMAT : TAutomat;

// Создать объект автомата
procedure TForm1.btn1Click(Sender: TObject);
begin
   if not Assigned(AUTOMAT)
   then begin
      AUTOMAT := TAutomat.Create(DefATab);
      edt1.Text := 'S' + IntToStr(AUTOMAT.GetCurrStat);
   end;
end;

// Изменить выбранные входные сигналы и выполнить автомат
procedure TForm1.btn2Click(Sender: TObject);
begin
   XArr[1] := StrToInt(cbb1.Text);
   XArr[2] := StrToInt(cbb2.Text);
   XArr[3] := StrToInt(cbb3.Text);
   XArr[4] := StrToInt(cbb4.Text);
   if Assigned(AUTOMAT)
   then begin
     AUTOMAT.RunAutomat(XArr);
     edt1.Text := 'S' + IntToStr(AUTOMAT.GetCurrStat);
   end
   else begin
     ShowMessage('Вначале создайте объект автомата');
   end;
end;

// Удалить объект автомата 
procedure TForm1.btn3Click(Sender: TObject);
begin
   if Assigned(AUTOMAT) then
   begin
       AUTOMAT.Free;
       AUTOMAT := nil;
       edt1.Text := '';
   end;
end;

end.
