home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 04 / quellen / calcaos.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1979-12-31  |  5.3 KB  |  133 lines
  1. (*****************************************************************************)
  2. (*                              CALCAOS.PAS                                  *)
  3. (*                                                                           *)
  4. (*                     Bildschirmausgabe von Calc-Programmen                 *)
  5. (*****************************************************************************)
  6.  
  7.  
  8. PROCEDURE calcaos(pptr : calc_prog;vartable : calc_vartab);
  9.  
  10. VAR value : STRING[50];
  11.     len : BYTE ABSOLUTE value;
  12.     key : char;
  13.     dummy : calc_operand;
  14.     pptr1 : calc_prog;
  15. {$a-}
  16.  
  17.   PROCEDURE writeaos( pptr : calc_prog);
  18.  
  19.   VAR pptra,pptrb : calc_prog;
  20.       paren : BOOLEAN;
  21.  
  22.   BEGIN
  23.     IF (pptr <> nil)
  24.       THEN
  25.         BEGIN
  26.           if keypressed THEN
  27.           BEGIN
  28.             read(kbd,key);
  29.             if key = ^s THEN read(kbd,key)
  30.           END;
  31.           pptra := pptr^.nextinst;
  32.           IF pptra <> nil
  33.             THEN
  34.               BEGIN
  35.                 pptrb := endof(pptra);
  36.                 pptrb := pptrb^.nextinst
  37.               END;
  38.           CASE pptr^.instruct OF
  39.             calc_const : BEGIN
  40.                            dummy := pptr^.operand;
  41.                            Str(dummy:0:10,value);
  42.                            WHILE value[len] = '0' DO
  43.                              len := Pred(len);
  44.                            IF value[len] = '.'
  45.                              THEN
  46.                                len := Pred(len);
  47.                            paren := dummy < 0.0;
  48.                            IF paren
  49.                              THEN
  50.                                Write('(');
  51.                            Write(value);
  52.                            IF paren
  53.                              THEN
  54.                                Write(')')
  55.                          END;
  56.             calc_var   : Write(vartable^[pptr^.varindex].varid);
  57.             calc_add..calc_pow : BEGIN
  58.                                    paren := (pptr^.instruct IN [calc_mul..
  59.                                               calc_pow]) AND
  60.                                                (pptrb^.
  61.                                               instruct IN [calc_add,
  62.                                               calc_sub]);
  63.                                    paren := paren or (pptr^.instruct =
  64.                                      calc_pow) and (pptrb^.instruct in
  65.                                        [calc_add..calc_pow]);
  66.                                    IF paren
  67.                                      THEN
  68.                                        Write('(');
  69.                                    writeaos(pptrb);
  70.                                    IF paren
  71.                                      THEN
  72.                                        Write(')');
  73.                                    if pptr^.instruct in [calc_div..Calc_Kgv]
  74.                                      THEN Write(' ');
  75.                                    Write(calc_ids[pptr^.instruct]);
  76.                                    if pptr^.instruct in [calc_div..Calc_Kgv]
  77.                                      THEN Write(' ');
  78.                                    paren := (pptr^.instruct IN [calc_mul..
  79.                                               calc_pow]) AND (pptra^.
  80.                                               instruct IN [calc_add,
  81.                                               calc_sub]);
  82.                                    paren := paren OR ((pptr^.instruct IN [
  83.                                               calc_dvd..calc_pow]) AND (
  84.                                               pptra^.instruct IN [calc_add..calc_pow]));
  85.                                    paren := paren OR ((pptr^.instruct =
  86.                                               calc_sub) AND (pptra^.
  87.                                               instruct IN [calc_add,
  88.                                               calc_sub]));
  89.                                    IF paren
  90.                                      THEN
  91.                                        Write('(');
  92.                                    writeaos(pptra);
  93.                                    IF paren
  94.                                      THEN
  95.                                        Write(')')
  96.                                  END;
  97.             calc_neg : BEGIN
  98.                          Write('(-');
  99.                          paren := pptra^.instruct IN [calc_add..calc_pow];
  100.                          IF paren
  101.                            THEN
  102.                              Write('(');
  103.                          writeaos(pptra);
  104.                          IF paren
  105.                            THEN
  106.                              Write(')');
  107.                          Write(')')
  108.                        END;
  109.             calc_sqr..calc_fak : BEGIN
  110.                                    Write(calc_ids[pptr^.instruct],'(');
  111.                                    writeaos(pptra);
  112.                                    Write(')')
  113.                                  END
  114.           END
  115.         END
  116.   END;
  117. {$a+}
  118.  
  119. BEGIN
  120.   IF pptr <> nil
  121.     THEN
  122.       BEGIN
  123.         pptr1 := pptr;
  124.         invert(pptr);
  125.         pptr := pptr^.nextinst;
  126.         writeaos(pptr);
  127.         invert(pptr1);
  128.         Writeln
  129.       END
  130.     ELSE Writeln('Funktion ist nicht definiert !')
  131. END;
  132.  
  133.