Code archives/Miscellaneous/skn3[ac]'s String/Int/Float Expression Evaluator with functions, variables, and more operators
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
Now has SetVar(varname$,expression$) and GetVar(varname$). Also some function examples, and string/int/float variables. Also I took the liberty of making errors none-fatal. skn3[ac] has made an excellent evaluator library and it has loads of potential. There's one bug I've noticed and fixing it is beyong me. It seems you can't have more than one bracket cluster in an expression. For example: (1+1)+(1+1). I've also noticed a few other strange problems, probably with my own code... like using variables inside brackets SOMETIMES doesn't seem to work. I haven't experimented enough to nail the problem. I'll probably update all this later. | |||||
;String/Int/Float evaluator for within Blitz by skn3[ac] ;Extra Operators, none-crash error trapping, functions and variables added by Streaksy ;Currently supported functions: Sin(),Cos(),Tan(),Atan(),Rnd(),Rand() ;---[ Variables ]------------------ Global MaxVars=2000,MaxStringVars=2000,MaxFloatVars=2000 Global Vars,StringVars,FloatVars Dim VarName$(MaxVars) Dim VarValue(MaxVars) Dim StringVarName$(MaxVars) Dim StringVarValue$(MaxVars) Dim FloatVarName$(MaxVars) Dim FloatVarValue#(MaxVars) ;---[ Operators ]------------------ Const OpTotal=15 Dim op$(OpTotal) op$(1)="^";POW op$(2)="*";MUL op$(3)="/";DIV op$(4)="+";ADD op$(5)="-";SUB op$(6)="|";OR op$(7)="&";AND op$(8)="~";XOR op$(9)="%";MOD op$(10)="=";EQU op$(11)="<";LES op$(12)=">";MOR op$(13)="{";ELS op$(14)="}";EMR op$(15)="@";NOT ;not really not... but "<>" Global ParseSeps$ For t=1 To optotal:parseseps=parseseps+op(t):Next ;---[ Reserverd ]------------------ Const ResTotal=11 Dim res$(ResTotal) res$(1)="0" res$(2)="1" res$(3)="2" res$(4)="3" res$(5)="4" res$(6)="5" res$(7)="6" res$(8)="7" res$(9)="8" res$(10)="9" res$(11)="." ;---[ Special ]------------------ Global SPEC_quote$=Chr$(34) ;---[ Eval_Error's ]------------------ Dim ers$(8) ers$(1)="Unexpected ')'" ers$(2)="Expecting expression" ers$(3)="Expecting operator" ers$(4)="Ilegal character" ers$(5)="Missing ')'" ers$(6)="Missing " + SPEC_quote$ + " end quote" ers$(7)="Value types incorrect" ers$(8)="Result of expression out of range" Global CalcError$ ;---Test--- ;---Test--- ;---Test--- SetVar "st$","teststring" ;setting strings doesnt evaluate the value. Use SetVar "st$",calculate("teststring"+"teststring") for that. SetVar "t","51+12" Graphics 800,300,32,2 Color 255,255,255 Print "Type an expression:" Print "The following variables are set: st$="+Chr(34)+getvar("st$")+Chr(34)+", t="+getvar("t") Print "The following functions are available: Sin(), Cos(), Tan(), ATan(), Rnd(), Rand()" Print "" .restart Color 255,255,0 ask$=Input$(">") If ask="" Then End result$=calculate$(ask$) ;Color 100,255,100:Print "Tokenised: "+filtersum(ask) If CalcError<>"" Then Color 255,0,0:Print CalcError Else Color 100,255,255:Print result Print "" Goto restart ;----------- ;----------- ;----------- Function GetVar$(n$) n=Lower(n) If Right(n,1)="#" Then typ=1:n=Left(n,Len(n)-1) If Right(n,1)="$" Then typ=2:n=Left(n,Len(n)-1) If typ=0 Then For t=1 To vars If varname(t)=n Then Return varvalue(t) Next EndIf If typ=0 Or typ=1 For t=1 To floatvars If floatvarname(t)=n Then Return floatvarvalue(t) Next EndIf If typ=0 Or typ=2 For t=1 To stringvars If stringvarname(t)=n Then Return stringvarvalue(t) Next EndIf If typ=0 Then Return 0 If typ=1 Then Return Float(0) If typ=2 Then Return "" End Function Function SetVar(n$,ex$) ;dont let a variable name start with anything other than a letter!! This function should really check for that... n=Lower(n) If Right(n,1)="#" Then typ=1:n=Left(n,Len(n)-1) If Right(n,1)="$" Then typ=2:n=Left(n,Len(n)-1) If typ=0 Then For t=1 To vars If varname(t)=n Then varvalue(t)=calculate(ex):Return Next EndIf If typ=0 Or typ=1 For t=1 To floatvars If floatvarname(t)=n Then floatvarvalue(t)=calculate(ex):Return Next EndIf If typ=0 Or typ=2 For t=1 To stringvars If stringvarname(t)=n Then stringvarvalue(t)=ex:Return Next EndIf If typ=0 Then If vars=maxvars Then RuntimeError "Out of integer variable space." vars=vars+1:varname(vars)=n:varvalue(vars)=calculate(ex) Return EndIf If typ=1 Then If floatvars=maxfloatvars Then RuntimeError "Out of float variable space." floatvars=floatvars+1:floatvarname(floatvars)=n:floatvarvalue(floatvars)=calculate(ex) Return EndIf If typ=2 Then If stringvars=maxstringvars Then RuntimeError "Out of string variable space." gotspeech=Instr(ex,Chr(34)) stringvars=stringvars+1:stringvarname(stringvars)=n If gotspeech Then stringvarvalue(stringvars)=calculate(ex) If Not gotspeech Then stringvarvalue(stringvars)=calculate(Chr(34)+ex+Chr(34)) Return EndIf End Function Function calculate$(sum$) If Trim(sum)="" Then Return 0 calcerror="" sum$=filtersum(sum) BRAK_x=1 BRAK_found=0 BRAK_getchar$="" BRAK_mode=False BRAK_marker=1 ;--[ Info ] ---- ;This loop cycles through the string 'sum$' finding the ;highest bracket. Once it finds it will calculate within the bracket. ;With the result from that calculation, it replaces the (x) bracket ;and its contense wit hthe result of the calculation. Repeat ;Get character from 'sum$' using the offset of 'BRAK_x' BRAK_getchar$=Mid$(sum$,BRAK_x,1) ;Test character's properties If BRAK_mode=False Then If BRAK_getchar$=SPEC_quote$ Then BRAK_mode=True BRAK_x=BRAK_x+1 ElseIf BRAK_getchar$="(" BRAK_found=BRAK_found+1 BRAK_marker=BRAK_x BRAK_x=BRAK_x+1 ElseIf BRAK_getchar$=")" ;--< Eval_Error >--"Unexpected ')'" If BRAK_found=0 Then Eval_Error ers$(1):Return Else If BRAK_x=BRAK_marker+1 Then ;--< Eval_Error >--"Expecting statement" Eval_Error ers$(2):Return Else ;--[ Found suitable bracket ]---- ;Calculate bracket contents GET_left$=Left$(sum$,BRAK_marker-1) GET_sum$=Mid$(sum$,BRAK_marker+1,BRAK_x-BRAK_marker-1) GET_right$=Right$(sum$,Len(sum$)-BRAK_x) sum$=GET_left$ + calculateSUB$(GET_sum$) + GET_right$ ;reset values BRAK_x=1 BRAK_found=BRAK_found-2 BRAK_marker=1 End If End If Else If BRAK_x>Len(sum$) Then If BRAK_found>0 Then Eval_Error ers$(5):Return Else ;--[ Found end of sum sucessfully ]---- ;check not end ;Calculate sum$ If Len(sum$)>2 Then sum$=calculateSUB$(sum$) End If ;END Return sum$ End If Else BRAK_x=BRAK_x+1 End If End If Else ;--[ Info ] ---- ;This section is to make sure quotes are read properly. If BRAK_getchar$=SPEC_quote$ Then BRAK_x=BRAK_x+1 BRAK_mode=False Else ;--< Eval_Error >--"Unexpected End to statement" If BRAK_x>=Len(sum$) Then Eval_Error ers$(6):Return Else BRAK_x=BRAK_x+1 End If End If End If Forever End Function Function calculateSUB$(sum$) CALC_x=1 CALC_mode=1 CALC_start=False CALC_getchar$="" CALC_makeTok$="" CALC_marker=1 CALC_op$="" CALC_val1$="" CALC_readtype1$="" CALC_val2$="" CALC_readtype2$="" CALC_type$="" ;---LOOP--- ;This loop checks the entire sum in order of OP preferance For TEST_loop=1 To optotal Repeat CALC_getchar$=Mid$(sum$,CALC_x,1) If CALC_mode=1 Then ;expected end of statement If CALC_x>Len(sum$) Then CALC_x=1 CALC_start=False Exit End If ;Find start of first value If CALC_Start=False Then If CALC_getchar$=" " Then CALC_x=CALC_x+1 Else CALC_marker=CALC_x ;Detect type of value to read in If CALC_getchar$=SPEC_quote$ Then ;IS a string CALC_readtype1$="string" CALC_start=True CALC_maketok$="" CALC_x=CALC_x+1 Else ;IS a value CALC_readtype1$="value" CALC_start=True CALC_maketok$="" End If End If Else ;---[ Parse value until operater is met ]------ If CALC_readtype1$="string" Then ;Looking for string If CALC_getchar$=SPEC_quote$ Then If CALC_x=Len(sum$) Then CALC_x=1 CALC_start=False Exit Else ;Find operator after quote GETSUB$="" Repeat CALC_x=CALC_x+1 If CALC_x=Len(sum$) Then CALC_x=1 CALC_start=False Exit End If GETSUB$=Mid$(sum$,CALC_x,1) Until GETSUB$<>" " ;Character after quote has been found ; ;If character = add and test loop then continue If op$(TEST_loop)=GETSUB$ Then ;Everything matches and is ready ;Check needs expression Eval_Error If CALC_x=Len(sum$) Then Eval_Error ers$(2):Return Else ;SWITCH TO MODE 2 CALC_val1$=CALC_maketok$ CALC_op$=op$(4) CALC_mode=2 CALC_x=CALC_x+1 CALC_maketok$="" CALC_start=False ;Stop End If Else ;Character was not ADD ;(only OP that can follow a String) ;so check OP is valid TEST_skip=False For TEST_array=1 To optotal If op$(TEST_array)=GETSUB$ Then TEST_skip=True Exit End If Next If TEST_skip=True Then CALC_start=False CALC_x=CALC_x+1 Else Eval_Error ers$(4) :Return End If End If End If Else If CALC_x=Len(sum$) Then Eval_Error ers$(6):Return Else CALC_maketok$=CALC_maketok$+CALC_getchar$ CALC_x=CALC_x+1 End If End If Else ;Looking for int / float ;--[info]-- ;Look For negative value symol First If CALC_getchar$="-" And Len(CALC_maketok$)=0 Then CALC_maketok$=CALC_maketok$+CALC_getchar$ If CALC_x=Len(sum$) Then Eval_Error ers$(2):Return Else CALC_x=CALC_x+1 End If Else ;CALC_getchar$ is not a negative symbol ;of the number so detect reserved chars TEST_found=False For TEST_array=1 To restotal If res$(TEST_array)=CALC_getchar$ Then ;Test to see if it turns INT into FLOAT If TEST_Array=11 Then If CALC_readtype1$="float" Then ;--< Eval_Error >--Float type already set extra '.' Eval_Error ers$(4):Return Else CALC_readtype1$="float" End If End If TEST_found=True Exit End If Next ;If Reserved character was met then add it to the token If TEST_found=True Then CALC_maketok$=CALC_maketok$+CALC_getchar$ CALC_x=CALC_x+1 Else If op$(TEST_loop)=CALC_getchar$ Then If Len(CALC_maketok$)=0 Then Eval_Error ers$(4):Return Else If CALC_x=Len(sum$) Then Eval_Error ers$(2):Return Else ;set values CALC_val1$=CALC_maketok$ CALC_op$=CALC_getchar$ CALC_mode=2 ;reset values CALC_start=False CALC_x=CALC_x+1 CALC_maketok$="" End If End If Else ;Make sure is proper character TEST_found=False For TEST_array=1 To optotal If op$(TEST_array)=CALC_getchar$ Then TEST_found=True Exit End If Next If TEST_found=True Then ;reset values CALC_start=False CALC_x=CALC_x+1 CALC_maketok$="" CALC_readtype1$="" Else Eval_Error ers$(4):Return End If End If End If End If End If End If ;---[ INFO ]-------------- ;The all important condition. ;This will compare the two values and effect them with the ;VAL1 and the OP that was got in MODE1 ElseIf CALC_mode=2 If CALC_start=False Then If CALC_getchar$=" " Then CALC_x=CALC_x+1 Else ;Value 3=string If CALC_getchar$=SPEC_quote$ Then ;set CALC_readtype2$="string" CALC_x=CALC_x+1 CALC_start=True CALC_maketok$="" Else CALC_readtype2$="value" CALC_start=True CALC_maketok$="" End If End If Else ;Parse until end If CALC_readtype2$="string" Then If CALC_getchar$=SPEC_quote$ Then ;---------------------- ;VALUE found finish off ;---------------------- ;End quote found so do sum and update MAKE_left$=Left$(sum$,CALC_marker-1) MAKE_right$=Right$(sum$,Len(sum$)-CALC_x) MAKE_sum$=CALC_val1$+CALC_maketok$ sum$=MAKE_left$+SPEC_quote$+MAKE_sum$+SPEC_quote$+MAKE_right$ ;reset CALC_x=1 CALC_mode=1 CALC_start=False CALC_type$="" CALC_val1$="" CALC_val2$="" CALC_op$="" CALC_readtype1$="" CALC_readtype2$="" CALC_maketok$="" CALC_marker=1 Else If CALC_x=Len(sum$) Then CALC_x=1 CALC_start=False End If CALC_maketok$=CALC_maketok$+CALC_getchar$ CALC_x=CALC_x+1 End If Else ;Look to make value negative ? If CALC_getchar$="-" And Len(CALC_maketok$)=0 Then CALC_maketok$=CALC_maketok$+CALC_getchar$ If CALC_x=Len(sum$) Then Eval_Error ers$(2):Return Else CALC_x=CALC_x+1 End If Else ;Is character a reserved character TEST_found=False For TEST_array=1 To restotal If res$(TEST_array)=CALC_getchar$ Then TEST_found=True If TEST_Array=11 Then CALC_readtype2$="float" End If Exit End If Next ;Character matches reserved character If TEST_found=True Then If CALC_x=Len(sum$) Then CALC_maketok$=CALC_maketok$+CALC_getchar$ ;---------------------- ;VALUE found finish off ;---------------------- MAKE_left$=Left$(sum$,CALC_marker-1) MAKE_right$=Right$(sum$,Len(sum$)-CALC_x) CALC_val2$=CALC_maketok$ If CALC_readtype1$="string" Then MAKE_sum$=CALC_val1$+CALC_val2$ sum$=MAKE_left$+SPEC_quote$+MAKE_sum$+SPEC_quote$+MAKE_right$ Else If CALC_readtype1$="value" Then Select CALC_op$ Case op$(1);POW MAKE_sum$=(Int(CALC_val1$)^Int(CALC_val2$)) Case op$(2);MUL MAKE_sum$=(Int(CALC_val1$)*Int(CALC_val2$)) Case op$(3);DIV MAKE_sum$=(Int(CALC_val1$)/Int(CALC_val2$)) Case op$(4);ADD MAKE_sum$=(Int(CALC_val1$)+Int(CALC_val2$)) Case op$(5);SUB MAKE_sum$=(Int(CALC_val1$)-Int(CALC_val2$)) Case op$(6);OR MAKE_sum$=(Int(CALC_val1$) Or Int(CALC_val2$)) Case op$(7);AND MAKE_sum$=(Int(CALC_val1$) And Int(CALC_val2$)) Case op$(8);XOR MAKE_sum$=(Int(CALC_val1$) Xor Int(CALC_val2$)) Case op$(9);MOD MAKE_sum$=(Int(CALC_val1$) Mod Int(CALC_val2$)) Case op$(10);EQU MAKE_sum$=(Int(CALC_val1$) = Int(CALC_val2$)) Case op$(11);LES MAKE_sum$=(Int(CALC_val1$) < Int(CALC_val2$)) Case op$(12);MOR MAKE_sum$=(Int(CALC_val1$) > Int(CALC_val2$)) Case op$(13);ELS MAKE_sum$=(Int(CALC_val1$) =< Int(CALC_val2$)) Case op$(14);EMR MAKE_sum$=(Int(CALC_val1$) => Int(CALC_val2$)) Case op$(15);NOT MAKE_sum$=(Int(CALC_val1$) <> Int(CALC_val2$)) End Select Else Select CALC_op$ Case op$(1);POW MAKE_sum$=(Float#(CALC_val1$)^Float#(CALC_val2$)) Case op$(2);MUL MAKE_sum$=(Float#(CALC_val1$)*Float#(CALC_val2$)) Case op$(3);DIV MAKE_sum$=(Float#(CALC_val1$)/Float#(CALC_val2$)) Case op$(4);ADD MAKE_sum$=(Float#(CALC_val1$)+Float#(CALC_val2$)) Case op$(5);SUB MAKE_sum$=(Float#(CALC_val1$)-Float#(CALC_val2$)) Case op$(6);OR MAKE_sum$=(Float#(CALC_val1$) Or Float#(CALC_val2$)) Case op$(7);AND MAKE_sum$=(Float#(CALC_val1$) And Float#(CALC_val2$)) Case op$(8);XOR MAKE_sum$=(Float#(CALC_val1$) Xor Float#(CALC_val2$)) Case op$(9);MOD MAKE_sum$=(Float#(CALC_val1$) Mod Float#(CALC_val2$)) Case op$(10);EQU MAKE_sum$=(Float#(CALC_val1$) = Float#(CALC_val2$)) Case op$(11);LES MAKE_sum$=(Float#(CALC_val1$) < Float#(CALC_val2$)) Case op$(12);MOR MAKE_sum$=(Float#(CALC_val1$) > Float#(CALC_val2$)) Case op$(13);ELS MAKE_sum$=(Float#(CALC_val1$) =< Float#(CALC_val2$)) Case op$(14);EMR MAKE_sum$=(Float#(CALC_val1$) => Float#(CALC_val2$)) Case op$(15);NOT MAKE_sum$=(Float#(CALC_val1$) <> Float#(CALC_val2$)) End Select End If ;NUMBEr OUT OF RANGE If MAKE_sum$="Infinity" Then Eval_Error ers$(8):Return Else sum$=MAKE_left$+MAKE_sum$+MAKE_right$ End If End If ;RESET VALUES CALC_x=1 CALC_mode=1 CALC_start=False CALC_type$="" CALC_val1$="" CALC_val2$="" CALC_op$="" CALC_readtype1$="" CALC_readtype2$="" CALC_maketok$="" CALC_marker=1 ;///////////FINISH END///////////// Else CALC_maketok$=CALC_maketok$+CALC_getchar$ CALC_x=CALC_x+1 End If Else ;is not reserved character If CALC_x>Len(sum$) Then Eval_Error ers$(2):Return Else ;Check it is a valid character TEST_found=False For TEST_array=1 To optotal If op$(TEST_array)=CALC_getchar$ Then TEST_found=True Exit End If Next If TEST_found=True Then ;---------------------- ;VALUE found finish off ;---------------------- MAKE_left$=Left$(sum$,CALC_marker-1) MAKE_right$=Right$(sum$,Len(sum$)-CALC_x+1) CALC_val2$=CALC_maketok$ If CALC_readtype1$="string" Then MAKE_sum$=CALC_val1$+CALC_val2$ sum$=MAKE_left$+SPEC_quote$+MAKE_sum$+SPEC_quote$+MAKE_right$ Else If CALC_readtype1$="value" Then Select CALC_op$ Case op$(1);POW MAKE_sum$=(Int(CALC_val1$)^Int(CALC_val2$)) Case op$(2);MUL MAKE_sum$=(Int(CALC_val1$)*Int(CALC_val2$)) Case op$(3);DIV MAKE_sum$=(Int(CALC_val1$)/Int(CALC_val2$)) Case op$(4);ADD MAKE_sum$=(Int(CALC_val1$)+Int(CALC_val2$)) Case op$(5);SUB MAKE_sum$=(Int(CALC_val1$)-Int(CALC_val2$)) Case op$(6);OR MAKE_sum$=(Int(CALC_val1$) Or Int(CALC_val2$)) Case op$(7);AND MAKE_sum$=(Int(CALC_val1$) And Int(CALC_val2$)) Case op$(8);XOR MAKE_sum$=(Int(CALC_val1$) Xor Int(CALC_val2$)) Case op$(9);MOD MAKE_sum$=(Int(CALC_val1$) Mod Int(CALC_val2$)) Case op$(10);EQU MAKE_sum$=(Int(CALC_val1$) = Int(CALC_val2$)) Case op$(11);LES MAKE_sum$=(Int(CALC_val1$) < Int(CALC_val2$)) Case op$(12);MOR MAKE_sum$=(Int(CALC_val1$) > Int(CALC_val2$)) Case op$(13);ELS MAKE_sum$=(Int(CALC_val1$) =< Int(CALC_val2$)) Case op$(14);EMR MAKE_sum$=(Int(CALC_val1$) => Int(CALC_val2$)) Case op$(15);NOT MAKE_sum$=(Int(CALC_val1$) <> Int(CALC_val2$)) End Select Else Select CALC_op$ Case op$(1);POW MAKE_sum$=(Float#(CALC_val1$)^Float#(CALC_val2$)) Case op$(2);MUL MAKE_sum$=(Float#(CALC_val1$)*Float#(CALC_val2$)) Case op$(3);DIV MAKE_sum$=(Float#(CALC_val1$)/Float#(CALC_val2$)) Case op$(4);ADD MAKE_sum$=(Float#(CALC_val1$)+Float#(CALC_val2$)) Case op$(5);SUB MAKE_sum$=(Float#(CALC_val1$)-Float#(CALC_val2$)) Case op$(6);OR MAKE_sum$=(Float#(CALC_val1$) Or Float#(CALC_val2$)) Case op$(7);AND MAKE_sum$=(Float#(CALC_val1$) And Float#(CALC_val2$)) Case op$(8);XOR MAKE_sum$=(Float#(CALC_val1$) Xor Float#(CALC_val2$)) Case op$(9);MOD MAKE_sum$=(Float#(CALC_val1$) Mod Float#(CALC_val2$)) Case op$(10);EQU MAKE_sum$=(Float#(CALC_val1$) = Float#(CALC_val2$)) Case op$(11);LES MAKE_sum$=(Float#(CALC_val1$) < Float#(CALC_val2$)) Case op$(12);MOR MAKE_sum$=(Float#(CALC_val1$) > Float#(CALC_val2$)) Case op$(13);ELS MAKE_sum$=(Float#(CALC_val1$) =< Float#(CALC_val2$)) Case op$(14);EMR MAKE_sum$=(Float#(CALC_val1$) => Float#(CALC_val2$)) Case op$(15);NOT MAKE_sum$=(Float#(CALC_val1$) <> Float#(CALC_val2$)) End Select End If ;NUMBEr OUT OF RANGE If MAKE_sum$="Infinity" Then Eval_Error ers$(8):Return Else sum$=MAKE_left$+MAKE_sum$+MAKE_right$ End If End If ;RESET VALUES CALC_x=1 CALC_mode=1 CALC_start=False CALC_type$="" CALC_val1$="" CALC_val2$="" CALC_op$="" CALC_readtype1$="" CALC_readtype2$="" CALC_maketok$="" CALC_marker=1 ;///////////FINISH END///////////// Else Eval_Error ers$(4):Return End If End If End If End If End If End If End If Forever Next If Left$(sum$,1)=SPEC_quote$ Then Return Mid$(sum,2,Len(sum$)-2) Else Return sum$ End If End Function Function Parseargument$(ss$,sp,seplist$=" ") If ss$="" Then Return stt=1:For tt=1 To Len(ss$);trim spaces off start! mm$=Mid$(ss$,tt,1) If mm$<>" " Then stt=tt:Exit Next For tt=stt To Len(ss$) ;find start of word If sp-1=Spaces Then ws=tt:Exit mm$=Mid$(ss$,tt,1) If Instr(seplist$,mm$) Then Spaces=Spaces+1 Next If ws=0 Then Return ;bad scr_argument! out of range and stuff If ws=Len(ss$) Then Return Right$(ss$,1) wrd$="" For tt = ws To Len(ss$) k$=Mid$(ss$,tt,1) If Instr(seplist,k$)=0 Then wrd$=wrd$+k$ Else Return wrd$ If tt=Len(ss$) Then Return wrd$ Next End Function Function Parsearguments(S$,sep$=" ") argz=0:newword=1 For t=1 To Len(s$) m$=Mid(s$,t,1) If newword=1 Then argz=argz+1:newword=0 For sp=1 To Len(sep$) o$=Mid(sep,sp,1) If o$=m$ Then newword=1:Exit Next Next Return argz End Function Function parseArgumentSeperator$(ss$,sp,seplist$=" ") If ss$="" Then Return stt=1:For tt=1 To Len(ss$);trim spaces off start! mm$=Mid$(ss$,tt,1) If mm$<>" " Then stt=tt:Exit Next For tt=stt To Len(ss$) ;find start of word If sp-1=Spaces Then ws=tt:Exit mm$=Mid$(ss$,tt,1):lastsep$=mm If Instr(seplist$,mm$) Then Spaces=Spaces+1 Next If ws=0 Then Return ;bad scr_argument! out of range and stuff If ws=Len(ss$) Then outo$=lastsep$:Goto retty;Right$(ss$,1) wrd$="" For tt = ws To Len(ss$) k$=Mid$(ss$,tt,1):lastsep$=k If Instr(seplist,k$)=0 Then wrd$=wrd$+k$ Else outo$=k$:Goto retty If tt=Len(ss$) Then outo$=lastsep$:Goto retty Next Return .retty If Instr(seplist,outo) Then Return outo End Function Function FilterSum$(Sum$) If Len(sum)=1 Then Return filtersegment(sum) sum2$="":lastpoint=1 Repeat:t=t+1 c$=Mid(sum,t,1) If c=Chr(34) Then speech=speech+1 If speech=1 Then seg$=Mid(sum,lastpoint,t-lastpoint) ;outside a string seg=FilterSegment(seg) sum2=sum2+""+seg+"" lastpoint=t+1 Else seg$=Mid(sum,lastpoint,t-lastpoint) ;inside a string sum2=sum2+""+Chr(34)+seg+Chr(34)+"" speech=0 lastpoint=t+1 EndIf c=0 EndIf Until t=Len(sum) If lastpoint<t Then seg$=Mid(sum,lastpoint,t-lastpoint+1) ;outside a string seg=FilterSegment(seg) sum2=sum2+""+seg+"" lastpoint=t+1 EndIf Return sum2 End Function Function FilterSegment$(seg$) seg=Lower(seg) seg=Replace(seg,"=<","{") seg=Replace(seg,"<=","{") seg=Replace(seg,"=>","}") seg=Replace(seg,">=","}") seg=Replace(seg,"><","@") seg=Replace(seg,"<>","@") args=ParseArguments(seg,parseseps+" ") For a=1 To args arg$=ParseArgument(seg,a,ParseSeps+" ") sep$=ParseArgumentSeperator(seg,a,ParseSeps+" ") If arg="and" Then arg="&" If arg="or" Then arg="|" If arg="mod" Then arg="%" If arg="xor" Then arg="~" If Len(arg)>1 Then rt$=Right(arg,1) If rt="#" Then ctyp=1:arg=Left(arg,Len(arg)-1) If rt="$" Then ctyp=2:arg=Left(arg,Len(arg)-1) EndIf If Len(arg)>2 Then ;FUNCTIONS If Right(arg,1)=")" Then Fnc$=parseargument(arg,1,"(") If Right(fnc,1)="%" Then fnc=Left(fnc,Len(fnc)-1) If Right(fnc,1)="$" Then fnc=Left(fnc,Len(fnc)-1) If Right(fnc,1)="#" Then fnc=Left(fnc,Len(fnc)-1) FncArgs$=Mid(arg,Len(fnc)+2,Len(arg)-Len(fnc)-2) If Fnc="sin" Then arg=Sin(calculate(fncargs)) If Fnc="cos" Then arg=Cos(calculate(fncargs)) If Fnc="tan" Then arg=Tan(calculate(fncargs)) If Fnc="atan" Then arg=ATan(calculate(fncargs)) If Fnc="rnd" Then arg=Rnd( calculate(parseargument(fncargs,1,",)")) , calculate(parseargument(fncargs,2,",)")) ) If Fnc="rand" Then arg=Rand( calculate(parseargument(fncargs,1,",)")) , calculate(parseargument(fncargs,2,",)")) ) EndIf EndIf If vtyp=0 Then For t=1 To vars ;VARIABLES If varname(t)=arg Then arg=varvalue(t):Goto gotvar Next EndIf If vtyp=0 Or vtyp=1 Then For t=1 To stringvars If stringvarname(t)=arg Then arg=Chr(34)+stringvarvalue(t)+Chr(34):Goto gotvar Next EndIf If vtyp=0 Or vtyp=1 Then For t=1 To floatvars If floatvarname(t)=arg Then arg=floatvarvalue(t):Goto gotvar Next EndIf .gotvar segout$=segout+arg+sep Next segout=Replace(segout," ","") If Len(segout)>0 Then L$=Right(segout,1) For t=1 To optotal If l=op(t) Then segout=Left(segout,Len(segout)-1):Exit Next EndIf Return segout End Function Function Eval_Error(message$) ;temp error message CalcError=Message ;RuntimeError message$ + " AT:line " + GLOBAL_line End Function |
Comments
| ||
Cool nice additions! Sorry I can't look into the bug, my time is very pressed! Plus it is 5 year old code.. ACK lol |
| ||
I'd kill for a bug-free evaluater suite :P |
Code Archives Forum