<![CDATA[size : 6793
uploaded_on : Sat Jul 18 00:00:00 1998
modified_on : Wed Dec 8 14:03:07 1999
title : String parsing unit
org_filename : Parse.pas
author : Palfrader Peter
authoremail : Weasel@holidayinfo.com
description : Parsing strings
keywords :
tested : not tested yet
submitted_by : The CKB Crew
submitted_by_email : ckb@netalive.org
uploaded_by : nobody
modified_by : nobody
owner : nobody
lang : pas
file-type : text/plain
category : pascal-alg-maths
__END_OF_HEADER__
{
Written by Palfrader Peter (Weasel@holidayinfo.com) in 1998
for the Coder's Knowledge Base at http://www.netalive.org/ckb/
Released into Public Domain. Credits would be fine.
}
unit parse;
interface
type
TElementtype = (etOperator, etConst, etVar);
TOperatorType =(otPlus, otMinus, otMultiply, otDivide, otNegate);
TWhat = (wtLength, wtcode, wtElement);
PElement = ^TElement;
TElement = object {an element is either a operator, a value or a variable}
ElementType : TElementtype;
Operator : TOperatorType;
tree1, tree2 : PElement;
varName : string;
value : extended;
constructor init;
destructor done;
function calc : extended;
end;
TTree = object
top : PElement;
constructor init;
destructor done;
procedure FreeAll;
procedure Parse(parsestr : string);
function calc : extended;
end;
implementation
function GetVariableValue(varname : string) : extended;
begin end;
const
MaxLength=1024; {may be changed without any problems}
AllowedVarChars:set of char=['A'..'Z','a'..'z','_'];
type
TCharElement = record
what : TWhat;
case TWhat of
wtLength : ( Length : integer);
wtcode : ( code : char);
wtElement : ( Element : PElement);
end;
TItmStr = array[0..MaxLength-1] of TCharElement;
{**************** Element implementation ****************}
constructor TElement.init;
begin
tree1:=nil;
tree2:=nil;
varName:=' ';
ElementType:=etConst;
Operator:=otplus;
value:=0;
end;
destructor TElement.done;
begin
if tree1<>nil then dispose(tree1,done);
if tree2<>nil then dispose(tree2,done);
end;
function TElement.calc : extended;
begin
case ElementType of
etOperator :
case Operator of
otPlus : calc:=tree1^.calc+tree2^.calc;
otMinus : calc:=tree1^.calc-tree2^.calc;
otMultiply : calc:=tree1^.calc*tree2^.calc;
otDivide : calc:=tree1^.calc/tree2^.calc;
otNegate : calc:=-tree1^.calc;
end;
etconst : calc:=value;
etvar : calc:=GetVariableValue(varName);
end;
end;
{**************** Tree implementation ****************}
constructor TTree.init;
begin
Top:=nil;
end;
destructor TTree.done;
begin
FreeAll;
end;
procedure TTree.FreeAll;
begin
if Top<>nil then dispose(Top,done);
end;
function TTree.calc : extended;
begin
calc:=top^.calc;
end;
procedure TTree.Parse(parsestr : string);
function BaseConvert(str : string) : extended;
var
r:extended;
code:integer;
begin {if you want other bases than 10 be enabled
for example by adding a h at the end of the number,
do this yourself. The after a number will be in str}
val(str,r,code);
BaseConvert:=r;
end;
procedure Copyps(
var Dest : TItmStr;
Source : TItmStr;
fromi,toi : integer);
{Copy a part from to inclusive}
var
z : integer;
begin
fillchar(dest,sizeof(dest),0);
dest[0].what:=wtlength;
dest[0].length:=toi-fromi+1;
for z:=1 to dest[0].length do
dest[z]:=source[z+fromi-1];
end;
procedure Subststr(
VAR ItStr : TItmStr;
fromi,toi : integer;
Element : PElement);
{Substitute a part by a Item instead}
var
z : integer;
itstr2 : TItmStr;
begin
fillchar(itstr2,sizeof(itstr2),0);
itstr2[0].what:=wtlength;
itstr2[0].length:=itstr[0].length - toi + fromi;
for z:=1 to fromi-1 do itstr2[z]:=itstr[z];
itstr2[fromi].what :=wtelement;
itstr2[fromi].element:=element;
for z:=fromi+1 to itstr2[0].length do
itstr2[z]:=itstr[z-fromi+toi];
ItStr:=itstr2;
end;
procedure InsertElement(
VAR ItStr : TItmStr;
Pos : integer;
OpType : TOperatorType);
var
n { = new }: PElement;
begin
n:=nil;
new(n,init);
n^.ElementType := etoperator;
n^.Operator := OPType;
case OpType of
otPlus, otMinus, otMultiply, otDivide :
begin
n^.Tree1:=itstr[pos-1].element;
n^.Tree2:=itstr[pos+1].element;
subststr(itstr,pos-1,pos+1,n);
end;
otNegate :
begin
n^.Tree1:=itstr[pos+1].element;
subststr(itstr,pos,pos+1,n);
end;
end;
end;
function Parsblock(itstr : TItmStr) : PElement;
var
pos : integer;
z : integer;
s : integer;
itstr2 : TItmStr;
begin
pos:=1;
while pos<=itstr[0].length do
begin
if (itstr[pos].what=wtcode) and (itstr[pos].code='(') then
begin
z:=1;
s:=pos;
while z<>0 do
begin
inc(s);
if itstr[s].code='(' then
inc(z);
if itstr[s].code=')' then
dec(z);
end;
Copyps(itstr2,itstr,pos+1,s-1);
subststr(itstr,pos,s,Parsblock(itstr2));
end;
inc(pos);
end;
pos:=itstr[0].length; {this time from right to left so many - each after the other won't hurt}
while pos>=1 do
begin
if (itstr[pos].what=wtcode) and
(itstr[pos].code='-') and
( (pos=1) or (
(itstr[pos-1].what=wtcode) and
((itstr[pos-1].code='+') or (itstr[pos-1].code='-'))
)
)
then
InsertElement(itstr,pos,otnegate);
dec(pos);
end;
pos:=1;
while pos<=itstr[0].length do
begin
if (itstr(.pos.).what=wtcode) then
case itstr(.pos.).code of
'/' :
begin
InsertElement(itstr,pos,otdivide);
dec(pos);
end;
'*' :
begin
InsertElement(itstr,pos,otmultiply);
dec(pos);
end;
end;
inc(pos);
end;
pos:=1;
while pos<=itstr[0].length do
begin
if (itstr(.pos.).what=wtcode) and
(itstr(.pos.).code='-') then
begin
InsertElement(itstr,pos,otminus);
dec(pos);
end;
inc(pos);
end;
pos:=1;
while pos<=itstr[0].length do
begin
if (itstr(.pos.).what=wtcode) and
(itstr(.pos.).code='+') then
begin
InsertElement(itstr,pos,otplus);
dec(pos);
end;
inc(pos);
end;
Parsblock:=itstr[1].element;
end;
var
s : integer;
itstr : TItmStr;
newel : PElement;
tmp : string;
fromi : integer;
begin
FreeAll;
fillchar(itstr,sizeof(itstr),0);
itstr[0].what:=wtlength;
itstr[0].length:=length(parsestr);
for s:=1 to length(parsestr) do
begin
itstr[s].what:=wtcode;
itstr[s].code:=parsestr[s];
end;
s:=1;
while s<=itstr[0].length do {get constants}
begin
if (itstr[s].what=wtcode) and (itstr[s].code in ['0'..'9']) then
begin
fromi:=s;
tmp:='';
while (s<=itstr[0].length) and not (i
]]>