home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 21 / a_auto / a_auto.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-10-27  |  13.8 KB  |  498 lines
  1.  
  2. Program endliche_Maschine_ohne_Ausgabe;
  3.  
  4. uses tpcrt;
  5.  
  6. type Band_Fortsetzung = ^Band_Stelle;
  7.  
  8.      Band_Stelle = Record
  9.                       Stelle      : string[10];
  10.                       Stellen_Nr  : integer;
  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.                   verzweigung: string[3]
  21.                end;
  22.      asaetze = array[1..100] of saetze;
  23.  
  24.      str_1  = string[1];
  25.      str_3  = string[3];
  26.      str_10 = string[10];
  27.      str_12 = string[12];
  28.  
  29. var  j,
  30.      Stelle,
  31.      Befehl_Nr,
  32.      Max_Befehle        : integer;
  33.      Befehl             : asaetze;
  34.      Datei              : text;
  35.      DosDatei           : str_12;
  36.      Abbruch            : boolean;
  37.      Band_Anfang,
  38.      Schreibkopf,
  39.      Band_Ende,
  40.      DruckStelle,
  41.      Before,Next,
  42.      Neues_Element       : Band_Fortsetzung;
  43.      Laenge,
  44.      Anzahl,
  45.      Frequenz,
  46.      BandStelle,
  47.      Band_Stellenzahl,
  48.      SchreibkopfStelle,
  49.      Zaehler             : integer;
  50.      m,
  51.      l,
  52.      Art_str,
  53.      Ende                : str_1;
  54.      k,
  55.      Regel_Nr            : str_3;
  56.      Zahl                : str_10;
  57.      Art,aa              : char;
  58.  
  59. { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  60.  
  61.  
  62. procedure Set_Color(i:integer);
  63. begin
  64.   case i of
  65.     1 : begin TextColor(White); TextBackGround(Black); end;
  66.     2 : begin TextColor(Black); TextBackGround(White); end;
  67.   end;
  68. end;  { proc set_Color }
  69.  
  70.  
  71. procedure set_Rahmen(x1,y1,x2,y2:integer);
  72. var j:integer;
  73. begin
  74.   j:=0;
  75.   GotoXY(x1,y1); write(chr(218));
  76.   FOR j:=x1+1 TO x2-1 DO write(chr(196));
  77.   write(chr(191));
  78.   FOR j:=y1+1 TO y2-1 DO
  79.   begin
  80.      GotoXY(x1,j); write(chr(179));
  81.      GotoXY(x2,j); write(chr(179));
  82.   end;
  83.   GotoXY(x1,y2); write(chr(192));
  84.   FOR j:= x1+1 TO x2-1 DO write(chr(196));
  85.   write(chr(217));
  86. end;   { proc set_Rahmen }
  87.  
  88.  
  89. procedure install_Windows;
  90. var i,j:integer;
  91. begin
  92.   set_Rahmen(1,1,26,23);
  93.   GotoXY(8,1); Write(' Lese-Band ');
  94.   set_Rahmen(27,1,80,17);
  95.   GotoXY(43,1); Write(' Automaten-Zustände ');
  96.   set_Rahmen(27,18,53,23);
  97.   GotoXY(28,18); Write(' Neuer Maschinen-Zustand ');
  98.   set_Rahmen(54,18,80,20);
  99.   GotoXY(58,18); Write(' Lese-Band-Stelle ');
  100.   set_Rahmen(54,21,80,23);
  101.   GotoXY(57,21); Write(' Band-Lauf-Frequenz ');
  102. end;  { proc install_Windows }
  103.  
  104.  
  105. procedure Set_Window(i:integer);
  106. begin
  107.   Window(1,1,80,25);
  108.   case i of
  109.     0 : Window(1,1,80,25);
  110.    13 : Window(28,2,79,16);         { Automaten - Zustände }
  111.     2 : begin                    { Neuer Maschinen-Zustand }
  112.           Set_Color(1); Window(28,19,52,22);
  113.         end;
  114.    21 : begin                           { Lese-Band-Stelle }
  115.           Set_Color(1);
  116.           Window(55,19,79,20); GotoXY(13,1);
  117.         end;
  118.    23 : begin                         { Band-Lauf-Frequenz }
  119.           Set_Color(1);
  120.           Window(55,22,79,23); GotoXY(12,1);
  121.         end;
  122.     3 : begin                    { Eingabe/Anfrage - Zeile }
  123.           Window(1,24,80,25); Set_Color(1);
  124.           GotoXY(1,1); Write('>> '); ClrEol;
  125.         end;
  126.     4 : begin                    { Eingabe/Anfrage - Zeile }
  127.           Set_Color(1);
  128.           Window(1,24,80,25); GotoXY(1,1);
  129.           Write('>> '); ClrEol; Set_Color(2);
  130.           GotoXY(1,2); ClrEol;
  131.         end;
  132.     5 : begin
  133.           Window(2,2,25,22); LowVideo;
  134.           GotoXY(1,11); Write('==>         <== LeseKopf');
  135.         end;
  136.    51 : begin Window(6,2,12,22); LowVideo; end;
  137.   end;
  138. end;  { proc set_Window }
  139.  
  140.  
  141. function Datei_einlesen(var Max_Befehle:integer;
  142.                          var Befehl:asaetze):boolean;
  143. var i:integer; flag:Boolean;
  144. begin
  145.    Datei_einlesen:=false; flag:=false; i:=0;
  146.    Repeat
  147.      Set_Window(4); GotoXY(22,2);
  148.      Write('Datei des auszuführenden Automaten?');
  149.      Set_Color(1); GotoXY(4,1); ReadLn(DosDatei);
  150.      Assign(Datei,DosDatei);
  151.      {$I-} Reset(Datei); {$I+}
  152.      if IOresult=0 then
  153.      begin
  154.        While not(eof(Datei)) do
  155.        begin
  156.           Max_Befehle:=Max_Befehle+1;
  157.           With Befehl[Max_Befehle] Do
  158.           ReadLn(datei,regel,afiller,
  159.                        code,bfiller,verzweigung);
  160.        end;
  161.        close(Datei);
  162.        flag:=true;
  163.        Datei_einlesen:=true;
  164.      end
  165.      else begin
  166.        Set_Window(3); GotoXY(4,1);
  167.        Write(' Automat: ',DosDatei,' ist auf Diskette/');
  168.        Write('Platte nicht verfügbar!');
  169.        i:=i+1;
  170.        if i=4 then Abbruch:=true;
  171.        Delay(3000);
  172.      end;
  173.    Until flag or Abbruch;
  174. end;  { func Datei_einlesen }
  175.  
  176.  
  177. Procedure Automaten_Druck(Befehl:asaetze;
  178.                             Max_Befehle:integer);
  179. var j,Zeile,Spalte:integer;
  180. begin
  181.   LowVideo; Set_Window(13); Zeile:=1; Spalte:=2;
  182.   For j:=1 TO Max_Befehle Do begin
  183.     Delay(50);
  184.     GotoXY(Spalte,Zeile); Zeile:=Zeile+1;
  185.     With Befehl[j] Do if j<=75 then
  186.       Write(regel,afiller,code,bfiller,verzweigung);
  187.     IF Zeile=16 THEN begin Zeile:=1; Spalte:=Spalte+10; end;
  188.   end;
  189.   HighVideo;
  190. end;  { proc Automaten_Druck }
  191.  
  192.  
  193. Procedure Zustand_drucken(var Spalte,Zeile,j_Merker:integer;
  194.                           Befehl:asaetze; Befehl_Nr:integer);
  195. begin
  196.   Set_Window(13); GotoXY(Spalte,Zeile);
  197.   LowVideo;
  198.   With Befehl[j_Merker] Do
  199.       Write(regel,afiller,code,bfiller,verzweigung);
  200.   HighVideo;
  201.   Case Befehl_Nr of
  202.     1..15  : Spalte:=2;
  203.     8..30 : Spalte:=12;
  204.    15..45 : Spalte:=22;
  205.    22..60 : Spalte:=32;
  206.    29..75 : Spalte:=42;
  207.   end;
  208.   Case Befehl_Nr of
  209.     1..15 : Zeile:=Befehl_Nr;
  210.    16..30 : Zeile:=Befehl_Nr-15;
  211.    31..45 : Zeile:=Befehl_Nr-30;
  212.    46..60 : Zeile:=Befehl_Nr-45;
  213.    61..75 : Zeile:=Befehl_Nr-60;
  214.   end;
  215.   Set_Window(13); GotoXY(Spalte,Zeile);
  216.   With Befehl[Befehl_Nr] Do
  217.       Write(regel,afiller,code,bfiller,verzweigung);
  218.   LowVideo; j_Merker:=Befehl_Nr;
  219. end;  { proc Zustand_drucken }
  220.  
  221.  
  222. procedure BandStellenDruck(Druckstelle:Band_Fortsetzung;
  223.                                                  art:char);
  224. begin
  225.   Case Art of
  226.    'r' : begin
  227.       Set_Window(51); GotoXY(1,1); InsLine;
  228.       if Druckstelle^.Stellen_Nr mod 5 = 0 then
  229.         Write(Druckstelle^.Stelle,'  ',Druckstelle^.Stellen_Nr)
  230.       else Write(Druckstelle^.Stelle);
  231.       end;
  232.    '■' : begin
  233.       Set_Window(51); GotoXY(1,11);
  234.       if Druckstelle^.Stellen_Nr mod 5 = 0 then
  235.         Write(Druckstelle^.Stelle,'  ',Druckstelle^.Stellen_Nr)
  236.       else Write(Druckstelle^.Stelle);
  237.       end;
  238.    'g' : begin
  239.       Set_Window(51); GotoXY(1,1);
  240.       if Druckstelle^.Stellen_Nr mod 5 = 0 then
  241.       begin
  242.         InsLine;
  243.         Write(Druckstelle^.Stelle,'  ',Druckstelle^.Stellen_Nr);
  244.         Delay(100);
  245.       end
  246.       else begin
  247.         InsLine; Write(Druckstelle^.Stelle); Delay(100);
  248.       end;
  249.    end
  250.    else  end;
  251. end;  { proc BandStellenDruck }
  252.  
  253.  
  254. Procedure Band_Generierung(Anzahl:integer; Art_str:str_1);
  255. var i:integer;
  256. begin
  257.   if Art_str<>Chr(254) then
  258.   begin
  259.     for i:=1 to Anzahl do
  260.     begin
  261.       new(Next);
  262.       Schreibkopf^.Right:=Next;
  263.       Next^.Left:=Schreibkopf;
  264.       Schreibkopf:=Next;
  265.       Band_Stellenzahl:=Band_Stellenzahl+1;
  266.       Schreibkopf^.Stelle:=Art_str;
  267.       Schreibkopf^.Stellen_Nr:=Band_Stellenzahl;
  268.       Next:=nil;
  269.       BandStellenDruck(Schreibkopf,'g');
  270.     end
  271.   end
  272.   else begin
  273.     for i:=1 to Anzahl do
  274.     begin
  275.       new(Next);
  276.       Schreibkopf^.Right:=Next;
  277.       Next^.Left:=Schreibkopf;
  278.       Schreibkopf:=Next;
  279.       Band_Stellenzahl:=Band_Stellenzahl+1;
  280.       if i=1 then Schreibkopf^.Stelle:='s'
  281.         else Schreibkopf^.Stelle:=Art_str;
  282.       Schreibkopf^.Stellen_Nr:=Band_Stellenzahl;
  283.       Next:=nil;
  284.       BandStellenDruck(Schreibkopf,'g');
  285.     end
  286.   end;
  287. end; { proc Band_Generierung }
  288.  
  289.  
  290. Procedure Band_Eingabe;
  291. begin
  292.   Repeat
  293.     Set_Window(4); GotoXY(2,2);
  294.     Write('Welches Zeichen:   ''0'' für Nullen, ''1'' für ');
  295.     Write('Einsen bzw. ''2'' für Leerzeichen ''■''');
  296.     Set_Window(3); GotoXY(4,1); ReadLn(Art_str);
  297.     if Art_str='2' then Art_str:=Chr(254);
  298.     if Art_str<>Chr(254) then
  299.     begin
  300.       GotoXY(4,1); ClrEol;
  301.       Set_Window(4); GotoXY(28,2);
  302.       Write('Anzahl dieses Zeichens?');
  303.       Set_Window(3); GotoXY(4,1); ReadLn(Anzahl);
  304.     end
  305.     else Anzahl:=1;
  306.     GotoXY(4,1); ClrEol;
  307.     Band_Generierung(Anzahl,Art_str);
  308.   Until Art_str=Chr(254);
  309.   Set_Window(3); GotoXY(1,2); ClrEol;
  310.  
  311.   Set_Window(4); GotoXY(22,2);
  312.   Write('Anfangszustand ist die Band-Stelle: 1 ');
  313.   Delay(2000); SchreibkopfStelle:=1;
  314.   Set_Window(4); GotoXY(19,2);
  315.   Write('Geben Sie die Ablaufgeschwindigkeit an ');
  316.   Set_Window(3); GotoXY(4,1); ReadLn(Frequenz);
  317. End;  { proc Band_Eingabe }
  318.  
  319.  
  320. procedure Maschinen_Lauf;
  321. var c,
  322.     Spalte,Zeile,
  323.     j_Merker      : integer;
  324. begin
  325.   Regel_Nr:='000'; m:='0'; c:=0;
  326.   j_Merker:=1; Spalte:=2; Zeile:=1;
  327.   Set_Window(51); GotoXY(1,1);
  328.   for j:=1 to 21 do DelLine;    { Window-Inhalt löschen }
  329.   Delay(500); Set_Window(5);
  330.   Delay(700); Set_Window(51);
  331.   DruckStelle:=Band_Anfang;
  332.   BandStelle:=SchreibkopfStelle; Delay(200);
  333.  
  334.   { Ausdrucken bis zur oberen Window-Grenze Zeile 1 }
  335.   for j:=DruckStelle^.Stellen_Nr to SchreibkopfStelle+9 do
  336.   begin
  337.     if DruckStelle^.Stellen_Nr<Band_Ende^.Stellen_Nr then
  338.     begin
  339.       DruckStelle:=DruckStelle^.Right;
  340.       BandStellenDruck(DruckStelle,'g');
  341.     end
  342.     else if DruckStelle^.Stellen_Nr=Band_Ende^.Stellen_Nr then
  343.     begin
  344.       new(Next);
  345.       Band_Ende^.Right:=Next;
  346.       Next^.Left:=Band_Ende;
  347.       Band_Ende:=Next;
  348.       Band_Stellenzahl:=Band_Stellenzahl+1;
  349.       Band_Ende^.Stellen_Nr:=Band_Stellenzahl;
  350.       Band_Ende^.Stelle:='■';
  351.       DruckStelle:=Next; Next:=nil;
  352.       BandStellenDruck(DruckStelle,'g');
  353.     end
  354.     else begin
  355.       Set_Window(5); GotoXY(4,1);
  356.       Write('Lauf-Fehler! Abbruch des Programms!');
  357.       HALT;
  358.     end;
  359.   end;
  360.  
  361.   Schreibkopf:=Band_Anfang;
  362.   while SchreibkopfStelle>Schreibkopf^.Stellen_Nr do
  363.                           Schreibkopf:=Schreibkopf^.Right;
  364.   Next:=Schreibkopf; Before:=Schreibkopf;
  365.   for j:=1 to 10 do begin
  366.     if not (Next^.Stellen_Nr=Band_Ende^.Stellen_Nr) then
  367.       Next:=Next^.Right;
  368.   end;
  369.   for j:=1 to 10 do begin
  370.     if not (Before^.Stellen_Nr=Band_Anfang^.Stellen_Nr) then
  371.       Before:=Before^.Left;
  372.   end;
  373.  
  374.   Set_Window(23); GotoXY(11,1); LowVideo; Write(Frequenz);
  375.   Set_Window(21); LowVideo; Write(BandStelle);
  376.  
  377.   Set_Window(3); GotoXY(4,1); ClrEol;
  378.   Set_Window(4); GotoXY(25,2);
  379.   Write(' START mit beliebiger Taste ');
  380.   Repeat aa:=Readjez; Until aa<>'?';
  381.   Set_Window(3); GotoXY(4,1); ClrEol;
  382.   Set_Window(4); GotoXY(25,2);
  383.   Write('                            ');
  384.  
  385.  
  386.   Repeat
  387.  
  388.   Delay(Frequenz);
  389.  
  390.   Repeat Befehl_Nr:=Befehl_Nr+1;
  391.          c:=c+1; if c>1000 then Abbruch:=true;
  392.          if Befehl_Nr>Max_Befehle then Befehl_Nr:=1;
  393.          k:=Befehl[Befehl_Nr].regel;
  394.          l:=Befehl[Befehl_Nr].code;
  395.   until ((Regel_Nr=k) and (Schreibkopf^.Stelle=l)) or Abbruch;
  396.  
  397.   if not Abbruch then begin
  398.     Zustand_drucken(Spalte,Zeile,j_Merker,Befehl,Befehl_Nr);
  399.     Set_Window(2); LowVideo;
  400.     With Befehl[Befehl_Nr] Do begin
  401.       GotoXY(9,1); DelLine; GotoXY(9,4);
  402.       Write(regel,afiller,code,bfiller,verzweigung);
  403.     end;
  404.     Set_Window(21); LowVideo; Write(BandStelle);
  405.     BandStelle:=BandStelle+1;
  406.  
  407.     if not (Schreibkopf^.Stelle='■') and
  408.        not (Schreibkopf^.Stelle='s')        then
  409.     begin
  410.       if (Next^.Stellen_Nr=Band_Ende^.Stellen_Nr) then
  411.       begin
  412.         new(Neues_Element);
  413.         Band_Ende^.Right:=Neues_Element;
  414.         Neues_Element^.Left:=Band_Ende;
  415.         Band_Ende:=Neues_Element;
  416.         Neues_Element:=nil;
  417.         Band_Stellenzahl:=Band_Stellenzahl+1;
  418.         Band_Ende^.Stelle:='■';
  419.         Band_Ende^.Stellen_Nr:=Band_Stellenzahl;
  420.       end;
  421.       if Schreibkopf^.Stellen_Nr-10=Before^.Stellen_Nr then
  422.         Before:=Before^.Right;
  423.       Next:=Next^.Right; Schreibkopf:=Schreibkopf^.Right;
  424.       art:='r'; BandStellenDruck(Next,art);
  425.     end;
  426.  
  427.     Regel_Nr:=Befehl[Befehl_Nr].verzweigung;
  428.   end;
  429.  
  430.   Until (Befehl[Befehl_Nr].code='s') or Abbruch;
  431. end;  { proc Maschinen_Lauf }
  432.  
  433.  
  434. procedure Ende_Kommentar;
  435. begin
  436.   if Befehl[Befehl_Nr].code='s' then
  437.   begin
  438.     Set_Window(4); GotoXY(20,2);
  439.     Write('Halten des endlichen Automaten im Endzustand');
  440.   end
  441.   else begin
  442.     Set_Window(4); GotoXY(5,2);
  443.     Write('Vorzeitiges Halten! Das Band-Wort gehört ');
  444.     Write('nicht zum endlichen Automaten!');
  445.   end;
  446. end;  { proc Ende_Kommentar }
  447.  
  448.  
  449. Procedure Cursor(i:integer);
  450. begin
  451.   Case i of
  452.    1 : HiddenCursor;
  453.    2 : BlockCursor;
  454.    else end;
  455. end;  { proc Cursor }
  456.  
  457.  
  458. Procedure initialisieren;
  459. begin
  460.   Abbruch:=false;
  461.   j:=0; Zahl:='0'; Max_Befehle:=0; Befehl_Nr:=0;
  462. end;  { proc initialisieren }
  463.  
  464.  
  465.  
  466. begin   { - - - - -  H A U P T P R O G R A M M  - - - - - }
  467.   Window(1,1,80,25); ClrScr; Cursor(1);
  468.   initialisieren; install_Windows; Set_Window(11);
  469.  
  470.   if Datei_Einlesen(Max_Befehle,Befehl) then
  471.     Automaten_Druck(Befehl,Max_Befehle)
  472.   else begin
  473.     set_Window(3); GotoXY(4,1);
  474.     Write('Keine Datei kann eingelesen werden!');
  475.     Delay(2000);
  476.   end;
  477.  
  478.   if not Abbruch then begin
  479.     new(Band_Anfang); Schreibkopf:=Band_Anfang;
  480.     Band_Anfang^.Stelle:='■'; Band_Anfang^.Stellen_Nr:=0;
  481.     Band_Stellenzahl:=0; art:=' ';
  482.     SchreibkopfStelle:=0;
  483.  
  484.     Delay(600); Band_Eingabe;
  485.  
  486.     Band_Ende:=nil;          Band_Ende:=Schreibkopf;
  487.     Schreibkopf:=nil;        Schreibkopf:=Band_Anfang;
  488.     Next:=nil;               Next:=Band_Anfang;
  489.     Next:=Next^.Right;
  490.  
  491.     Maschinen_Lauf;
  492.  
  493.     Ende_Kommentar;
  494.     Repeat aa:=Readjez; Until aa<>'?';
  495.   end;
  496.  
  497.   Set_Window(0); GotoXY(1,1); Cursor(2);
  498. end.   { Programm endliche_Maschine_ohne_Ausgabe }