Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Calc_EVal.bi
| Uploader: |  Eternal_Pain |
| Datum/Zeit: | 09.08.2007 20:28:27 |
/'
eval() v0.01 - written by Lutz Ifer (c) }:-> published under LGPL!
06 oct 2006, about 2:00am...
EVal v0.02
+StrReplace by Eternal Pain
+PI = "(ATN(1)*4)
+E = "*10^"
+, = "."
'/
#IfNDef _EVal_
#Define _EVal_
'#define __debug__
#ifdef __debug__
# define dprint(x) print x
#else
# define dprint(x)
#endif
#IFNDEF StrReplace
Declare Function StrReplace (Byval StrEx as String, _
Byval StrMask as String, _
Byval StrRplce as String) as String
'-----------------------------------------------------------------------------'
Function StrReplace (Byval StrEx as String, _
Byval StrMask as String, _
Byval StrRplce as String) as String
If Len(StrEx)=0 or Len(StrMask)>Len(StrEx) Then Return StrEx
Dim Buffer as String=StrEx
Dim MaskSearch as UInteger
Dim MFound as byte
Dim lp as UInteger=1
Do
MaskSearch=InStr(lp,Buffer,StrMask)
MFound=0
If MaskSearch Then
MFound=1:lp=MaskSearch+Len(StrRplce)
''
Buffer=Left(Buffer,MaskSearch-1)+ _
StrRplce+ _
Right(Buffer,Len(Buffer)-(MaskSearch+(Len(StrMask)-1)))
''
End If
Loop while MFound=1
Return Buffer
End Function
'-----------------------------------------------------------------------------'
#ENDIF
enum char
char_space
char_bracket
char_sys
char_num
char_alpha
char_operator
char_else
end enum
declare function eval(as string) as string
declare function eval_getchar(as ubyte) as char
declare function eval_adspace(as string) as integer
declare function eval_despace(as string) as integer
declare function eval_brackets_scan(as string) as string
declare function eval_functions_scan(as string) as string
declare function eval_functions_resolve(as integer, as string) as string
declare function eval_operators_scan(as string) as string
declare function eval_operators_resolve(as integer, as string, as string) as string
function eval(expression as string) as string
if len(expression) = 0 then return " EVal [v0.02 2007] - [v0.01 2006] written by Lutz Ifer (c) }:->"
dprint("eval("""""+expression+""""")")
dim as string e = trim(ucase(expression))
e=StrReplace(e,",",".")
e=StrReplace(e,"E","*10^")
e=StrReplace(e,"PI","(ATN(1)*4)")
dprint("- trimmed: "+chr(34)+e+chr(34))
if eval_adspace(e) then return e
if eval_despace(e) then return e
return eval_brackets_scan(e)
end function
function eval_getchar(character as ubyte) as char
select case as const character
case 32
return char_space
case 33
return char_alpha
case 35 to 38
return char_alpha
case 40, 41
return char_bracket
case 42, 43, 45, 47, 60, 61, 62, 92, 94
return char_operator
case 46
return char_num
case 48 to 57
return char_num
case 65 to 90
return char_alpha
case 97 to 112
return char_alpha
case else
return char_else
end select
end function
function eval_adspace(e as string) as integer
dprint("- adding space")
dprint("-- before: "+chr(34)+e+chr(34))
dim as integer i
dim as char chThis, chPrev = char_space
do
i += 1
if mid(e, i, 2) <> "&H" and mid(e, i, 2) <> "&O" then
chThis = eval_getchar(e[i-1])
if chThis = char_else then
e = "ERROR #1 - komisches Zeichen: [" _
+ str(e[i-1])+"|"+chr(e[i-1])+"]"
return -1
end if
if chPrev = char_sys then
if ((chThis=char_num) or (chThis=char_alpha)) then
chThis = chPrev
end if
end if
if chThis <> chPrev then
e = left(e, i-1) + " " + mid(e, i)
i += 1
end if
chPrev = chThis
else
chPrev = char_sys
i += 1
end if
loop until i = len(e)
dprint("-- after : "+chr(34)+e+chr(34))
return 0
end function
function eval_despace(e as string) as integer
dprint("- removing space")
dprint("-- before: "+chr(34)+e+chr(34))
dim as integer i = 1
do
if mid(e, i, 2) = " " then
e = left(e, i) + mid(e, i + 2)
else
i += 1
end if
loop until i >= len(e)
dprint("-- after : "+chr(34)+e+chr(34))
return 0
end function
function eval_brackets_scan(e as string) as string
dprint("- scanning for brackets")
dim as integer bracket_open, bracket_close, bracket_count
dprint("-- scanning in: "+chr(34)+e+chr(34))
for bracket_open = 1 to len(e)
if mid(e, bracket_open, 1) = "(" then exit for
next
if bracket_open >= len(e) then
dprint ("-- no opening brackets found")
return eval_functions_scan(e)
else
for bracket_close = bracket_open to len(e)
if mid(e, bracket_close, 1) = "(" then bracket_count += 1
if mid(e, bracket_close, 1) = ")" then bracket_count -= 1
if bracket_count <= 0 then exit for
next
dprint ("-- bracket found")
return eval_brackets_scan(_
left(e, bracket_open - 1) + _
eval_brackets_scan(_
mid(e, bracket_open + 1, bracket_close - bracket_open - 1)_
) + _
mid(e, bracket_close + 1))
end if
end function
function eval_functions_scan(e as string) as string
dprint("- scanning for functions")
dprint("-- scanning in "+chr(34)+e+chr(34))
dim as string functions(7) => {"NOT", "SQR", "SIN", "COS", "TAN", "ATN", "RND", "INT"}
dim as integer func_found, func_start, func_ende
for func_found = 0 to 7
func_start = instr(e, functions(func_found))
if func_start <> 0 then exit for
next
if func_start then
for func_ende = func_start + 5 to len(e)
if mid(e, func_ende, 1) = " " then exit for
next
dprint ("-- function found")
return eval_operators_scan(_
left(e, func_start - 1) + _
eval_functions_scan( _
eval_functions_resolve(func_found, _
mid(e, func_start + 3, func_ende - func_start - 3) _
) _
) + _
mid(e, func_ende))
else
dprint ("-- no functions found")
return eval_operators_scan(e)
end if
end function
function eval_functions_resolve(id as integer, e as string) as string
dprint ("--- functions resolve")
dprint ("--- resolving ("+str(id)+") <"+e+">")
select case as const id
case 0 : return str(not(val(eval_operators_scan(e))))
case 1 : return str(sqr(val(eval_operators_scan(e))))
case 2 : return str(sin(val(eval_operators_scan(e))))
case 3 : return str(cos(val(eval_operators_scan(e))))
case 4 : return str(tan(val(eval_operators_scan(e))))
case 5 : return str(atn(val(eval_operators_scan(e))))
case 6 : return str(rnd(val(eval_operators_scan(e))))
case 7 : return str(int(val(eval_operators_scan(e))))
end select
end function
function eval_operators_scan(e as string) as string
dprint("- scanning for operators")
dprint("-- scanning in "+chr(34)+e+chr(34))
dim as string operators(17) => {"^","*","/","\","MOD","+","-",">","<","=",">=","<=","<>","AND","OR","XOR","EQV","IMP"}
dim as integer oper_found, oper_pos, a_start, a_ende, b_start, b_ende
for oper_found = 0 to 17
oper_pos = instr(e, operators(oper_found))
if oper_pos <> 0 then exit for
next
if oper_pos then
for b_start = oper_pos + 1 to len(e)
if mid(e, b_start, 1) = " " then exit for
next
for b_ende = b_start + 1 to len(e)
if mid(e, b_ende, 1) = " " then exit for
next
for a_ende = oper_pos - 1 to 1 step -1
if mid(e, a_ende, 1) = " " then exit for
next
for a_start = a_ende - 1 to 1 step -1
if mid(e, a_start, 1) = " " then exit for
next
if oper_found = 6 then
if b_start - a_ende - 2 then
dprint("--- non-oper minus found, ignoring")
if instr(e, "#") then return e else return str(val(e))
end if
end if
dprint("-- operator found")
return eval_operators_scan(_
left(e, a_start)+_
eval_operators_resolve(_
oper_found,_
mid(e, a_start + 1, a_ende - a_start - 1),_
mid(e, b_start + 1, b_ende - b_start - 1))+_
mid(e, b_ende))
else
dprint("-- no operator found")
if instr(e, "#") then return e else return str(val(e))
end if
end function
function eval_operators_resolve(id as integer, a as string, b as string) as string
dprint ("--- operator resolve")
dprint ("--- resolving ("+str(id)+") <"+chr(34)+a+chr(34)+","+chr(34)+b+chr(34)+">")
select case as const id
case 0 : return str(val(a) ^ val(b))
case 1 : return str(val(a) * val(b))
case 2 : return str(val(a) / val(b))
case 3 : return str(val(a) \ val(b))
case 4 : return str(val(a) MOD val(b))
case 5 : return str(val(a) + val(b))
case 6 : return str(val(a) - val(b))
case 7 : return str(val(a) > val(b))
case 8 : return str(val(a) < val(b))
case 9 : return str(val(a) = val(b))
case 10 : return str(val(a) >= val(b))
case 11 : return str(val(a) <= val(b))
case 12 : return str(val(a) <> val(b))
case 13 : return str(val(a) AND val(b))
case 14 : return str(val(a) OR val(b))
case 15 : return str(val(a) XOR val(b))
case 16 : return str(val(a) EQV val(b))
case 17 : return str(val(a) IMP val(b))
end select
end function
#EndIf