Something

program t;
uses dos,crt;
const
   max = 20;
   er1 = 'Ошибка: файл не найден';
   er2 = 'Ошибка: символов входного алфавита слишком много или слишком мало';
   er3 = 'Ошибка: состояний слишком мало или слишком много';
   er4 = 'Ошибка: в ленте присутствуют символы не соответствующие входному алфавиту';
   er5 = 'Ошибка: лента кончилась справа';
   er6 = 'Ошибка: лента кончилась слева';
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;
   writeln('Некое подобие машины Тьюринга.');
   writeln('Сначала введите имя файла с управляющей таблицей.');
   writeln('Затем количество символов входного алфавита и количество состояний, они могут быть в пределах от 1 до ',max,'.');
   writeln('Не ошибитесь. Иначе я могу неверно интерпретировать управляющую таблицу!');
   writeln('Для продолжения нажмите клавишу Enter.');
   readln; 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);

   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;
      end;  
      curstate := curcom.new;
      writeln('##переходим в состояние ',curstate);
      writeln('##текущая лента ',tape);
      writeln;
   end;
   writeln('Результат: ',tape);
end.