home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 05 / tricks / upn22.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-02-05  |  18.8 KB  |  546 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     UPN22.PAS                          *)
  3. (*  Eingabe in Infix-Notation, Rechnung mit Postfix-Term  *)
  4. (*        (c) 1991 Wolfgang Müllner & TOOLBOX             *)
  5. (* ------------------------------------------------------ *)
  6. PROGRAM Taschenrechner_in_UPN;
  7.  
  8. USES Crt, RealStck, ChStack, ScrnStck, ScrnOut;
  9.  
  10. CONST
  11.   Ziffern     = ['0'..'9'];
  12.   MonOperator = ['s','S','k','K','W','w','q','Q',
  13.                                         'e','E','L','l'];
  14.   (* Sinus, Kosinus, (Quadrat-) Wurzel, Quadrat, Exponent,
  15.                                         Log zur Basis e *)
  16.   BinOperator = ['+','-','*','/','^'];
  17.  
  18. TYPE
  19.   Meldung = ARRAY[1..10] OF ScrnOut.S80;
  20.  
  21. VAR
  22.   TermInfix, Term  : STRING;
  23.   Ergebnis, Dummy, links, rechts, deltaX : RealStck.ElTyp;
  24.   I : INTEGER;
  25.   Scrn1, Scrn2 : Bildschirm;  (* aus UNIT ScrnStck *)
  26.  
  27.   (* Diese Variablen sollen verschiedene Bildschirme
  28.      zwischenspeichern. *)
  29.   M : Meldung;
  30.  
  31.  
  32.   PROCEDURE SmR(y1, y2   : INTEGER;
  33.                 M        : Meldung;
  34.                 Schatten : BOOLEAN);
  35.   (* Schreibt einen Rahmen um die Strings aus dem Array M.
  36.      Die Ausgabe erfolgt mittig, es müssen nur die y-Werte
  37.      übergeben werden. *)
  38.   VAR
  39.     I, Anzahl, Breite : INTEGER;
  40.  
  41.     FUNCTION x(B : INTEGER; links : BOOLEAN) : INTEGER;
  42.     BEGIN
  43.       IF links THEN x := 39 - B
  44.                ELSE x := 41 + B;
  45.     END;
  46.  
  47.   BEGIN
  48.     Anzahl := y2 - y1 - 1;
  49.     Breite := 0;
  50.     (* Bestimme den breitesten String *)
  51.     FOR I := 1 TO Anzahl DO
  52.      IF Breite < Length(M[I]) THEN
  53.        Breite := Length(M[I]);
  54.     Breite := Breite DIV 2;
  55.     Rahmen(x(Breite, TRUE), y1,
  56.            x(Breite, FALSE), y2, Schatten);
  57.     FOR I := 1 TO Anzahl DO BEGIN
  58.       Breite := Length(M[I]) DIV 2;
  59.       WrtXY(40-Breite, y1+I, M[I]);
  60.     END;
  61.   END;
  62.  
  63.   PROCEDURE Vorspann;
  64.   CONST
  65.     S : ARRAY[1..13] OF S80 =
  66.      (' Erweiterung 1        ',' Erkannt werden reelle',
  67.      ' Koeffizienten und x  ', ' als Variable.        ',
  68.      ' Erweiterung 2.1       ',' Terme können in Infix-',
  69.      ' Schreibweise eingege- ',' ben werden.           ',
  70.      ' Erweiterung 2.2       ',' Die Ausgabe ist dem   ',
  71.      ' heutigen Standard an- ',' gepaßt.               ',
  72.      ' w e i t e r   m i t   RET . .');
  73.   BEGIN
  74.     ClrScr;
  75.     Rahmen(1,1,80,25,FALSE);
  76.     Hintergrund(2,2,79,24,'║');
  77.     Scrn1 := Screen^;
  78.     FillChar(M,SizeOf(M),' ');
  79.     M[1] := '    UPN-Taschenrechner-Simulation     ';
  80.     M[2] := ' (UPN / Umgekehrt Polnische Notation) ';
  81.     SmR(2,5,M,TRUE);
  82.     FillChar(M,SizeOf(M),' ');
  83.     M[1] := ' Beispiele  ';
  84.     M[2] := ' Infix-Notation (AOS)  '
  85.                +'            Postfix-Notation (UPN)   ';
  86.     M[3] := ' (Schulalltag)         '
  87.                +'            (ungewohnt, aber elegant)';
  88.     M[4] := ' (3-2)^5               '
  89.                +'            3,2-5^                   ';
  90.     M[5] := ' 5*s(2)  ( s für sin ) '
  91.                +'            5,2s*                    ';
  92.     M[6] := ' x^2-2.8*x+7.3         '
  93.                +'            x2^2.8x*-7.3+            ';
  94.     SmR(8,15,M,FALSE);
  95.     Farbe(WeissVorRot); Rahmen( 2,17,25,22,FALSE);
  96.     Rahmen(28,17,52,22,FALSE); Rahmen(55,17,79,22,FALSE);
  97.     WrtXY(3,18,S[1]);   Farbe(GelbVorBlau);
  98.     WrtXY(3,19,S[2]);   WrtXY( 3,20,S[3]);
  99.     WrtXY(3,21,S[4]);   Farbe(WeissVorRot);
  100.     WrtXY(29,18,S[5]);  Farbe(GelbVorBlau);
  101.     WrtXY(29,19,S[6]);  WrtXY(29,20,S[7]);
  102.     WrtXY(29,21,S[8]);  Farbe(WeissVorRot);
  103.     WrtXY(56,18,S[9]);  Farbe(GelbVorBlau);
  104.     WrtXY(56,19,S[10]); WrtXY(56,20,S[11]);
  105.     WrtXY(56,21,S[12]);
  106.     Rahmen(80-Length(S[13])-5,23,78,25,FALSE);
  107.     WrtXY(80-Length(S[13])-3,24,S[13]); GotoXY(1,1);
  108.     ReadLn;
  109.     Screen^ := Scrn1
  110.   END;
  111.  
  112.   PROCEDURE EingabeString(VAR Term : STRING);
  113.   VAR
  114.     x, y : INTEGER;
  115.     OK   : BOOLEAN;
  116.   BEGIN
  117.     FillChar(M,SizeOf(M),' ');
  118.     M[1] := ' Erlaubte Operationen ';
  119.     Farbe(WeissVorRot);  SmR(2,4,M,FALSE);
  120.     Farbe(DunkelgrauVorHellgrau);
  121.     FillChar(M,SizeOf(M),' ');
  122.     M[1] := ' Binäre Operationen    '
  123.               +'                  Monäre Operationen    ';
  124.     M[2] := '  (zwei Operanden)     '
  125.               +'                     (ein Operand)      ';
  126.     M[3] := ' ----------------------'
  127.               +'--------------------------------------- ';
  128.     M[4] := ' +     -               '
  129.               +'             S(inus) K(osinus) W(urzel) ';
  130.     M[5] := ' *     /               '
  131.               +'             Q(uadrat) E(xponent) L(oga-';
  132.     M[6] := ' ^                     '
  133.               +'             rithmus zur Basis e)       ';
  134.     SmR(5,12,M,TRUE);
  135.     Farbe(BlauVorHellgrau);
  136.     FillChar(M,SizeOf(M),' ');
  137.     M[1] := ' Hinweis: Eine Prüfung '
  138.               +'findet nur hinsichtlich der erlaubten  ';
  139.     M[2] := '          Zeichen, nich'
  140.               +'t jedoch auf korrekte Syntax statt !   ';
  141.     SmR(14,17,M,TRUE);
  142.     FillChar(M,SizeOf(M),' ');
  143.     Farbe(WeissVorRot);
  144.     M[1] := ' Funktionsterm in (gewo'
  145.               +'hnter) Infix-Schreibweise eingeben : ';
  146.     SmR(19,23,M,FALSE);
  147.     WrtXY(40-(Length(M[1]) DIV 2),21,' Eingabe : ');
  148.     x :=21; y:=21;
  149.     OK := FALSE;
  150.     Scrn2 := Screen^;
  151.     REPEAT
  152.       Screen^ := Scrn2;
  153.       GotoXY(x,y); ReadLn( Term );
  154.       GotoXY(x,y+1); write('Alles ok ?  j/n');
  155.       OK := (UpCase(ReadKey)='J')
  156.     UNTIL OK;
  157.     Farbe(GelbVorBlau);
  158.     Screen^ := Scrn1;
  159.   END;
  160.  
  161.   PROCEDURE EingabeGrenzen(Term : S80;
  162.               VAR links, rechts, deltaX : RealStck.ElTyp);
  163.   CONST
  164.     S : ARRAY[1..4] OF S80 =
  165.      (' Eingabe Startwert : ',
  166.      '           Endwert : ',
  167.      '      Schrittweite : ',
  168.      ' Alles ok ?  j/n  ');
  169.   VAR x, y : INTEGER;
  170.       OK : BOOLEAN;
  171.   BEGIN
  172.     (* Überschrift *)
  173.     FillChar(M,SizeOf(M),' ');
  174.     M[1] := 'f(x) = '+Term;
  175.     M[2] := ' ';
  176.     M[3] := ' Eingabe von Intervall'
  177.                            +'grenzen und Schrittweite ';
  178.     Farbe(DunkelgrauVorHellgrau ); SmR(2,6,M,TRUE);
  179.     Farbe(GelbVorBlau);
  180.     Rahmen(5,10,32,15,FALSE);
  181.     WrtXY(6,11,S[1]); x:=6+Length(S[1]); y := 11;
  182.     WrtXY(6,12,S[2]);WrtXY(6,13,S[3]);
  183.     Scrn2 := Screen^;
  184.     REPEAT
  185.       Screen^ := Scrn2;
  186.       GotoXY(x,y);   ReadLn(links);
  187.       GotoXY(x,y+1); ReadLn(rechts);
  188.       GotoXY(x,y+2); ReadLn(deltaX);
  189.       WrtXY(6,14,S[4]); GotoXY(1,1);
  190.       OK := (UpCase(ReadKey) = 'J') AND (deltaX <> 0);
  191.     UNTIL OK;
  192.     Screen^ := Scrn1;
  193.   END;
  194.  
  195.   FUNCTION LeseReelleZahl(T     : STRING;
  196.                           VAR I : INTEGER) : REAL;
  197.   (* Liest eine reelle Zahl aus dem übergebenen String und
  198.      gibt in I Anzahl der schon gelesenen Zeichen zurück. *)
  199.   VAR
  200.     KommaErkannt : BOOLEAN;
  201.     Zahl,            (* Speichert schon gelesenen Teil    *)
  202.     Position : REAL; (* Speichert Kehrwert der Wertigkeit *)
  203.     L : INTEGER;     (* der aktuellen Nachkommastelle     *)
  204.  
  205.     FUNCTION Wert(CH : CHAR) : INTEGER;
  206.       (* Konvertierung Zeichen - entsprechende Ziffer *)
  207.     BEGIN
  208.       Wert := (Ord(CH) - 48);
  209.     END;
  210.  
  211.   BEGIN
  212.     Zahl := 0; KommaErkannt := FALSE;
  213.     Position := 1;  L := Length(T);
  214.     WHILE (I <= L) AND ((T[I] IN Ziffern) OR
  215.           ((T[I] = '.') AND (NOT KommaErkannt))) DO BEGIN
  216.       IF T[I] = '.' THEN
  217.         KommaErkannt := TRUE
  218.       ELSE IF NOT KommaErkannt THEN BEGIN
  219.         (* Man ist noch vor dem Komma und die
  220.            Stellenwertigkeit ist eine Zehnerpotenz *)
  221.         (* Null anfügen *)
  222.         Zahl := Zahl * 10;
  223.         (* Einer dazu *)
  224.         Zahl := Zahl + Wert(T[I]);
  225.       END ELSE BEGIN
  226.         (* Man ist nach dem Komma, die Stel-
  227.            lenwertigkeit beträgt eine Potenz von 1/10 *)
  228.         Position := Position * 10;
  229.         Zahl := Zahl + Wert(T[I]) / Position;
  230.       END;
  231.       I := I + 1
  232.     END;
  233.     I := I - 1;
  234.     (* Korrektur, da letzte Erhöhung zum Abbruch führte   *)
  235.     LeseReelleZahl := Zahl
  236.   END;
  237.  
  238.   PROCEDURE AuswertungTerm(    Term : STRING;
  239.                                x    : RealStck.ElTyp;
  240.                            VAR Erg  : RealStck.ElTyp);
  241.   VAR
  242.     Stack : RealStck.KELLER;
  243.  
  244.     PROCEDURE MonOp(Operation : CHAR;
  245.                              VAR Element : RealStck.ElTyp);
  246.     (* Wendet die ausgewählte Operation auf Element an und
  247.        gibt das Ergebnis in Element zurück. *)
  248.     BEGIN
  249.       CASE UpCase(Operation) OF
  250.         'S' : Element :=  Sin(Element);
  251.         'K' : Element :=  Cos(Element);
  252.         'W' : Element := Sqrt(Element);
  253.         'Q' : Element :=  Sqr(Element);
  254.         'E' : Element :=  Exp(Element);
  255.         'L' : Element :=   Ln(Element)
  256.       END;
  257.     END;
  258.  
  259.     PROCEDURE BinOp(    El1       : RealStck.ElTyp;
  260.                         Operation : CHAR;
  261.                         El2       : RealStck.ElTyp;
  262.                     VAR Erg       : RealStck.ElTyp);
  263.     (* Wendet auf die übergebenen Operanden El1 und El2
  264.        die ausgewählte Operation an (Reihenfolge festgelegt
  265.        durch den Index!) und gibt in Erg das Ergebnis zu-
  266.        rück. *)
  267.  
  268.        FUNCTION Potenz(Basis    : RealStck.ElTyp;
  269.                        Exponent : INTEGER) : REAL;
  270.        (* Liefert die Zahl Basis hoch Exponent *)
  271.        VAR
  272.          Erg : REAL;
  273.        BEGIN
  274.          Erg := 1.0;
  275.          WHILE Exponent > 0 DO BEGIN
  276.            Erg := Erg * Basis;
  277.            Exponent := Pred(Exponent);
  278.          END;
  279.          Potenz := Erg
  280.        END;
  281.  
  282.     BEGIN
  283.       CASE Operation OF
  284.         '+' : Erg := El1 + El2;
  285.         '-' : Erg := El1 - El2;
  286.         '*' : Erg := El1 * El2;
  287.         '/' : Erg := El1 / El2;
  288.         '^' : Erg := Potenz(El1, Trunc(El2));
  289.       END;
  290.     END;
  291.  
  292.   VAR
  293.     L, SchonGelesen           : INTEGER;
  294.     Zeichen                   : CHAR;
  295.     Zahl, Element1, Element2,
  296.     Element, Ergebnis         : RealStck.ElTyp;
  297.  
  298.   BEGIN
  299.     RealStck.StackInit(Stack);
  300.     SchonGelesen := 1;
  301.     (* SchonGelesen "zeigt" auf die Position bis zu
  302.        der der übergebene String schon gelesen wurde *)
  303.     L := Length( Term );
  304.     WHILE SchonGelesen <= L DO BEGIN
  305.       Zeichen := Term[SchonGelesen];
  306.       IF Zeichen IN Ziffern THEN
  307.         RealStck.PUSH(Stack,
  308.                       LeseReelleZahl(Term, SchonGelesen))
  309.         ELSE IF Zeichen IN MonOperator THEN BEGIN
  310.           RealStck.POP(Stack, Element);
  311.           MonOp(Zeichen, Element);
  312.           RealStck.PUSH(Stack, Element);
  313.         END ELSE IF Zeichen IN BinOperator THEN BEGIN
  314.           RealStck.POP(Stack,Element2);
  315.           RealStck.POP(Stack,Element1);
  316.           BinOp(Element1, Zeichen, Element2,Ergebnis);
  317.           RealStck.PUSH(Stack, Ergebnis);
  318.         END ELSE IF (Zeichen='x') OR (Zeichen='X') THEN
  319.           RealStck.PUSH(Stack, x)
  320.         ELSE IF Zeichen=',' THEN
  321.           SchonGelesen := Succ(SchonGelesen)
  322.             (* Einfach überlesen ! *)
  323.         ELSE
  324.           WriteLn('Fehler ! Zeichen ', Zeichen, ' ?');
  325.           (* Ende der Auswertung eines Zeichens. *)
  326.           SchonGelesen := Succ(SchonGelesen);
  327.       END;
  328.       (* Jetzt ist im Stack das Ergebnis. Dieses wird in Erg
  329.          zurückgegeben *)
  330.       RealStck.POP(Stack, Erg);
  331.   END;
  332.  
  333.   PROCEDURE Konvertiere(    Infix   : STRING;
  334.                         VAR Postfix : STRING);
  335.   (* Es wird ein in Infix-Notation geschriebener String in
  336.      einen Postfix-String konvergiert.                      *)
  337.  
  338.     FUNCTION Priority(Op : CHAR) : INTEGER;
  339.     (* Diese Funktion gibt die Priorität einer Operation zu-
  340.       rück. Da im Stapel auch "Klammer auf" abgelegt wird,
  341.       bekommt dieses Zeichen auch eine Priorität zugewiesen,
  342.       und zwar die niedrigste . Je höher der zurückgegebene
  343.       Wert, desto vorrangiger wird die Operation ausgeführt.
  344.     *)
  345.     BEGIN
  346.       CASE Op OF
  347.         '('            : Priority := 1;
  348.         '+','-'        : Priority := 2; (* binäre *)
  349.         '*','/'        : Priority := 3; (* Opera- *)
  350.         '^'            : Priority := 4; (* toren  *)
  351.         'S','K','W',                    (* monäre *)
  352.         'Q','E','L'    : Priority := 5  (* Operatoren *)
  353.       END;
  354.     END;  (* von priority *)
  355.  
  356.   VAR
  357.     SchonGelesen, L, LaengePostfix : INTEGER;
  358.     oben, Zeichen : ChStack.ElTyp;
  359.     Stapel : ChStack.KELLER;
  360.     ZuletztZahlGespeichert : BOOLEAN;
  361.     Zahl : REAL;
  362.     S, Sganz : STRING;
  363.     Merker, Breite, Nachkomma, Ganzteil : INTEGER;
  364.  
  365.   BEGIN
  366.     ChStack.StackInit(Stapel);
  367.     Postfix := ''; L := Length(Infix);  SchonGelesen := 1;
  368.     ZuletztZahlGespeichert := FALSE;
  369.     WHILE SchonGelesen <= L DO BEGIN
  370.       Zeichen := Infix[ SchonGelesen ];
  371.       IF (Zeichen IN MonOperator) OR (Zeichen = 'x') THEN
  372.         Zeichen := UpCase(Zeichen);
  373.       CASE Zeichen OF
  374.         'X'      : Postfix := Postfix + 'X';
  375.         '0'..'9' : BEGIN
  376.                      LaengePostfix := Length(Postfix);
  377.                      IF LaengePostfix > 0 THEN
  378.                        ZuletztZahlGespeichert :=
  379.                         (Postfix[LaengePostfix] IN Ziffern);
  380.                      IF ZuletztZahlGespeichert THEN
  381.                        Postfix := Postfix + ',';
  382.                      (* Somit Trennzeichen gesetzt. *)
  383.                      Merker := SchonGelesen;
  384.                      Zahl :=
  385.                         LeseReelleZahl(Infix, SchonGelesen);
  386.                      (* Es muß nun ermittelt werden, aus
  387.                         wievielen Stellen die Zahl besteht
  388.                         und wieviele Nachkommastellen vor-
  389.                         handen sind.
  390.                      Zuerst die Breite der Zahl. *)
  391.                      Breite := SchonGelesen-Merker+1;
  392.                      (* Anzahl der Nachkommastellen *)
  393.                      IF (Trunc(Zahl) - Zahl < 0) THEN BEGIN
  394.                             (* Zahl ist nicht ganz *)
  395.                        Str(Trunc(Zahl), Sganz);
  396.                        Nachkomma := Breite-Length(Sganz) -1;
  397.                      END ELSE Nachkomma := 0;
  398.                      (* Konvergiere Zahl in String*)
  399.                      Str(Zahl:Breite:Nachkomma, S);
  400.                      Postfix := Postfix + S;
  401.                    END;
  402.         '(','S','K',
  403.         'W','Q','E',
  404.         'L'      : ChStack.PUSH(Stapel, Zeichen);
  405.         '+','-','*',
  406.         '/','^'  : BEGIN
  407.                        (* nur lesen *)
  408.                      ChStack.TOP(Stapel, oben);
  409.                      WHILE (NOT ChStack.IstLeer(Stapel)) AND
  410.                       (Priority(Zeichen) <= Priority(oben))
  411.                      DO BEGIN
  412.                          (* jetzt entfernen *)
  413.                        ChStack.POP(Stapel, oben);
  414.                        Postfix := Postfix + oben;
  415.                        ChStack.TOP(Stapel, oben)
  416.                      END;
  417.                      ChStack.PUSH(Stapel, Zeichen);
  418.                    END;
  419.         ')'      : BEGIN
  420.                     (* Alles vom Stapel bis "Klammer auf" *)
  421.                      ChStack.POP(Stapel, oben);
  422.                      WHILE oben <> '(' DO BEGIN
  423.                        Postfix := Postfix + oben;
  424.                        ChStack.POP(Stapel, oben);
  425.                      END
  426.                    END;
  427.       END;
  428.       SchonGelesen := Succ(SchonGelesen);
  429.     END;
  430.     WHILE NOT ChStack.IstLeer(Stapel) DO BEGIN
  431.           (* Übertrage den Rest des Kellers *)
  432.       ChStack.POP(Stapel, oben);
  433.       Postfix := Postfix + oben;
  434.     END
  435.   END;
  436.  
  437.   FUNCTION machLesbarer(S : STRING) : STRING;
  438.   (* Ersetzt die verabredeten Abkürzungen für die monären
  439.      Oparationen durch die allgemein üblichen Namen. *)
  440.   VAR
  441.     i, Stelle   : INTEGER;
  442.     D(* ummy *) : STRING;
  443.   BEGIN
  444.     D := S;
  445.         (* "Stelle" zeigt auf aktuelle Stelle im String D *)
  446.     Stelle := 1;
  447.                (* I zeigt auf aktuelle Stelle im String S *)
  448.     FOR i := 1 TO Length(S) DO BEGIN
  449.       IF S[i] IN MonOperator THEN BEGIN
  450.         D[Stelle] := UpCase(S[i]);
  451.         CASE D[Stelle] OF
  452.           'S' : BEGIN                            (* Sinus *)
  453.                   Insert('IN', D, Succ(Stelle));
  454.                   Stelle := Succ(Succ(Stelle));
  455.                 END;
  456.           'K' : BEGIN                          (* Kosinus *)
  457.                   Delete(D, Stelle, 1);
  458.                   Insert('COS', D, Stelle);
  459.                   Stelle := Succ(Succ(Stelle));
  460.                 END;
  461.           'W' : BEGIN                    (* Quadratwurzel *)
  462.                   Delete(D, Stelle, 1);
  463.                   Insert('SQRT', D, Stelle);
  464.                   Stelle := Succ(Succ(Succ(Stelle)));
  465.                 END;
  466.           'Q' : BEGIN                          (* Quadrat *)
  467.                   Delete(D, Stelle, 1);
  468.                   Insert('SQR', D, Stelle);
  469.                   Stelle := Succ(Succ(Stelle));
  470.                 END;
  471.           'L' : BEGIN                   (* Log. naturalis *)
  472.                   Insert('N', D, Succ(Stelle));
  473.                   Stelle := Succ(Stelle);
  474.                 END;
  475.           'E' : BEGIN                         (* e hoch x *)
  476.                   Insert('XP', D, Succ(Stelle));
  477.                   Stelle := Succ(Stelle);
  478.                 END
  479.         END;
  480.       END;
  481.       Stelle := Succ(Stelle);
  482.     END;
  483.     machLesbarer := D;
  484.   END;
  485.  
  486.   PROCEDURE vertausche(VAR x, y : REAL);
  487.   VAR
  488.     Dummy : REAL;
  489.   BEGIN
  490.     Dummy := x ; x := y ; y := Dummy
  491.   END;
  492.  
  493.   PROCEDURE WerteTabelle(TermInfix, Term : S80;
  494.                    links, rechts, deltaX : RealStck.ElTyp);
  495.   VAR
  496.     Satz, Wort : S80;
  497.     Ergebnis : RealStck.ElTyp;
  498.     I : INTEGER;
  499.   BEGIN
  500.     Screen^ := Scrn1;
  501.     FillChar(M,SizeOf(M),' ');
  502.     M[1] := ' < <   W e r t e t a b e l l e   > > ';
  503.     Farbe(BlauVorHellgrau);  SmR(3, 5, M, TRUE);
  504.     Farbe(WeissVorRot);      Rahmen(10,8,70,23,FALSE);
  505.     M[1] := '  x-Wert           y = f(x) = ' +
  506.             machLesbarer(TermInfix);
  507.     Farbe(DunkelgrauVorHellgrau);   SmR(9, 11, M, FALSE);
  508.     Farbe(GelbVorBlau);
  509.     Scrn2 := Screen^;
  510.     I := 12;
  511.     WHILE links <= rechts DO BEGIN
  512.       IF (i = 23) THEN BEGIN
  513.         Satz := 'w e i t e r  m i t  RET . .';
  514.         Farbe(WeissVorRot);
  515.         Rahmen(75 - Length(Satz), 23, 78, 25, FALSE);
  516.         WrtXY(76 - Length(Satz), 24, Satz);
  517.         Farbe(GelbVorBlau);
  518.         ReadLn;
  519.         Screen^ := Scrn2;
  520.         i := 12;
  521.       END;
  522.       AuswertungTerm(Term, links, Ergebnis);
  523.         (* Wandle x-Wert in String um, wg WrtXY *)
  524.       Str(links:13:2, Wort);
  525.       WrtXY(16, i, Wort);
  526.         (* Wandle Ergebnis in String um, wg WrtXY *)
  527.       Str(Ergebnis:13:2, Wort);
  528.       WrtXY(38, i, Wort);
  529.       links := links + deltaX;
  530.       i := Succ(i);
  531.     END;
  532.   END;
  533.  
  534. BEGIN
  535.   Vorspann;
  536.   EingabeString(TermInfix);
  537.   Konvertiere(TermInfix, Term);
  538.   EingabeGrenzen(machLesbarer(TermInfix), links,
  539.                  rechts, deltaX);
  540.   IF links > rechts THEN vertausche(links, rechts);
  541.   WerteTabelle(TermInfix, Term, links, rechts, deltaX);
  542.   ReadLn;
  543.   ClrScr
  544. END.
  545. (* ------------------------------------------------------ *)
  546. (*                Ende von UPN22.PAS                      *)