home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 03 / fkplot3.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-02-03  |  5.9 KB  |  222 lines
  1. {---------------------------------------------------------------------------}
  2. {                          fkplot3.pas                                      }
  3.  
  4. {            Klammerueberschuss berechnen - rueckwaerts:                    }
  5.  
  6. PROCEDURE U1 (VAR i, ue, st: INTEGER; q2: Str);
  7.  
  8. VAR k: INTEGER;
  9.  
  10. BEGIN
  11.   FOR k := i-1 DOWNTO 1 DO
  12.     CASE q2[k] OF
  13.       ']': ue := ue+1;
  14.       '[': BEGIN
  15.              ue := ue-1;
  16.              IF (st = 0) AND (ue = 0) THEN st := k;
  17.            END;
  18.     END;
  19. END;
  20.  
  21. {             Klammerueberschuss berechnen - vorwaerts:                     }
  22.  
  23. PROCEDURE U2 (VAR i, ue, st: INTEGER; q2: Str);
  24.  
  25. VAR k: INTEGER;
  26.  
  27. BEGIN
  28.   ue := 0;
  29.   st := 0;
  30.   FOR k := i+1 TO Length(q2) DO
  31.     CASE q2[k] OF
  32.       '[': ue := ue+1;
  33.       ']': BEGIN
  34.              ue := ue-1;
  35.              IF (st = 0) AND (ue = 0) THEN st := k;
  36.            END;
  37.     END;
  38. END;
  39.  
  40. { Funktion, die den zweiten Teil der Uebersetzung des Strings q2 vornimmt:  }
  41.  
  42. FUNCTION translat2 (q2: Str): Str;
  43.  
  44. TYPE Str = STRING[255];
  45.  
  46. VAR ins: STRING[2];
  47.     i, j, ue, st: INTEGER;
  48.  
  49. BEGIN
  50.                               {******************1.Teil*********************}
  51.   REPEAT                      { Umwandeln der Funktionen A-S in a-s,        }
  52.     ue := 0;                  { gleichzeitig Setzen der Klammern            }
  53.     st := 0;                  { (hoechste Prioritaet)                       }
  54.     i := 1;
  55.     REPEAT
  56.       IF q2[i] IN ['A'..'S'] THEN
  57.         BEGIN
  58.           q2[i] := Chr(Ord(q2[i])+32);
  59.           Insert('[', q2, i);
  60.           j := i+1;
  61.           U2(j, ue, st, q2);
  62.           Insert(']', q2, st);
  63.         END
  64.       ELSE
  65.         i := i+1;
  66.     UNTIL (i > Length(q2)) OR (st > 0);
  67.   UNTIL st = 0;
  68.  
  69.   REPEAT                     { Umwandeln ( ^ -> v ) und Setzen der Klammern }
  70.     ue := 0;                 { (zweithoechste Prioritaet)                   }
  71.     st := 0;
  72.     i := 1;
  73.     REPEAT
  74.       IF q2[i] = '^' THEN
  75.         BEGIN
  76.           q2[i] := 'v';
  77.           U1(i, ue, st, q2);
  78.           Insert('[', q2, st);
  79.           U2(i, ue, st, q2);
  80.           Insert(']', q2, st);
  81.         END
  82.       ELSE
  83.         i := i+1;
  84.     UNTIL (i > Length(q2)) OR (st > 0);
  85.   UNTIL st = 0;
  86.  
  87.   REPEAT                   { Umwandeln der Vorzeichen +,- in 0+.. bzw. 0-.. }
  88.     ue := 0;            { und Setzen der Klammern(dritthoechste Prioritaet) }
  89.     st := 0;
  90.     i := 1;
  91.     REPEAT
  92.       IF ((q2[i] = '+') OR (q2[i] = '-')) AND (q2[i-1] = '[') THEN
  93.         BEGIN
  94.           Insert('0]', q2, i);
  95.           i := i+2;
  96.           CASE q2[i] OF
  97.             '+': q2[i] := 'z';
  98.             '-': q2[i] := 'y';
  99.           END;
  100.           U1(i, ue, st, q2);
  101.           Insert('[', q2, st);
  102.           U2(i, ue, st, q2);
  103.           Insert(']', q2, st);
  104.         END
  105.       ELSE
  106.         i := i+1;
  107.     UNTIL (i > Length(q2)) OR (st > 0);
  108.   UNTIL st = 0;
  109.  
  110.   REPEAT                 { Umwandeln ( *,/ -> x,w ) und Setzen der Klammern }
  111.     ue := 0;             { (vierthoechste Prioritaet)                       }
  112.     st := 0;
  113.     i := 1;
  114.     REPEAT
  115.       IF (q2[i] = '*') OR (q2[i] = '/') THEN
  116.         BEGIN
  117.           CASE q2[i] OF
  118.             '*': q2[i] := 'x';
  119.             '/': q2[i] := 'w';
  120.           END;
  121.           U1(i, ue, st, q2);
  122.           Insert('[', q2, st);
  123.           U2(i, ue, st, q2);
  124.           Insert(']', q2, st);
  125.         END
  126.       ELSE
  127.         i := i+1;
  128.     UNTIL (i > Length(q2)) OR (st > 0);
  129.   UNTIL st = 0;
  130.  
  131.   REPEAT                  { Umwandeln ( T,U -> t,u) und Setzen der Klammern }
  132.     ue := 0;              { (fuenfthoechste Prioritaet)                     }
  133.     st := 0;
  134.     i := 1;
  135.     REPEAT
  136.       IF (q2[i] = 'T') OR (q2[i] = 'U') THEN
  137.         BEGIN
  138.           CASE q2[i] OF
  139.             'T': q2[i] := 't';
  140.             'U': q2[i] := 'u';
  141.           END;
  142.           U1(i, ue, st, q2);
  143.           Insert('[', q2, st);
  144.           U2(i, ue, st, q2);
  145.           Insert(']', q2, st);
  146.         END
  147.       ELSE
  148.         i := i+1;
  149.     UNTIL (i > Length(q2)) OR (st > 0);
  150.   UNTIL st = 0;
  151.  
  152.   REPEAT                 { Umwandeln ( +,- -> z,y ) und Setzen der Klammern }
  153.     ue := 0;             { (niedrigste Prioritaet)                          }
  154.     st := 0;
  155.     i := 1;
  156.     REPEAT
  157.       IF (q2[i] = '+') OR (q2[i] = '-') THEN
  158.         BEGIN
  159.           CASE q2[i] OF
  160.             '+': q2[i] := 'z';
  161.             '-': q2[i] := 'y';
  162.           END;
  163.           U1(i, ue, st, q2);
  164.           Insert('[', q2, st);
  165.           U2(i, ue, st, q2);
  166.           Insert(']', q2, st);
  167.         END
  168.       ELSE
  169.         i := i+1;
  170.     UNTIL (i > Length(q2)) OR (st > 0);
  171.   UNTIL st = 0;
  172.  
  173.                               {******************2.Teil*********************}
  174.   REPEAT                      { Umwandeln [2]z[3] in Z([2],[3])             }
  175.     ue := 0;
  176.     st := 0;
  177.     i := 1;
  178.     REPEAT
  179.       IF q2[i] IN ['t'..'z'] THEN
  180.         BEGIN
  181.           U1(i, ue, st, q2);
  182.           ins := UpCase(q2[i])+'(';
  183.           Insert(ins, q2, st);
  184.           j := i+2;
  185.           U2(j, ue, st, q2);
  186.           Insert(')', q2, st+1);
  187.           q2[i+2] := ',';
  188.         END
  189.       ELSE
  190.         i := i+1;
  191.     UNTIL (i > Length(q2)) OR (st > 0);
  192.   UNTIL st = 0;
  193.  
  194.   REPEAT                                     { Umwandeln a[[4]] in A([[4]]) }
  195.     ue := 0;
  196.     st := 0;
  197.     i := 1;
  198.     REPEAT
  199.       IF q2[i] IN ['a'..'s'] THEN
  200.         BEGIN
  201.           q2[i] := UpCase(q2[i]);
  202.           Insert('(', q2, i+1);
  203.           j := i+1;
  204.           U2(j, ue, st, q2);
  205.           Insert(')', q2, st+1);
  206.         END
  207.       ELSE
  208.         i := i+1;
  209.     UNTIL (i > Length(q2)) OR (st > 0);
  210.   UNTIL st = 0;
  211.  
  212.                               {******************3.Teil*********************}
  213.   i := 1;                     { Alle eckigen Klammern loeschen              }
  214.   REPEAT
  215.     IF q2[i] IN ['[',']'] THEN
  216.       Delete(q2, i, 1)
  217.     ELSE
  218.       i := i+1;
  219.   UNTIL i = Length(q2)+1;
  220.   translat2 := q2;
  221. END;
  222.