XProfan

declare y1%,y2%

proc Operator

    Parameters f$
    declare a%

    whileloop 5

        if Instr(Mid$("+-*/^",&Loop,1),f$)

            inc a%
            Break

        endif

    wend

    Return a%

endproc

proc GetBefore

    Parameters b$,r%
    Print "Durchsuche ",b$
    y1%=r%-1

    while And(InStr(Mid$(b$,y1%,1),".9876543210"),GT(y1%,1))

        Dec y1%

    wend

    Return Val(Mid$(b$,y1%,2))

endproc

proc GetAfter

    Parameters b$,r%
    y2%=r%+1

    while Instr(Mid$(b$,y2%,1),".9876543210")

        Inc y2%

    wend

    Return Val(Mid$(b$,r%+1,y2%-r%))

endproc

proc Parse

    Parameters fx$
    declare z$,y$,d%,c%,x$,xl%,erg$,a%,erg!,x1!,x2!,in%
    fx$=Translate$(Translate$(Translate$(Translate$(Translate$(Translate$(fx$,",","."),"{","("),"[","("),"}",")"),"]",")")," ","")
    Print "Optimierte Formel: "+fx$
    Noch abfragen ob Anz("(")=Anz(")")!!!

    while Instr("(",fx$)

        d%=Len(fx$)

        while Neq$("(",Mid$(fx$,d%,1))

            Dec d%

        wend

        x$=Right$(fx$,Len(fx$)-d%)
        x$=Left$(x$,Instr(")",x$))
        xl%=Len(x$)
        x$=Del$(x$,Len(x$),1)

        if Operator(x$)

            Print "Parse "+x$+"..."

            whileloop 5

                in%=Instr(Mid$("^*/+-",&Loop,1),x$)
                c%=&Loop

                while in%

                    a%=in%
                    x1!=GetBefore(x$,a%)
                    x2!=GetAfter(x$,a%)

                    if Equ(c%,1)

                        Print "Potenz"
                        erg!=x1!^x2!

                    elseif Equ(c%,2)

                        Print "Mal"
                        erg!=x1!*x2!

                    elseif Equ(c%,3)

                        Print "Durch"
                        erg!=x1!/x2!

                    elseif Equ(c%,4)

                        Print "Plus"
                        erg!=x1!+x2!

                    else

                        Print "Minus"
                        erg!=x1!-x2!

                    endif

                    y$=Del$(x$,1,y2%-1)
                    z$=If(Equ(y1%,1),"",Left$(x$,y1%-1))
                    x$=z$+Str$(erg!)+y$
                    Print Str$(x1!)+","+Str$(x2!)+"="+Str$(erg!)
                    Print "Neue Teilformel: "+x$
                    in%=Instr(Mid$("^*/+-",c%,1),x$)
                    waitinput

                wend

            wend

        endif

        fx$=Left$(fx$,d%-1)+Str$(erg!)+Right$(fx$,Len(fx$)-d%-xl%)
        Print "Neue Formel: "+fx$

    wend

    Return fx$

endproc

declare s$
cls
s$="(((3+5)*2+3*(12+345))+12)"
Print "Formel: "+s$
Print "Ergebnis: "+Parse(s$)
waitinput

Declare Y1%,Y2%

Proc Operator

    Parameters F$
    Declare A%

    Whileloop 5

        If Instr(Mid$("+-*/^",&Loop,1),F$)

            Inc A%
            Break

        Endif

    Wend

    Return A%
    *** zeigt, wieviele unterschiedliche Operatoren vorhanden sind
    *** ermittelt aber nicht, wieviele Operatoren insgesamt da sind
    *** (jeder Operator wird nur einmal (als erstes Vorkommen) gezählt

Endproc

Proc Getbefore

    Parameters B$,R%
    Print "Durchsuche ",B$
    Y1% = R% - 1

    While And(Instr(Mid$(B$,Y1%,1),".9876543210"),Gt(Y1%,1))

        *** Abbruchbedingung "Y1% > 1" sollte VOR "Mid$(..,Y1%,..)" stehen.
        *** (auch der Eintritt in die Schleife muß beachtet werden: was, wenn Y1% = 0 am Anfang)
        Dec Y1%

    Wend

    Return Val(Mid$(B$,Y1%,2))
    *** FEHLER: die Länge von Mid$ steht fest auf 2
    *** Außderdem wird Y1% auf ein Zeichen vor der ersten Ziffer oder auf Pos.1 stehen

Endproc

Proc Getafter

    Parameters B$,R%
    Y2% = R% + 1

    While Instr(Mid$(B$,Y2%,1),".9876543210")

        *** Ein String ist irgendwann mal zu Ende: ABFANGEN (B$)
        *** (Microsoft patcht immer noch an seinen programmierten Pufferüberläufen herum.)
        *** (Das hätten sie sich gespart, wenn sie immer alle Sonderfälle abgefangen hätten.)
        Inc Y2%

    Wend

    Return Val(Mid$(B$,R%+1,Y2%-R%))
    *** Probe:
    *** B$ = "(12+345"
    *** R% = 4
    *** Y2% = 8
    *** Val( Mid$("(12+345",5,4) ) == 345 ** ABER: es wurde 1 Stelle zuviel berechnet (4)

Endproc

Proc Parse

    Parameters Fx$
    Declare Z$,Y$,D%,C%,X$,Xl%,Erg$,A%,Erg!,X1!,X2!,In%
    *** die folgenden Translates sehen bei mir wunderschön eingerückt aus
    *** und die Parameter dann wieder ausgerückt - war sehr übersichtlich  ;-(
    Fx$ = Translate$(
    Translate$(
    Translate$(
    Translate$(
    Translate$(
    Translate$(Fx$,",","."),   wandle Komma in Punkt
    "{","("),   wandle geschweifte Klammer in runde K.
    "[","("),   wandle eckige K. in runde K.
    "}",")"),   wandle geschweifte Klammer in runde K.
    "]",")"),   wandle eckige K. in runde K.
    " ","")  entferne alle Leerzeichen
    Print "Optimierte Formel: "+Fx$
    Noch abfragen ob Anz("(")=Anz(")")!!!
    ***   If NEq(
    ***          ( Len(Fx$) - Len(Translate$(Fx$,"(","")) ),
    ***          ( Len(Fx$) - Len(Translate$(Fx$,")","")) )
    ***         )
    ***     Teletubby_Modus(ein)
    ***       say "ohh-ohhh"
    ***     Teletubby_Modus(aus)
    ***   EndIf

    While Instr("(",Fx$)

        *** ohne Klammern macht der Parser dicke Backen...
        D% = Len(Fx$)

        While Neq$("(",Mid$(Fx$,D%,1))

            Dec D%

        Wend

        X$ = Right$(Fx$,Len(Fx$)-D%)
        X$ = Left$(X$,Instr(")",X$))
        Xl% = Len(X$)
        X$ = Del$(X$,Len(X$),1)

        If Operator(X$)

            Print "Parse "+X$+"..."

            Whileloop 5

                In%=Instr(Mid$("^*/+-",&Loop,1),X$)
                C%=&Loop

                While In%

                    A% = In%
                    X1! = Getbefore(X$,A%)
                    X2! = Getafter(X$,A%)

                    If Equ(C%,1)

                        Print "Potenz"
                        Erg! = X1! ^ X2!

                    Elseif Equ(C%,2)

                        Print "Mal"
                        Erg! = X1! * X2!

                    Elseif Equ(C%,3)

                        Print "Durch"
                        Erg! = X1! / X2!

                    Elseif Equ(C%,4)

                        Print "Plus"
                        Erg! = X1! + X2!

                    Else

                        Print "Minus"
                        Erg! = X1! - X2!

                    Endif

                    Y$ = Del$(X$,1,Y2%-1)
                    Z$ = If(Equ(Y1%,1),"",Left$(X$,Y1%-1))
                    X$ = Z$ + Str$(Erg!) + Y$
                    Print Str$(X1!) + "," + Str$(X2!) + "=" + Str$(Erg!)
                    Print "Neue Teilformel: "+X$
                    In% = Instr(Mid$("^*/+-",C%,1),X$)
                    Waitinput

                Wend

            Wend

        Endif

        Fx$ = Left$(Fx$,D%-1) + Str$(Erg!) + Right$(Fx$,Len(Fx$)-D%-Xl%)
        Print "Neue Formel: "+Fx$

    Wend

    Return Fx$

Endproc

Declare S$
Cls
S$ = "(((3+5)*2+3*(12+345))+12)"
Print "Formel: "+S$
Print "Ergebnis: "+Parsepan>S$)
Waitinput
End