//--Info
// * Originally written by Madura Anushanga Shelton
// * Last updated: 16/09/09
// * Please give credit where credit is due, if you are planning to use this code
// or its ideas :D
//--
program Project1;
{$APPTYPE CONSOLE}
uses SysUtils;
var s:string; iWidth:integer; sTmp:string;
//--main cal functions
function add(sVal1,sVal2:string):string;
var r1,r2:real;
begin
val(sval1,r1,iWidth);
val(sval2,r2,iWidth);
result:=formatfloat('',r2+r1) ;
end;
function subtract(sVal1,sVal2:string):string;
var r1,r2:real;
begin
val(sval1,r1,iWidth);
val(sval2,r2,iWidth);
result:=formatfloat('',r1-r2) ;
end;
function divide(sVal1,sVal2:string):string;
var r1,r2:real;
begin
val(sval1,r1,iWidth);
val(sval2,r2,iWidth);
result:=formatfloat('',r1/r2) ;
end;
function multiply(sVal1,sVal2:string):string;
var r1,r2:real;
begin
val(sval1,r1,iWidth);
val(sval2,r2,iWidth);
result:=formatfloat('',r1*r2) ;
end;
//--
//--string manipulation and convertion
function Rev(sMain:string):string;
var s:string;i:integer;
begin
s:=smain;
for i := 1 to length(sMain) do
begin
s[length(sMain)-i+1]:=sMain[i];
end;
rev:= s;
end;
function Mid(const strMain:string;const iStart,iLen:Integer):string;
var i,j:integer;var strOut:string;
begin
j:=iLen;
if iLen = 0 then
begin
j:=length(strMain)-iStart;
end;
for i := 1 to j do
begin
strOut := strOut + strMain[i+iStart];
end;
result:=strout;
end;
function Replace(const strMain,strSearch,strReplace:string):string;
var i:integer;strOut:string;t:integer;
begin
//go through the string
i:=-1;
t:=1;
while (t=1) do
begin
i:=i+1;
if strSearch = mid(strMain,i,length(strSearch)) then
begin
strOut:=strOut+strReplace; //replace if found
i:= i+length(strSearch)-1;
end
else
begin
strOut:=strOut+mid(strMain,i,1); //if not found amend
end;
if i= length(strMain) then t:=0;
end;
result:=strOut;
end;
function InStr(const strMain,strSearch:string; iStart:integer=0):integer;
var i,j:integer;
begin
j:=-1;
for i := iStart to length(strMain) - length(strSearch) do
begin
if strSearch=mid(strMain,i,length(strSearch)) then
begin
j:=i;
break;
end;
end;
InStr:=j;
end;
function c_sr(sNum:string):real;
var r1:real;
begin
val(snum,r1,iWidth);
c_sr:=r1;
end;
function c_rs(rNum:real):string;
begin
c_rs:=formatfloat('',rNum);
end;
procedure GetNumbers(const strMain,strChk:string;var iL,iR:real;var strRep:string);
var i,j:integer;k,l:string; label 2;
begin
j:=instr(strmain,strChk,1);
for i := j+2 to length(strmain) do
begin
if ((strmain[i]='/') or (strmain[i]='*') or (strmain[i]='+') or (strmain[i]='-') )And not (j+2=i )then
begin
//if (strmain[i]='+') or (strmain[i]='-') then k:=k+strmain[i];
break;
end
else
begin
k:=k+strmain[i];
end;
end;
for i := j downto 1 do
begin
if (strmain[i]='/') or (strmain[i]='*') or (strmain[i]='+') or (strmain[i]='-') then
begin
if (strmain[i]='+') or (strmain[i]='-') then l:=l+strmain[i];
break;
end
else
begin
l:=l+strmain[i];
end;
end;
l:=rev(l);
iL:=c_sr(l);
iR:=c_sr(k);
strRep:=l+strchk+k;
end;
//--
//--recursive
function Division(const strMain:string;var strRes:string):string;
var sOut,sRep:string;r1,r2:real;
begin
if not (instr(strmain,'/') = -1) then
begin
getnumbers(strmain,'/',r1,r2,sRep);
sout:=replace(strmain,srep,c_rs(r1/r2));
if instr(sout,'/') = -1 then
strRes := sout
else
Division(sout,strRes);
end
else strres:=strmain;
end;
function Multiplication(const strMain:string;var strRes:string):string;
var sOut,sRep:string;r1,r2:real;
begin
if not (instr(strmain,'*') = -1) then
begin
getnumbers(strmain,'*',r1,r2,sRep);
sout:=replace(strmain,srep,c_rs(r1*r2));
if instr(sout,'*') = -1 then
strRes := sout
else
Multiplication(sout,strRes);
end
else strres:=strmain;
end;
function Addition(const strMain:string;var strRes:string):string;
var sOut,sRep:string;r1,r2:real;
begin
if not (instr(strmain,'+',1) = -1) then
begin
getnumbers(strmain,'+',r1,r2,sRep);
sout:=replace(strmain,srep,c_rs(r1+r2));
if instr(sout,'+') = -1 then
strRes := sout
else
Addition(sout,strRes);
end
else strres:=strmain;
end;
function Subtraction(const strMain:string;var strRes:string):string;
var sOut,sRep:string;r1,r2:real;
begin
if not (instr(strmain,'-',1) = -1) then
begin
getnumbers(strmain,'-',r1,r2,sRep);
sout:=replace(strmain,srep,c_rs(r1-r2));
if (instr(sout,'-') = -1) then
strRes := sout
else
Subtraction(sout,strRes);
end
else strres:=strmain;
end;
//--
//--Execution--no parenthesis level
function Execute(const str:string):string;
var i:integer; label 1;
begin
//BODMAS
if (trim(str)='') then begin stmp:=str; goto 1; end;
division(str,stmp);
multiplication(stmp,stmp);
addition(stmp,stmp);
subtraction(stmp,stmp);
1: Execute:=stmp;
end;
//--
//--Calculator-main
procedure CutParenthesis(strIn:string);
var i,j,k:integer; a:string;
begin
k:=0;
for i := 0 to length(strIn) do if strIn[i] = '(' then j:=i; //get last '('
for i := j to length(strIn) do if (strIn[i] = ')') and (k=0) then k:=i ; //first ')'
a:=mid(strIn,j,k-j-1); //execute a, a will not include '(',')'
strIn:=replace(strIn,'('+a+')',trim(Execute(a)));
if instr(strIn,'(')=-1 then
begin
strIn:=Execute(strIn);
writeln(' = '+strIn);
writeln('');
end
else
cutparenthesis(strIn);
end;
procedure Calc(); //main loop of the whole calculator
var s:string;
begin
stmp:='';
iWidth:=3;
s:='';
readln(s);
if not (instr(s,'{') = -1) then s:=replace(s,'{','(');
if not (instr(s,'[') = -1) then s:=replace(s,'[','(');
if not (instr(s,']') = -1) then s:=replace(s,']',')');
if not (instr(s,'}') = -1) then s:=replace(s,'}',')');
CutParenthesis(s);
end;
//--
//--Some DOS graphics :P
procedure PrintHeader();
var j:integer;
begin
for j := 1 to 80 do write('=');
writeln('');
writeln(' A Simple Scientific Calculator - Written by Madura Anushanga Shelton in Delphi');
writeln(' * Do NOT enter wrong expressions, it''ll not throw an error for wrong input.');
writeln('');
for j := 1 to 80 do write('=');
writeln('');
end;
//--
var i:integer;
begin
PrintHeader;
i:=0;
while i=0 do calc;
end.
