Unnamed

program t;
uses dos,crt;
const
   {максимальное количество состояний/символов алфавита}
   max = 20;
   {ошибки}
   er1 = 'Ошибка: файл не найден';
   er2 = 'Ошибка: символов входного алфавита слишком много или слишком мало';
   er3 = 'Ошибка: состояний слишком мало или слишком много';
   er4 = 'Ошибка: в ленте присутствуют символы не соответствующие входному алфавиту';
   er5 = 'Ошибка: лента кончилась справа';
   er6 = 'Ошибка: лента кончилась слева';
   er7 = 'Ошибка: невозможно выполнить сдвиг';
   er8 = 'Ошибка: лента пуста';
type
   {команда}
   tcom	     = record
		  move : char;
		  new  : integer;
		  out  : char;
	       end;
   {алфавит}
   talphabet = char;
   {состояния}
   tstate    = 0..max;
var
   table       : array [talphabet,tstate] of tcom; {управляющая таблица}
   tablefile   : text;     {файл с управляющей таблицей}
   k1,k2       : integer;  {счётчики}
   filename    : string;   {имя файла с управляющй таблицей}
   curstate    : tstate;   {текущее состояние}
   maxalphabet : 0..max;   {количество символов входного алфавита}
   maxstate    : tstate;   {количество состояний}
   endstate    : tstate;   {конечное состояние}
   tape	       : string;   {лента}
   curpos      : integer;  {текущая позиция}
   curcom      : tcom;     {текущая команда}
   symbol      : char;     {символ входного алфавита}
   alphabet    : array [1..max] of talphabet; {входной алфавит}
   symbolfind  : boolean;  {признак соответствия символов на ленте и символов входного алфавита}
   alphabetend : boolean;  {признак конча входного алфавита}
begin
   clrscr;
   {ввод данных и проверка на их допустимость}
   write('файл с управляющей таблицей: '); readln(filename);
   if (fsearch(filename,'') = '') then begin writeln(er1); exit; end;
   write('количество символов входного алфавита: '); readln(maxalphabet);
   if (maxalphabet > max) or (maxalphabet <= 0) then begin writeln(er2); exit; end;
   write('количество состояний: '); readln(maxstate);
   if (maxstate > max) or (maxstate <= 0) then begin writeln(er3); exit; end;
   write('лента: '); readln(tape);
   if (tape = '') then begin writeln(er8); exit; end;
   {заполнение управляющей таблицы}
   assign(tablefile,filename); reset(tablefile); alphabetend := false;
   for k1 := 1 to maxstate do begin
      writeln('##состояние ',k1);
      for k2 := 1 to maxalphabet do begin
	 readln(tablefile,symbol); if not alphabetend then alphabet[k2] := symbol;
	 with table[symbol,k1] do begin
	    readln(tablefile,out); readln(tablefile,move); readln(tablefile,new); readln(tablefile);
	    writeln('##',symbol,' -> ',out,' ',move,' ',new);
	 end;
      end;
      alphabetend := true; writeln;
   end;
   
   write('##входной алфавит: '); for k1 := 1 to maxalphabet do write(alphabet[k1]); writeln; writeln;
   {проверка соответсивия символов ленты символам входного алфавита}
   for k1 := 1 to length(tape) do begin
      symbolfind := false;
      for k2 := 1 to maxalphabet do begin
	 if tape[k1] = alphabet[k2] then symbolfind := true;
      end;
      if not symbolfind then begin writeln(er4); exit; end;
   end;
   {выполнение команды}
   curstate := 1; endstate := 0; curpos := length(tape);
   while (curstate <> endstate) do begin
      curcom := table[tape[curpos],curstate];
      writeln('##текущее состояние ',curstate);
      writeln('##заменяем символ ',tape[curpos],' на ',curcom.out);
      tape[curpos] := curcom.out;
      case curcom.move of
	'r' : begin if curpos = length(tape) then begin writeln(er5); exit; end else begin inc(curpos); writeln('##сдвигаемся вправо'); end; end;
	'n' : begin writeln('##стоим на месте'); end;
	'l' : begin if curpos = 1 then begin writeln(er6); exit; end else begin dec(curpos); writeln('##сдвигаемся влево'); end; end;
      else begin writeln(er7); exit; end;
      end;  
      curstate := curcom.new;
      writeln('##переходим в состояние ',curstate);
      writeln('##текущая лента ',tape);
      writeln;
   end;
   writeln('Результат: ',tape);
end.