home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / PARSTP20 / CALC.PAS next >
Pascal/Delphi Source File  |  1993-10-25  |  2KB  |  57 lines
  1. (******************************************************************************
  2. *                                    calc                                     *
  3. * ISoft D&M CALC - Parser demo program.                                       *
  4. * (c) 1992, Loewy Ron.                                                        *
  5. * Version 2.0, Oct. 1993.                                                     *
  6. ******************************************************************************)
  7. program calc;
  8.  
  9. uses
  10.    parser
  11.    ;
  12.  
  13. var
  14.    exitFlag,
  15.    validity : boolean;
  16.    s        : string;
  17.    result   : real;
  18.  
  19. (******************************************************************************
  20. *                                  makeUpper                                  *
  21. * receive a string, and convert it to upper-case                              *
  22. ******************************************************************************)
  23. function makeUpper(s : string) : string;
  24. var
  25.    i : byte;
  26. begin
  27.    for i := 1 to length(s) do
  28.       if (s[i] in ['a' .. 'z']) then
  29.          s[i] := upCase(s[i]);
  30.    makeUpper := s;
  31. end; {makeUpper}
  32.  
  33. begin
  34.    writeln('CALC V2.0, ISoft D&M, Parser demo program');
  35.    writeln;
  36.    writeln('Enter mathematical expression, or QUIT/EXIT to DOS');
  37.    writeln;
  38.    exitFlag := false;
  39.    repeat
  40.       write('CALC> ');
  41.       readln(s);
  42.       s := makeUpper(s);
  43.       if ((copy(s, 1, 4) = 'QUIT') or (copy(s, 1, 4) = 'EXIT')) then 
  44.          exitFlag := true
  45.       else begin
  46.          result :=  getExpr(s, validity);
  47.          if (not validity) then
  48.             writeln('Error in expression, at position ', errAt)
  49.          else
  50.             writeln('RSLT> ', result);
  51.       end; { not a QUIT command }
  52.    until (exitFlag);
  53.    writeln;
  54.    writeln('Thank you for using CALC, ISoft D&M');
  55.    writeln;
  56. end.
  57.