Evaluateur d'expressions mathématiques.

' Expression que l'on doit évaluer
dim Expr$
' Prochain caractère traité
dim nextchar$

dim evaluer, ErrMismatchC, Expression, factor, Fonction, GetFloat, i, term, value

dim chiffre_ou_lettre%, est_ce_un_chiffre%, est_ce_une_lettre%, false%, flag%, identifiant_valide%
dim operateur_niveau_un%, plus_ou_moins%, res%, true%, yy%

false%=0
true%=1

dim liste_operateurs_priorite_zero$, liste_operateurs_priorite_un$
dim c$, CRLF$, element$, erreur1$, erreur2$, erreur3$, erreur4$, erreur5$, erreur6$, GetIdent$, ligne$, nom$, ret$
CRLF$=chr$(13)

dll_on "kgf.dll"

' Contient la liste des variables avec leurs valeurs.
list 1

' Descriptions et codes d'erreurs possibles.
erreur1$ = "'%1' attendu"
erreur2$ = "Variable '%1' déjà déclaréz"
erreur3$ = "Variable '%1' inconnue"
erreur4$ = "Fonction '%1()' inconnue"
erreur5$ = "'%1' n'est pas un nom de variable valide"
erreur6$ = "'%1' non valide à la fin de l'expression"

' Liste des opérateurs de niveau de priorité 0 : Addition et Soustraction
liste_operateurs_priorite_zero$ = "+-"

' Liste des opérateurs de niveau de priorité 1 : Multiplication, Division, Division entière, Reste (modulo) et puissance
liste_operateurs_priorite_un$ = "*/\%^"

ligne$="2+3"
evaluer(ligne$)
terminate

' Fonction retournant la valeur de l'expression qu'elle reçoit en argument
sub evaluer(ligne$)
   
    expr$ = ligne$
    ' On initialise la lecture
    nextchar$ = left$(expr$, 1)

    ' On lance l'évaluation
    expression()
    evaluer = expression
    message ligne$+" = "+str$(evaluer)
    ' S'il reste quelque chose après l'évaluation, y a un PB !!
    if expr$ <> "" then erreur(erreur6$, 0, Expr$)

    dll_off

end_sub

' Renvoie True si C est un chiffre entre 0 et 9
sub est_ce_un_chiffre(c$)
   
    ' Dim A As Double
    ' A = Asc(C & vbNullChar)
    ' est_ce_un_chiffre = (A >= Asc("0") And A <= Asc("9"))
   
    est_ce_un_chiffre%=false%
    if instr("0123456789",c$)>0 then est_ce_un_chiffre%=true%

end_sub

' Renvoie True si C est une lettre entre a et z ou A et Z
sub est_ce_une_lettre(c$)
   
    ' Dim A As Double
    ' A = Asc(LCase$(C) & vbNullChar)
    ' est_ce_une_lettre = (A >= Asc("a") And A <= Asc("z"))

    est_ce_une_lettre%=false%
    if instr("abcdefghijklmnopqrstuvwxyz",lower$(c$))>0 then est_ce_une_lettre%=true%

end_sub

' Renvoie True si C est un chiffre entre 0 et 9 ou une lettre entre a et z ou A et Z
sub chiffre_ou_lettre(c$)

    ' chiffre_ou_lettre% = (est_ce_une_lettre(C) Or est_ce_un_chiffre(C))
   
    chiffre_ou_lettre%=false%
    if instr("0123456789abcdefghijklmnopqrstuvwxyz",lower$(c$))>0 then chiffre_ou_lettre%=true%

end_sub

' Renvoie True si C est + ou -
sub plus_ou_moins(c$)

    ' plus_ou_moins% = (InStr(AddOpList, vbNullChar & Left$(C, 1) & vbNullChar) <> 0)

    plus_ou_moins%=false%
    if left$(c$,1)="+" or left$(c$,1)="-" then plus_ou_moins%=true%

end_sub

' Renvoie True si C est *, /, \, % ou ^
sub operateur_niveau_un(c$)

    ' operateur_niveau_un = (InStr(MulOpList, vbNullChar & Left$(C, 1) & vbNullChar) <> 0)

    operateur_niveau_un%=false%
    if instr("*/\%^",left$(c$,1))>0 then operateur_niveau_un%=true%

end_sub

' Renvoie True si S est un identifiant valide (1er car = Lettre, autres cars = Chiffre ou lettre)
sub identifiant_valide(S$)
   
    ' On prend le 1er caract?re
    c$ = left$(S$,1)

    ' Si S ne commence pas par une lettre, ce n'est pas un identifiant
    est_ce_une_lettre(c$)
    if est_ce_une_lettre%=false%
      identifiant_valide% = false%
      ' Donc on sort
      exit_sub
    end_if

    ' On regarde à partir du 2eme caractère
    S$ = right_pos$(S$,2)

    ' Tant que la chaine n'est pas vide
    while S$ <> ""
        ' On prend le 1er caractère
        c$ = left$(S$,1)
        ' On le supprime de la chaine
        S$ = right_pos$(S$,2)
        ' Si ce n'est pas un chiffre ou une lettre, ce n'est pas un identifiant
        est_ce_un_chiffre(c$)
        est_ce_une_lettre(c$)
        if est_ce_un_chiffre%=false% or est_ce_une_lettre%=false%
          identifiant_valide% = false%
          ' Donc on sort
          exit_sub
        end_if
    end_while

    ' Si on arrive là, on a bien un identifiant
    identifiant_valide% = true%

end_sub

' Déclenche une erreur
sub erreur(Msg$, code, param3$)
   
    i = 1
    ' Tant qu'il y a un '%1', '%2', etc dans le message
    ' while inStr(Msg$, "%" + str$(i)) <> 0
        ' On le remplace par l'argument correspondant
        ' Msg$ = Replace$(Msg$, "%" + str$(i), param3$)
    ' end_while

    ' On déclenche l'erreur
    message "Erreur: "+str$(code)+CRLF$+Msg$
    dll_off
    terminate
   
end_sub

' Lit un identifiant dans l'expression
sub GetIdent()

    ' Si le prochain caractère n'est pas une lettre, inutile de continuer
    est_ce_une_lettre(nextchar$)
    if est_ce_une_lettre%=false% then erreur(erreur1$, ErrMismatchC, "Identifiant")
   
    ' On stocke le 1er cract?re
    ret$ = nextchar$
    ' On lit le suivant
    GetChar()
   
    ' Tant que c'est une lettre ou un chiffre
    while true%=1

        chiffre_ou_lettre(nextchar$)
        if chiffre_ou_lettre%=false% then exit_while

        ' On l'ajoute
        ret$ = ret$ + nextchar$
        ' On lit le caractère suivant
        GetChar()

    end_while

    ' On retourne le tout
    GetIdent$ = ret$

end_sub

' Lit un nombre décimal
sub GetFloat()
    ' Si le 1er caractère n'est pas un chiffre ou un '.', inutile de continuer
    est_ce_un_chiffre(nextchar$)
    if est_ce_un_chiffre%=false% and nextchar$ <> "." then erreur(erreur1$, ErrMismatchC, "Nombre")

    ' On stocke le 1er caractère
    ret$ = nextchar$
    ' On lit le suivant
    GetChar()
    ' Tant que l'on a des chiffre
    while true%=1
        est_ce_un_chiffre(nextchar$)
        if est_ce_un_chiffre%=false% then exit_while

        ' On les ajoute
        ret$ = ret$ + nextchar$
        ' Et on lit le suivant
        GetChar()
    end_while

    ' Si on s'est arrêté sur le '.' décimal
    if nextchar$ = "."
      ' On l'ajoute
      ret$ = ret$ + "."
      ' On lit le caractère suivant
      GetChar()

      ' Tant que l'on a des chiffre
      while true%=1
            est_ce_un_chiffre(nextchar$)
            if est_ce_un_chiffre%=false% then exit_while

            ' On les ajoute
            ret$ = ret$ + nextchar$
            ' On le lit caractère suivant
            GetChar()
      end_while
    end_if

    ' On retourne le tout, sans oublier de remplacer le '.' par une ',' (nous sommes en France !!)
    while true%=1
          yy%=instr(ret$,".")
          if yy%=0 then exit_while
         
          ret$=left$(ret$,yy%-1)+","+right_pos$(ret$,yy%+1)
    end_while

    GetFloat = val(ret$)
end_sub

' Lit le caractère suivant dans l'expression et le stocke dans nextchar$
sub GetChar()

    expr$ = right_pos$(expr$, 2)
    nextchar$ = left$(expr$, 1)

end_sub

' Déclenche une erreur si C ne correspond pas au prochain caractère de l'expression
sub match(c$)

    if nextchar$ = c$
      GetChar()
          else
      erreur(erreur1$+" ligne 268", ErrMismatchC, C$)
    end_if

end_sub

' Ajoute une variable à la collection
sub ajouter_variable_a_la_liste(nom$,valeur)
   
    ' Délenche une erreur si le nom transmis n'est pas un identifiant
    identifiant_valide(nom$)
    if identifiant_valide%=false% then erreur(erreur5$, ErrBadVarNameC, Nom$)

    chercher(nom$+";")
    if res%>0
      erreur(erreur2$, ErrDuplicateC, Nom$)
          else
      ' Sinon, ajoute la variable.
      add_item 1,nom$+";"+str$(valeur)
    end_if

end_sub

' Modifie la valeur d'une variable.
sub modifier_variable(nom$,Valeur)
   
    chercher(nom$+";")
    if res%=0
      erreur(erreur3$, ErrUnknownVarC, nom$)
          else
      item_delete 1,res%
      add_item 1,nom$+";"+str$(valeur)
    end_if

end_sub

' Evalue une fonction mathématique
' Ajouter du code ici pour augmenter le nombre de fonctions reconnues
sub fonction(nom$)

    flag%=0

    if nom$="cos"
      flag%=1
      expression()
      fonction = cos(expression)
    end_if
    if nom$="sin"
      flag%=1
      expression()
      fonction = sin(expression)
    end_if
    if nom$="tan"
      flag%=1
      expression()
      fonction = tan(expression)
    end_if
    if nom$="sqr"
      flag%=1
      expression()
      fonction = sqr(expression)
    end_if
    if nom$="log"
      flag%=1
      expression()
      fonction = log(expression)
    end_if

    ' Fonction inconnu donc déclenchement d'une erreur
    if flag%=0 then erreur(erreur4$, ErrUnknownFuncC, Nom$)

end_sub

' Evalue un facteur
sub factor()

    ' Si on est en présence d'une '(' -> Expression du genre ... *(a + 8)
    if nextchar$ = chr$(40)
      ' On s'assure d'avoir une parenthèse
      match(chr$(40))
      ' On évalue ce qu'il y a entre les parenthèses
      expression()
      Factor = Expression

      ' On absorbe la parenthèse fermante
      match(chr$(41))

          ' Si on est en présence d'une lettre
          else

      est_ce_une_lettre(nextchar$)
      if est_ce_une_lettre%=true%
          ' On lit l'identifiant qui vient
          GetIdent()
          Nom$ = GetIdent$

          ' Si après on a une '(' -> Expression du genre ... * cos(pi)
          if nextchar$ = chr$(40)
            ' On s'assure d'avoir une parenthèse
            match(chr$(40))
            ' On évalue la fonction
            fonction(nom$)
            factor=fonction
            ' On absorbe la parenthèse fermante
            match(chr$(41))
                else
            ' Sinon si c'est un nom de variable.
            chercher(nom$)
            if res%>0
                ' On retourne la valeur de celle-ci.
                factor = val(right_pos$(instr(item_read$(1,res%),";")+1))
                  else
                ' Sinon c'est une erreur
                erreur(erreur3$, ErrUnknownVarC, Nom$)
            end_if

          end_if
            else
          ' Sinon ca ne peut être qu'un nombre
          getfloat()
          factor = getFloat

      end_if
    end_if

end_sub

' Evalue un terme
sub term()

    ' On lit le 1er terme
    factor()
    value = factor

    ' Tant que l'on pointe sur un opérateur de niveau 1
    operateur_niveau_un(nextchar$)
    while operateur_niveau_un%=true%
        ' En fonction de l'operateur
            if nextchar$="*"
                ' On s'assure d'avoir un '*'
                match("*")
                ' On fait le calcul en évaluant le second facteur
                expression()
                value = value * expression
            end_if
            if nextchar$="/"
                ' On s'assure d'avoir un '/'
                match("/")
                ' On fait le calcul en évaluant le second facteur
                expression()
                value = value / expression
            end_if
            if nextchar$="\"
                ' On s'assure d'avoir un '\'
                match("\")
                ' On fait le calcul en évaluant le second facteur
                expression()
                value = value \ expression
            end_if
            if nextchar$="%"
                ' On s'assure d'avoir un '%'
                match("%")
                ' On fait le calcul en évaluant le second facteur
                expression()
                value = mod(value,expression)
            end_if
            if nextchar$="^"
                ' On s'assure d'avoir un '^'
                match("^")
                ' On fait le calcul en évaluant le second facteur
                expression()
                value = value ^ expression
            end_if
    end_while

    ' On retourne le résultat
    term = value
message "Ligne 441: "+str$(term)
end_sub

' Evalue une expression
sub expression()

    ' Si on a un '-' ou un '+' devant, c'est un opérateur unaire
    plus_ou_moins(nextchar$)
    if plus_ou_moins%=true%
      value = 0
          else
      term()
      value = term
    end_if

    ' Tant que l'on a un opérateur de niveau 0
    while true%=1
          plus_ou_moins(nextchar$)
          if plus_ou_moins%=false% then exit_while

          ' En fonction de l'opérateur
          if nextchar$="+"
            ' On s'assure d'avoir un '+'
            match("+")
            ' On fait le calcul en évaluant le second terme
            term()
          end_if

          if nextchar$="-"
            ' On s'assure d'avoir un '-'
            match("-")
            ' On fait le calcul en évaluant le second terme
            term()
            value = value - term
          end_if

    end_while

    ' On retourne le résultat
    expression = value

end_sub

sub chercher(element$)

    ' Recherche un élément dans une liste.
    ' On passe une chaîne de caractères en paramètre qui représente le début de l'élément recherché.
    ' On peut chercher également l'élément exact.
    ' La recherche est insensible à la casse.
    ' res% fournit 0 si l'élément n'est pas trouvé.

    res% = dll_call3("SearchListBox",handle(1),0,adr(element$))

end_sub