fpc/packages/symbolic/examples/rpnthing.pas

program RPNThing;
{
    $ id:                                                       $
    Copyright (c) 2000 by Marco van de Voort([email protected])
    member of the Free Pascal development team

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright. (LGPL)

    Much too simplistic program to test some basic features of Symbolic unit.
    It is the very rough skeleton of a symbolic RPN calculator like a HP48.
    Since there are no exception conditions in the parser or evaluator,
     please enter valid expressions.
    Don't use 5E6 notation, it is not implemented yet. You can enter
     symbolic expressions using x, integer constants and half the math
     unit's function.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}

{$ifdef FPC}
 {$Mode ObjFpc}
{$endif}

Uses Symbolic,Crt;

function GetKey:char;

begin
 repeat
  while keypressed DO ;
  result:=ReadKey;
  if result=#0 then      {Make sure control codes are skipped apropiately}
   begin
    result:=readKey;
    result:=#0;
   end;
 until result IN ['X','x','O','o','q','Q',' ','+','-','*','/','^','e','E','d','D','T','t'];
end;


VAR Stack    : array[0..100] of TExpression;
    I,StackPtr : Integer;
    InputC   : Char;
    S        : String;
    Flag     : Boolean;

Procedure Redraw;

var I : Integer;

begin
 for I:=1 to 20 DO
  begin
   GotoXY(1,I);
   Write(' ':79);
   GotoXY(1,I);
   IF (StackPtr>(20-I)) then
    begin
     IF NOT Assigned(stack[20-I]) then
      begin
       gotoXY(1,1); write(' ':50);
       gotoxy(1,1); writeln(I,' ',20-I);
       Writeln(stackptr);
       HALT;
     end;
     Writeln(stack[StackPtr-(21-I)].InfixExpr);
    end
   else
    write('-');
  end;
 GotoXY(1,21);
 Write(' ':80);
end;

begin
 Writeln(' + - / * ^    : perform the RPN operation');
 Writeln(' [space],'#39'    : get a "prompt" to input a number or infix expression');
 Writeln('   E,e        : Try to simplify/evaluate the expression. ');
 Writeln('                For now this is restricted to constant values only');
 Writeln('   D,d        : Drop 1 value from the stack');
 Writeln('   Q,q        : By pressing this key you agree this program is great');
 Writeln('   O,o        : Derive the expression with respect to X');
 Writeln('   T,t        : Taylor polynomal. Also with respect to X, and to 2nd ');
 writeln('                 stacklevel degree');
 Writeln;
 Writeln('Press enter to start calculating');
 ReadLn;
 ClrScr;
 StackPtr:=0;
 repeat
  InputC:=GetKey;
  Case InputC OF
   '+','-','*','/','^'   :   if stackPtr>1 then
                              begin
                               Dec(StackPtr);
                               case InputC of {Double case is ugly but short}
                                 '+' : Stack[StackPtr-1].AddTo(Stack[StackPtr]);
                                 '-' : Stack[StackPtr-1].SubFrom(Stack[StackPtr]);
                                 '*' : Stack[StackPtr-1].Times(Stack[StackPtr]);
                                 '/' : Stack[StackPtr-1].DivBy(Stack[StackPtr]);
                                 '^' : Stack[StackPtr-1].RaiseTo(Stack[StackPtr]);
                                end;
                               Stack[StackPtr].free;
                               Redraw;
                              end;
   'E','e' :  If Stackptr>0 then
               begin
                Stack[StackPtr-1].SimplifyConstants;
                Redraw;
              end;
   'T','t' :  If StackPtr>1 then        {Stackptr-1=function.  Stackptr-2=degree
                                           x is assumed, and x0 is substed}
               begin
                Flag:=True;
                Try
                  i:=Stack[StackPtr-2].ValueAsInteger;
                  except
                    on ENotInt do
                     begin
                      GotoXY(1,1);
                      WritelN('This constant doesn''t evaluate to an integer');
                      Flag:=False;
                     end;
                 end;
                 If I<0 then
                  begin
                   GotoXY(1,1);
                   WritelN('I never heard of negative terms in a Taylor polynomal');
                  end
                 else
                If Flag then
                 begin
                  Stack[StackPtr-2].Free;
                  Stack[StackPtr-2]:=Stack[StackPtr-1];
                  Stack[StackPtr-1]:=Stack[StackPtr-2].Taylor(I,'X','0.0');
                  Redraw;
                 end;
               end;
   'O','o' :  if StackPtr>0 then
               begin
                Stack[StackPtr]:=Stack[StackPtr-1].Derive('X');
                Inc(StackPtr);
                Redraw;
               end;
   'D','d' :  If StackPtr>0 Then
                begin
                 Stack[StackPtr-1].free;
                 Dec(StackPtr);
                 Redraw;
                end;
   ' ',#39   : If Stackptr<100 then
                begin
                 GotoXY(1,1); Writeln(' ':60);
                 gotoxy(1,1); write('Enter expr. : '); readln(s);
                 s:=upcase(S);
                 stack[StackPtr]:=TExpression.Create(S);
                 Stack[StackPtr].Simplificationlevel:=2; {Don't add reals to integer. Only evaluates
                                                        (integer op integer) and (real op real) and
                                                        function(real)}
                 Inc(Stackptr);
                 Redraw;
                end;
   'X','x'  : begin
               ClrScr;
               Writeln(stdout,stack[StackPtr-1].InfixExpr);
               Writeln;
               Writeln(stdout,stack[StackPtr-1].RPNExpr);
               inputC:='q';
              end;
            end;
   until (InputC IN ['q','Q']);

If StackPtr>0 THEN
 For I:=0 To StackPtr-1 Do
  Stack[I].Free;
end.