{ TURING.PAS                Copyright (c) TrSek alias Zdeno Sekerak }
{ Pre potreby vyucby turingovych strojov.                           }
{ Ma vyborne prepracovane IDE podobne tomu z Turbo Pascalu.         }
{ Pre potreby vyucby je mozne napisany program krokovat, zastavovat.}
{                                                                   }
{ Datum:12.05.1997                             http://www.trsek.com }

program turingov_stroj;

uses crt,dos,trsek;

const shifz:set of char=
    [')','!','@','#','$','%','^','&','*','('];
      shiftz:array[0..9] of char=
    ')!@#$%^&*(';


var i,y,yr,pp:integer;
    meno:string;
    ss:word;
    re,lock:string;
    ch:char;
    ok:boolean;
    strana:array[1..2,10..70,7..11] of byte;
    paska:array[-15..1102] of char;
    edit:array[1..1024] of string[12];
    inx:array[1..1024,1..2] of word;
    f:text;


procedure uvod;
const p=65;
var s:string;
begin
s:='EEx”‹™œ†—ŠE‡žEywxjpE†‘Ž†˜E‰Š“”ExŠŠ—†QEy—“”›EV]QE•Sp†•š˜†“žQEu—Š˜”›QEU]WVW';
for i:=1 to length(s) do s[i]:=chr(ord(s[i])-37);
gotoxy(1,24);
sound(110);delay(p);writeln('             ²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²');
sound(98); delay(p);writeln('           ²²                                                               ²² ');
sound(131);delay(p);writeln('     ²²²²²²                                                                    ');
sound(110);delay(p);writeln(' ²²²²²²²       ²²   ²²   ²²²²²²   ²²  ²²     ²²    ²²²²²    ²²²²    ²²    ²²   ');
sound(165);delay(p);writeln('       ²²      ²²   ²²   ²²   ²²  ²²  ²²²    ²²  ²²       ²²    ²²  ²²    ²²   ');
sound(147);delay(p);writeln('        ²²     ²²   ²²   ²²   ²²  ²²  ²² ²²  ²²  ²²  ²²²² ²²    ²²   ²²  ²²    ');
sound(196);delay(p);writeln('         ²²    ²²   ²²   ²²²²²    ²²  ²²  ²² ²²  ²²    ²² ²²    ²²    ²²²²     ');
sound(165);delay(p);writeln('          ²²    ²²²²²    ²²  ²²²  ²²  ²²    ²²²    ²²²²²    ²²²²       ²²      ');
sound(247);delay(p);writeln('                                                                               ');
sound(220);delay(p);writeln('                                                                               ');
sound(294);delay(p);writeln('                                                                               ');
sound(247);delay(p);writeln('                   ²²²²²²   ²²²²²²²²   ²²²²²²²     ²²²²²²     ²²²²²²²          ');
sound(349);delay(p);writeln('                 ²²            ²²      ²²    ²²   ²²    ²²         ²²          ');
sound(330);delay(p);writeln('                  ²²²²²        ²²      ²²    ²²   ²²    ²²         ²²          ');
sound(440);delay(p);writeln('            ²²²²       ²       ²²      ²²²²²²     ²²    ²²  ²²    ²²           ');
sound(349);delay(p);writeln('                ²²²²²²²        ²²      ²²    ²²    ²²²²²²    ²²²²²             ');
sound(523);delay(p);writeln;
sound(494);delay(p);writeln;
sound(659);delay(p);writeln(s);
sound(523);delay(p);writeln;
sound(699);delay(p);writeln('                   S I M U L A T O R    F O R   P C   X T / A T ');
sound(659);delay(p);writeln('                             P r e s s   E n t e r ');
nosound;
repeat until (readkey in [#27,#13]);
end;

procedure vezmi;
var i,y:integer;
    reg:registers;
begin
 for i:=10 to 70 do
  for y:=7 to 11 do begin
   gotoxy(i,y);
   reg.ah:=8;
   reg.bh:=0;
   intr($10,reg);
   strana[1,i,y]:=reg.ah;
   strana[2,i,y]:=reg.al;
   end;
end;

procedure poloz;
var i,y:integer;
    reg:registers;
begin
 for i:=11 to 70 do
  for y:=7 to 11 do begin
   gotoxy(i,y);
   reg.ah:=$9;
   reg.bh:=0;
   reg.al:=strana[2,i,y];
   reg.bl:=strana[1,i,y];
   reg.cx:=1;
   intr($10,reg);
   end;
end;

procedure writec(fp,fd:integer;s:string;dlz:integer);
var i,y:integer;
begin
i:=0;y:=0;
repeat
 i:=i+1;y:=y+1;
 if s[i]='^' then begin
     textcolor(fp);i:=i+1;
     write(s[i]);end
    else begin
     textcolor(fd);
     write(s[i]);end;
until (i>=length(s));
textcolor(fd);
for i:=y to dlz do write(' ');
end;

function Filnulou(w : Word) : String;
var  s:String;
begin
  Str(w:0,s);
  if Length(s) = 1 then s:='0'+s;
  Filnulou:=s;
end;

procedure vpaska(p:integer);
begin
 gotoxy(2,20);
 for i:=p-14 to p+63 do write(paska[i]);
end;

procedure inicialy(y1:integer);
var  h, m, s, hund : Word;
begin
 farba(lightgray,black);
 gettime(h,m,s,hund);
 gotoxy(34,23);
 write(Filnulou(h),':',Filnulou(m),':',Filnulou(s));
{ ss:=ss+1;}
 if ss<>s then begin re:=copy(re,2,length(re))+re[1];
                gotoxy(1,22);write(copy(re,1,80));
                ss:=s;
               end;
 getdate(h,m,s,hund);
 gotoxy(17,23);
 write(Filnulou(s),':',Filnulou(m),':',Filnulou(h));
 gotoxy(6,23);
 if y1=0 then write(y:4)
         else write(y1:4);
end;


procedure okno(y,yr,f:integer);
var xv,yv:integer;
begin
 textbackground(f);textcolor(yellow);
 xv:=3+round(13*int((yr-1)/18));yv:=round(yr-18*int(yr/18));
 if yv=0 then yv:=18;
 gotoxy(xv,yv);
 write(edit[y]);
end;

procedure allvypis(y:integer);
begin
 for i:=1 to 108 do okno(y+i-1,i,blue);
end;

procedure oprav;
begin
 window(1,1,80,25);
 farba(blue,yellow);
 gotoxy(36,2);write(' ',meno,copy('           ',1,11-length(meno)));
 farba(lightgray,black);
 gotoxy(49,25);write(' ',meno,copy('           ',1,11-length(meno)));
 window(1,3,80,25);
end;

procedure save;
var i:integer;
    men:string;
begin
 vezmi;
 farba(lightgray,black);
 open_win(16,9,64,13,' Save ',1);
 gotoxy(11,1);write('Napis mi meno tvojho dristu');
 men:=tread(19,2,11,meno,#0,#0);
 window(1,3,80,25);
 poloz;
 if men='' then exit;
 assign(f,men);
 rewrite(f);
 for i:=1 to 1024 do write(f,paska[i]);
 for i:=1 to 1024 do
  if edit[i][1]<>' ' then begin
     write(f,chr(i div 256));write(f,chr(i mod 256));
     write(f,edit[i]);
     end;
 close(f);
 meno:=men;
 oprav;
end;

function valu(sh:string):integer;
var v,i:integer;
begin
 val(sh,v,i);
 while ((i<>0) and (sh<>'')) do begin delete(sh,i,1);
                       val(sh,v,i);end;
 valu:=v;
end;

procedure load(ak:integer);
var i,y:integer;
    ch:char;
    s:string[11];
    men:string;
    dir:searchrec;
begin
 vezmi;men:=meno;
 farba(lightgray,black);
 if ak<>0 then begin
  open_win(16,9,64,13,' Load ',1);
  gotoxy(7,1);write('Ako sa vola program, ktory mam nahrat');
  men:=tread(19,2,11,meno,#0,#0);
  window(1,3,80,25);
  end;
 textcolor(yellow);
 poloz;
 if men='' then exit;
 {$I-}
 assign(f,men);
 reset(f);
 {$I+}
 if ioresult<>0 then begin
    vezmi;
    farba(lightgray,black);
    open_win(16,9,64,12,' Ty error ',1);
    gotoxy(11,1);write('No ale ',men,' neexistuje.');
    repeat until (readkey in [#27,#32,#13]);
    window(1,3,80,25);
    poloz;
    textcolor(yellow);
    exit;
    end;
 for i:=1 to 1024 do edit[i]:='           ';
 for i:=1 to 1024 do begin inx[i,1]:=0;inx[i,2]:=0;end;
 for i:=1 to 1024 do read(f,paska[i]);
 findfirst(men,archive,dir);
 for i:=1 to (dir.size-1024) div 13 do begin
  read(f,ch);y:=ord(ch);
  read(f,ch);y:=y*256+ord(ch);
  read(f,s);edit[y]:=s;
  if edit[y][1]<>#16 then begin
    inx[y,1]:=valu(copy(edit[y],2,3));
    inx[y,2]:=valu(copy(edit[y],9,3));
    end;
  end;
 close(f);
 pp:=1;
 if ak<>0 then begin allvypis(1);
               okno(1,1,cyan);farba(blue,yellow);
               vpaska(pp);oprav;
               end;
 meno:=men;
end;

procedure edit_paska;
var ch:char;
begin
 textbackground(lightgray);
 vpaska(pp);
 repeat
  inicialy(pp);
  if keypressed then begin ch:=readkey;
   if ch=#0 then case readkey of
     #75:begin pp:=pp-1;if pp<1 then pp:=1;vpaska(pp);end;
     #77:begin pp:=pp+1;if pp>1024 then pp:=1024;vpaska(pp);end;
     #71:begin pp:=1;vpaska(pp);end;
     #79:begin pp:=pp+78;if pp>1024 then pp:=1024;
               vpaska(pp);end;
     end;
   if ch=#32 then begin for i:=1 to 1024 do paska[i]:='B';
                  pp:=1;end;
   if ch in ['!'..'z'] then begin
    paska[pp]:=ch;
    pp:=pp+1;if pp>1024 then pp:=1024;
    vpaska(pp);
    gotoxy(16,20);
    end;
   end;
 until (ch in [#13,#27,#32]);
 farba(blue,yellow);vpaska(pp);
end;

procedure krak;
begin
 farba(lightgray,black);
 open_win(20,9,58,13,' No krak !!! ',1);
 gotoxy(2,1);write('        Nelegalna kopia. ');
 gotoxy(2,2);write('  Radsej si program kup u TRSEKa,');
 gotoxy(2,3);write('     alebo jeho distributorov');
 delay(1400);
 repeat until keypressed;
 halt(1);
end;

procedure run(pr:integer);
var ns,nsr,i,is,akt:integer;
    vykon:boolean;
begin
if not(ok) then krak;
akt:=999;ns:=y;nsr:=yr;is:=y;ch:=#31;
for i:=1 to 1024 do if (akt>inx[i,1]) and (inx[i,1]<>0) then akt:=inx[i,1];
repeat
 vykon:=true;
 for i:=1 to 1024 do begin
  if ((inx[i,1]=akt) and not (ch in [#27,#13,#32])) then
     if edit[i][5]=paska[pp] then begin
        inicialy(pp);ss:=ss+3;
        vykon:=false;
        if (not(pr=0) and ((is-y+yr)>0) and ((is-y+yr)<109)) then okno(is,is-y+yr,blue);
        if (not(pr=0) and ((i-y+yr)>0) and ((i-y+yr)<109)) then okno(i,i-y+yr,cyan)
                      else if not(pr=0) then begin y:=i-8;
                           if y<1 then y:=1;
                           allvypis(y);yr:=i-y+1;
                           okno(i,yr,cyan);end;
        case edit[i][6] of
         'R':begin pp:=pp+1;if pp>1024 then pp:=1;end;
         'r':begin pp:=pp+1;if pp>1024 then pp:=1;end;
         'L':begin pp:=pp-1;if pp<1 then pp:=1024;end;
         'l':begin pp:=pp-1;if pp<1 then pp:=1024;end;
        else paska[pp]:=edit[i][6];
        end;
        farba(blue,yellow);vpaska(pp);akt:=inx[i,2];
        is:=i;if pr=1 then begin delay(150);ss:=ss+55;end;
        if keypressed then ch:=readkey;
        if pr=2 then repeat inicialy(i);
                     ch:=#31;
                     if keypressed then ch:=readkey;
                     until (ch in [#65,#27,#13,#32]);
       end;
    end;
until vykon;
y:=ns;yr:=nsr;
allvypis(y-yr+1);
okno(y,yr,cyan);
vezmi;
farba(lightgray,black);
open_win(16,9,64,12,' Finis ',1);
gotoxy(6,1);write('Program skoncil. Dufam, ze si spokojny.');
window(1,3,80,25);
textcolor(yellow);
repeat until (readkey in [#27,#13]);
poloz;ch:=#31;
end;

procedure pisem(y,yr:integer);
var xv,yv,i,p:integer;
    von:boolean;
begin
 if ch=#13 then exit;
 xv:=3+round(13*int((yr-1)/18));yv:=round(yr-18*int(yr/18));
 if yv=0 then yv:=18;
 textbackground(lightgray);
 gotoxy(xv,yv);write(edit[y]);
 von:=false;
 if ch in ['0'..'9'] then begin gotoxy(xv,yv);inx[y,1]:=ord(ch)-48;
          inx[y,2]:=0;
          edit[y]:='q'+ch+'     q   ';write(edit[y]);i:=2;end
     else begin
          if ch in [#32] then begin edit[y]:='           ';
               von:=true;inx[y,1]:=0;inx[y,2]:=0;end
             else begin edit[y]:=chr(16)+ch;
                  gotoxy(xv,yv);write(chr(16),ch,'         ');
                  gotoxy(xv+2,yv);
                  repeat
                   if keypressed then begin ch:=readkey;
                      if ord(ch) in [27,13,32,59..68,72,80,77,75,73,81] then von:=true
                         else begin edit[y]:=edit[y]+ch;
                              write(ch);end;
                      end;
                  until (von or (length(edit[y])>10));
                  von:=true;
                  edit[y]:=edit[y]+copy('           ',1,11-length(edit[y]));
                  end;
                 end;
 repeat
  if keypressed then begin
       ch:=readkey;
       if (ch in ['0'..'9']) and (i<4) then
              begin inx[y,1]:=inx[y,1]*10+ord(ch)-48;
              edit[y]:=copy(edit[y],1,i)+ch+copy(edit[y],i+2,12-i);
              gotoxy(xv,yv);write(edit[y]);i:=i+1;end;
       if ((ch in ['!'..'/',':'..'z']) or (ch in shifz)) and (i<6) then
              begin if i<5 then i:=4;
              if ch in shifz then for p:=0 to 9 do if shiftz[p]=ch then ch:=chr(p+48);
              edit[y]:=copy(edit[y],1,i)+ch+copy(edit[y],i+2,12-i);
              gotoxy(xv,yv);write(edit[y]);i:=i+1;ch:=#31;end;
       if (ch in ['0'..'9']) and (i>5) then
              begin if i<9 then begin i:=8;end;
              inx[y,2]:=inx[y,2]*10+ord(ch)-48;
              edit[y]:=copy(edit[y],1,i)+ch+copy(edit[y],i+2,12-i);
              gotoxy(xv,yv);write(edit[y]);i:=i+1;end;
       if ord(ch) in [27,13,32,59..68,72,80,77,75,73,81] then begin
             if i<9 then edit[y]:='           ';
             von:=true;
             end;
       end;
  inicialy(0);
 until ((i>10) or von);
 farba(cyan,yellow);
 gotoxy(xv,yv);write(edit[y]);
end;

procedure anonie(an:boolean);
begin
 if an then textbackground(green)
       else textbackground(lightgray);
 gotoxy(15,2);
 if an then write(chr(16),' Ano ',chr(17))
       else write('  Ano  ');
 if an then textbackground(lightgray)
       else textbackground(green);
 gotoxy(24,2);
 if an then write('  Nie  ')
       else write(chr(16),' Nie ',chr(17));
end;

procedure talkend;
var yes:boolean;
    s:string;
begin
 vezmi;
 farba(lightgray,black);
 open_win(16,9,64,12,' A co teraz ??? ',1);
 gotoxy(9,1);write('Chces naozaj ukoncit pracu !?');
 anonie(false);yes:=false;
 repeat
  ch:=readkey;
  if ch=#75 then begin anonie(true); yes:=true;end;
  if (ch=#77) or (ch=#27) then begin anonie(false);yes:=false;end;
 until ((ch=#13) or (ch=#27));
 if yes then begin
    window(1,1,80,25);farba(black,white);
    lowvideo;clrscr;
    s:='x”‹™œ†—ŠE‡žEEyEwExEjEpEE†‘Ž†˜E‰Š“”ExŠŠ—†QEy—“”›EV]QE•Sp†•š˜†“žQEu—Š˜”›QU]WVW';
    for i:=1 to length(s) do s[i]:=chr(ord(s[i])-37);
    farba(blue,yellow);
    write(s);
    farba(black,white);
    halt(0);end;
 ch:=#31;
 window(1,3,80,25);
 poloz;
end;

procedure help;
var ch:char;
begin
 open_win(2,3,78,20,' Help ',1);
 writeln('  Simulator  Turingovho stroja je plne automatizovany.');
 writeln('  Parametre: najvyssi index tzv. q je az 999');
 writeln('          v editore moze byt az 1024 zapisov');
 writeln('          dlzka pasky je 1024 znakov');
 writeln('  Editor: pracuje na principe sipok (vlavo, vpravo, hore,dole,PgUp,PgDn)');
 writeln('          medzi jeho zvlastnosti patri to,ze pre indexovanie treba pisat');
 writeln('          najprv cislo ( q dava automaticky). Potom,  pre  zadanie znaku');
 writeln('          aky ma hladat je  potrebne  pisat  pismeno  "a"  az "z"  alebo ');
 writeln('          shift+"0" az "9" po napisani dvoch znakov je treba znova zadat');
 writeln('          cisla. V pripade spatneho zadania nebude prikaz brany do uvahy.');
 writeln('          Ak zacnete pisat iba  pismena, bude  to povazovat  za komentar');
 writeln('          Stlacenim medzery sa riadok vymaze.');
 writeln('  U moznosti paska je pohyb sipkamy a klavesami Home, End, ESC, Enter.');
 writeln('  Ostatne prikazy su intuitivne jasne zo znamych softwarov (napr. Pascal)');
 writeln('                                           TRSEK Vas rodinny programator.');
 repeat
  if keypressed then ch:=readkey;
 until (ch in [#27,#13]);
 window(2,3,78,20);
 farba(blue,yellow);clrscr;
 window(1,3,80,25);
 allvypis(y);
 okno(y,yr,cyan);
end;

function kontrola:boolean;
var dir:searchrec;
begin
 findfirst('*.*',volumeid,dir);
 if length(dir.name)<4 then begin kontrola:=false;exit;end;
 if lock=dir.name then kontrola:=true
                  else kontrola:=false;
end;


BEGIN
   re:='xŽ’š‘†™”—EEyš—Ž“Œ”›”E˜™—”†EE›ž•—†ˆ”›†“žE•—ŠE{†˜ŠEuhE}yTfyESEfš™”—_E‰Š“”ExŠ';
re:=re+'Š—†SEEr”†E”“™†™“†E†‰—Š˜†_E‰Š“”ExŠŠ—†QEy—“”›EV]QE•Sp†•š˜†“žQEu—Š˜”›QEux';
re:=re+'hEU]WVWSE{E•—Ž•†‰ŠE“ŠŸ—”›“†‘”˜™ŽE›ŽŠ™ŠE“†E””E“†‰†›†™SEEEywxjpE{†˜E—”‰Ž““žE•—';
re:=re+'”Œ—†’†™”—EEE';
lock:='²³²©';
for i:=1 to 4 do lock[i]:=chr(ord(lock[i])-100);
ok:=false;
for i:=1 to length(re) do re[i]:=chr(ord(re[i])-37);
for i:=1 to 1024 do edit[i]:='           ';
for i:=1 to 1024 do begin inx[i,1]:=0;inx[i,2]:=0;end;
for i:=-15 to 1102 do paska[i]:=' ';
for i:=1 to 1024 do paska[i]:='B';
farba(magenta,yellow);pp:=1;
ok:=kontrola;
clrscr;
uvod;
farba(blue,yellow);
if paramcount>0 then begin meno:=paramstr(1);load(0);end
                else meno:='NONAME.TUR';
if paramcount>1 then if paramstr(2)='/l:'+lock then ok:=true;
for i:=1 to length(meno) do meno[i]:=upcase(meno[i]);
if copy(meno,length(meno)-2,3)<>'TUR' then meno:='NONAME.TUR';
open_win(1,2,80,23,meno,1);
window(1,1,80,25);
gotoxy(1,21);
write('ΜΝΝΝΝΝΝΝΝΝΝΝΝΝ ',chr(31),' ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ Paska ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΉ');
gotoxy(16,22);
for i:=1 to 64 do write(paska[i]);
farba(lightgray,black);
gotoxy(1,1);writec(red,black,'^F1-Help  ^F2-Save  ^F3-Load  ^F4-Paska  ^F5-Run  ^F6-SlowRun  ^F7-Step  ^F10-Exit ',79);
gotoxy(1,25);write('                                                                               ');
gotoxy(1,25);writec(red,black,'^L^i^n^e 1     ^D^a^t^e             ^T^i^m^e            ^F^i^l^e '+meno,78);
window(1,3,80,25);
y:=1;yr:=1;ss:=0;ch:=#12;
inicialy(0);allvypis(y);okno(y,yr,cyan);
{kontrola kraknuta samotnym autorom }
{if not(ok) then krak;}
repeat
 inicialy(0);
 if keypressed then begin ch:=readkey;
  if not (ord(ch) in [0,27,59..68]) then begin pisem(y,yr);
         okno(y,yr,blue);y:=y+1;yr:=yr+1;
         if yr>108 then begin yr:=108;y:=y+8;
                       if y>1024 then y:=1024;
                       allvypis(y-107);end;
         okno(y,yr,cyan);end;
  if ch=#27 then talkend;
  if ch=#0 then case readkey of
    #72:begin okno(y,yr,blue);y:=y-1;yr:=yr-1;
         if yr<1 then begin yr:=1;y:=y-18;
                       if y<1 then y:=1;
                       allvypis(y);end;
         okno(y,yr,cyan);end;
    #80:begin okno(y,yr,blue);y:=y+1;yr:=yr+1;
         if yr>108 then begin yr:=108;y:=y+8;
                       if y>1024 then y:=1024;
                       allvypis(y-107);end;
         okno(y,yr,cyan);end;
    #75:begin okno(y,yr,blue);
         if yr>18 then begin yr:=yr-18;y:=y-18;end;
         okno(y,yr,cyan);end;
    #77:begin okno(y,yr,blue);
         if yr<91 then begin yr:=yr+18;y:=y+18;end;
         okno(y,yr,cyan);end;
    #73:begin okno(y,yr,blue);y:=y-108;
         if y<108 then begin y:=1;yr:=1;end;
         allvypis(y-yr+1);
         okno(y,yr,cyan);end;
    #81:begin okno(y,yr,blue);y:=y+108;
         if (y-yr+1)>916 then begin y:=1024;yr:=108;end;
         allvypis(y-yr+1);
         okno(y,yr,cyan);end;
    #82:begin for i:=1024 downto y+1 do begin edit[i]:=edit[i-1];
                   inx[i,1]:=inx[i-1,1];inx[i,2]:=inx[i-1,2];
                   end;
        edit[y]:='           ';inx[y,1]:=0;inx[y,2]:=0;
        allvypis(y-yr+1);okno(y,yr,cyan);end;
    #83:begin for i:=y to 1023 do begin edit[i]:=edit[i+1];
                   inx[i,1]:=inx[i+1,1];inx[i,2]:=inx[i+1,2];
                   end;
        edit[1024]:='           ';inx[1024,1]:=0;inx[1024,2]:=0;
        if (y-yr+1)>916 then begin y:=1024;yr:=108;end;
        allvypis(y-yr+1);okno(y,yr,cyan);end;
    #59:help;
    #60:save;
    #61:begin load(1);okno(y,yr,blue);y:=1;yr:=1;okno(y,yr,cyan);end;
    #62:edit_paska;
    #63:run(0);
    #64:run(1);
    #65:run(2);
    #68:talkend;
    end;
  end;
until (ch=#27);
END.