{ 20SPORTK.PAS                                                      }
{                                                                   }
{ Author: Martin Karniz & Peter Kertes                              }
{ Date  : 1994, 1998                           http://www.trsek.com }

program Turingov_stroj;

uses crt;

const
  VELKOST = 1024;                     {VELKOST dlzka pasky}
  MAX_POCET_INSTRUKCII = 100;
  FarbaAktual = 15;
  FarbaIna = 11;
  PrazdneMiesto = '.';
  OldPrazdneMiesto = 'B';

type
  matica = array[1..MAX_POCET_INSTRUKCII] of string[12];

var
  DLZKA, PC: word; {DLZKA...dlzka programu, PC...pocet prikazov}
  ProgramTS: matica;  {program T.S.}

  ZaciatokPasky, PozPasky, PozProg: integer;
  pause: integer;   {velkost pauzy}

  {paska T.S., p_final povodna paska}
  final, p_final: array [1..VELKOST] of char;
  stav: string[3];


procedure ZobrazKurzor; assembler;
asm
  mov ax,0100h
  mov cx,0808h
  int 10h
end;

procedure SkryKurzor; assembler;
asm
  mov ax,0100h
  mov cx,2020h
  int 10h
end;


procedure Hlasenie(text: string);
begin
  gotoxy(1,24);
  write(text);
end;

procedure zmaz_hlas;
var
  i: integer;
begin
  gotoxy(1,24);
  for i:=1 to 79 do
    write(' ');
end;

function NacitajCislo(x, y, min, max: integer): integer;
var
  i: LongInt;
  key: char;
begin
  i := 0;
  gotoxy(x, y);
  write('0');

  repeat
    key := readkey;

    case key of
      '0'..'9':
        if (i*10+(ord(key)-ord('0')) <= max) and ((i <> 0) or (key <> '0')) then
        begin
          i := i*10+(ord(key)-ord('0'));
          gotoxy(x, y);
          write(key);
          Inc(x);
        end;

      Chr(8):
        if i > 0 then
        begin
          i := i div 10;
          Dec(x);
          gotoxy(x, y);

          if i = 0 then
            write('0')
          else
            write(' ');
        end;

    end;

  until (Ord(key)=13) and (i >= min);

  NacitajCislo := i;
end;

function IntToStr(I: Longint): String;
var
  S: string[11];
begin
  Str(I, S);
  IntToStr := S;
end;

procedure beep;
var
  i: integer;
begin
  for i:=1 to 20 do
  begin
    sound(1000+50*i);
    delay(20-i);
  end;

  nosound;
end;


procedure maska;    {predstavuje pasku Turingoveho stroja}
begin
  clrscr; textcolor(FarbaIna);
  writeln('                     Simulator TURINGOVHO STROJA (T.S.)');
  writeln;
  writeln('Paska T.S.               Klavesa 8 - obnovenie pasky');

  gotoxy(50,13); writeln('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
  gotoxy(50,14); writeln('º     Parametre TS     º');
  gotoxy(50,15); writeln('ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹');
  gotoxy(50,16); writeln('º Stav:                º');
  gotoxy(50,17); writeln('º                      º');
  gotoxy(50,18); writeln('º Pozicia pasky:       º');
  gotoxy(50,19); writeln('º Pozicia prog.:       º');
  gotoxy(50,20); writeln('º PC:                  º');
  gotoxy(50,21); writeln('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ');

  gotoxy(1,5);
  writeln('ËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍËÍË');
  writeln('³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³');
  writeln('ÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊÍÊ');
  writeln('                                     ^');
  writeln('                                   ® ³ ¯');
  writeln('                                     ³');
  writeln('                                  ÉÍÍÍÍÍ»');
  writeln('                                  º R J º');
  writeln('                                  ÈÍÍÍÍͼ');

  gotoxy(1,12); writeln('Program:');
  gotoxy(1,13); writeln('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
  gotoxy(1,21); writeln('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ');
  textcolor(FarbaAktual);
end;


procedure zastav;    {Chybove hlasenie}
begin
  gotoxy(1,10);
  textcolor(FarbaAktual);
  write('Program '); textcolor(FarbaIna);
  writeln('k uspesnemu fungovaniu potrebuje dva subory vytvorene lubovolnym');
  writeln('textovym editorom. Prvy subor obsahuje program pre riadiacu jednotku');
  writeln('Turingovho stroja. Druhy subor obsahuje vlastnu pasku Turingovho stroja (TS).');
  writeln('Subory v danom poradi zadajte prosim v prikazovom riadku.');
end;


procedure AktualizujPC;
begin
  gotoxy(56,20); write(PC:5);
end;

procedure EditProgram;      {prevadza vypis programu}
var
  i, j: integer;
const
  StavQ = 'q';
begin
  textcolor(FarbaAktual);
  gotoxy(58,16); write(StavQ+stav);
  gotoxy(67,19); write(PozProg:5);

  for i:=14 to 20 do
  begin
    gotoxy(2, i);

    if i=16 then
      textcolor(FarbaAktual)
    else
      textcolor(FarbaIna);

    if (i >= 16-PozProg+1) and (DLZKA-PozProg+1 > i-16) then
    begin
      j := PozProg+i-16;
      write(Copy(ProgramTS[j], 1, 3)+' '+StavQ+Copy(ProgramTS[j], 4, 3)+' ',
            ProgramTS[j][7]+' '+ProgramTS[j][8]+' '+StavQ,
            Copy(ProgramTS[j], 9, 3)+' '+ProgramTS[j][12]);
    end
    else
      write('                     ');
  end;
end;

procedure EditProgram_Rucne;    {pre rucny posun, prezeranie programu}
var
  key: integer;
begin
  Hlasenie('Pohyb:  '+chr(24)+'   '+chr(25)+'   '+chr(27)+chr(217));

  repeat
    EditProgram;
    key:=Ord(readkey);

    case key of
      80: if (DLZKA>PozProg) then Inc(PozProg);
      72: if (PozProg>1) then Dec(PozProg);
    end;
    stav := Copy(ProgramTS[PozProg], 4, 3);

  until key=13;
end;


procedure AdresaPrg;         {JUMP program nastavenie riadku programu}
begin
  Hlasenie('Zadajte poziciu programu (1-'+IntToStr(DLZKA)+'): ');

  PozProg := NacitajCislo(32+Length(IntToStr(DLZKA)), 24, 1, DLZKA);
  stav := Copy(ProgramTS[PozProg], 4, 3);

  EditProgram;
end;

procedure EditPaska;    {prevadza vypis pasky}
var
  i: integer;
begin
  textcolor(FarbaAktual);
  gotoxy(67,18); write(PozPasky:5);

  for i:=1 to 39 do
  begin
    gotoxy(2*i,6);

    if i=19 then
      textcolor(FarbaAktual)
    else
      textcolor(FarbaIna);

    if (i >= 19-PozPasky+1) and (VELKOST-PozPasky+1>i-19) then
      write(final[i-19+PozPasky])
    else
      write(' ');
  end;
end;


procedure EditPaska_Rucne;   {pre rucny posun, prezeranie pasky}
var
  key: integer;
begin
  Hlasenie('Pohyb:  '+chr(27)+'   '+chr(26)+'   '+chr(27)+chr(217));
  repeat
    EditPaska;
    key:=Ord(readkey);

    case key of
     77: if (VELKOST>PozPasky) then Inc(PozPasky);
     75: if (PozPasky>1) then Dec(PozPasky);
    end;

  until key=13;
end;

procedure AdresaPasky;  {JUMP pasky nastavenie znaku pasky}
begin
  Hlasenie('Zadajte poziciu pasky (1-'+IntToStr(VELKOST)+'): ');
  PozPasky := NacitajCislo(29+Length(IntToStr(VELKOST)), 24, 1, VELKOST);
  EditPaska;
end;

function step(Krokovanie: boolean): boolean;    {vykonavanie prikazov}
var
  pretecenie, ObnovPasku: boolean;
begin
  pretecenie := False;
  ObnovPasku := False;

  if (Copy(ProgramTS[PozProg], 4, 3) = stav) and
     (ProgramTS[PozProg][7]=final[PozPasky]) and (stav <> 'END') then
  begin

    if (not Krokovanie) and (pause=2) then
    begin
      Hlasenie('Stlacte klavesu.');
      readkey;
    end;

    if not (ProgramTS[PozProg][8] in ['R', 'L']) then
    begin
      Final[PozPasky] := ProgramTS[PozProg][8];
      ObnovPasku := True;
    end;

    if ('L' in [ProgramTS[PozProg][8], ProgramTS[PozProg][12]]) then
      if (PozPasky > 1) then
      begin
        Dec(PozPasky);
        ObnovPasku := True;
      end
      else
        pretecenie := True;

    if ('R' in [ProgramTS[PozProg][8], ProgramTS[PozProg][12]]) then
      if (PozPasky < VELKOST) then
      begin
        Inc(PozPasky);
        ObnovPasku := True;
      end
      else
        pretecenie := True;
{
    if not pretecenie then
    begin
}
      stav := Copy(ProgramTS[PozProg], 9, 3);
      Inc(PC);
      textcolor(FarbaAktual);
      AktualizujPC;
{
    end;
}
    if ObnovPasku then
      EditPaska;
  end;

  if (stav <> 'END') and (not pretecenie) then
  begin
    PozProg := 1 + (PozProg mod DLZKA);

    if (pause <> 0) or Krokovanie then
      EditProgram;
  end
  else
   begin
      EditProgram;
      zmaz_hlas;

      if pretecenie then
        Hlasenie('Error: Paska T.S. mimo rozsah !')
      else
        Hlasenie('Turingov stroj vykonal dany program. Stlacte klavesu.');

      {beep;}
      readkey;
      zmaz_hlas;
      PC := 0;
    end;

  step := pretecenie;
end;


procedure InitTS;
begin
  maska;
  PozPasky := ZaciatokPasky;
  PozProg  := 1;
  PC       := 0;

  AktualizujPC;
  stav  := Copy(ProgramTS[PozProg], 4, 3);
  final := p_final;
  EditPaska;
  EditProgram;
end;


procedure turing;            {procedura hlavne menu}
var
  z: char;
begin
  InitTS;
  repeat
    if z <> '1' then
      Hlasenie('1..KROK 2..PAUSE 3..RUN  Prg<4..Edit 6..Jmp>  Paska<5..Edit 7..Jmp>  Esc..QUIT');

    z := readkey;
    if z in ['2'..'7'] then
      zmaz_hlas;

    case z of
      '1': step(True);
      '2':
      begin
        Hlasenie('Zadaj spomalenie instrukcii (0-2):');
        pause := NacitajCislo(36, 24, 0, 2);
      end;

      '3':
      begin
        AktualizujPC;

        if pause <> 2 then
          Hlasenie('Stlacte klavesu pre zastavenie programu.');

        while (not keypressed) and (stav <> 'END') and (not step(False)) do ;

        if pause=0 then
          EditProgram;
      end;

      '4': EditProgram_Rucne;
      '5': EditPaska_Rucne;
      '6': AdresaPrg;
      '7': AdresaPasky;
      '8': InitTS;
    end;

  until z = Chr(27);
  clrscr;
end;


procedure VypisChybu(cislo: integer);
begin
  if cislo > 0 then
    write('Error ', cislo, ': ');

  case cislo of
    1: writeln('Program obsahuje nepripustne znaky');
    2: writeln('Chybne ulozene medzery, chyba medzera');
    3: writeln('Paska nemoze obsahovat posuv hlavy R,L');
    4: writeln('Chybny posledny znak');
    5: writeln('Viac posuvov v instrukcii');

    6: writeln('Paska moze obsahovat znaky <A,Z> - {L,R} U <0,9>');
    7: writeln('Prilis dlha paska (max. dlzka: ', VELKOST, ')');
  end;
end;


function citaj_prog: Boolean; {kontrola prveho suboru}
var
  f:      text;
  riadok: string;
  j:      integer;
  OK      : boolean;
  Log_Test: byte;
begin
  DLZKA := 0;
  Log_Test := 0;
  OK := True;

  writeln('Vypis programu:');

  assign(f,paramstr(1));
  reset(f);

  repeat
    for j:=1 to sizeof(riadok)-1 do
      riadok[j] := ' ';

    readln(f, riadok);

    if riadok <> 'END' then  {podm1  testuj okrem posledneho riadku, ktory obsahuje END}
    begin

      for j:=1 to 16 do                   {test velke pismena riadku}
      begin
        if not (riadok[j] in ['A'..'Z', '0'..'9', ' ']) then
          Log_Test:= 1;

        if (riadok[j] = OldPrazdneMiesto) and ((j=9) or (j=11)) then
          riadok[j] := PrazdneMiesto;
      end;

      {test medzier na spravnych a nespravnych miestach}
      if not (' ' in [riadok[4], riadok[8], riadok[9], riadok[10], riadok[11], riadok[12], riadok[16]]) then
        Log_Test:=2;

      if riadok[9] in ['L', 'R'] then
        Log_Test:=3;

      if not (riadok[17] in ['L', 'R', ' ']) then
        Log_Test:=4;

      if (riadok[17] in ['L', 'R']) and (riadok[11] in ['L', 'R']) then
        Log_Test:=5;


      if Log_Test = 0 then
        textcolor(FarbaIna)
      else
        begin
          textcolor(FarbaAktual);
          OK := False;
        end;

      writeln(riadok);
      if Log_Test <> 0 then
      begin
        VypisChybu(Log_Test);
        readkey;
      end;

      Log_Test := 0;

      if OK then
      begin                        {konvert textu}
        Inc(DLZKA);                {inkrementuj pocitadlo}

        if (DLZKA < MAX_POCET_INSTRUKCII) then
        begin
          ProgramTS[DLZKA]:='            ';
          ProgramTS[DLZKA][1]:=riadok[1];     {3 navestie}
          ProgramTS[DLZKA][2]:=riadok[2];
          ProgramTS[DLZKA][3]:=riadok[3];
          ProgramTS[DLZKA][4]:=riadok[5];     {3 pociatocny stav}
          ProgramTS[DLZKA][5]:=riadok[6];
          ProgramTS[DLZKA][6]:=riadok[7];
          ProgramTS[DLZKA][7]:=riadok[9];     {1 znak pasky}
          ProgramTS[DLZKA][8]:=riadok[11];    {1 znak nastav or posun hlavy}
          ProgramTS[DLZKA][9]:=riadok[13];    {3 nastav stav}
          ProgramTS[DLZKA][10]:=riadok[14];
          ProgramTS[DLZKA][11]:=riadok[15];
          ProgramTS[DLZKA][12]:=riadok[17];
        end;
      end;
    end;
  until eof(f) or (riadok='END') or (DLZKA > MAX_POCET_INSTRUKCII);

  if (riadok<>'END') or (DLZKA > MAX_POCET_INSTRUKCII) then
    Log_Test := 1;

  close(f);

  textcolor(FarbaIna);
  writeln(riadok);
  writeln;
  writeln;
  textcolor(FarbaAktual);

  if Log_Test=0 then
    writeln('Syntax OK.  Pocet instrukcii: ', DLZKA)
  else
    writeln('Syntax ERROR !');

  readkey;
  citaj_prog := OK and (DLZKA <= MAX_POCET_INSTRUKCII);
end;

function citaj_pasku: boolean;  {kontrola pasky}
var
  f:      text;
  riadok: string;
  i:      integer;
  Log_Test: byte;
begin
  Log_Test := 0;

  clrscr;
  textcolor(FarbaAktual);
  writeln('Vypis pasky T.s.:');
  writeln;

  assign(f, paramstr(2));
  reset(f);
  readln(f, riadok);

  if not eof(f) then
    Log_Test  := 7;

  close(f);

  for i:=1 to length(riadok) do
    if (i>VELKOST) or (not (riadok[i] in ['A'..'Z', '0'..'9'])) or
       (riadok[i] in ['L', 'R']) then
    begin
      Log_Test:=6;
      Break;
    end;

  if length(riadok) > VELKOST then
    Log_Test:=7;

  textcolor(FarbaIna);

  if Log_Test=0 then
  begin
    ZaciatokPasky := (VELKOST - length(riadok)) div 2;

    for i:=1 to VELKOST do
    begin
      if (i <= ZaciatokPasky) or (i > ZaciatokPasky+length(riadok)) then
        p_final[i] := PrazdneMiesto
      else
        p_final[i] := riadok[i-ZaciatokPasky];

      write(p_final[i]);
    end;

    Inc(ZaciatokPasky);
  end;

  writeln;
  writeln;
  textcolor(FarbaAktual);

  if Log_Test=0 then
    writeln('Syntax OK')
  else
    VypisChybu(Log_Test);

  readkey;

  citaj_pasku := Log_test=0;
end;


begin                     {telo programu}
  SkryKurzor;
  clrscr;
  pause := 1;

  if ParamCount <> 2 then
    zastav                {Vypisanie poznamky}
  else                    {Ak prik. riad. obsahuje dva retazce}
    begin
      if citaj_prog then           {kontrola programu}
        if citaj_pasku then        {kontrola pasky}
          turing;                  {hlavna procedura}
    end;

  ZobrazKurzor;
end.