home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 04 / turing / turing.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-01-21  |  8.8 KB  |  278 lines
  1. (* ----------------------------------------------------------------------- *)
  2. (*                               TURING.PAS                                *)
  3. (*                    ein Turing-Maschinen-Interpreter                     *)
  4.  
  5. PROGRAM TM_Interpreter (Input, Output);
  6.  
  7. (*$C-*)
  8.  
  9. CONST max_Regeln = 32;
  10.       ymin       = 12;
  11.       ymax       = 25;
  12.  
  13. TYPE Regel_Satz = RECORD
  14.                     Status, NeuerStatus: INTEGER;
  15.                     Code, Aktion       : CHAR;
  16.                   END;
  17.      MyString = STRING[100];
  18.  
  19. VAR  Datei : TEXT;
  20.      Regel : ARRAY[1..max_Regeln] OF Regel_Satz;
  21.      Band,
  22.      DateiName, Blanks     : MyString;
  23.      i, row, Frequenz      : INTEGER;
  24.      Regel_Anzahl,
  25.      Regel_Nummer,
  26.      aktuelle_Regel,
  27.      alte_Regel,
  28.      ausgefuehrte_Regeln,
  29.      Bandlaenge,
  30.      Band_Index            : INTEGER;
  31.  
  32. (* ----------------------------------------------------------------------- *)
  33. PROCEDURE RevOn;                                (* inverse Textdarstellung *)
  34.  
  35. BEGIN
  36.   TextColor(Black);  TextBackGround(White);
  37. END;
  38.  
  39.  
  40. PROCEDURE RevOff;                                (* normale Textdarstelung *)
  41.  
  42. BEGIN
  43.   TextColor(White);  TextBackGround(Black);
  44. END;
  45.  
  46.  
  47. PROCEDURE Scroll_up;           (* Inhalt des Ausführungs-Fensters scrollen *)
  48.                                (* DelLine löscht eine Zeile und läßt die   *)
  49. BEGIN                          (* darunter befindlichen "hochrutschen"     *)
  50.   row := Succ(row);
  51.   IF row = ymax THEN BEGIN
  52.     GotoXY(1,ymin);  DelLine;  row := ymax-1;
  53.   END;
  54.   GotoXY(1,row);
  55. END;
  56.  
  57.  
  58. PROCEDURE Pause (msec : INTEGER);              (* Pause einlegen - klar ?! *)
  59.  
  60. BEGIN
  61.   Delay(msec);
  62. END;
  63.  
  64. (* ----------------------------------------------------------------------- *)
  65. (*             Setzt jeweils um die vier Fenster einen Rahmen:             *)
  66.  
  67. PROCEDURE Rahmen (x1, y1, x2, y2 : INTEGER);
  68.  
  69. VAR  i : INTEGER;
  70.  
  71. BEGIN
  72.   RevOn;  GotoXY(x1,y1);
  73.   FOR i := x1 TO x2 DO BEGIN
  74.     GotoXY(i,y1);  Write(' ');  GotoXY(i,y2);  Write(' ');
  75.   END;
  76.   FOR i := y1+1 TO y2-1 DO BEGIN
  77.     GotoXY(x1,i);  Write(' ');  GotoXY(x2,i);  Write(' ');
  78.   END;
  79.   RevOff;
  80. END;
  81.  
  82. (* ----------------------------------------------------------------------- *)
  83.  
  84. PROCEDURE Bildaufbau;
  85.  
  86. BEGIN
  87.   ClrScr;
  88.   Rahmen(21,1,80,10); GotoXY(35,1);  Write(' Turing-Maschine: ');
  89.   Rahmen(1,1,20,5);   GotoXY(4,1);   Write(' Regel-Zähler ');
  90.   Rahmen(1,6,20,10);  GotoXY(3,6);   Write(' Regel-Anzeige ');
  91.   Rahmen(1,11,80,11); GotoXY(3,11);  Write(' Turing-Regel ');
  92.                       GotoXY(42,11); Write(' Turing-Band ');
  93. END;
  94.  
  95. (* ----------------------------------------------------------------------- *)
  96. (*    Turing-Maschine aus Datei einlesen, Eingabe des Bandes, der Start-   *)
  97. (*                       Position sowie der Pausenzeit:                    *)
  98.  
  99. FUNCTION Turing_Maschine_initialisiert : BOOLEAN;
  100.  
  101. VAR  open_err, read_err: BOOLEAN;
  102.      i, x, y : INTEGER;
  103.  
  104. BEGIN
  105.   REPEAT
  106.     Regel_Anzahl := 0;
  107.     WriteLn; Scroll_up;
  108.     Write('Name der Turing-Maschine eingeben (leere Eingabe beendet!):');
  109.     Scroll_up;  ReadLn(DateiName);  Scroll_up;
  110.     IF DateiName <> '' THEN BEGIN
  111.       IF Pos('.',DateiName) = 0 THEN DateiName := Concat(DateiName,'.TUR');
  112.       Assign(Datei,DateiName);
  113.       (*$I-*)
  114.       ReSet(Datei);
  115.       (*$I+*)
  116.       open_err := IOResult <> 0;  read_err := FALSE;
  117.       IF NOT open_err THEN BEGIN
  118.         WHILE NOT(Eof(Datei) OR read_err) AND (Regel_Anzahl < max_Regeln) DO
  119.         BEGIN
  120.           Regel_Anzahl := Succ(Regel_Anzahl);
  121.           WITH Regel[Regel_Anzahl] DO BEGIN
  122.             (*$I-*)
  123.             ReadLn(Datei, Status, Code, Code, Aktion, Aktion, NeuerStatus);
  124.             (*$I+*)
  125.             read_err := IOResult <> 0;
  126.             Aktion := UpCase(Aktion);
  127.           END;
  128.         END;
  129.         IF read_err THEN BEGIN
  130.           WriteLn('*** Fehler: ungültige Regeln in "',DateiName,'" !');
  131.           Scroll_up;  Regel_Anzahl := 0;
  132.         END
  133.         ELSE BEGIN
  134.           GotoXY(53,1);  Write(Copy(DateiName,1,14),' ');  DateiName := '';
  135.           RevOn;  Write('            ');  RevOff;
  136.         END;
  137.       END
  138.       ELSE BEGIN
  139.         WriteLn('*** Fehler: "',DateiName,'" nicht gefunden !');  Scroll_up;
  140.       END;
  141.       Close(Datei);
  142.     END;
  143.   UNTIL DateiName = '';
  144.   x := 23;  y := 1;                          (* Regeln im Fenster ausgeben *)
  145.   FOR i := 1 TO max_Regeln DO BEGIN
  146.     y := Succ(y);  GotoXY(x,y);
  147.     IF i <= Regel_Anzahl THEN
  148.       WITH Regel[i] DO  Write(Status:3,' ',Code:1,' ',Aktion,NeuerStatus:4)
  149.     ELSE
  150.       Write(' ':11);
  151.     IF y = 9 THEN BEGIN  y := 1;  x := x + 14;  END;
  152.   END;
  153.   IF Regel_Anzahl > 0 THEN BEGIN
  154.     WriteLn; Scroll_up;
  155.     WriteLn('Bitte das Band eingeben: ');  Scroll_up;
  156.     WriteLn; Scroll_up;
  157.     WriteLn('    |    |    |    |    |    |',
  158.             '    |    |    |    |    |    |');  Scroll_up;
  159.     ReadLn(Band);  Scroll_up;  Bandlaenge := Length(Band);
  160.     IF Bandlaenge > 60 THEN Band := Copy(Band,1,60);
  161.     WriteLn; Scroll_up;
  162.     Write('Startspalte: '); ReadLn(Band_Index);  Scroll_up;
  163.     WriteLn; Scroll_up;
  164.     REPEAT
  165.       Write('Pausenzeit (0 - 30 sec.): '); ReadLn(Frequenz);  Scroll_up;
  166.     UNTIL Frequenz IN [0..30];
  167.     Frequenz := Frequenz * 1000;
  168.     WriteLn; Scroll_up;
  169.   END;
  170.   Turing_Maschine_initialisiert := Regel_Anzahl <> 0;
  171. END;
  172.  
  173. (* ----------------------------------------------------------------------- *)
  174. (*   Unterlegt beim Programmlauf den soeben ausgeführten Turing-Befehl im  *)
  175. (*                           Fenster rechts oben:                          *)
  176.  
  177. PROCEDURE invertiere_Regel;
  178.  
  179.   PROCEDURE XY_Position (Regel_Nummer : INTEGER);
  180.  
  181.   VAR x, y : INTEGER;
  182.  
  183.   BEGIN
  184.     x := 23 + (Pred(Regel_Nummer) DIV 8) * 14;
  185.     y := 1 + Regel_Nummer - (Pred(Regel_Nummer) DIV 8) * 8;
  186.     GotoXY(x,y);
  187.   END;
  188.  
  189. BEGIN
  190.   IF alte_Regel > 0 THEN BEGIN
  191.     XY_Position(alte_Regel);  RevOff;
  192.     WITH Regel[alte_Regel] DO
  193.       Write(Status:3,' ',Code:1,' ',Aktion,NeuerStatus:4);
  194.   END;
  195.   XY_Position(aktuelle_Regel);  RevOn;
  196.   WITH Regel[aktuelle_Regel] DO
  197.     Write(Status:3,' ',Code:1,' ',Aktion,NeuerStatus:4);
  198.   RevOff;
  199.   alte_Regel := aktuelle_Regel;
  200. END;
  201.  
  202. (* ----------------------------------------------------------------------- *)
  203. (*    Zeigt die Regeln sowie das Turing-Band während des Programmlaufs:    *)
  204.  
  205. PROCEDURE zeige_Regelausfuehrung;
  206.  
  207. BEGIN
  208.   GotoXY(1,row);
  209.   WITH Regel[aktuelle_Regel] DO BEGIN
  210.     Write(Status:6,' ',Code:1,' ',Aktion,NeuerStatus:4,' ':5);
  211.     IF Aktion IN ['0','1'] THEN
  212.       Band[Band_Index] := Aktion;
  213.     RevOff;  Write(Copy(Band,1,Band_Index-1));
  214.     RevOn;   Write(Copy(Band,Band_Index,1));
  215.     RevOff;  WriteLn(Copy(Band,Band_Index+1,Bandlaenge));
  216.     Scroll_up;
  217.   END
  218. END;
  219.  
  220. (* ----------------------------------------------------------------------- *)
  221. (*          Ausführung der TURING-MASCHINE auf dem TURING-BAND:            *)
  222.  
  223. PROCEDURE Programmlauf;
  224.  
  225. VAR control : INTEGER;
  226.     break   : BOOLEAN;
  227.  
  228. BEGIN
  229.   aktuelle_Regel := 0;  alte_Regel := 0;
  230.   Regel_Nummer := 0;    ausgefuehrte_Regeln := 0;
  231.   REPEAT
  232.     control := 0;
  233.     REPEAT                          { Suche der anzuwendenden Turing-Regel }
  234.       aktuelle_Regel := Succ(aktuelle_Regel);
  235.       control := Succ(control);
  236.       break := control > 1000;
  237.       IF break THEN BEGIN
  238.         WriteLn;  Scroll_up;  Write('                      ');
  239.         WriteLn('Abbruch wegen Regelfehler !!');  Scroll_up;
  240.       END;
  241.       IF aktuelle_Regel > Regel_Anzahl THEN aktuelle_Regel := 1;
  242.     UNTIL ((Regel[aktuelle_Regel].Status = Regel_Nummer) AND
  243.            (Regel[aktuelle_Regel].Code = Band[Band_Index])) OR break;
  244.     IF NOT break THEN BEGIN
  245.       invertiere_Regel;
  246.       GotoXY(4,8);
  247.       WITH Regel[aktuelle_Regel] DO
  248.         Write(Status:3,' ',Code:1,' ',Aktion,NeuerStatus:4);
  249.       ausgefuehrte_Regeln := Succ(ausgefuehrte_Regeln);
  250.       GotoXY(8,3);  Write(ausgefuehrte_Regeln:5);
  251.       CASE Regel[aktuelle_Regel].Aktion OF
  252.         'R' : Band_Index := Succ(Band_Index);
  253.         'L' : Band_Index := Pred(Band_Index);
  254.       END;
  255.       zeige_Regelausfuehrung;
  256.       Regel_Nummer := Regel[aktuelle_Regel].NeuerStatus;
  257.       IF (Band_Index = Bandlaenge) OR (Band_Index = 1) THEN BEGIN
  258.         WriteLn;  Scroll_up;
  259.         WriteLn('                         Band-Ende erreicht !!  ');
  260.         Scroll_up;  break := TRUE;
  261.       END;
  262.       Pause(Frequenz);
  263.     END;
  264.   UNTIL break OR KeyPressed;
  265. END;
  266.  
  267. (* ----------------------------------------------------------------------- *)
  268.  
  269. BEGIN
  270.   Bildaufbau;   row := ymin;
  271.   WriteLn; Scroll_up;  WriteLn; Scroll_up;
  272.   WriteLn('Turing-Maschinen-Interpreter v1.0',
  273.           '   (C) 1988   B.R.Wittek, MC & PASCAL INT.'); Scroll_up;
  274.   WriteLn; Scroll_up;  WriteLn; Scroll_up;
  275.   WHILE Turing_Maschine_initialisiert DO Programmlauf;
  276.   ClrScr;
  277. END.
  278.