Suche Home Einstellungen Anmelden Hilfe

 program parser;   { Beispiel: 2,3,5-trimethylhexane }
 uses Crt;

 var  Formel    : array[0..255] of char;
      Position_im_Formel : byte;
      i : byte;
      Zeichen : char;
      NOT_MAinChain : boolean;
      BNT_Wort: string[5];
      BNT_Sicherung : byte;
      BNT_Kontrolle : byte;     { Anzahl der Number's = BNT-Wert }

 procedure POS; forward;
 procedure Prefix; forward;
 procedure SUAC; forward;
 procedure SUAC_Radical; forward;
 procedure Substituent; forward;

 procedure Eingabe;
 begin
   writeln(' Ende der Eingabe mit dem Zeichen "$" ');
   writeln;
   writeln(' Bitte chemische Formel eingeben: ');
   write(' --> ');
   For i := 0 to 255 do Formel[i] := '$';
   For i := 0 to 255 do
     begin
       (Formel[i]):= readkey;
       write(Formel[i]);
       if Formel[i] = '$' then exit;
     end;
  NOT_MainChain := false;
  i := 0;
 end;

 procedure Ausgabe;
 begin
   writeln;
   writeln(' Die Formel ist korrekt !');
   readln;
end;

 procedure Fehler(FehlerCode:Byte);
 begin
   writeln;
   case FehlerCode of
     1:  writeln('Fehler im Modul POS');
     2:  writeln('Fehler im Modul Number');
     3:  writeln('Fehler im Modul Substituent');
     4:  writeln('Fehler im Modul BNT');
     5:  writeln('Fehler im Modul SUAC-Radical');
     6:  writeln('Fehler im Modul SUAC aus Richtung SUAC-Radical');
     7:  writeln('Fehler im Modul MainChain');
     8:  writeln('Fehler im Modul SUAC aus Richtung MainChain');
   end;
   writeln;
   readln;
   halt;
 end;

 procedure MainChain;
 var SUAC_Wort1, SUAC_Wort2, SUAC_Wort3 : string[4];
     SUAC_Wort4, SUAC_Wort5, SUAC_Wort6 : string[4];
     SUAC_Wort_Kontrolle : string[4];
     j : byte;
 begin
   NOT_MainChain := true;
   SUAC_Wort1:= ('meth');
   SUAC_Wort2:= ('eth ');
   SUAC_Wort3:= ('prop');
   SUAC_Wort4:= ('but ');
   SUAC_Wort5:= ('pent');
   SUAC_Wort6:= ('hex ');
   INC(i);
   j := 1;
   SUAC_Wort_Kontrolle := '    ';
   For i := i to i+2 do
     begin
       Insert(Formel[i], SUAC_Wort_Kontrolle, j);
       INC(j);
    end;
   if (SUAC_Wort1 = SUAC_Wort_Kontrolle) or
      (SUAC_Wort2 = SUAC_Wort_Kontrolle) or
      (SUAC_Wort3 = SUAC_Wort_Kontrolle) or
      (SUAC_Wort4 = SUAC_Wort_Kontrolle) or
      (SUAC_Wort5 = SUAC_Wort_Kontrolle) or
      (SUAC_Wort6 = SUAC_Wort_Kontrolle) then
      begin
        write('SUAC in MainChain ermittelte: ',SUAC_WORT_KONTROLLE);
        INC(i);
        if Formel[i] <> ('a') then begin Fehler(7); exit; end
                              else  write(' --> a');
        INC(i);
        if Formel[i] <> ('n') then begin Fehler(7); exit; end
                              else  write('n');
        INC(i);
        if Formel[i] <> ('e') then begin Fehler(7); exit; end
                              else  write('e');
     end;
   Ausgabe;
   halt;
 end;

 procedure Formula;
 begin
   if (NOT_MainChain = false) then Prefix else MainChain;
 end;

 procedure Number;
 begin
   BNT_Kontrolle := BNT_Sicherung;
   while (Zeichen <> '-') do
     begin
       Zeichen := Formel[i];
       INC(i);
       writeln;
       writeln('Nebenkette am ',Zeichen,'. Kohlenstoffatom');
       INC(BNT_Kontrolle);
       BNT_Sicherung := BNT_Kontrolle;
       if Zeichen IN  ['0'..'6'] then POS else Fehler(2);
     end;
 end;

 procedure POS;
 begin
   Zeichen := Formel[i];
   INC(i);
   if Zeichen IN [','] then Number
                       else
                       if Zeichen IN ['-'] then
                                           begin

                                             Substituent;
                                           end
                                           else Fehler(1);
 end;

 procedure BNT;
 var BNT_Wort_Kontrolle : string[5];
     j : byte;
 begin
   case BNT_Kontrolle of
     1 : BNT_Wort:= ('mono ');
     2 : BNT_Wort:= ('di   ');
     3 : BNT_Wort:= ('tri  ');
     4 : BNT_Wort:= ('tetra');
     5 : BNT_Wort:= ('penta');
     6 : BNT_Wort:= ('hexa ');
   end;
   BNT_Wort_Kontrolle := '     ';
   j:= 1;
   For i := i to (BNT_Kontrolle + i-1) do
       begin
         Insert(Formel[i], BNT_Wort_Kontrolle, j );
         INC(j);
       end;
   if BNT_Wort = BNT_Wort_Kontrolle then
      begin
        writeln('Anzahl der Nebenketten in BNT: ',BNT_Wort_Kontrolle);
        SUAC_Radical;
      end
      else Fehler(4);
 end;

 procedure SUAC;
 var SUAC_Wort1, SUAC_Wort2, SUAC_Wort3 : string[4];
     SUAC_Wort4, SUAC_Wort5, SUAC_Wort6 : string[4];
     SUAC_Wort_Kontrolle : string[4];
     j : byte;
begin
   SUAC_Wort1:= ('meth');
   SUAC_Wort2:= ('eth ');
   SUAC_Wort3:= ('prop');
   SUAC_Wort4:= ('but ');
   SUAC_Wort5:= ('pent');
   SUAC_Wort6:= ('hex ');
   INC(i);
   writeln;
   j := 1;
   SUAC_Wort_Kontrolle := '    ';
   For i := i to i+3 do
     begin
       Insert(Formel[i], SUAC_Wort_Kontrolle, j);
       INC(j);
    end;
       write('SUAC ermittelte: ',SUAC_WORT_KONTROLLE);
   if (SUAC_Wort1 = SUAC_Wort_Kontrolle) or
      (SUAC_Wort2 = SUAC_Wort_Kontrolle) or
      (SUAC_Wort3 = SUAC_Wort_Kontrolle) or
      (SUAC_Wort4 = SUAC_Wort_Kontrolle) or
      (SUAC_Wort5 = SUAC_Wort_Kontrolle) or
      (SUAC_Wort6 = SUAC_Wort_Kontrolle) then
      begin
        if NOT_MainChain = false then
        begin
          INC(i);
          if Formel[i] <> ('y') then begin Fehler(6); halt; end
                                else write(' --> y');
          INC(i);
          if Formel[i] <> ('l') then begin Fehler(6); halt; end
                                else writeln('l');
        end
      end;
   writeln;
   MainChain; exit;
 end;

 procedure SUAC_Radical;
 begin
   SUAC;
end;

 procedure Substituent;
 var BNT_Wort_Kontrolle : string[5];
     FehlerCode : integer;
 begin
   readln;
   if BNT_Kontrolle > 0 then BNT else SUAC_Radical;
 end;

 procedure Prefix;
 begin
   i := 0;
   Zeichen := Formel[i];
   INC(i);
   if Zeichen IN ['0'..'6'] then
      begin
        writeln;
        writeln('Nebenkette am ',Zeichen,'. Kohlenstoffatom');
        BNT_Sicherung := 1;
        POS;
     end
    else Substituent;
 end;

begin
  ClrScr;
  Eingabe;
  Formula;
  writeln('ausgetrickst');
  Ausgabe;
end.

Benutzer: Gast • Besitzer: mthomas • Zuletzt geändert am: