Emulátor Turingov stroj v pascale
Delphi & Pascal (česká wiki)
Kategorija: Programy zos Pascalu
Program: Turing.pas
Subor exe: Turing.exe
Mušiš mac: Trsek.pas
Ukažka: Move.tur, Prepis.tur
Program: Turing.pasSubor exe: Turing.exe
Mušiš mac: Trsek.pas
Ukažka: Move.tur, Prepis.tur
Program vznikol ako pomôcka pri učení TURINGOVHO stroja na FEI TU Košice. Každý kto absolvoval skúšku na tému Moore, Mealy automatov vie o čom hovorím. Pomáha vizuálne pochopiť funkčnosť, alebo navrhnúť vlastný program pre turingov stroj. Má príjemné ovládanie. Ďalej možnosti krokovať navrhnutý program, uložiť na disk, alebo vybrať z disku. Bohužiaľ prišiel som o ukážkové programy, tak som pár kúskov napísal. V čase vzniku sa program tešil veľkej obľube. Dúfam že ešte niekomu pomôže, pretože turingove stroje sú základ asembleru. Neveríte? Ani ja som neveril.
{ 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:='EExEEywxjpEEExQEyEV]QESpQEuQEU]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:='xEEEyEwExEjEpEEEExQEyEV]QESpQEuQU]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:='xEEyEEEEE{EuhE}yTfyESEf_EEx'; re:=re+'SEErEE_EExQEyEV]QESpQEuQEux'; re:=re+'hEU]WVWSE{EEEEEESEEEywxjpE{EE'; 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.