home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 21 / turing.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-08-12  |  27.3 KB  |  894 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     TURING.PAS                         *)
  3. (*              Turing-Maschinen-Interpreter              *)
  4. (*         (c) 1991 Burkhard R. Wittek & TOOLBOX          *)
  5. (* ------------------------------------------------------ *)
  6. PROGRAM Turing_Maschinen_Interpreter;
  7.  
  8. USES
  9.   Crt, Dos;
  10.  
  11. CONST
  12.   Umbruch = 20000;
  13.  
  14. TYPE
  15.   Band_Fortsetzung = ^Band_Stelle;
  16.  
  17.   Band_Stelle      = RECORD
  18.                        St    : STRING[10];  { Stelle }
  19.                        St_Nr : INTEGER;     { Stellen_Nr }
  20.                        right : Band_Fortsetzung;
  21.                        left  : Band_Fortsetzung;
  22.                      END;
  23.  
  24.   Saetze           = RECORD
  25.                        regel       : STRING [3];
  26.                        afiller     : STRING [1];
  27.                        Code        : CHAR;
  28.                        bfiller     : STRING [1];
  29.                        anweisung   : CHAR;
  30.                        cfiller     : STRING [1];
  31.                        verzweigung : STRING [3]
  32.                      END;
  33.   asaetze          = ARRAY [1..100] OF Saetze;
  34.  
  35. VAR
  36.   Datei               : Text;
  37.   Dosdatei            : STRING[14];
  38.   Befehl              : asaetze;
  39.   Band_Anfang,
  40.   Schreibkopf,
  41.   Band_Ende,
  42.   Drucken,
  43.   DruckStelle,
  44.   Before, Next,
  45.   Neues_Element       : Band_Fortsetzung;
  46.   Abbruch,
  47.   Menue_Ende,
  48.   Prg_Ende            : BOOLEAN;
  49.   c,i,j,
  50.   x1,y1,x2,y2         : INTEGER;
  51.   Laenge,
  52.   Modus,
  53.   Anzahl,
  54.   Frequenz,
  55.   Anz_Regeln,
  56.   Anz_Regeln_TOTAL,
  57.   Anz_Stellen_TOTAL,
  58.   Plus_Stellen,
  59.   Befehl_Nr,
  60.   Max_Befehle,
  61.   Band_Stellenzahl,
  62.   SchreibkopfStelle   : INTEGER;
  63.   l,
  64.   m,
  65.   aa,
  66.   Art                 : CHAR;
  67.   KeyCode             : WORD;
  68.   Band_LeerZeichen,
  69.   Art_str             : STRING[1];
  70.   k,
  71.   Regel_Nr            : STRING[3];
  72.  
  73. { -------------------------------------------------------- }
  74.  
  75.   FUNCTION Readjez : CHAR;
  76.   VAR
  77.     ch : CHAR;
  78.   BEGIN
  79.     ch := ReadKey;
  80.     IF ch = #0 THEN ch := ReadKey;
  81.     Readjez := ch;
  82.   END;
  83.  
  84.   FUNCTION CheckKbd(VAR KeyCode : WORD) : BOOLEAN;
  85.   VAR
  86.     Regs : Registers;
  87.   BEGIN
  88.     Regs.ah  := 1;
  89.     Intr($16, Regs);
  90.     KeyCode  := Regs.AX;
  91.     CheckKbd := (Regs.Flags AND fZero) = fZero;
  92.   END;
  93.  
  94.   PROCEDURE SetColor(i:INTEGER);
  95.   BEGIN
  96.     CASE i OF
  97.       1 : BEGIN
  98.             TextColor(White); TextBackground(Black);
  99.           END;
  100.       2 : BEGIN
  101.             TextColor(Black); TextBackground(White);
  102.           END;
  103.     END;
  104.   END;
  105.  
  106.   PROCEDURE Set_Window(i : INTEGER);
  107.   BEGIN
  108.     Window(1, 1, 80, 25);
  109.     CASE i OF
  110.       0 : Window(1,1,80,25);
  111.       1 : BEGIN
  112.             Window(2,2,25,22); LowVideo;
  113.             GotoXY(1,11); Write('==>            <== Kopf');
  114.           END;
  115.       2 : Window(26,2,44,4);
  116.      22 : Window(26,5,44,9);
  117.       3 : Window(47,2,62,4);
  118.      33 : Window(47,6,62,9);
  119.      34 : Window(65,2,79,4);
  120.      35 : Window(65,6,79,9);
  121.       4 : Window(28,11,79,22);
  122.       5 : BEGIN
  123.             Window(1, 24, 80, 25); SetColor(1);
  124.             GotoXY(1, 1); Write('>> '); ClrEol;
  125.           END;
  126.       6 : BEGIN
  127.             Window(1, 24, 80, 25); GotoXY(1, 1);
  128.             SetColor(1); Write('>> '); ClrEol;
  129.             SetColor(2); GotoXY(1,2); ClrEol;
  130.           END;
  131.      11 : BEGIN
  132.             Window(6, 2, 16, 22); LowVideo;
  133.           END;
  134.     END;
  135.   END;
  136.  
  137.   PROCEDURE Kommentar(Spalte, Zeile : INTEGER; Satz : STRING);
  138.   BEGIN
  139.     Window(1, 24, 80, 25); GotoXY(1, 1);
  140.     SetColor(1); Write('>> '); ClrEol;
  141.     SetColor(2); GotoXY(1, 2); ClrEol;
  142.     GotoXY(Spalte, Zeile); Write(Satz);
  143.     SetColor(1);
  144.   END;
  145.  
  146.   PROCEDURE Set_Rahmen(x1, y1, xn, yn : INTEGER);
  147.   VAR
  148.     j : INTEGER;
  149.   BEGIN
  150.     j := 0;
  151.     GotoXY(x1, y1); Write(Chr(218));
  152.     FOR j := x1+1 TO x2-1 DO Write(Chr(196));
  153.     Write(Chr(191));
  154.     FOR j := y1+1 TO y2-1 DO BEGIN
  155.       GotoXY(x1,j);  Write(Chr(179));
  156.       GotoXY(x2,j);  Write(Chr(179));
  157.     END;
  158.     GotoXY(x1, y2);  Write(Chr(192));
  159.     FOR j := x1+1 TO x2-1 DO Write(Chr(196));
  160.     Write(Chr(217));
  161.   END;
  162.  
  163.   PROCEDURE Install_Windows;
  164.   BEGIN
  165.     HighVideo;
  166.     x1 :=  1; y1 := 1; x2 := 26; y2 := 23;
  167.     Set_Rahmen(x1, y1, x2, y2);
  168.     GotoXY(7, 1); Write(' Turing-Band ');
  169.     x1 := 27; y1 := 1; x2 := 45; y2 :=  5;
  170.     Set_Rahmen(x1, y1, x2, y2);
  171.     GotoXY(29, 1); Write(' Regel-Anzeige ');
  172.     x1 := 27; y1 := 5; x2 := 45; y2 := 9;
  173.     Set_Rahmen(x1, y1, x2, y2);
  174.     GotoXY(29, 5); Write(' Regel-Zähler ');
  175.     x1 := 46; y1 := 1; x2 := 63; y2 := 5;
  176.     Set_Rahmen(x1, y1, x2, y2);
  177.     GotoXY(47, 1); Write(' Lauf-Frequenz ');
  178.     x1 := 46; y1 := 5; x2 := 63; y2 := 9;
  179.     Set_Rahmen(x1, y1, x2, y2);
  180.     GotoXY(48, 5); Write(' Band-Stelle ');
  181.     x1 := 64; y1 := 1; x2 := 80; y2 := 5;
  182.     Set_Rahmen(x1, y1, x2, y2);
  183.     GotoXY(66, 1); Write('');
  184.     x1 := 64; y1 := 5; x2 := 80; y2 := 9;
  185.     Set_Rahmen(x1, y1, x2, y2);
  186.     GotoXY(66, 5); Write('');
  187.     x1 := 27; y1 := 10; x2 := 80; y2 := 23;
  188.     Set_Rahmen(x1, y1, x2, y2);
  189.     GotoXY(45, 10); Write(' Turing-Maschine ');
  190.     LowVideo;
  191.   END;  { proc install_Windows }
  192.  
  193.  
  194.   PROCEDURE Set_Menue(i : INTEGER);
  195.   BEGIN
  196.     CASE i OF
  197.       1 : Kommentar(3, 2, 'BAND-GENERIERUNG:      1:Band nur aus Nullen ' +
  198.                           '    2:Individuelle Band-Eingabe');
  199.       2 : Kommentar(1, 2, 'MENÜ:  F1:Lauf-Frequenz   Cursor hoch/abwärts' +
  200.                           '   PgUp/PgDn   e:Menü-  E:Prg-Ende');
  201.     END;
  202.   END;
  203.  
  204.  
  205.   FUNCTION Datei_einlesen(VAR Max_Befehle : INTEGER;
  206.                           VAR Befehl      : aSaetze) : BOOLEAN;
  207.   VAR
  208.     i : INTEGER; flag : BOOLEAN;
  209.   BEGIN
  210.     Datei_einlesen := FALSE; flag := FALSE; i := 0;
  211.     REPEAT
  212.       Kommentar(20, 2, 'Datei der auszuführenden Turing-Maschine?');
  213.       SetColor(1); GotoXY(4,1); ReadLn(Dosdatei);
  214.       Assign(Datei, Dosdatei);
  215.     {$I-}
  216.       Reset(Datei);
  217.     {$I+}
  218.       IF IOResult = 0 THEN BEGIN
  219.         WHILE NOT (EOF(Datei)) DO BEGIN
  220.           Max_Befehle := Max_Befehle+1;
  221.           WITH Befehl[Max_Befehle] DO
  222.             ReadLn(Datei, regel, afiller, Code, bfiller,
  223.                    anweisung, cfiller, verzweigung);
  224.         END;
  225.         Close(Datei);
  226.         flag := TRUE;
  227.         Datei_einlesen := TRUE;
  228.       END ELSE BEGIN
  229.         Set_Window(5); GotoXY(4,1);
  230.         Write(' Turing-Maschine: ', Dosdatei, ' ist auf ');
  231.         Write('Diskette/Platte nicht verfügbar!');
  232.         INC(i);
  233.         IF i = 3 THEN Abbruch := TRUE;
  234.         Delay(3000);
  235.       END;
  236.     UNTIL flag OR Abbruch;
  237.   END;  { proc Datei_einlesen }
  238.  
  239.   PROCEDURE BandStellenDruck(DruckStelle : Band_Fortsetzung;
  240.                              Art         : CHAR);
  241.   BEGIN
  242.     CASE Art OF
  243.       'r' : BEGIN
  244.               Set_Window(11); GotoXY(1,1); InsLine;
  245.               IF DruckStelle^.St_Nr MOD 5 = 0 THEN
  246.                 Write(DruckStelle^.St, '  ', DruckStelle^.St_Nr)
  247.               ELSE
  248.                 Write(DruckStelle^.St);
  249.             END;
  250.       'l' : BEGIN
  251.               Set_Window(11); GotoXY(1,1); DelLine;
  252.               IF (Schreibkopf^.St_Nr-10 >= DruckStelle^.St_Nr)
  253.                  AND NOT (Band_Anfang^.St_Nr = DruckStelle^.St_Nr) THEN BEGIN
  254.                 Set_Window(11); GotoXY(1,21);
  255.                 IF DruckStelle^.St_Nr MOD 5 = 0 THEN
  256.                   Write(DruckStelle^.St,'  ',DruckStelle^.St_Nr)
  257.                 ELSE
  258.                   Write(DruckStelle^.St);
  259.               END ELSE IF Band_Anfang^.St_Nr=DruckStelle^.St_Nr THEN BEGIN
  260.                 {** **}
  261.               END;
  262.             END;
  263.      '0' : BEGIN
  264.              Set_Window(11); GotoXY(1,11);
  265.              IF DruckStelle^.St_Nr MOD 5 = 0 THEN
  266.                Write(DruckStelle^.St,'  ',DruckStelle^.St_Nr)
  267.              ELSE
  268.                Write(DruckStelle^.St);
  269.            END;
  270.      '1' : BEGIN
  271.              Set_Window(11); GotoXY(1,11);
  272.              IF DruckStelle^.St_Nr MOD 5 = 0 THEN
  273.                Write(DruckStelle^.St, '  ', DruckStelle^.St_Nr)
  274.              ELSE
  275.                Write(DruckStelle^.St);
  276.            END;
  277.      'g' : BEGIN
  278.              Set_Window(11); GotoXY(1,1);
  279.              IF DruckStelle^.St_Nr MOD 5 = 0 THEN BEGIN
  280.                InsLine;
  281.                Write(DruckStelle^.St, '  ', DruckStelle^.St_Nr);
  282.                Delay(100);
  283.              END ELSE BEGIN
  284.                InsLine; Write(DruckStelle^.St); Delay(100);
  285.              END;
  286.            END;
  287.     ELSE
  288.       Set_Window(11);  GotoXY(1, 11);
  289.       IF DruckStelle^.St_Nr MOD 5 = 0 THEN
  290.         Write(DruckStelle^.St, '  ', DruckStelle^.St_Nr)
  291.       ELSE
  292.         Write(DruckStelle^.St);
  293.     END;
  294.   END;
  295.  
  296.   PROCEDURE Band_Generierung(Anzahl : INTEGER; Art_str : STRING);
  297.   VAR
  298.     i : INTEGER;
  299.   BEGIN
  300.     FOR i := 1 TO Anzahl DO BEGIN
  301.     New(Next);
  302.       Schreibkopf^.right := Next;
  303.       Next^.left         := Schreibkopf;
  304.       Schreibkopf        := Next;
  305.       Band_Stellenzahl   := Band_Stellenzahl+1;
  306.       Schreibkopf^.St    := Art_str;
  307.       Schreibkopf^.St_Nr := Band_Stellenzahl;
  308.       Next               := NIL;
  309.       BandStellenDruck(Schreibkopf, 'g');
  310.     END;
  311.   END;
  312.  
  313.   PROCEDURE Band_Eingabe;
  314.   VAR
  315.     Antwort : STRING [1];
  316.   BEGIN
  317.     Antwort:='';
  318.     Set_Menue(1); Set_Window(5); GotoXY(4,1); ReadLn(Modus);
  319.  
  320.     CASE Modus OF
  321.       1 : BEGIN
  322.             Anzahl:=21;
  323.             Art_str:='0'; Band_LeerZeichen:='0';
  324.             Band_Generierung(Anzahl,Art_str); Delay(500);
  325.           END;
  326.       2 : BEGIN
  327.             REPEAT
  328.               Art_str:=' ';
  329.               Kommentar(11, 2, 'Welches Zeichen:   ''0'' für Nullen   ' +
  330.                                'bzw.  ''1'' für Einsen');
  331.               Set_Window(5);
  332.               GotoXY(4,1); ReadLn(Art_str);
  333.               GotoXY(4,1); ClrEol;
  334.               Kommentar(28,2,'Anzahl dieses Zeichens?');
  335.               Set_Window(5); GotoXY(4,1); ReadLn(Anzahl);
  336.               GotoXY(4,1); ClrEol;
  337.               Band_Generierung(Anzahl,Art_str);
  338.               Kommentar(15, 2, 'Band-Erstellen beenden (''J'',''j'') ' +
  339.                                'weiter mit RETURN');
  340.               Set_Window(5); GotoXY(4,1); ReadLn(Antwort);
  341.             UNTIL (Antwort = 'J') OR (Antwort = 'j');
  342.             Kommentar(9, 2, 'Was soll Band-Leerzeichen sein: ''0'' ' +
  343.                             'oder ein anderes Zeichen?');
  344.             Set_Window(5); GotoXY(4,1); ReadLn(Band_LeerZeichen);
  345.             Set_Window(5); GotoXY(1,2); ClrEol;
  346.           END;
  347.     END;
  348.  
  349.     Kommentar(22, 2, 'Geben Sie den Anfangszustand an ');
  350.     Set_Window(5); GotoXY(4,1); ReadLn(SchreibkopfStelle);
  351.     Kommentar(12,2, 'Geben Sie die Pausenzeit an (0 - 60 Zehntel-Sekunden)');
  352.     REPEAT
  353.       Set_Window(5); GotoXY(4,1);
  354.       ReadLn(Frequenz);
  355.     UNTIL Frequenz IN [0..60];
  356.     Frequenz := Frequenz*100;
  357.   END;
  358.  
  359.   PROCEDURE Turing_Maschine(Befehl      : aSaetze;
  360.                             Max_Befehle : INTEGER);
  361.   VAR
  362.     j, Zeile, Spalte : INTEGER;
  363.   BEGIN
  364.     LowVideo; Set_Window(4); Zeile := 1; Spalte := 2; j := 0;
  365.     FOR j := 1 TO Max_Befehle DO BEGIN
  366.       Delay(50);
  367.       GotoXY(Spalte, Zeile); INC(Zeile);
  368.       WITH Befehl[j] DO
  369.         IF j <= 48 THEN
  370.           Write(regel, afiller, Code, bfiller, anweisung,
  371.                 cfiller, verzweigung);
  372.       IF Zeile = 13 THEN BEGIN
  373.         Zeile := 1;  INC(Spalte, 13);
  374.       END;
  375.     END;
  376.     HighVideo;
  377.   END;
  378.  
  379.   PROCEDURE Drucken_Turingmaschine(VAR Spalte, Zeile, j_Merker : INTEGER;
  380.                                        Befehl                  : aSaetze;
  381.                                        Befehl_Nr               : INTEGER);
  382.   BEGIN
  383.     Set_Window(4);
  384.     GotoXY(Spalte, Zeile);
  385.     LowVideo;
  386.     WITH Befehl[j_Merker] DO
  387.       Write(regel, afiller, Code, bfiller,
  388.             anweisung, cfiller, verzweigung);
  389.     HighVideo;
  390.     CASE Befehl_Nr OF
  391.        0..12 : Spalte :=  2;
  392.       13..24 : Spalte := 15;
  393.       25..36 : Spalte := 28;
  394.       37..48 : Spalte := 41;
  395.     END;
  396.     CASE Befehl_Nr OF
  397.        1..12 : Zeile := Befehl_Nr;
  398.       13..24 : Zeile := Befehl_Nr-12;
  399.       25..36 : Zeile := Befehl_Nr-24;
  400.       37..48 : Zeile := Befehl_Nr-36;
  401.     END;
  402.     Set_Window(4); GotoXY(Spalte,Zeile);
  403.     WITH Befehl[Befehl_Nr] DO
  404.       Write(regel, afiller, Code, bfiller, anweisung,
  405.             cfiller, verzweigung);
  406.     LowVideo; j_Merker:=Befehl_Nr;
  407.   END;
  408.  
  409.   PROCEDURE RegelZaehler(VAR Anz_Regeln : INTEGER);
  410.   BEGIN
  411.     INC(Anz_Regeln);
  412.     Set_Window(22);  GotoXY(9, 3);  Write(Anz_Regeln);
  413.     IF Anz_Regeln = UMBRUCH THEN BEGIN
  414.       INC(Anz_Regeln_TOTAL);
  415.       GotoXY(9,3); ClrEol;
  416.       GotoXY(6,4);
  417.       Write('(', Anz_Regeln_TOTAL:0, ' x ', UMBRUCH, ')');
  418.       Anz_Regeln := 0;
  419.     END;
  420.   END;
  421.  
  422.   PROCEDURE Bandstelle(Stelle : INTEGER);
  423.   BEGIN
  424.     Set_Window(33);
  425.     CASE Stelle OF
  426.       9, 99, 999, 9999 : BEGIN
  427.                            GotoXY(7, 2); Write('     ');
  428.                          END;
  429.     END;
  430.     IF Stelle = UMBRUCH THEN BEGIN
  431.       INC(Anz_Stellen_TOTAL);
  432.       GotoXY(8,2); ClrEol;
  433.       GotoXY(3,3);
  434.       Write('(', Anz_Stellen_TOTAL:0, ' x ', UMBRUCH, ')');
  435.       Stelle := 0;
  436.     END;
  437.     GotoXY(8, 2);  Write(Stelle);
  438.   END;
  439.  
  440.   PROCEDURE RegelAnzeige(Befehl : asaetze; Befehl_Nr : INTEGER);
  441.   BEGIN
  442.     Set_Window(2); GotoXY(6,2);
  443.     WITH Befehl[Befehl_Nr] DO
  444.       Write(regel, afiller, Code, bfiller, anweisung, cfiller,
  445.             verzweigung);
  446.   END;
  447.  
  448.   PROCEDURE Lauf_Frequenz(Frequenz : INTEGER);
  449.   BEGIN
  450.     LowVideo; Set_Window(3);
  451.     GotoXY(8,2); Write('      ');
  452.     IF Frequenz > 900 THEN BEGIN
  453.       GotoXY(5, 2); Write(Frequenz/1000:0:0, '  Sek.');
  454.     END ELSE BEGIN
  455.       GotoXY(5, 2); Write(Frequenz/100:0:0, '/10  Sek.');
  456.     END;
  457.     HighVideo;
  458.   END;
  459.  
  460.   PROCEDURE Programmlauf_Menue(VAR Frequenz : INTEGER);
  461.   VAR
  462.     a                     : CHAR;
  463.     Ant                   : STRING [1];
  464.     BewFlag, ende1, ende2 : BOOLEAN;
  465.     Band_Stelle           : INTEGER;
  466.  
  467.     PROCEDURE Band_Position;
  468.     VAR
  469.       i : INTEGER;
  470.     BEGIN
  471.       i := 0;
  472.       IF BewFlag THEN BEGIN
  473.         Schreibkopf := Band_Anfang^.right;
  474.         WHILE Schreibkopf^.St_Nr < Band_Stelle DO
  475.           Schreibkopf := Schreibkopf^.right;
  476.         Before := Schreibkopf;  Next := Schreibkopf;
  477.         WHILE Schreibkopf^.St_Nr+10 > Next^.St_Nr DO
  478.           Next := Next^.right;
  479.         WHILE Schreibkopf^.St_Nr-10<Before^.St_Nr DO
  480.           Before := Before^.left;
  481.         Drucken := Before;
  482.         FOR i := 1 TO 21 DO BEGIN
  483.           BandStellenDruck(Drucken, 'r');
  484.           Drucken := Drucken^.right;
  485.         END;
  486.         Delay(200);
  487.       END;
  488.     END;
  489.  
  490.   BEGIN
  491.     Ant := ''; Band_Stelle := 0; BewFlag := FALSE;
  492.     Band_Stelle := Schreibkopf^.St_Nr;
  493.  
  494.     REPEAT
  495.       aa := Readjez;
  496.       CASE aa OF
  497.         'H' {curup}  :
  498.           BEGIN
  499.             BewFlag := TRUE;
  500.             IF Next^.St_Nr = Band_Ende^.St_Nr THEN BEGIN
  501.               New(Neues_Element);
  502.               Band_Ende^.right    := Neues_Element;
  503.               Neues_Element^.left := Band_Ende;
  504.               Band_Ende           := Neues_Element;
  505.               Neues_Element       := NIL;
  506.               Band_Stellenzahl    := Band_Stellenzahl+1;
  507.               Band_Ende^.St       := Band_LeerZeichen;
  508.               Band_Ende^.St_Nr    := Band_Stellenzahl;
  509.             END;
  510.             IF Schreibkopf^.St_Nr-10 = Before^.St_Nr THEN
  511.               Before := Before^.right;
  512.             Next        := Next^.right;
  513.             Schreibkopf := Schreibkopf^.right;
  514.             Art         := 'r';
  515.             BandStellenDruck(Next, Art);
  516.             Bandstelle(Schreibkopf^.St_Nr);
  517.           END;
  518.         'P' {curdown} :
  519.           BEGIN
  520.             BewFlag := TRUE;
  521.             ende1   := TRUE;
  522.             IF Schreibkopf^.St_Nr-1 = Band_Anfang^.St_Nr THEN BEGIN
  523.               Kommentar(15, 2, 'Unteres Band-Ende ist erreicht!');
  524.               Delay(1000);
  525.               Set_Menue(2);
  526.               ende1 := TRUE;
  527.             END ELSE IF Before^.St_Nr = Band_Anfang^.St_Nr THEN BEGIN
  528.               Next        := Next^.left;
  529.               Before      := Before;
  530.               Schreibkopf := Schreibkopf^.left;
  531.             END ELSE BEGIN
  532.               Next        := Next^.left;
  533.               Before      := Before^.left;
  534.               Schreibkopf := Schreibkopf^.left;
  535.             END;
  536.             IF NOT ende1 THEN BEGIN
  537.               Art := 'l';  BandStellenDruck(Before, Art);
  538.               Bandstelle(Schreibkopf^.St_Nr);
  539.             END;
  540.           END;
  541.         'I' {pgup}   :
  542.           BEGIN
  543.             BewFlag := TRUE;
  544.             FOR j := 1 TO 20 DO BEGIN
  545.               IF Next^.St_Nr = Band_Ende^.St_Nr THEN BEGIN
  546.                 New(Neues_Element);
  547.                 Band_Ende^.right    := Neues_Element;
  548.                 Neues_Element^.left := Band_Ende;
  549.                 Band_Ende           := Neues_Element;
  550.                 Neues_Element       := NIL;
  551.                 Band_Stellenzahl    := Band_Stellenzahl+1;
  552.                 Band_Ende^.St       := Band_LeerZeichen;
  553.                 Band_Ende^.St_Nr    := Band_Stellenzahl;
  554.               END;
  555.               IF Schreibkopf^.St_Nr-10 = Before^.St_Nr THEN
  556.                 Before:=Before^.right;
  557.               Next        := Next^.right;
  558.               Schreibkopf := Schreibkopf^.right;
  559.               Art         := 'r';
  560.               BandStellenDruck(Next, Art);
  561.               Bandstelle(Schreibkopf^.St_Nr);
  562.             END;
  563.           END;
  564.         'Q' {pgdown} :
  565.           BEGIN
  566.             BewFlag := TRUE;
  567.             ende2   := FALSE;
  568.             FOR j := 1 TO 20 DO BEGIN
  569.               IF NOT ende2 THEN BEGIN
  570.                 IF Schreibkopf^.St_Nr-1 = Band_Anfang^.St_Nr THEN BEGIN
  571.                   Kommentar(15, 2, 'Unteres Band-Ende ist erreicht!');
  572.                   Delay(1000);
  573.                   Set_Menue(2);
  574.                   ende2 := TRUE;
  575.                 END ELSE IF Before^.St_Nr = Band_Anfang^.St_Nr THEN BEGIN
  576.                   Next        := Next^.left;
  577.                   Before      := Before;
  578.                   Schreibkopf := Schreibkopf^.left;
  579.                 END ELSE BEGIN
  580.                   Next        := Next^.left;
  581.                   Before      := Before^.left;
  582.                   Schreibkopf := Schreibkopf^.left;
  583.                 END;
  584.                 Art := 'l';
  585.                 BandStellenDruck(Before, Art);
  586.                 Bandstelle(Schreibkopf^.St_Nr);
  587.               END;
  588.             END;
  589.           END;
  590.         ';' {F1} :
  591.           BEGIN
  592.             Kommentar(25, 2, 'Neue Ablaufgeschwindigkeit? ');
  593.             Set_Window(5);  GotoXY(4, 1);
  594.             ReadLn(Frequenz);
  595.             Frequenz := Frequenz*100;
  596.             Lauf_Frequenz(Frequenz);
  597.             Menue_Ende := TRUE;
  598.           END;
  599.         'e' :
  600.           BEGIN
  601.             Kommentar(16, 2, 'Weiter an (V)ORHERIGER oder ' +
  602.                              '(J)ETZIGER Position?');
  603.             REPEAT
  604.               Ant := UpCase(Readjez);
  605.             UNTIL (Ant = 'V') OR (Ant = 'J');
  606.             Set_Window(5); GotoXY(4, 1); Write(Ant);
  607.             IF Ant = 'V' THEN Band_Position;
  608.             Menue_Ende := TRUE;
  609.           END;
  610.         'E' :
  611.           BEGIN
  612.             Abbruch  := TRUE;
  613.             Prg_Ende := TRUE;
  614.           END;
  615.       END;
  616.     UNTIL Menue_Ende OR Prg_Ende OR Abbruch;
  617.   END;
  618.  
  619.   PROCEDURE Programmlauf(Befehl                           : aSaetze;
  620.                          Befehl_Nr, Max_Befehle, Frequenz : INTEGER);
  621.   VAR
  622.     Spalte, Zeile,
  623.     j_Merker       : INTEGER;
  624.   BEGIN
  625.     j_Merker := 1;
  626.     Spalte   := 2;
  627.     Zeile    := 1;
  628.     Regel_Nr := '000';
  629.     m        := '0';
  630.     c        := 0;
  631.  
  632.     Set_Window(11);  GotoXY(1,1);
  633.     FOR j := 1 TO 21 DO DelLine;    { Window-Inhalt löschen }
  634.     Delay(500);  Set_Window(1);
  635.     Delay(700);  Set_Window(11);
  636.     DruckStelle := Band_Anfang;
  637.  
  638.      { Banddruck bis zur oberen Window-Grenze Zeile 1 }
  639.     FOR j := DruckStelle^.St_Nr TO SchreibkopfStelle+9 DO BEGIN
  640.       IF DruckStelle^.St_Nr < Band_Ende^.St_Nr THEN BEGIN
  641.         DruckStelle := DruckStelle^.right;
  642.         BandStellenDruck(DruckStelle, 'g');
  643.       END ELSE IF DruckStelle^.St_Nr = Band_Ende^.St_Nr THEN BEGIN
  644.         New(Next);
  645.         Band_Ende^.right := Next;
  646.         Next^.left       := Band_Ende;
  647.         Band_Ende        := Next;
  648.         Band_Stellenzahl := Band_Stellenzahl+1;
  649.         Band_Ende^.St_Nr := Band_Stellenzahl;
  650.         Band_Ende^.St    := Band_LeerZeichen;
  651.         DruckStelle      := Next;
  652.         Next             := NIL;
  653.         BandStellenDruck(DruckStelle, 'g');
  654.       END ELSE BEGIN
  655.         Set_Window(5);  GotoXY(4,1);
  656.         Write('Lauf-Fehler! Abbruch des Programms!');
  657.         Abbruch := TRUE;
  658.       END;
  659.     END;
  660.  
  661.     IF NOT Abbruch THEN BEGIN
  662.       Schreibkopf := Band_Anfang;
  663.       WHILE SchreibkopfStelle > Schreibkopf^.St_Nr DO
  664.         Schreibkopf := Schreibkopf^.right;
  665.       Next   := Schreibkopf;
  666.       Before := Schreibkopf;
  667.      FOR j := 1 TO 10 DO BEGIN
  668.        IF NOT (Next^.St_Nr = Band_Ende^.St_Nr) THEN
  669.          Next := Next^.right;
  670.      END;
  671.      FOR j := 1 TO 10 DO BEGIN
  672.        IF NOT (Before^.St_Nr = Band_Anfang^.St_Nr) THEN
  673.          Before := Before^.left;
  674.      END;
  675.  
  676.      Set_Window(5); GotoXY(4,1); ClrEol;
  677.      Kommentar(29, 2, ' START mit beliebiger Taste ');
  678.      REPEAT
  679.        aa := Readjez
  680.      UNTIL aa <> '';
  681.      Set_Window(5); GotoXY(4,1); ClrEol;
  682.      Kommentar(22, 2, ' HALT und MENÜ mit RETURN-Taste ');
  683.  
  684.      LowVideo;
  685.      Set_Window(22); GotoXY(6,4); Write('(0 x ', UMBRUCH,')');
  686.      Set_Window(33); GotoXY(3,3); Write('(0 x ', UMBRUCH,')');
  687.      Lauf_Frequenz(Frequenz);
  688.      HighVideo;
  689.    END;
  690.  
  691.    REPEAT
  692.      WHILE (NOT CheckKbd(KeyCode)) AND (NOT Abbruch) DO BEGIN
  693.        Delay(Frequenz);
  694.  
  695.        Befehl_Nr := 0;
  696.        c         := 0;
  697.        Abbruch   := FALSE;
  698.  
  699.        REPEAT
  700.          INC(Befehl_Nr);
  701.          INC(c);
  702.          IF c > Max_Befehle*2 THEN Abbruch := TRUE;
  703.          IF Befehl_Nr > Max_Befehle THEN Befehl_Nr := 1;
  704.          k := Befehl[Befehl_Nr].regel;
  705.          l := Befehl[Befehl_Nr].Code;
  706.        UNTIL ((Regel_Nr = k) AND (Schreibkopf^.St = l)) OR Abbruch;
  707.  
  708.        IF NOT Abbruch THEN BEGIN
  709.          Drucken_Turingmaschine(Spalte, Zeile,
  710.                                 j_Merker, Befehl, Befehl_Nr);
  711.          RegelZaehler(Anz_Regeln);
  712.          RegelAnzeige(Befehl, Befehl_Nr);
  713.  
  714.          CASE Befehl[Befehl_Nr].anweisung OF
  715.            'r' :
  716.              BEGIN
  717.                IF Next^.St_Nr = Band_Ende^.St_Nr THEN BEGIN
  718.                  New(Neues_Element);
  719.                  Band_Ende^.right    := Neues_Element;
  720.                  Neues_Element^.left := Band_Ende;
  721.                  Band_Ende           := Neues_Element;
  722.                  Neues_Element       := NIL;
  723.                  Band_Stellenzahl    := Band_Stellenzahl+1;
  724.                  Band_Ende^.St       := Band_LeerZeichen;
  725.                  Band_Ende^.St_Nr    := Band_Stellenzahl;
  726.                END;
  727.                IF Schreibkopf^.St_Nr-10 = Before^.St_Nr THEN
  728.                  Before := Before^.right;
  729.                Next        := Next^.right;
  730.                Schreibkopf := Schreibkopf^.right;
  731.                Art         := 'r';
  732.                BandStellenDruck(Next, Art);
  733.                Bandstelle(Schreibkopf^.St_Nr);
  734.              END;
  735.            'l' :
  736.              BEGIN
  737.                IF Schreibkopf^.St_Nr-1 = Band_Anfang^.St_Nr THEN BEGIN
  738.                  Kommentar(19, 2, 'Unteres Band-Ende ist erreicht! ABBRUCH!');
  739.                  REPEAT
  740.                    aa := Readjez;
  741.                  UNTIL aa <> '';
  742.                  Set_Window(0);
  743.                  Abbruch := TRUE;
  744.                END ELSE IF Before^.St_Nr = Band_Anfang^.St_Nr THEN BEGIN
  745.                  Next        := Next^.left;
  746.                  Before      := Before;
  747.                  Schreibkopf := Schreibkopf^.left;
  748.                END ELSE BEGIN
  749.                  Next        := Next^.left;
  750.                  Before      := Before^.left;
  751.                  Schreibkopf := Schreibkopf^.left;
  752.                END;
  753.                Art := 'l';
  754.                BandStellenDruck(Before, Art);
  755.                Bandstelle(Schreibkopf^.St_Nr);
  756.              END;
  757.            's' :
  758.              BEGIN
  759.                Kommentar(26, 2, 'Halten der Turing-Maschine!');
  760.                REPEAT
  761.                  aa := Readjez;
  762.                UNTIL aa <> '';
  763.                Prg_Ende := TRUE;
  764.              END;
  765.                { Schreiben von '0','1' etc. des Ausgabe-Alphabets: }
  766.           ELSE
  767.             Art             := Befehl[Befehl_Nr].anweisung;
  768.             Schreibkopf^.St := Befehl[Befehl_Nr].anweisung;
  769.             BandStellenDruck(Schreibkopf, Art);
  770.           END;
  771.  
  772.           Regel_Nr := Befehl[Befehl_Nr].verzweigung;
  773.         END;
  774.       END;
  775.  
  776.       IF Lo(KeyCode) = 13 THEN BEGIN
  777.         { MenüAbfrage : 13 = RETURN-Taste }
  778.         Set_Menue(2);
  779.         Programmlauf_Menue(Frequenz);
  780.         Kommentar(22, 2, ' HALT und MENÜ mit RETURN-Taste ');
  781.       END;
  782.  
  783.     UNTIL Prg_Ende OR Abbruch;
  784.  
  785.     IF Abbruch THEN BEGIN
  786.       Kommentar(20, 2, 'Vorzeitiges Halten der Turing-Maschine!');
  787.       REPEAT
  788.         aa := Readjez;
  789.       UNTIL aa <> '';
  790.     END;
  791.   END;
  792.  
  793. VAR
  794.   CurrentMode : BYTE ABSOLUTE LastMode;
  795.  
  796.   PROCEDURE SetCursorSize(Start, Ende : INTEGER);
  797.   VAR
  798.     Regs : Registers;
  799.   BEGIN
  800.     Regs.ah := 1;
  801.     Intr($10, Regs);
  802.     Regs.CH := BYTE(Start);
  803.     Regs.CL := BYTE(Ende);
  804.   END;
  805.  
  806.   PROCEDURE HiddenCursor;
  807.   BEGIN
  808.     SetCursorSize($20, 0);
  809.   END;
  810.  
  811.   PROCEDURE BlockCursor;
  812.   VAR
  813.     EndLine : BYTE;
  814.   BEGIN
  815.     IF (Hi(LastMode) <> 0) OR (CurrentMode <> 7) THEN
  816.       EndLine := $07
  817.     ELSE
  818.       EndLine := $0C;
  819.     SetCursorSize(0, EndLine);
  820.   END;
  821.  
  822.   PROCEDURE Cursor(i : INTEGER);
  823.   BEGIN
  824.     CASE i OF
  825.       1 : HiddenCursor;
  826.       2 : BlockCursor;
  827.     END;
  828.   END;
  829.  
  830.   PROCEDURE Initialisieren;
  831.   BEGIN
  832.     Prg_Ende   := FALSE;
  833.     Menue_Ende := FALSE;
  834.     Abbruch    := FALSE;
  835.     aa  := ' ';
  836.     l   := ' ';
  837.     m   := ' ';
  838.     Art := ' ';
  839.     c   := 0; i := 0; j := 0; x1 := 0; y1 := 0; x2 := 0; y2 := 0;
  840.     Laenge := 0; Modus := 0; Anzahl := 0; Frequenz := 0;
  841.     Dosdatei := '';  Art_str := '';  k := '';  Regel_Nr := '';
  842.  
  843.     New(Band_Anfang);
  844.     Schreibkopf := Band_Anfang;
  845.     Band_Anfang^.St    := '0';
  846.     Band_Anfang^.St_Nr := 0;
  847.     Band_Stellenzahl   := 0;
  848.     Max_Befehle        := 0;
  849.     Befehl_Nr          := 0;
  850.     SchreibkopfStelle  := 0;
  851.     Anz_Regeln         := 0;
  852.     Anz_Regeln_TOTAL   := 0;
  853.     Anz_Stellen_TOTAL  := 0;
  854.     Plus_Stellen       := 0;
  855.     Band_LeerZeichen   := '0';
  856.   END;
  857.  
  858. BEGIN
  859.   Set_Window(0);
  860.   ClrScr;
  861.   LowVideo;
  862.   Initialisieren;
  863.   Install_Windows;
  864.   Cursor(1);
  865.   Delay(100);
  866.   IF Datei_einlesen(Max_Befehle, Befehl) THEN BEGIN
  867.     Delay(50);
  868.     Turing_Maschine(Befehl, Max_Befehle)
  869.   END ELSE BEGIN
  870.     Set_Window(5); GotoXY(4,1);
  871.     Write('Keine Datei kann eingelesen werden!');
  872.     Delay(2000);
  873.   END;
  874.  
  875.   IF NOT Abbruch THEN BEGIN
  876.     Delay(600);
  877.     Band_Eingabe;
  878.  
  879.     Band_Ende   := NIL;
  880.     Band_Ende   := Schreibkopf;
  881.     Schreibkopf := NIL;
  882.     Schreibkopf := Band_Anfang;
  883.     Next        := NIL;
  884.     Next        := Band_Anfang;
  885.     Next        := Next^.right;
  886.  
  887.     Programmlauf(Befehl, Befehl_Nr, Max_Befehle, Frequenz);
  888.   END;
  889.   Set_Window(0); GotoXY(1, 1); Cursor(2);
  890. END.
  891. (* ------------------------------------------------------ *)
  892. (*                Ende von TURING.PAS                     *)
  893.  
  894.