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