home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 21 / k_auto / k_auto.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-10-27  |  19.8 KB  |  692 lines

  1.  
  2. Program Keller_Automat_Interpreter;
  3.  
  4. uses tpcrt;
  5.  
  6. type Band_Fortsetzung = ^Band_Stelle;
  7.  
  8.      Band_Stelle = Record
  9.                       St     : string[1];  { Stelle }
  10.                       St_Nr  : integer;    { Stellen_Nr }
  11.                       right  : Band_Fortsetzung;
  12.                       left   : Band_Fortsetzung;
  13.                    End;
  14.  
  15.      saetze =  Record
  16.                   regel:           string[3];
  17.                   afiller:         string[1];
  18.                   code:            string[1];
  19.                   bfiller:         string[1];
  20.                   keller:          string[1];
  21.                   cfiller:         string[1];
  22.                   keller_eintrag:  string[1];
  23.                   dfiller:         string[1];
  24.                   verzweigung:     string[3]
  25.                end;
  26.      asaetze = array[1..100] OF saetze;
  27.  
  28.      str_1  = string[1];
  29.      str_3  = string[3];
  30.      str_10 = string[10];
  31.      str_12 = string[12];
  32.  
  33. var  j,
  34.      Stelle,
  35.      Befehl_Nr,
  36.      Max_Befehle        : integer;
  37.      Befehl             : asaetze;
  38.      Datei              : text;
  39.      DosDatei           : str_12;
  40.      Ende,
  41.      Abbruch            : boolean;
  42.      Band_Anfang,
  43.      Schreibkopf,
  44.      Band_Ende,
  45.      DruckStelle,
  46.      Before,Next,
  47.      Neues_Element,
  48.      Band_Anfang2,
  49.      Schreibkopf2,
  50.      Band_Ende2,
  51.      DruckStelle2,
  52.      Before2,Next2,
  53.      Neues_Element2     : Band_Fortsetzung;
  54.      Laenge,
  55.      Anzahl,
  56.      Frequenz,
  57.      BandStelle,
  58.      BandStelle2,
  59.      Band_Stellenzahl,
  60.      Band_Stellenzahl2,
  61.      SchreibkopfStelle  : integer;
  62.      i,
  63.      m,
  64.      l,
  65.      Art_str            : str_1;
  66.      k,
  67.      Regel_Nr           : str_3;
  68.      Zahl               : str_10;
  69.      Art,aa             : char;
  70.  
  71. { - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  72.  
  73. procedure set_Color(i:integer);
  74. begin
  75.   case i of
  76.     1 : begin TextColor(White); TextBackGround(Black); end;
  77.     2 : begin TextColor(Black); TextBackGround(White); end;
  78.   end;
  79. end;  { proc set_Color }
  80.  
  81.  
  82. procedure set_Rahmen(x1,y1,x2,y2:integer);
  83. var j:integer;
  84. begin
  85.   j:=0;
  86.   GotoXY(x1,y1); write(chr(218));
  87.   FOR j:=x1+1 TO x2-1 DO write(chr(196));
  88.   write(chr(191));
  89.   FOR j:=y1+1 TO y2-1 DO
  90.   begin
  91.      GotoXY(x1,j); write(chr(179));
  92.      GotoXY(x2,j); write(chr(179));
  93.   end;
  94.   GotoXY(x1,y2); write(chr(192));
  95.   FOR j:= x1+1 TO x2-1 DO write(chr(196));
  96.   write(chr(217));
  97. end;   { proc set_Rahmen }
  98.  
  99.  
  100. procedure install_Windows;
  101. var i,j:integer;
  102. begin
  103.   set_Rahmen(1,1,26,23);
  104.   GotoXY(3,1); Write(' Lese- / Keller-Band ');
  105.   set_Rahmen(27,1,80,17);
  106.   GotoXY(40,1); Write(' Kellerautomaten-Zustände ');
  107.   set_Rahmen(27,18,53,23);
  108.   GotoXY(28,18); Write(' Neuer Maschinen-Zustand ');
  109.   set_Rahmen(54,18,80,20);
  110.   GotoXY(58,18); Write(' Lese-Band-Stelle ');
  111.   set_Rahmen(54,21,80,23);
  112.   GotoXY(57,21); Write(' Band-Lauf-Frequenz ');
  113. end;  { proc install_Windows }
  114.  
  115.  
  116. procedure set_Window(i:integer);
  117. begin
  118.   Window(1,1,80,25);
  119.   case i of
  120.     0 : Window(1,1,80,25);
  121.    13 : Window(28,2,79,16);         { Automaten - Zustände }
  122.     2 : begin                    { Neuer Maschinen-Zustand }
  123.           set_Color(1); Window(28,19,52,22);
  124.         end;
  125.    21 : begin                           { Lese-Band-Stelle }
  126.           set_Color(1);
  127.           Window(55,19,79,20); GotoXY(13,1);
  128.         end;
  129.    23 : begin                         { Band-Lauf-Frequenz }
  130.           set_Color(1);
  131.           Window(55,22,79,23); GotoXY(12,1);
  132.         end;
  133.     3 : begin                    { Eingabe/Anfrage - Zeile }
  134.           Window(1,24,80,25); set_Color(1);
  135.           GotoXY(1,1); Write('>> '); ClrEol;
  136.         end;
  137.     4 : begin                    { Eingabe/Anfrage - Zeile }
  138.           set_Color(1);
  139.           Window(1,24,80,25); GotoXY(1,1);
  140.           Write('>> '); ClrEol; set_Color(2);
  141.           GotoXY(1,2); ClrEol;
  142.         end;
  143.     5 : begin
  144.           Window(2,2,25,22); LowVideo;
  145.           GotoXY(1,11); Write('==>   <==');
  146.           GotoXY(21,6); Write('<===');
  147.         end;
  148.    { Lese-Band }
  149.    51 : begin Window(6,2,7,22); LowVideo; end;
  150.    { Keller-Band }
  151.    52 : begin Window(19,2,20,22); LowVideo; end;
  152.     6 : begin { Richtungspfeil nach unten (Lese-Band) }
  153.           Window(2,2,25,22); LowVideo;
  154.           GotoXY(8,16); Write('Richtung:');
  155.           GotoXY(9,18); Write('║');
  156.           GotoXY(9,19); Write('║');
  157.           GotoXY(9,20); Write(chr(31));
  158.         end;
  159.    61 : begin { Richtungspfeil nach unten (Keller-Band) }
  160.           Window(2,2,25,22); HighVideo;
  161.           GotoXY(14,18); Write('║');
  162.           GotoXY(14,19); Write('║');
  163.           GotoXY(14,20); Write(chr(31));
  164.         end;
  165.    62 : begin { Richtungspfeil nach oben (Keller-Band) }
  166.           Window(2,2,25,22); HighVideo;
  167.           GotoXY(14,18); Write(chr(30));
  168.           GotoXY(14,19); Write('║');
  169.           GotoXY(14,20); Write('║');
  170.         end;
  171.    63 : begin { Richtungspfeil beenden (Lese-/Keller-Band) }
  172.           Window(2,2,25,22); LowVideo;
  173.           GotoXY(9,18); Write('║    ║');
  174.           GotoXY(9,19); Write('║    ║');
  175.           GotoXY(9,20); Write('║    ║');
  176.         end;
  177.   end;
  178. end;  { proc set_Window }
  179.  
  180.  
  181. function Datei_einlesen(var Max_Befehle:integer;
  182.                         var Befehl:asaetze):boolean;
  183. var i:integer; flag:boolean;
  184. begin
  185.    Datei_einlesen:=false; flag:=false; i:=0;
  186.    Repeat
  187.      set_Window(4);
  188.      GotoXY(22,2);
  189.      Write('Datei des auszuführenden Automaten?');
  190.      set_Color(1);
  191.      GotoXY(4,1); ReadLn(DosDatei);
  192.      Assign(Datei,DosDatei);
  193.      {$I-} Reset(Datei); {$I+}
  194.      if IOresult=0 then
  195.      begin
  196.        while not(eof(Datei)) do begin
  197.          Max_Befehle:=Max_Befehle+1;
  198.          with Befehl[Max_Befehle] Do
  199.           ReadLn(datei,regel,afiller,code,bfiller,keller,
  200.                 cfiller,keller_eintrag,dfiller,verzweigung);
  201.        end;
  202.        close(Datei);
  203.        flag:=true;
  204.        Datei_einlesen:=true;
  205.      end
  206.      else begin
  207.        set_Window(3); GotoXY(4,1);
  208.        Write(' Automat: ',DosDatei,' ist auf Diskette/');
  209.        Write('Platte nicht verfügbar!');
  210.        Delay(3000);
  211.        i:=i+1;
  212.        if i=3 then abbruch:=true;
  213.      end;
  214.    Until flag or Abbruch;
  215. end;  { proc Datei_einlesen }
  216.  
  217.  
  218. Procedure Automaten_Druck(Befehl:asaetze;
  219.                           Max_Befehle:integer);
  220. var j,Zeile,Spalte:integer;
  221. begin
  222.   LowVideo; set_Window(13); j:=0;
  223.   Zeile:=1; Spalte:=4;
  224.   Repeat
  225.     Delay(50);
  226.     j:=j+1;
  227.     if j>1000 then HALT; { = zur Gefahren-Verhütung }
  228.     GotoXY(Spalte,Zeile);
  229.     Zeile:=Zeile+1;
  230.     With Befehl[j] Do if j<=75 then
  231.       Write(regel,afiller,code,bfiller,keller,
  232.             cfiller,keller_eintrag,dfiller,verzweigung);
  233.     if Zeile=16 then
  234.       begin Zeile:=1; Spalte:=Spalte+16; end;
  235.   Until (j>=Max_Befehle) or (Spalte>50);
  236.   HighVideo;
  237. end;  { proc Automaten_Druck }
  238.  
  239.  
  240. Procedure Zustand_Drucken(var Spalte,Zeile,j_Merker:integer;
  241.                          Befehl:asaetze; Befehl_Nr:integer);
  242. begin
  243.   set_Window(13); GotoXY(Spalte,Zeile);
  244.   LowVideo;
  245.   With Befehl[j_Merker] Do
  246.     Write(regel,afiller,code,bfiller,keller,
  247.           cfiller,keller_eintrag,dfiller,verzweigung);
  248.   HighVideo;
  249.   Case Befehl_Nr of
  250.     1..15  : Spalte:=4;
  251.     8..30 : Spalte:=20;
  252.    15..45 : Spalte:=36;
  253.    else Spalte:=36;
  254.   end;
  255.   Case Befehl_Nr of
  256.     1..15 : Zeile:=Befehl_Nr;
  257.    16..30 : Zeile:=Befehl_Nr-15;
  258.    31..45 : Zeile:=Befehl_Nr-30;
  259.    else Zeile:=15;
  260.   end;
  261.   set_Window(13); GotoXY(Spalte,Zeile);
  262.   With Befehl[Befehl_Nr] Do
  263.     Write(regel,afiller,code,bfiller,keller,
  264.           cfiller,keller_eintrag,dfiller,verzweigung);
  265.   LowVideo; j_Merker:=Befehl_Nr;
  266. end;  { proc Zustand_Drucken }
  267.  
  268.  
  269. PROCEDURE BandStellenDruck(Druckstelle:Band_Fortsetzung;
  270.                            art:char);
  271. begin
  272.   Case Art of
  273.     'r' : begin
  274.             set_Window(51); GotoXY(1,1); InsLine;
  275.             Write(Druckstelle^.St);
  276.           end;
  277.     'R' : begin
  278.             set_Window(52); GotoXY(1,1);
  279.             InsLine; Write('■');
  280.             GotoXY(1,6); Write(Druckstelle^.St);
  281.           end;
  282.     'L' : begin
  283.             set_Window(52); GotoXY(1,1); DelLine;
  284.           end;
  285.     'Z' : begin
  286.             set_Window(52); GotoXY(1,6);
  287.             Write(Druckstelle^.St);
  288.           end;
  289.     'z' : begin
  290.             set_Window(52); GotoXY(1,21);
  291.             Write(Druckstelle^.St);
  292.           end;
  293.     '■' : begin
  294.             set_Window(51); GotoXY(1,11);
  295.             Write(Druckstelle^.St);
  296.           end;
  297.     'g' : begin
  298.             set_Window(51); GotoXY(1,1);
  299.             InsLine; Write(Druckstelle^.St); Delay(100);
  300.           end;
  301.     'k' : begin
  302.             set_Window(52); GotoXY(1,1);
  303.             InsLine; Write(Druckstelle^.St); Delay(100);
  304.           end;
  305.     else begin   end;
  306.   end;
  307. end;  { proc BandStellenDruck }
  308.  
  309.  
  310. Procedure Band_Generierung(Anzahl:integer; Art_str:str_1);
  311. var i : integer;
  312. begin
  313.   if Art_str<>Chr(254) then
  314.   begin
  315.     for i:=1 to Anzahl do
  316.     begin
  317.       new(Next);
  318.       Schreibkopf^.Right:=Next;
  319.       Next^.Left:=Schreibkopf;
  320.       Schreibkopf:=Next;
  321.       Band_Stellenzahl:=Band_Stellenzahl+1;
  322.       Schreibkopf^.St:=Art_str;
  323.       Schreibkopf^.St_Nr:=Band_Stellenzahl;
  324.       Next:=nil;
  325.       BandStellenDruck(Schreibkopf,'g');
  326.     end
  327.   end
  328.   else begin
  329.     for i:=1 to Anzahl do
  330.     begin
  331.       new(Next);
  332.       Schreibkopf^.Right:=Next;
  333.       Next^.Left:=Schreibkopf;
  334.       Schreibkopf:=Next;
  335.       Band_Stellenzahl:=Band_Stellenzahl+1;
  336.       if i=1 then Schreibkopf^.St:='s'
  337.         else Schreibkopf^.St:=Art_str;
  338.       Schreibkopf^.St_Nr:=Band_Stellenzahl;
  339.       Next:=nil;
  340.       BandStellenDruck(Schreibkopf,'g');
  341.     end
  342.   end;
  343. end; { proc Band_Generierung }
  344.  
  345.  
  346. Procedure Band_Eingabe;
  347. Begin
  348.   Repeat
  349.     set_Window(4); GotoXY(3,2);
  350.     Write('Welches Zeichen:   ''0'' für Nullen, ''1'' für ');
  351.     Write('Einsen bzw. ''2'' Endzeichen setzen');
  352.     set_Window(3); GotoXY(4,1); ReadLn(Art_str);
  353.     if Art_str='2' then Art_str:=Chr(254);
  354.     if Art_str<>Chr(254) then begin
  355.       GotoXY(4,1); ClrEol;
  356.       set_Window(4); GotoXY(28,2);
  357.       Write('Anzahl dieses Zeichens?');
  358.       set_Window(3); GotoXY(4,1); ReadLn(Anzahl);
  359.     end
  360.     else Anzahl:=1;
  361.     GotoXY(4,1); ClrEol;
  362.     Band_Generierung(Anzahl,Art_str);
  363.   Until Art_str=Chr(254);
  364.   set_Window(3); GotoXY(1,2); ClrEol;
  365.  
  366.   set_Window(4); GotoXY(22,2);
  367.   Write('Anfangszustand ist die Band-Stelle: 1 ');
  368.   Delay(2000); SchreibkopfStelle:=1;
  369.   set_Window(4); GotoXY(19,2);
  370.   Write('Geben Sie die Ablaufgeschwindigkeit an ');
  371.   set_Window(3); GotoXY(4,1); ReadLn(Frequenz);
  372. End;  { proc Band_Eingabe }
  373.  
  374.  
  375. procedure Neuer_Zustand_BandStelle;
  376. begin
  377.   set_Window(2); LowVideo;
  378.   With Befehl[Befehl_Nr] Do begin
  379.     GotoXY(7,1); DelLine; GotoXY(7,4);
  380.     Write(regel,afiller,code,bfiller,keller,
  381.           cfiller,keller_eintrag,dfiller,verzweigung);
  382.   end;
  383.   set_Window(21); LowVideo;
  384.   BandStelle:=BandStelle+1; Write(BandStelle);
  385. end; { proc Neuer_Zustand_BandStelle }
  386.  
  387.  
  388. procedure Maschinen_Lauf;
  389. var c,
  390.     Spalte,Zeile,
  391.     Richtung,
  392.     j_Merker      : integer;
  393. begin
  394.   Richtung:=0;
  395.   Regel_Nr:='000'; m:='0'; c:=0;
  396.   j_Merker:=1; Spalte:=4; Zeile:=1;
  397.   set_Window(51); GotoXY(1,1);
  398.   for j:=1 to 21 do DelLine; { Window-Inhalt löschen }
  399.   Delay(500); set_Window(5);
  400.   Delay(700); set_Window(51);
  401.   DruckStelle:=Band_Anfang;
  402.   DruckStelle2:=Band_Anfang2;
  403.   BandStelle:=SchreibkopfStelle;
  404.   BandStelle2:=SchreibkopfStelle;
  405.   Delay(200);
  406.  
  407.   { Herstellen/Ausdrucken Leseband bis obere Window-Grenze }
  408.   for j:=DruckStelle^.St_Nr to SchreibkopfStelle+9 do
  409.   begin
  410.     if DruckStelle^.St_Nr<Band_Ende^.St_Nr then
  411.     begin
  412.       DruckStelle:=DruckStelle^.Right;
  413.       BandStellenDruck(DruckStelle,'g');
  414.     end
  415.     else if DruckStelle^.St_Nr=Band_Ende^.St_Nr then begin
  416.       new(Next);
  417.       Band_Ende^.Right:=Next; Next^.Left:=Band_Ende;
  418.       Band_Ende:=Next; Band_Stellenzahl:=Band_Stellenzahl+1;
  419.       Band_Ende^.St_Nr:=Band_Stellenzahl;
  420.       Band_Ende^.St:='■';
  421.       DruckStelle:=Next; Next:=nil;
  422.       BandStellenDruck(DruckStelle,'g');
  423.     end
  424.     else begin
  425.       set_Window(5); GotoXY(4,1);
  426.       Write('Lauf-Fehler! Abbruch des Programms!');
  427.       HALT;
  428.     end;
  429.   end;
  430.  
  431.   Schreibkopf:=Band_Anfang;
  432.   while SchreibkopfStelle>Schreibkopf^.St_Nr do
  433.      Schreibkopf:=Schreibkopf^.Right;
  434.   Next:=Schreibkopf; Before:=Schreibkopf;
  435.   for j:=1 to 10 do begin
  436.     if not (Next^.St_Nr=Band_Ende^.St_Nr) then
  437.        Next:=Next^.Right;
  438.   end;
  439.   for j:=1 to 10 do begin
  440.     if not (Before^.St_Nr=Band_Anfang^.St_Nr) then
  441.       Before:=Before^.Left;
  442.   end;
  443.  
  444.   { Herstellen/Ausdrucken Kellerband bis obere Window-Grenze }
  445.   Delay(300); new(Next2);
  446.   Band_Ende2^.Right:=Next2;
  447.   Next2^.Left:=Band_Ende2;
  448.   Band_Ende2:=Next2;
  449.   Band_Stellenzahl2:=Band_Stellenzahl2+1;
  450.   Band_Ende2^.St_Nr:=Band_Stellenzahl2;
  451.   Band_Ende2^.St:='k';
  452.   DruckStelle2:=Next2;
  453.   Schreibkopf2:=Next2; Next2:=nil;
  454.   BandStellenDruck(DruckStelle2,'k');
  455.   for j:=Band_Anfang2^.St_Nr to 4 do
  456.   begin
  457.     if DruckStelle2^.St_Nr=Band_Ende2^.St_Nr then begin
  458.       new(Next2);
  459.       Band_Ende2^.Right:=Next2;
  460.       Next2^.Left:=Band_Ende2;
  461.       Band_Ende2:=Next2;
  462.       Band_Stellenzahl2:=Band_Stellenzahl2+1;
  463.       Band_Ende2^.St_Nr:=Band_Stellenzahl2;
  464.       Band_Ende2^.St:='■';
  465.       DruckStelle2:=Next2; Next2:=nil;
  466.       BandStellenDruck(DruckStelle2,'k');
  467.     end
  468.     else begin
  469.       set_Window(5); GotoXY(4,1);
  470.       Write('Lauf-Fehler! Abbruch des Programms!');
  471.       Delay(2000);
  472.       HALT;
  473.     end;
  474.   end;
  475.  
  476.   Next2:=Schreibkopf2; Before2:=Schreibkopf2;
  477.   for j:=1 to 10 do begin
  478.     if not (Next2^.St_Nr=Band_Ende2^.St_Nr) then
  479.        Next2:=Next2^.Right;
  480.   end;
  481.   for j:=1 to 10 do begin
  482.     if not (Before2^.St_Nr=Band_Anfang2^.St_Nr) then
  483.        Before2:=Before2^.Left;
  484.   end;
  485.  
  486.   set_Window(23); GotoXY(12,1); LowVideo; Write(Frequenz);
  487.   set_Window(21); LowVideo; Write(BandStelle);
  488.  
  489.   set_Window(3); GotoXY(4,1); ClrEol;
  490.   set_Window(4); GotoXY(25,2);
  491.   Write(' START mit beliebiger Taste ');
  492.   Repeat aa:=Readjez Until aa<>'?';
  493.   set_Window(3); GotoXY(4,1); ClrEol;
  494.   set_Window(4); GotoXY(25,2);
  495.   Write(' HALT mit beliebiger Taste ');
  496.   set_Color(1); set_Window(6);
  497.  
  498.  
  499.   Repeat
  500.  
  501.   Delay(Frequenz);
  502.  
  503.   if not Abbruch then begin
  504.    Repeat Befehl_Nr:=Befehl_Nr+1;
  505.           c:=c+1; if c>1000 then Abbruch:=true;
  506.           if Befehl_Nr>Max_Befehle then Befehl_Nr:=1;
  507.           k:=Befehl[Befehl_Nr].regel;
  508.           l:=Befehl[Befehl_Nr].code;
  509.           i:=Befehl[Befehl_Nr].keller;
  510.    Until ((Regel_Nr=k) and (Schreibkopf^.St=l) and
  511.                           (Schreibkopf2^.St=i)) or Abbruch;
  512.   end;
  513.  
  514.   if not Abbruch then begin
  515.    Zustand_Drucken(Spalte,Zeile,j_Merker,Befehl,Befehl_Nr);
  516.    Neuer_Zustand_BandStelle;
  517.  
  518.    { Leseband lesen + um eins nach rechts }
  519.    if not (Schreibkopf^.St='■') and
  520.       not (Schreibkopf^.St='s')        then
  521.    begin
  522.      if (Next^.St_Nr=Band_Ende^.St_Nr) then
  523.      begin
  524.        new(Neues_Element);
  525.        Band_Ende^.Right:=Neues_Element;
  526.        Neues_Element^.Left:=Band_Ende;
  527.        Band_Ende:=Neues_Element;
  528.        Neues_Element:=nil;
  529.        Band_Stellenzahl:=Band_Stellenzahl+1;
  530.        Band_Ende^.St:='■';
  531.        Band_Ende^.St_Nr:=Band_Stellenzahl;
  532.      end;
  533.      if Schreibkopf^.St_Nr-10=Before^.St_Nr then
  534.         Before:=Before^.Right;
  535.      Next:=Next^.Right;
  536.      Schreibkopf:=Schreibkopf^.Right;
  537.      art:='r'; BandStellenDruck(Next,art);
  538.    end;
  539.  
  540.    { Schreibband beschreiben + um eins nach rechts }
  541.    with Befehl[Befehl_Nr] do
  542.    begin
  543.     if (Keller_Eintrag<>'■') then
  544.     begin
  545.      if Richtung<>1 then
  546.        begin set_Window(61); Richtung:=1 end;
  547.      if (Keller='k') and (Keller_Eintrag<>'■') and
  548.         not (Keller_Eintrag='k') then begin
  549.       if Next2^.St_Nr=Band_Ende2^.St_Nr then
  550.       begin
  551.         new(Neues_Element2);
  552.         Band_Ende2^.Right:=Neues_Element2;
  553.         Neues_Element2^.Left:=Band_Ende2;
  554.         Band_Ende2:=Neues_Element2;
  555.         Neues_Element2:=nil;
  556.         Band_Stellenzahl2:=Band_Stellenzahl2+1;
  557.         Band_Ende2^.St:='■';
  558.         Band_Ende2^.St_Nr:=Band_Stellenzahl2;
  559.       end;
  560.       if Schreibkopf2^.St_Nr-16=Before2^.St_Nr then
  561.         Before2:=Before2^.Right;
  562.       Next2:=Next2^.Right;
  563.       Schreibkopf2:=Schreibkopf2^.Right;
  564.       Schreibkopf2^.St:=Keller_Eintrag;
  565.       art:='R'; BandStellenDruck(Schreibkopf2,art);
  566.      end
  567.      else if (Keller<>'k') and (Keller_Eintrag<>'■') then
  568.       begin
  569.       if Next2^.St_Nr=Band_Ende2^.St_Nr then
  570.       begin
  571.         new(Neues_Element2);
  572.         Band_Ende2^.Right:=Neues_Element2;
  573.         Neues_Element2^.Left:=Band_Ende2;
  574.         Band_Ende2:=Neues_Element2;
  575.         Neues_Element2:=nil;
  576.         Band_Stellenzahl2:=Band_Stellenzahl2+1;
  577.         Band_Ende2^.St:='■';
  578.         Band_Ende2^.St_Nr:=Band_Stellenzahl2;
  579.       end;
  580.       if Schreibkopf2^.St_Nr-16=Before2^.St_Nr then
  581.         Before2:=Before2^.Right;
  582.       Next2:=Next2^.Right;
  583.       Schreibkopf2:=Schreibkopf2^.Right;
  584.       Schreibkopf2^.St:=Keller_Eintrag;
  585.       art:='R'; BandStellenDruck(Schreibkopf2,art);
  586.      end;
  587.     end;
  588.  
  589.     if (Keller_Eintrag='■') then
  590.     begin
  591.      if Richtung<>2 then
  592.        begin set_Window(62); Richtung:=2; end;
  593.      if (Keller<>'k') and (Keller_Eintrag='■') then begin
  594.       Schreibkopf2^.St:=Keller_Eintrag;
  595.       art:='Z'; BandStellendruck(Schreibkopf2,art);
  596.       Schreibkopf2:=Schreibkopf2^.Left; Next2:=Next2^.Left;
  597.       art:='L'; BandStellendruck(Schreibkopf2,art);
  598.       if Before2^.St_Nr-1>Band_Anfang2^.St_Nr then
  599.       begin
  600.         Before2:=Before2^.Left;
  601.         art:='z'; BandStellenDruck(Before2,art);
  602.       end;
  603.      end;
  604.     end;
  605.  
  606.     if (Keller='k') and (Keller_Eintrag='k') then begin
  607.       Schreibkopf2^.St:=Keller_Eintrag;
  608.       art:='Z'; BandStellendruck(Schreibkopf2,art);
  609.       Ende:=true;
  610.     end;
  611.    end;
  612.  
  613.    Regel_Nr:=Befehl[Befehl_Nr].Verzweigung;
  614.   end;
  615.  
  616.   Until (Befehl[Befehl_Nr].code='s') or Ende or Abbruch;
  617. end;  { proc Maschinen_Lauf }
  618.  
  619.  
  620. procedure End_Kommentar;
  621. begin
  622.   set_Window(63); Delay(100);
  623.   if Befehl[Befehl_Nr].code='s' then
  624.   begin
  625.     set_Window(4); GotoXY(22,2);
  626.     Write('Halten des Keller-Automaten im Endzustand');
  627.   end
  628.   else begin
  629.     set_Window(4); GotoXY(7,2);
  630.     Write('Vorzeitiges Halten! Das Band-Wort gehört ');
  631.     Write('nicht zum Keller-Automaten!');
  632.   end;
  633.   Repeat aa:=Readjez Until aa<>'?';
  634.   Delay(5000);
  635. end;  { proc End_Kommentar }
  636.  
  637.  
  638. Procedure Cursor(i:integer);
  639. begin
  640.    Case i of
  641.     1 : HiddenCursor;
  642.     2 : BlockCursor;
  643.     else end;
  644. end;  { proc Cursor }
  645.  
  646.  
  647. procedure initialisieren;
  648. begin
  649.   Abbruch:=false; Ende:=false;
  650.   Window(1,1,80,25); ClrScr;
  651.   j:=0; Zahl:='0'; Max_Befehle:=0; Befehl_Nr:=0;
  652. end;  { proc initialisieren }
  653.  
  654.  
  655. begin   { - - - - -  H A U P T P R O G R A M M  - - - - - }
  656.   initialisieren; install_Windows; set_Window(11); Cursor(1);
  657.  
  658.   if Datei_Einlesen(Max_Befehle,Befehl) then
  659.     Automaten_Druck(Befehl,Max_Befehle)
  660.   else begin
  661.     set_Window(3); GotoXY(4,1);
  662.     Write('Keine Datei konnte eingelesen werden!');
  663.     Delay(2000);
  664.   end;
  665.  
  666.   if not Abbruch then begin
  667.     new(Band_Anfang); Schreibkopf:=Band_Anfang;
  668.     Band_Anfang^.St:='■'; Band_Anfang^.St_Nr:=0;
  669.     new(Band_Anfang2); Schreibkopf2:=Band_Anfang2;
  670.     Band_Anfang2^.St:='■'; Band_Anfang2^.St_Nr:=0;
  671.     Band_Stellenzahl:=0; Band_Stellenzahl2:=0; art:=' ';
  672.     SchreibkopfStelle:=0;
  673.  
  674.     Delay(600); Band_Eingabe;
  675.  
  676.     Band_Ende:=nil;          Band_Ende:=Schreibkopf;
  677.     Schreibkopf:=nil;        Schreibkopf:=Band_Anfang;
  678.     Next:=nil;               Next:=Band_Anfang;
  679.     Next:=Next^.Right;
  680.     Band_Ende2:=nil;          Band_Ende2:=Schreibkopf2;
  681.     Schreibkopf2:=nil;        Schreibkopf2:=Band_Anfang2;
  682.     Next2:=nil;               Next2:=Band_Anfang2;
  683.     Next2:=Next2^.Right;
  684.  
  685.     Maschinen_Lauf;
  686.  
  687.     End_Kommentar;
  688.   end;
  689.  
  690.   set_Window(0); GotoXY(1,1); Cursor(2);
  691. end.  { program Keller_Automat_Interpreter }
  692.