Emulator of Turing machine in pascal
Delphi & Pascal (česká wiki)
Category: Source in Pascal
Program: Turing.pas
File exe: Turing.exe
need: Trsek.pas
Example: Move.tur, Prepis.tur
Program: Turing.pasFile exe: Turing.exe
need: Trsek.pas
Example: Move.tur, Prepis.tur
This program was made up to serve as a learning device when studying the TURING machine at Koçice University (Faculty of Electrical Engineering and Information Technology). Anyone who had at least one exam with Doc. Hudák knows what I'm talking about. It helps the visual understanding of the TURING machine functionality or can become handy when suggesting your own program for TURING machine. I found its operating leisurely and easy to follow. Other advantages include functions like the stepping of a suggested program, saving it on the disc or loading the disc. Unfortunately, I came short of the model programs so what I collected and made up in a very short time can be viewed in the MOVE.TUR file. This program was very favourite with its contemporary users. I hope it can still help someone as TURING machines are the basis of the assembler. Believe me, I'm not joking.
{ 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.