home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turbo Toolbox
/
Turbo_Toolbox.iso
/
1991
/
06
/
titel
/
turing.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-03-11
|
20KB
|
551 lines
(* ------------------------------------------------------ *)
(* TURING.PAS *)
(* Turing-Maschinen-Interpreter *)
(* (c) 1991 Burkhard R. Wittek & TOOLBOX *)
(* ------------------------------------------------------ *)
PROGRAM Turing;
USES Crt;
CONST
UMBRUCH = 20000;
TYPE
Band_Fortsetzung = ^Band_Stelle;
Band_Stelle = RECORD
St : STRING [10]; { Stelle }
St_Nr : INTEGER; { Stellen_Nr }
right : Band_Fortsetzung;
left : Band_Fortsetzung;
END;
saetze = RECORD
regel : STRING [3];
afiller : STRING [1];
Code : CHAR;
bfiller : STRING [1];
anweisung : CHAR;
cfiller : STRING [1];
verzweigung : STRING [3];
END;
asaetze = ARRAY [1..100] OF saetze;
VAR
Datei : Text;
Dosdatei : STRING [14];
Befehl : asaetze;
Band_Anfang, Schreibkopf, Band_Ende,
Drucken, DruckStelle, Before, Next,
Neues_Element : Band_Fortsetzung;
Ende, Abbruch : BOOLEAN;
c, i, j, x1, y1, x2, y2 : INTEGER;
Laenge, Modus, Anzahl, Frequenz,
Anz_Regeln, Anz_Regeln_TOTAL,
Anz_Stellen_TOTAL, Plus_Stellen,
Befehl_Nr, Max_Befehle,
Band_Stellenzahl, SchreibkopfStelle : INTEGER;
l, m, aa, Art : CHAR;
Art_str : STRING [1];
k, Regel_Nr : STRING [3];
PROCEDURE SetColor(i : INTEGER);
BEGIN
CASE i OF
1: BEGIN TextColor(White); TextBackground(Black); END;
2: BEGIN TextColor(Black); TextBackground(White); END;
END;
END;
PROCEDURE Set_Window(i : INTEGER);
BEGIN
Window(1,1,80,25);
CASE i OF
0 : Window(1,1,80,25);
1 : BEGIN
Window(2,2,25,22); LowVideo;
GotoXY(1,11); Write('==> <== Kopf');
END;
2 : Window(26, 2,44, 4);
22 : Window(26, 5,44, 9);
3 : Window(47, 2,62, 4);
33 : Window(47, 6,62, 9);
34 : Window(65, 2,79, 4);
35 : Window(65, 6,79, 9);
4 : Window(28,11,79,22);
5 : BEGIN
Window(1,24,80,25); SetColor(1);
GotoXY(1,1); Write('>> '); ClrEol;
END;
6 : BEGIN
Window(1,24,80,25); GotoXY(1,1);
SetColor(1); Write('>> '); ClrEol;
SetColor(2); GotoXY(1,2); ClrEol;
END;
11 : BEGIN
Window(6,2,16,22); LowVideo;
END;
END;
END;
PROCEDURE Kommentar(Spalte, Zeile : INTEGER;
Satz : STRING);
BEGIN
Window(1,24,80,25); GotoXY(1,1);
SetColor(1); Write('>> '); ClrEol;
SetColor(2); GotoXY(1,2); ClrEol;
GotoXY(Spalte, Zeile); Write(Satz); SetColor(1);
END;
PROCEDURE SetRahmen(x1, y1, x2, y2 : INTEGER);
BEGIN
GotoXY(x1, y1); Write(Chr(218));
FOR j := x1+1 TO x2-1 DO Write(Chr(196));
Write(Chr(191));
FOR j := y1+1 TO y2-1 DO BEGIN
GotoXY(x1,j); Write(Chr(179));
GotoXY(x2,j); Write(Chr(179));
END;
GotoXY(x1,y2); Write(Chr(192));
FOR j := x1+1 TO x2-1 DO Write(Chr(196));
Write(Chr(217));
END;
PROCEDURE Install_Windows;
BEGIN
HighVideo; SetRahmen(1,1,26,23);
GotoXY(7,1); Write(' Turing-Band ');
SetRahmen(27,1,45,5);
GotoXY(29,1); Write(' Regel-Anzeige ');
SetRahmen(27,5,45,9);
GotoXY(29,5); Write(' Regel-Zähler ');
SetRahmen(46,1,63,5);
GotoXY(47,1); Write(' Lauf-Frequenz ');
SetRahmen(46,5,63,9);
GotoXY(48,5); Write(' Band-Stelle ');
SetRahmen(64,1,80,5); GotoXY(66,1); Write('');
SetRahmen(64,5,80,9); GotoXY(66,5); Write('');
SetRahmen(27,10,80,23);
GotoXY(45,10); Write(' Turing-Maschine '); LowVideo;
END;
PROCEDURE Set_Menue(i : INTEGER);
BEGIN
CASE i OF
1 : Kommentar(3, 2, 'BAND-GENERIERUNG: ' +
'1:Band nur aus Nullen ' +
'2:Individuelle Band-Eingabe');
2 : Kommentar(1, 2, 'MENÜ: F1:Lauf-Frequenz ' +
'Cursor hoch/abwärts ' +
'PgUp/PgDn e:Menü- ' +
'E:Prg-Ende');
END;
END;
FUNCTION Datei_einlesen(VAR Max_Befehle : INTEGER;
VAR Befehl : asaetze) : BOOLEAN;
VAR flag : BOOLEAN;
BEGIN
Datei_einlesen := FALSE; flag := FALSE; i := 0;
REPEAT
Kommentar(20,2,
'Datei der auszuführenden Turing-Maschine?');
SetColor(1); GotoXY(4,1); ReadLn(Dosdatei);
Assign(Datei, Dosdatei); {$I-} Reset(Datei); {$I+}
IF IOResult = 0 THEN BEGIN
WHILE NOT(EOF(Datei)) DO BEGIN
INC(Max_Befehle);
WITH Befehl[Max_Befehle] DO
ReadLn(Datei, regel, afiller, Code, bfiller,
anweisung, cfiller, verzweigung);
END;
Close(Datei);
flag := TRUE; Datei_einlesen := TRUE;
END ELSE BEGIN
Set_Window(5); GotoXY(4,1);
Write(' Turing-Maschine: ', Dosdatei, ' ist auf ');
Write('Diskette/Platte nicht verfügbar!');
INC(i); IF i = 3 THEN Abbruch := TRUE; Delay(3000);
END;
UNTIL flag OR Abbruch;
END;
PROCEDURE BandStellenDruck(DruckStelle : Band_Fortsetzung;
Art : CHAR);
BEGIN
CASE Art OF
'r' : BEGIN
Set_Window(11); GotoXY(1,1); InsLine;
IF DruckStelle^.St_Nr MOD 5 = 0 THEN
Write(DruckStelle^.St, ' ', DruckStelle^.St_Nr)
ELSE Write(DruckStelle^.St);
END;
'l' : BEGIN
Set_Window(11); GotoXY(1,1); DelLine;
IF (Schreibkopf^.St_Nr-10>=DruckStelle^.St_Nr) AND
NOT (Band_Anfang^.St_Nr=DruckStelle^.St_Nr)
THEN BEGIN
Set_Window(11); GotoXY(1,21);
IF DruckStelle^.St_Nr MOD 5 = 0 THEN
Write(DruckStelle^.St, ' ',DruckStelle^.St_Nr)
ELSE Write(DruckStelle^.St);
END ELSE
IF Band_Anfang^.St_Nr=DruckStelle^.St_Nr THEN { }
END;
'0' : BEGIN
Set_Window(11); GotoXY(1,11);
IF DruckStelle^.St_Nr MOD 5 = 0 THEN
Write(DruckStelle^.St, ' ', DruckStelle^.St_Nr)
ELSE Write(DruckStelle^.St);
END;
'1' : BEGIN
Set_Window(11); GotoXY(1,11);
IF DruckStelle^.St_Nr MOD 5 = 0 THEN
Write(DruckStelle^.St, ' ', DruckStelle^.St_Nr)
ELSE Write(DruckStelle^.St);
END;
'g' : BEGIN
Set_Window(11); GotoXY(1,1);
IF DruckStelle^.St_Nr MOD 5 = 0 THEN BEGIN
InsLine;
Write(DruckStelle^.St, ' ', DruckStelle^.St_Nr);
Delay(100);
END ELSE BEGIN
InsLine;
Write(DruckStelle^.St); Delay(100);
END;
END;
ELSE
Set_Window(11); GotoXY(1,11);
IF DruckStelle^.St_Nr MOD 5 = 0 THEN
Write(DruckStelle^.St,' ',DruckStelle^.St_Nr)
ELSE Write(DruckStelle^.St);
END;
END;
PROCEDURE Band_Generierung(Anzahl : INTEGER;
Art_str : STRING);
BEGIN
FOR i := 1 TO Anzahl DO BEGIN
New(Next);
Schreibkopf^.right := Next;
Next^.left := Schreibkopf; Schreibkopf := Next;
INC(Band_Stellenzahl);
Schreibkopf^.St := Art_str;
Schreibkopf^.St_Nr := Band_Stellenzahl;
Next := NIL;
BandStellenDruck(Schreibkopf, 'g');
END;
END;
PROCEDURE Band_Eingabe;
VAR Antwort : STRING [1];
BEGIN
Antwort := '';
Set_Menue(1); Set_Window(5); GotoXY(4,1); ReadLn(Modus);
CASE Modus OF
1 : BEGIN
Anzahl := 21; Art_str := '0';
Band_Generierung(Anzahl, Art_str); Delay(500);
END;
2 : BEGIN
REPEAT
Art_str:=' ';
Kommentar(11,2,
'Welches Zeichen: ''0'' für ' +
'Nullen bzw. ''1'' für Einsen');
Set_Window(5);
GotoXY(4,1); ReadLn(Art_str);
GotoXY(4,1); ClrEol;
Kommentar(28,2,'Anzahl dieses Zeichens?');
Set_Window(5); GotoXY(4,1); ReadLn(Anzahl);
GotoXY(4,1); ClrEol;
Band_Generierung(Anzahl, Art_str);
Kommentar(15,2,'Band-Erstellen beenden ' +
'(''J'',''j'') weiter mit RETURN');
Set_Window(5); GotoXY(4,1); ReadLn(Antwort);
UNTIL (Antwort = 'J') OR (Antwort = 'j');
Set_Window(5); GotoXY(1,2); ClrEol;
END;
END;
Kommentar(22, 2, 'Geben Sie den Anfangszustand an ');
Set_Window(5); GotoXY(4,1); ReadLn(SchreibkopfStelle);
Kommentar(12, 2, 'Geben Sie die Pausenzeit an ' +
'(0 - 60 Zehntel-Sekunden)');
REPEAT
Set_Window(5); GotoXY(4,1); ReadLn(Frequenz);
UNTIL Frequenz IN [0..60];
Frequenz := Frequenz * 100;
END;
PROCEDURE Turing_Maschine(Befehl : asaetze;
Max_Befehle : INTEGER);
VAR j, Zeile, Spalte : INTEGER;
BEGIN
LowVideo; Set_Window(4);
Zeile := 1; Spalte := 2; j := 0;
FOR j := 1 TO Max_Befehle DO BEGIN
Delay(50); GotoXY(Spalte, Zeile); INC(Zeile);
WITH Befehl[j] DO IF j <= 48 THEN
Write(regel, afiller, Code, bfiller,
anweisung, cfiller, verzweigung);
IF Zeile = 13 THEN BEGIN
Zeile := 1; Spalte := Spalte + 13;
END;
END;
HighVideo;
END;
PROCEDURE Drucken_Turingmaschine
(VAR Spalte, Zeile, j_Merker : INTEGER;
Befehl : asaetze; Befehl_Nr : INTEGER);
BEGIN
Set_Window(4); GotoXY(Spalte,Zeile); LowVideo;
WITH Befehl[j_Merker] DO
Write(regel, afiller, Code, bfiller,
anweisung, cfiller, verzweigung);
HighVideo;
CASE Befehl_Nr OF
0..12 : Spalte := 2; 13..24 : Spalte := 15;
25..36 : Spalte := 28; 37..48 : Spalte := 41;
END;
CASE Befehl_Nr OF
1..12 : Zeile := Befehl_Nr;
13..24 : Zeile := Befehl_Nr-12;
25..36 : Zeile := Befehl_Nr-24;
37..48 : Zeile := Befehl_Nr-36;
END;
Set_Window(4); GotoXY(Spalte,Zeile);
WITH Befehl[Befehl_Nr] DO
Write(regel, afiller, Code, bfiller,
anweisung, cfiller, verzweigung);
LowVideo; j_Merker := Befehl_Nr;
END;
PROCEDURE RegelZaehler(VAR Anz_Regeln : INTEGER);
BEGIN
INC(Anz_Regeln);
Set_Window(22); GotoXY(9,3); Write(Anz_Regeln);
IF Anz_Regeln = UMBRUCH THEN BEGIN
INC(Anz_Regeln_TOTAL);
GotoXY(9,3); ClrEol; GotoXY(6,4);
Write('(', Anz_Regeln_TOTAL:0, ' x ', UMBRUCH, ')');
Anz_Regeln := 0;
END;
END;
PROCEDURE Bandstelle(Stelle : INTEGER);
BEGIN
Set_Window(33);
CASE Stelle OF
9,99,999,9999 : BEGIN
GotoXY(7,2); Write(' ');
END;
END;
IF Stelle = UMBRUCH THEN BEGIN
Anz_Stellen_TOTAL := Anz_Stellen_TOTAL + 1;
GotoXY(8,2); ClrEol; GotoXY(3,3);
Write('(', Anz_Stellen_TOTAL:0, ' x ', UMBRUCH, ')');
Stelle := 0;
END;
GotoXY(8,2); Write(Stelle);
END;
PROCEDURE RegelAnzeige(Befehl : asaetze;
Befehl_Nr : INTEGER);
BEGIN
Set_Window(2); GotoXY(6,2);
WITH Befehl[Befehl_Nr] DO
Write(regel, afiller, Code, bfiller,
anweisung, cfiller, verzweigung);
END;
PROCEDURE Lauf_Frequenz(Frequenz : INTEGER);
BEGIN
LowVideo; Set_Window(3); GotoXY(8,2); Write(' ');
IF Frequenz > 900 THEN BEGIN
GotoXY(5,2); Write(Frequenz/1000:0:0, ' Sek.');
END ELSE BEGIN
GotoXY(5,2); Write(Frequenz/100:0:0,'/10 Sek.');
END; HighVideo;
END;
PROCEDURE Programmlauf(Befehl : asaetze;
Befehl_Nr, Max_Befehle,
Frequenz : INTEGER);
VAR Spalte, Zeile, j_Merker : INTEGER;
BEGIN
j_Merker := 1; Spalte := 2; Zeile := 1;
Regel_Nr := '000'; m := '0'; c := 0;
Set_Window(11); GotoXY(1,1);
FOR j := 1 TO 21 DO DelLine; { Window-Inhalt löschen }
Delay(500); Set_Window(1);
Delay(700); Set_Window(11);
DruckStelle := Band_Anfang;
{ Banddruck bis zur oberen Window-Grenze, Zeile 1 }
FOR j := DruckStelle^.St_Nr TO
SchreibkopfStelle+9 DO BEGIN
IF DruckStelle^.St_Nr < Band_Ende^.St_Nr THEN BEGIN
DruckStelle := DruckStelle^.right;
BandStellenDruck(DruckStelle, 'g');
END ELSE
IF DruckStelle^.St_Nr=Band_Ende^.St_Nr THEN BEGIN
New(Next); Band_Ende^.right := Next;
Next^.left := Band_Ende;
Band_Ende := Next;
INC(Band_Stellenzahl);
Band_Ende^.St_Nr := Band_Stellenzahl;
Band_Ende^.St := '0';
DruckStelle := Next; Next := NIL;
BandStellenDruck(DruckStelle, 'g');
END ELSE BEGIN
Set_Window(5); GotoXY(4,1);
Write('Lauf-Fehler! Abbruch des Programms!');
Abbruch := TRUE;
END;
END;
IF NOT Abbruch THEN BEGIN
Schreibkopf := Band_Anfang;
WHILE SchreibkopfStelle > Schreibkopf^.St_Nr DO
Schreibkopf := Schreibkopf^.right;
Next := Schreibkopf; Before := Schreibkopf;
FOR j := 1 TO 10 DO
IF NOT (Next^.St_Nr = Band_Ende^.St_Nr) THEN
Next := Next^.right;
FOR j := 1 TO 10 DO
IF NOT (Before^.St_Nr = Band_Anfang^.St_Nr) THEN
Before := Before^.left;
Set_Window(5); GotoXY(4,1); ClrEol;
Kommentar(29, 2, ' START mit beliebiger Taste ');
REPEAT aa := ReadKey; UNTIL aa <> '?';
Set_Window(5); GotoXY(4,1); ClrEol;
Kommentar(29, 2, ' HALT mit beliebiger Taste ');
LowVideo; Set_Window(22);
GotoXY(6,4); Write('(0 x ',UMBRUCH,')');
Set_Window(33);
GotoXY(3,3); Write('(0 x ',UMBRUCH,')');
Lauf_Frequenz(Frequenz); HighVideo;
END;
REPEAT
Delay(Frequenz); Befehl_Nr := 0; c := 0;
Abbruch := FALSE;
REPEAT
INC(Befehl_Nr); INC(c);
IF c > 1000 THEN Abbruch := TRUE;
IF Befehl_Nr > Max_Befehle THEN Befehl_Nr := 1;
k := Befehl[Befehl_Nr].regel;
l := Befehl[Befehl_Nr].Code;
UNTIL ((Regel_Nr = k) AND
(Schreibkopf^.St=l)) OR Abbruch;
IF NOT Abbruch THEN BEGIN
Drucken_Turingmaschine(Spalte, Zeile, j_Merker,
Befehl, Befehl_Nr);
RegelZaehler(Anz_Regeln);
RegelAnzeige(Befehl, Befehl_Nr);
CASE Befehl[Befehl_Nr].anweisung OF
'r' : BEGIN
IF Next^.St_Nr = Band_Ende^.St_Nr THEN BEGIN
New(Neues_Element);
Band_Ende^.right := Neues_Element;
Neues_Element^.left := Band_Ende;
Band_Ende := Neues_Element;
Neues_Element := NIL;
INC(Band_Stellenzahl);
Band_Ende^.St := '0';
Band_Ende^.St_Nr := Band_Stellenzahl;
END;
IF Schreibkopf^.St_Nr-10 = Before^.St_Nr THEN
Before := Before^.right;
Next := Next^.right;
Schreibkopf := Schreibkopf^.right;
Art := 'r';
BandStellenDruck(Next, Art);
Bandstelle(Schreibkopf^.St_Nr);
END;
'l' : BEGIN
IF Schreibkopf^.St_Nr-1 = Band_Anfang^.St_Nr
THEN BEGIN
Kommentar(19, 2,
'Unteres Band-Ende ist erreicht! ABBRUCH!');
REPEAT aa := ReadKey; UNTIL aa <> '?';
Set_Window(0); Abbruch := TRUE;
END ELSE
IF Before^.St_Nr = Band_Anfang^.St_Nr
THEN BEGIN
Next := Next^.left;
Before := Before;
Schreibkopf := Schreibkopf^.left;
END ELSE BEGIN
Next := Next^.left;
Before := Before^.left;
Schreibkopf := Schreibkopf^.left;
END;
Art := 'l';
BandStellenDruck(Before, Art);
Bandstelle(Schreibkopf^.St_Nr);
END;
's' : BEGIN
Kommentar(26,2,'Halten der Turing-Maschine!');
REPEAT aa := ReadKey; UNTIL aa <> '?';
Ende := TRUE;
END;
ELSE
Art := Befehl[Befehl_Nr].anweisung;
Schreibkopf^.St := Befehl[Befehl_Nr].anweisung;
BandStellenDruck(Schreibkopf, Art);
END;
Regel_Nr := Befehl[Befehl_Nr].verzweigung;
END;
UNTIL KeyPressed OR Abbruch;
Ende := FALSE;
IF Abbruch THEN BEGIN
Kommentar(20, 2,
'Vorzeitiges Halten der Turing-Maschine!');
REPEAT aa := ReadKey; UNTIL aa <> '?';
END;
END;
PROCEDURE Initialisieren;
BEGIN
Ende := FALSE; Abbruch := FALSE;
aa := ' '; l := ' ';
m := ' '; Art := ' ';
c := 0; i := 0;
j := 0; x1 := 0;
y1 := 0; x2 := 0;
y2 := 0; Laenge := 0;
Modus := 0; Anzahl := 0;
Frequenz := 0; Dosdatei := '';
Art_str := ''; k := '';
Regel_Nr := '';
New(Band_Anfang);
Schreibkopf := Band_Anfang;
Band_Anfang^.St := '0';
Band_Anfang^.St_Nr := 0; Band_Stellenzahl := 0;
Max_Befehle := 0; Befehl_Nr := 0;
SchreibkopfStelle := 0; Anz_Regeln := 0;
Anz_Regeln_TOTAL := 0; Anz_Stellen_TOTAL := 0;
Plus_Stellen := 0;
END;
BEGIN
Set_Window(0); ClrScr; LowVideo;
Initialisieren; Install_Windows; Delay(100);
IF Datei_Einlesen(Max_Befehle, Befehl) THEN BEGIN
Delay(50); Turing_Maschine(Befehl, Max_Befehle);
END ELSE BEGIN
Set_Window(5); GotoXY(4,1);
Write('Keine Datei kann eingelesen werden!');
Delay(2000);
END;
IF NOT Abbruch THEN BEGIN
Delay(600); Band_Eingabe;
Band_Ende := NIL; Band_Ende := Schreibkopf;
Schreibkopf := NIL; Schreibkopf := Band_Anfang;
Next := NIL; Next := Band_Anfang;
Next := Next^.right;
Programmlauf(Befehl, Befehl_Nr, Max_Befehle, Frequenz);
END;
Set_Window(0); GotoXY(1,1);
END.
(* ------------------------------------------------------ *)
(* Ende von TURING.PAS *)