PureBasic

Forums PureBasic - Français
http://forums.purebasic.com/french/

Editeur expression

http://forums.purebasic.com/french/viewtopic.php?t=16487

Page 1 sur 1

Editeur expression

Publié : lun. 13/févr./2017 8:18
par Shadow
Salut,

Je souhaiterais faire un éditeur d'expression pour calculer une opération et aussi la vérifier.
Je sais que c'est un travail énorme, et que je n'est pas les compétences pour.

Existe t-il un code que je pourrais utiliser ?
J'ai rien trouver sur ce forum.

J'ai réussi à adapté un code de Danilo qui date de 2011 qu'on m'as donnée:
http://forums.purebasic.com/german/view ... =8&t=24256

C'est déjà pas mal, un bon début mais ça ne fait pas tous
notamment les expressions de mats.

Existe t-il un editeur d'expression complet ?
Faudrait que ça face toutes les expressions math de pb.

Je poste mon code d'adaptation au cas ou ça intéresse:

Code : Tout sélectionner

; Interface Editeur D'expression 01.01
; Créer par Monsieur Dieppedalle David le 12/02/2017.

#GENERATE_STACKMASCHINE_ASM = 1

; by Danilo, May 2011
; german forum: http://forums.purebasic.com/german/viewtopic.php?f=8&t=24256
XIncludeFile "Evaluate.pbi"

Procedure.l Option_Fenetre(SystemMenu, TitleBar, MinimizeGadget, MaximizeGadget, SizeGadget, ScreenCentered, WindowCentered, Tool, Minimize, Maximize, BorderLess, NoGadgets, Invisible)
  
  If SystemMenu = 1
    Option_Fenetre|#PB_Window_SystemMenu
  EndIf
  
  If TitleBar = 1
    Option_Fenetre|#PB_Window_TitleBar
  EndIf
  
  If MinimizeGadget = 1
    Option_Fenetre|#PB_Window_MinimizeGadget
  EndIf
  
  If MaximizeGadget = 1
    Option_Fenetre|#PB_Window_MaximizeGadget
  EndIf
  
  If SizeGadget = 1
    Option_Fenetre|#PB_Window_SizeGadget
  EndIf
  
  If ScreenCentered = 1
    Option_Fenetre|#PB_Window_ScreenCentered
  EndIf
  
  If WindowCentered = 1
    Option_Fenetre|#PB_Window_WindowCentered
  EndIf
  
  If Tool = 1
    Option_Fenetre|#PB_Window_Tool
  EndIf
  
  If Minimize = 1
    Option_Fenetre|#PB_Window_Minimize
  EndIf
  
  If Maximize = 1
    Option_Fenetre|#PB_Window_Maximize
  EndIf
  
  If BorderLess = 1
    Option_Fenetre|#PB_Window_BorderLess
  EndIf
  
  If NoGadgets = 1
    Option_Fenetre|#PB_Window_NoGadgets
  EndIf
  
  If Invisible = 1
    Option_Fenetre|#PB_Window_Invisible
  EndIf
  
  ProcedureReturn Option_Fenetre
EndProcedure

Global Numero_InterfaceEditeurExpression = 1
Global Position_X_InterfaceEditeurExpression = 440
Global Position_Y_InterfaceEditeurExpression = 170
Global Largeur_InterfaceEditeurExpression = 395
Global Hauteur_InterfaceEditeurExpression = 435
Global Titre_InterfaceEditeurExpression$ = "Editeur D'expression 1.01"
Global Option_InterfaceEditeurExpression = Option_Fenetre(1, 1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0)

Enumeration
  #Boutton_0
  #Boutton_1
  #Boutton_2
  #Boutton_3
  #Boutton_4
  #Boutton_5
  #Boutton_6
  #Boutton_7
  #Boutton_8
  #Boutton_9
  #Boutton_Point
  #Boutton_Or
  #Boutton_Xor
  #Boutton_And
  #Boutton_Divise
  #Boutton_Parenthese_Ouvrente
  #Boutton_Parenthese_Fermente
  #Boutton_Plus
  #Boutton_Moins
  #Boutton_Multiplie
  #Boutton_Inferieur
  #Boutton_Superieur_Ou_Egale
  #Boutton_Inferieur_Ou_Egale
  #Boutton_Decalage_Droite
  #Boutton_Decalage_Gauche
  #Boutton_Superieur
  #Boutton_Not
  #Boutton_Modulo_Binaire
  #Boutton_Exponentiel
  #Boutton_Hexadecimal
  #Boutton_Different
  #Boutton_Egale
  #Editor_Opperation
  #Editor_Resultat_Opperation
  #Editor_Erreur
  #ButtonImage_Valider
  #ButtonImage_Annuler
  #Text_Info_Expression
  #Text_Info_Resultat_Opperation
  #Text_Info_Erreur
EndEnumeration

Procedure myErrorHandler(ERREUR.l,arg1.s)
  Define msg.s
  
  Select ERREUR
    Case #evalError_HexNumExpected
      msg="ERREUR: nombre HEX attendu après $"
    Case #evalError_BinNumExpected
      msg="ERREUR: nombre binaire attendu après %"
    Case #evalError_IllegalInput
      msg="ERREUR: entrée illégale détectée: '" + arg1 +"' - (Chr: "+Str(Asc(arg1))+")"
    Case #evalError_MissingOperator
      msg="ERREUR: opérateur attendue"
    Case #evalError_MissingOperand
      msg="ERREUR: opérande manquant après: " +arg1
    Case #evalError_MissingExpression
      msg="ERREUR: expression attendue après " + arg1
    Case #evalError_MissingRParenthesis
      msg="ERREUR: ')' manquant"
    Case #evalError_MissingDecimalPlace
      msg="ERREUR: . manquant après la décimale"
    Case #evalError_BinaryNotWithFloats
      msg="ERREUR: "+arg1+" binaire avec des valeurs en virgule flottante n'est pas pris en charge, utiliser des entiers"
    Case #evalError_DivisionWithNull
      msg="ERREUR: division par 0"
    Case #evalError_ModuloWithNull
      msg="ERREUR: modulo (%) par 0"
    Case #evalError_TokenCantStartExpression
      msg="ERREUR: "+arg1+" ne peut pas commencer une expression"
    Default
      msg="ERREUR: erreur inconnue"
  EndSelect
  AddGadgetItem(#Editor_Erreur,-1,msg)
EndProcedure

Procedure InterfaceEditeurExpression()
  
  If OpenWindow(Numero_InterfaceEditeurExpression, Position_X_InterfaceEditeurExpression, Position_Y_InterfaceEditeurExpression, Largeur_InterfaceEditeurExpression, Hauteur_InterfaceEditeurExpression, Titre_InterfaceEditeurExpression$, Option_InterfaceEditeurExpression)
    
    ; Création des Gadgets:
    ButtonGadget(#Boutton_0, 10, 395, 75, 30, "0")
    GadgetToolTip(#Boutton_0, "0")
    ButtonGadget(#Boutton_1, 10, 360, 35, 30, "1")
    GadgetToolTip(#Boutton_1, "1")
    ButtonGadget(#Boutton_2, 50, 360, 35, 30, "2")
    GadgetToolTip(#Boutton_2, "2")
    ButtonGadget(#Boutton_3, 90, 360, 35, 30, "3")
    GadgetToolTip(#Boutton_3, "3")
    ButtonGadget(#Boutton_4, 10, 325, 35, 30, "4")
    GadgetToolTip(#Boutton_4, "4")
    ButtonGadget(#Boutton_5, 50, 325, 35, 30, "5")
    GadgetToolTip(#Boutton_5, "5")
    ButtonGadget(#Boutton_6, 90, 325, 35, 30, "6")
    GadgetToolTip(#Boutton_6, "6")
    ButtonGadget(#Boutton_7, 10, 290, 35, 30, "7")
    GadgetToolTip(#Boutton_7, "7")
    ButtonGadget(#Boutton_8, 50, 290, 35, 30, "8")
    GadgetToolTip(#Boutton_8, "8")
    ButtonGadget(#Boutton_9, 90, 290, 35, 30, "9")
    GadgetToolTip(#Boutton_9, "9")
    ButtonGadget(#Boutton_Point, 90, 395, 35, 30, ".")
    GadgetToolTip(#Boutton_Point, ".")
    ButtonGadget(#Boutton_Or, 310, 360, 35, 30, "Or")
    GadgetToolTip(#Boutton_Or, "Ou Logique (|)")
    ButtonGadget(#Boutton_Xor, 350, 360, 35, 30, "Xor")
    GadgetToolTip(#Boutton_Xor, "Ou Exclusif Logique (!)")
    ButtonGadget(#Boutton_And, 310, 325, 35, 30, "And")
    GadgetToolTip(#Boutton_And, "Et Logique (&)")
    ButtonGadget(#Boutton_Divise, 130, 290, 35, 30, "/")
    GadgetToolTip(#Boutton_Divise, "Division")
    ButtonGadget(#Boutton_Parenthese_Ouvrente, 310, 290, 35, 30, "(")
    GadgetToolTip(#Boutton_Parenthese_Ouvrente, "Parenthese Fermente")
    ButtonGadget(#Boutton_Parenthese_Fermente, 350, 290, 35, 30, ")")
    GadgetToolTip(#Boutton_Parenthese_Fermente, "Parenthese Ouvrente")
    ButtonGadget(#Boutton_Plus, 130, 395, 35, 30, "+")
    GadgetToolTip(#Boutton_Plus, "Addition")
    ButtonGadget(#Boutton_Moins, 130, 360, 35, 30, "-")
    GadgetToolTip(#Boutton_Moins, "Soustraction")
    ButtonGadget(#Boutton_Multiplie, 130, 325, 35, 30, "*")
    GadgetToolTip(#Boutton_Multiplie, "Multiplication")
    ButtonGadget(#Boutton_Inferieur, 220, 290, 35, 30, "<")
    GadgetToolTip(#Boutton_Inferieur, "Inferieur à")
    ButtonGadget(#Boutton_Superieur_Ou_Egale, 260, 325, 35, 30, ">=")
    GadgetToolTip(#Boutton_Superieur_Ou_Egale, "Supérieur ou égale à")
    ButtonGadget(#Boutton_Inferieur_Ou_Egale, 220, 325, 35, 30, "<=")
    GadgetToolTip(#Boutton_Inferieur_Ou_Egale, "Inferieur ou egale à")
    ButtonGadget(#Boutton_Decalage_Droite, 260, 395, 35, 30, ">>")
    GadgetToolTip(#Boutton_Decalage_Droite, "Décalage à droite")
    ButtonGadget(#Boutton_Decalage_Gauche, 220, 395, 35, 30, "<<")
    GadgetToolTip(#Boutton_Decalage_Gauche, "Décalage à gauche")
    ButtonGadget(#Boutton_Superieur, 260, 290, 35, 30, ">")
    GadgetToolTip(#Boutton_Superieur, "Superieur à")
    ButtonGadget(#Boutton_Not, 350, 325, 35, 30, "Not")
    GadgetToolTip(#Boutton_Not, "N'est pas (~)")
    ButtonGadget(#Boutton_Modulo_Binaire, 170, 325, 35, 30, "%")
    GadgetToolTip(#Boutton_Modulo_Binaire, "Modulo / Binaire")
    ButtonGadget(#Boutton_Exponentiel, 170, 290, 35, 30, "^")
    GadgetToolTip(#Boutton_Exponentiel, "Exponentiel")
    ButtonGadget(#Boutton_Hexadecimal, 170, 360, 35, 30, "$")
    GadgetToolTip(#Boutton_Hexadecimal, "Hexadecimal")
    ButtonGadget(#Boutton_Different, 220, 360, 75, 30, "<>")
    GadgetToolTip(#Boutton_Different, "Différent de")
    ButtonGadget(#Boutton_Egale, 170, 395, 35, 30, "=")
    GadgetToolTip(#Boutton_Egale, "Egale à")
    EditorGadget(#Editor_Opperation, 10, 27, 375, 95)
    EditorGadget(#Editor_Resultat_Opperation, 10, 153, 375, 20, #PB_Editor_ReadOnly)
    TextGadget(#Text_Info_Expression, 10, 10, 375, 15, "Entrez votre expression:", #PB_Text_Center)
    EditorGadget(#Editor_Erreur, 10, 205, 375, 75, #PB_Editor_ReadOnly)
    TextGadget(#Text_Info_Resultat_Opperation, 10, 137, 375, 15, "Résultat:", #PB_Text_Center)
    TextGadget(#Text_Info_Erreur, 10, 188, 375, 15, "Erreurs:", #PB_Text_Center)
    ButtonImageGadget(#ButtonImage_Valider, 310, 395, 35, 30, 0)
    ButtonImageGadget(#ButtonImage_Annuler, 350, 395, 35, 30, 0)
    
    SetActiveGadget(#Editor_Opperation)
    
    Repeat ; Départ des évènements de boucle
      
      Event = WaitWindowEvent(1) ; Cette ligne attend pendent (Minuteur) qu'un évènement soit recus par la fenêtre
      EventWindow = EventWindow() ; La fenêtre ou l'évènement c'est produit
      EventGadget = EventGadget() ; Pour savoir sur quel gadget c'est produis l'évènement
      EventMenu = EventMenu() ; Pour savoir sur quel menue c'est produis l'évènement
      EventType = EventType() ; Le type d'évènement qui c'est produis sur le gadget
      
      Select Event
          
        Case 512 ; Déplacement de la souris sur la fenêtre
          
        Case 513 ; Bouton gauche appuiler avec la souris sur la fenêtre
          
        Case 514 ; Bouton gauche relacher avec la souris sur la fenêtre
          
        Case 515 ; Double clique gauche avec la souris sur la fenêtre
          
        Case 516 ; Bouton droit appuiler avec la souris sur la fenêtre
          
        Case 517 ; Bouton droit relacher avec la souris sur la fenêtre
          
        Case 518 ; Double clique droit avec la souris sur la fenêtre
          
        Case #PB_Event_Gadget
          
          Select EventGadget
              
            Case #Boutton_0
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, "0")
              
            Case #Boutton_1
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, "1")
              
            Case #Boutton_2
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, "2")
              
            Case #Boutton_3
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, "3")
              
            Case #Boutton_4
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, "4")
              
            Case #Boutton_5
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, "5")
              
            Case #Boutton_6
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, "6")
              
            Case #Boutton_7
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, "7")
              
            Case #Boutton_8
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, "8")
              
            Case #Boutton_9
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, "9")
              
            Case #Boutton_Point
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, ".")
              
            Case #Boutton_Or
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, "Or")
              
            Case #Boutton_Xor
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, "Xor")
              
            Case #Boutton_And
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, "And")
              
            Case #Boutton_Not
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, "Not")
              
            Case #Boutton_Parenthese_Ouvrente
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, "(")
              
            Case #Boutton_Parenthese_Fermente
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, ")")
              
            Case #Boutton_Plus
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, "+")
              
            Case #Boutton_Moins
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, "-")
              
            Case #Boutton_Multiplie
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, "*")
              
            Case #Boutton_Divise
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, "/")
              
            Case #Boutton_Inferieur
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, "<")
              
            Case #Boutton_Superieur
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, ">")
              
            Case #Boutton_Superieur_Ou_Egale
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, ">=")
              
            Case #Boutton_Inferieur_Ou_Egale
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, "<=")
              
            Case #Boutton_Different
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, "<>")
              
            Case #Boutton_Egale
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, "=")
              
            Case #Boutton_Decalage_Droite
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, ">>")
              
            Case #Boutton_Decalage_Gauche
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, "<<")
              
            Case #Boutton_Modulo_Binaire
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, "%")
              
            Case #Boutton_Exponentiel
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, "^")
              
            Case #Boutton_Hexadecimal
              SendMessage_(GadgetID(#Editor_Opperation), #EM_REPLACESEL, 0, "$")
              
            Case #Editor_Opperation
              
              Texte$ = ""
              
              ClearGadgetItems(#Editor_Erreur)
              
              For i = 0 To CountGadgetItems(#Editor_Opperation)
                Texte$ + GetGadgetItemText(#Editor_Opperation,i)
              Next
              
              ResultatExpressionEvaluer$ = Evaluate(Texte$)
              SetGadgetText(#Editor_Resultat_Opperation, ResultatExpressionEvaluer$)
              
            Case #Editor_Erreur
              
              
            Case #Text_Info_Expression
              
              
            Case #Text_Info_Erreur
              
              
            Case #ButtonImage_Valider
              Debug ResultatExpressionEvaluer$
              
            Case #ButtonImage_Annuler
              Event = #PB_Event_CloseWindow
              CloseWindow(Numero_InterfaceEditeurExpression)
              
          EndSelect
          
        Case #PB_Event_Menu
          
          Select EventMenu
              
            Case 0
              
          EndSelect
          
        Case #PB_Event_CloseWindow  
          
      EndSelect
      
    Until Event = #PB_Event_CloseWindow ; Fin des évènements de boucle
    
  EndIf
  
EndProcedure

SetEvaluateErrorHandler(@myErrorHandler())
InterfaceEditeurExpression()

Re: Editeur expression

Publié : lun. 13/févr./2017 8:18
par Shadow
Le code de Danilo:

Code : Tout sélectionner

;-[ INCLUDE: Evaluate.pbi ]-------------------------------------------------------------------------
;
;
; by Danilo, May 2011
;
; german forum: http://forums.purebasic.com/german/viewtopic.php?f=8&t=24256
;
;
; PUSH   value    - push a value onto the stack
; NEG             - negate top stack value
; NOT             - binary NOT top stack value
;
;
; MATH OPERATIONS with 2 operands: lhs OP rhs
;
; the following commands each take the 2 topmost
; values off the stack and push the result of the
; operation onto the stack:
;
; ADD, SUB, MUL, DIV, MOD, POW, OR, AND, XOR, SHL, SHR
;
;
; BOOL COMPARE with 2 operands: lhs CMP rhs
;
; the following compare commands each take the 2 topmost
; values off the stack and push the bool result of the
; compare operation onto the stack:
;
; CMP.Equal
; CMP.NotEqual
; CMP.GreaterThan
; CMP.GreaterEqual
; CMP.SmallerThan
; CMP.SmallerEqual
;
;
; LOGICAL BOOLEAN OPERATIONS with 2 operands: lhs LOGICAL rhs
;
; the following commands each take the 2 topmost
; values off the stack and push the bool result of the
; operation onto the stack:
;
; LOGICAL.OR
; LOGICAL.AND
; LOGICAL.XOR
;
; LOGICAL BOOLEAN OPERATIONS with 1 operand: LOGICAL rhs
;
; LOGICAL.NOT
;
;
;
;>-----------------------------------
; order of operator precedence      ;
;>------------------------------------ high
;                                   ;
; ()   ~    NOT  - (unary minus)    ;- __parseFactor()
;                                   ;
; &    |    !                       ;- __parseExpression6()
;                                   ;
; <<   >>                           ;- __parseExpression5()
;                                   ;
; *    /    %    ^                  ;- __parseExpression4()
;                                   ;
; +    -                            ;- __parseExpression3()
;                                   ;
; <    >    <=   =<   >=   =>       ;- __parseExpression2()
;                                   ;
; =    <>                           ;- __parseExpression1()
;                                   ;
; OR   AND  XOR                     ;- __parseExpression()
;                                   ;
;>------------------------------------ low


Enumeration
    #__firstToken

    #tkError
    #tkEndOfInput
    #tkIdentifier
    #tkInteger
    #tkFloat
    
    #tkLParenthesis      ; '('
    #tkRParenthesis      ; ')'
    #tkDollar            ; '$'

    #__firstOperator
        #tkAdd           ; '+'
        #tkSub           ; '-'
        #tkMul           ; '*'
        #tkDiv           ; '/'
        #tkMod           ; '%'
        #tkPow           ; '^'
        
        #tkShiftLeft     ; '<<'
        #tkShiftRight    ; '>>'
        
        #tkBinaryAnd     ; '&'
        #tkBinaryOr      ; '|'
        #tkBinaryXor     ; '!'
        #tkBinaryNot     ; '~'
        
        #tkLogicalOr     ; 'OR'
        #tkLogicalAnd    ; 'AND'
        #tkLogicalXor    ; 'XOR'
        #tkLogicalNot    ; 'NOT'
        
        #tkEqual         ; '='
        #tkNotEqual      ; '<>'
        #tkGreaterThan   ; '>'
        #tkSmallerThan   ; '<'
        #tkGreaterEqual  ; '>='  '=>'
        #tkSmallerEqual  ; '<='  '=<'
    #__lastOperator

    #__lastToken
EndEnumeration

Enumeration
    #evalError_MissingExpression
    #evalError_HexNumExpected
    #evalError_BinNumExpected
    #evalError_IllegalInput
    #evalError_MissingOperand
    #evalError_MissingOperator
    #evalError_MissingRParenthesis
    #evalError_MissingDecimalPlace
    #evalError_BinaryNotWithFloats
    #evalError_DivisionWithNull
    #evalError_ModuloWithNull
    #evalError_TokenCantStartExpression
EndEnumeration

Structure Token
   spelling.s
   type.l
EndStructure

Prototype.l EvaluateErrorHandler(Error.l,arg1.s="")
Prototype.l EvaluateAsmHandler(asmOutput.s)

Global NewMap EvaluateVariables.s()

Global *start.Character
Global evaluateErrorHandler.EvaluateErrorHandler = 0
Global evaluateAsmOutput.EvaluateAsmHandler      = 0

Procedure __error(error.l,arg1.s="")
    ; call user defined error procedure
    If evaluateErrorHandler
        ProcedureReturn evaluateErrorHandler(error,arg1)
    EndIf
EndProcedure

Procedure __emitReal(output.s)
    ; call user defined AsmOutput procedure
    If evaluateAsmOutput
        ProcedureReturn evaluateAsmOutput(output)
    EndIf
EndProcedure

Macro __emit(output) ; output pseudo-asm
    ; if #GENERATE_STACKMASCHINE_ASM is true, call __emitReal()
    ; otherwise insert no code
    CompilerIf #GENERATE_STACKMASCHINE_ASM
        __emitReal(output)
    CompilerEndIf
EndMacro

Procedure.s __getEvaluateVariable(name.s)
    If FindMapElement(EvaluateVariables(),name)
        ProcedureReturn Trim(EvaluateVariables())
    EndIf
    ProcedureReturn "0"
EndProcedure

Procedure.l __germanUmlaut(char.c)
    If char='ä' Or char='ö' Or char='ü' Or char='Ä' Or char='Ö' Or char='Ü' Or char='ß'
        ProcedureReturn #True
    EndIf
    ProcedureReturn #False
EndProcedure

Procedure __removeWhiteSpace()
    ; remove spaces and tabs
    While *start\c = ' ' Or *start\c = #TAB
        *start + SizeOf(Character)
    Wend
EndProcedure

Procedure.s __removeFloatEnding(input.s)
    ; remove ending Null (.00000) from floats
    If FindString(input,".",1)
        input = RTrim(input,"0")
    EndIf
    input = RTrim(input,".")
    ProcedureReturn input
EndProcedure

Procedure __checkKeywords(identifier.s)
    ; switch keywords
    ; faster with a sorted string table
    ; or a hash table for many keywords,
    ; but ok here
    Select UCase(identifier)
        Case "AND"   : ProcedureReturn #tkLogicalAnd
        Case "NOT"   : ProcedureReturn #tkLogicalNot
        Case "OR"    : ProcedureReturn #tkLogicalOr
        Case "XOR"   : ProcedureReturn #tkLogicalXor
    EndSelect
    ProcedureReturn #tkIdentifier
EndProcedure


Procedure __getToken(*tk.Token, lookUpOnly.l=0)
    Define *oldStart.Character = *start

    If *start And *tk
        *tk\spelling = ""
        *tk\type     = 0
        __removeWhiteSpace()
        Select *start\c 
            Case '0' To '9'                                                             ; numbers 0-9
                While *start\c >= '0' And *start\c <= '9'
                    *tk\spelling + Chr(*start\c)
                    *start + SizeOf(Character)
                Wend
                If *start\c = '.'                                                       ; float numbers .0-9
                    *tk\spelling + "."
                    *start + SizeOf(Character)
                    While *start\c >= '0' And *start\c <= '9'
                        *tk\spelling + Chr(*start\c)
                        *start + SizeOf(Character)
                    Wend
                    If Right(*tk\spelling,1)="."
                        *tk\spelling = "ERREUR"
                        *tk\type     = #tkError
                        __error(#evalError_MissingDecimalPlace)
                        ProcedureReturn 0
                    EndIf
                    *tk\type     = #tkFloat
                Else
                    *tk\type     = #tkInteger
                EndIf
            Case 'a' To 'z' , 'A' To 'Z' , '_','ä','ö','ü','Ä','Ö','Ü','ß'              ; identifiers
                While (*start\c >= 'a' And *start\c <= 'z') Or (*start\c >= 'A' And *start\c <= 'Z') Or (*start\c >= '0' And *start\c <= '9') Or *start\c = '_' Or __germanUmlaut(*start\c)
                    *tk\spelling + Chr(*start\c)
                    *start + SizeOf(Character)
                Wend
                *tk\type     = __checkKeywords(*tk\spelling)
            Case '$'                                                                    ; '$' hexnumbers
                *tk\spelling + Chr(*start\c)
                *start + SizeOf(Character)
                __removeWhiteSpace()
                While (*start\c >= '0' And *start\c <= '9') Or (*start\c >= 'a' And *start\c <= 'f') Or (*start\c >= 'A' And *start\c <= 'F')
                    *tk\spelling + Chr(*start\c)
                    *start + SizeOf(Character)
                Wend
                If Len(*tk\spelling)<2
                    *tk\spelling = "ERREUR"
                    *tk\type     = #tkError
                    __error(#evalError_HexNumExpected)
                    ProcedureReturn 0
                EndIf
                *tk\spelling = Str(Val(*tk\spelling))
                *tk\type     = #tkInteger
            Case '+'                                                                    ; '+'
                *tk\spelling + Chr(*start\c)
                *tk\type     = #tkAdd
                *start + SizeOf(Character)
            Case '-'                                                                    ; '-'
                *tk\spelling + Chr(*start\c)
                *tk\type     = #tkSub
                *start + SizeOf(Character)
            Case '*'                                                                    ; '*'
                *tk\spelling + Chr(*start\c)
                *tk\type     = #tkMul
                *start + SizeOf(Character)
            Case '/'                                                                    ; '/'
                *tk\spelling + Chr(*start\c)
                *tk\type     = #tkDiv
                *start + SizeOf(Character)
            Case '%'                                                                    ; '%'
                *tk\spelling + Chr(*start\c)
                *tk\type     = #tkMod
                *start + SizeOf(Character)
            Case '^'                                                                    ; '^'
                *tk\spelling + Chr(*start\c)
                *tk\type     = #tkPow
                *start + SizeOf(Character)
            Case '&'                                                                    ; '&'
                *tk\spelling + Chr(*start\c)
                *tk\type     = #tkBinaryAnd
                *start + SizeOf(Character)
            Case '|'                                                                    ; '|'
                *tk\spelling + Chr(*start\c)
                *tk\type     = #tkBinaryOr
                *start + SizeOf(Character)
            Case '!'                                                                    ; '!'
                *tk\spelling + Chr(*start\c)
                *tk\type     = #tkBinaryXor
                *start + SizeOf(Character)
            Case '~'                                                                    ; '~'
                *tk\spelling + Chr(*start\c)
                *tk\type     = #tkBinaryNot
                *start + SizeOf(Character)
            Case '('                                                                    ; '('
                *tk\spelling + Chr(*start\c)
                *tk\type     = #tkLParenthesis
                *start + SizeOf(Character)
            Case ')'                                                                    ; ')'
                *tk\spelling + Chr(*start\c)
                *tk\type     = #tkRParenthesis
                *start + SizeOf(Character)
            Case '='                                                                    ; '='
                *tk\spelling + Chr(*start\c)
                *tk\type     = #tkEqual
                *start + SizeOf(Character)
                __removeWhiteSpace()
                If *start\c = '>'                                                       ; '=>'
                    *tk\spelling + Chr(*start\c)
                    *tk\type     = #tkGreaterEqual
                    *start + SizeOf(Character)
                ElseIf *start\c = '<'                                                   ; '=<'
                    *tk\spelling + Chr(*start\c)
                    *tk\type     = #tkSmallerEqual
                    *start + SizeOf(Character)
                EndIf
            Case '<'                                                                    ; '<'
                *tk\spelling + Chr(*start\c)
                *tk\type     = #tkSmallerThan
                *start + SizeOf(Character)
                __removeWhiteSpace()
                If *start\c = '>'                                                       ; '<>'
                    *tk\spelling + Chr(*start\c)
                    *tk\type     = #tkNotEqual
                    *start + SizeOf(Character)
                ElseIf *start\c = '='                                                   ; '<='
                    *tk\spelling + Chr(*start\c)
                    *tk\type     = #tkSmallerEqual
                    *start + SizeOf(Character)
                ElseIf *start\c = '<'                                                   ; '<<'
                    *tk\spelling + Chr(*start\c)
                    *tk\type     = #tkShiftLeft
                    *start + SizeOf(Character)
                EndIf
            Case '>'                                                                    ; '>'
                *tk\spelling + Chr(*start\c)
                *tk\type     = #tkGreaterThan
                *start + SizeOf(Character)
                __removeWhiteSpace()
                If *start\c = '='                                                       ; '>='
                    *tk\spelling + Chr(*start\c)
                    *tk\type     = #tkGreaterEqual
                    *start + SizeOf(Character)
                ElseIf *start\c = '>'                                                   ; '>>'
                    *tk\spelling + Chr(*start\c)
                    *tk\type     = #tkShiftRight
                    *start + SizeOf(Character)
                EndIf
            Case 0                                                                      ; 0 = end of input
                *tk\type     = #tkEndOfInput
                ProcedureReturn 0
            Default                                                                     ; ERROR, unsupported input
                *tk\spelling = "ERREUR"
                *tk\type     = #tkError
                __error(#evalError_IllegalInput,Chr(*start\c))
                *start + SizeOf(Character)
                ProcedureReturn 0
        EndSelect
        If lookUpOnly
            *start = *oldStart
        EndIf
        ProcedureReturn *tk\type
    EndIf
    ProcedureReturn 0
EndProcedure

Declare __parseExpression(*tk.Token)

Procedure __parseFactor(*tk.Token)
    Define tk.Token
    *tk\spelling = ""
    *tk\type     = 0
    If __getToken(*tk)
        Select *tk\type
            Case #tkInteger                                                             ; integer number
                __emit("  PUSH "+*tk\spelling)
                ProcedureReturn #True
            Case #tkFloat                                                               ; float number
                __emit("  PUSH "+*tk\spelling)
                *tk\spelling = __removeFloatEnding(*tk\spelling)
                If FindString(*tk\spelling,".",1)
                    *tk\type = #tkFloat
                Else
                    *tk\type = #tkInteger
                EndIf
                ProcedureReturn #True
            Case #tkIdentifier                                                          ; identifier = variable
                __emit("  PUSH "+*tk\spelling)
                *tk\spelling = __getEvaluateVariable(*tk\spelling)
                If Left(*tk\spelling,1)="$"     ; hex number
                    *tk\spelling = Str(Val(*tk\spelling))
                    *tk\type = #tkInteger
                ElseIf Left(*tk\spelling,1)="%" ; binary number
                    *tk\spelling = Str(Val(*tk\spelling))
                    *tk\type = #tkInteger
                Else
                    *tk\spelling = __removeFloatEnding(*tk\spelling)
                    If FindString(*tk\spelling,".",1)
                        *tk\type = #tkFloat
                    Else
                        *tk\type = #tkInteger
                    EndIf
                EndIf
                ProcedureReturn #True
            Case #tkSub                                                                 ; unary minus
                If __parseFactor(*tk)
                    If *tk\type = #tkInteger Or *tk\type = #tkFloat
                        ;__emit("  PUSH "+*tk\spelling)
                        __emit("  NEG")
                        *tk\spelling = "-"+*tk\spelling
                        ProcedureReturn #True
                    EndIf
                Else
                    *tk\spelling = "ERREUR"
                    __error(#evalError_MissingOperand, "- (unary minus)")
                    ProcedureReturn 0
                EndIf
            Case #tkBinaryNot                                                           ; '~' binary NOT
                If __parseFactor(*tk)
                    If *tk\type = #tkInteger
                        __emit("  NOT")
                        *tk\spelling = Str(~Val(*tk\spelling))
                        ProcedureReturn #True
                    Else
                        *tk\spelling = "ERREUR"
                        __error(#evalError_BinaryNotWithFloats,"NOT")
                        ProcedureReturn 0
                    EndIf
                Else
                    *tk\spelling = "ERREUR"
                    __error(#evalError_MissingOperand, "~ (binary NOT)")
                    ProcedureReturn 0
                EndIf
            Case #tkLogicalNot                                                          ; 'NOT' LOGICAL.NOT
                If __parseFactor(*tk)
                    __emit("  LOGICAL.NOT")
                    If ValD(*tk\spelling)
                        *tk\spelling = "0"
                    Else
                        *tk\spelling = "1"
                    EndIf
                    *tk\type     = #tkInteger
                    ProcedureReturn #True
                Else
                    *tk\spelling = "ERREUR"
                    __error(#evalError_MissingExpression, "NOT")
                    ProcedureReturn 0
                EndIf
            Case #tkMod                                                                 ;'%' binary number
                __removeWhiteSpace()
                If *start\c = '0' Or *start\c = '1'
                    While *start\c = '0' Or *start\c = '1'
                        *tk\spelling + Chr(*start\c)
                        *start + SizeOf(Character)
                    Wend
                    *tk\spelling = Str(Val(*tk\spelling))
                    *tk\type     = #tkInteger
                    __emit("  PUSH "+*tk\spelling)
                    ProcedureReturn #True
                Else
                    *tk\spelling = "ERREUR"
                    *tk\type     = #tkError
                    __error(#evalError_BinNumExpected)
                    ProcedureReturn 0
                EndIf
            Case #tkLParenthesis                                                        ; ( Expression )
                If __parseExpression(*tk)
                    If __getToken(@tk,#True) And tk\type = #tkRParenthesis
                        __getToken(@tk)
                        ProcedureReturn #True
                    Else
                        *tk\spelling = "ERREUR"
                        __error(#evalError_MissingRParenthesis)
                        ProcedureReturn 0
                    EndIf
                Else
                    *tk\spelling = "ERREUR"
                    __error(#evalError_MissingExpression,"(")
                    ProcedureReturn 0
                EndIf
            Default
                __error(#evalError_TokenCantStartExpression,*tk\spelling)
                *tk\spelling = "ERREUR"
                ProcedureReturn 0
        EndSelect
    EndIf
    ProcedureReturn 0
EndProcedure

Procedure __parseExpression6(*tk.Token)
    Define tk.Token
    If __parseFactor(*tk)
        Repeat
            If __getToken(@tk,#True)
                Select tk\type
                    Case #tkBinaryOr                                                    ; '|' binary OR
                        __getToken(@tk)
                        If __parseFactor(@tk)
                            __emit("  OR")
                            If *tk\type = #tkInteger And tk\type = #tkInteger
                                *tk\spelling = Str( Val(*tk\spelling) | Val(tk\spelling) )
                                *tk\type     = #tkInteger
                            Else
                                *tk\spelling = "ERREUR"
                                __error(#evalError_BinaryNotWithFloats,"OR")
                                ProcedureReturn 0
                            EndIf
                            Continue
                        Else
                            *tk\spelling = "ERREUR"
                            __error(#evalError_MissingExpression,"|")
                            ProcedureReturn 0
                        EndIf
                    Case #tkBinaryAnd                                                   ; '&' binary AND
                        __getToken(@tk)
                        If __parseFactor(@tk)
                            __emit("  AND")
                            If *tk\type = #tkInteger And tk\type = #tkInteger
                                *tk\spelling = Str( Val(*tk\spelling) & Val(tk\spelling) )
                                *tk\type     = #tkInteger
                            Else
                                *tk\spelling = "ERREUR"
                                __error(#evalError_BinaryNotWithFloats,"AND")
                                ProcedureReturn 0
                            EndIf
                            Continue
                        Else
                            *tk\spelling = "ERREUR"
                            __error(#evalError_MissingExpression,"&")
                            ProcedureReturn 0
                        EndIf
                    Case #tkBinaryXor                                                   ; '!' binary XOR
                        __getToken(@tk)
                        If __parseFactor(@tk)
                            __emit("  XOR")
                            If *tk\type = #tkInteger And tk\type = #tkInteger
                                *tk\spelling = Str( Val(*tk\spelling) ! Val(tk\spelling) )
                                *tk\type     = #tkInteger
                            Else
                                *tk\spelling = "ERREUR"
                                __error(#evalError_BinaryNotWithFloats,"XOR")
                                ProcedureReturn 0
                            EndIf
                            Continue
                        Else
                            *tk\spelling = "ERREUR"
                            __error(#evalError_MissingExpression,"!")
                            ProcedureReturn 0
                        EndIf
                    Default
                        Break
                EndSelect
            Else
                Break
            EndIf
        ForEver
    Else
        ProcedureReturn 0
    EndIf
    ProcedureReturn #True
EndProcedure


Procedure __parseExpression5(*tk.Token)
    Define tk.Token
    If __parseExpression6(*tk)
        Repeat
            If __getToken(@tk,#True)
                Select tk\type
                    Case #tkShiftLeft                                                   ; '<<' SHIFT LEFT
                        __getToken(@tk)
                        If __parseExpression6(@tk)
                            __emit("  SHL")
                            If *tk\type = #tkInteger And tk\type = #tkInteger
                                *tk\spelling = Str( Val(*tk\spelling) << Val(tk\spelling) )
                                *tk\type     = #tkInteger
                            Else
                                *tk\spelling = "ERREUR"
                                __error(#evalError_BinaryNotWithFloats,"<<")
                                ProcedureReturn 0
                            EndIf
                            Continue
                        Else
                            *tk\spelling = "ERREUR"
                            __error(#evalError_MissingExpression,"<<")
                            ProcedureReturn 0
                        EndIf
                    Case #tkShiftRight                                                  ; '>>' SHIFT RIGHT
                        __getToken(@tk)
                        If __parseExpression6(@tk)
                            __emit("  SHR")
                            If *tk\type = #tkInteger And tk\type = #tkInteger
                                *tk\spelling = Str( Val(*tk\spelling) >> Val(tk\spelling) )
                                *tk\type     = #tkInteger
                            Else
                                *tk\spelling = "ERREUR"
                                __error(#evalError_BinaryNotWithFloats,">>")
                                ProcedureReturn 0
                            EndIf
                            Continue
                        Else
                            *tk\spelling = "ERREUR"
                            __error(#evalError_MissingExpression,">>")
                            ProcedureReturn 0
                        EndIf
                    Default
                        Break
                EndSelect
            Else
                Break
            EndIf
        ForEver
    Else
        ProcedureReturn 0
    EndIf
    ProcedureReturn #True
EndProcedure


Procedure __parseExpression4(*tk.Token)
    Define tk.Token
    If __parseExpression5(*tk)
        Repeat
            If __getToken(@tk,#True)
                Select tk\type
                    Case #tkMul                                                         ; '*' MUL
                        __getToken(@tk)
                        If __parseExpression5(@tk)
                            __emit("  MUL")
                            If *tk\type = #tkInteger And tk\type = #tkInteger
                                *tk\spelling = Str( Val(*tk\spelling) * Val(tk\spelling) )
                                *tk\type     = #tkInteger
                            Else
                                *tk\spelling = StrD( ValD(*tk\spelling) * ValD(tk\spelling) )
                                *tk\type     = #tkFloat
                            EndIf
                            Continue
                        Else
                            *tk\spelling = "ERREUR"
                            __error(#evalError_MissingExpression,"*")
                            ProcedureReturn 0
                        EndIf
                    Case #tkDiv                                                         ; '/' DIV
                        __getToken(@tk)
                        If __parseExpression5(@tk)
                            Define f2.f = ValD(tk\spelling)
                            If f2
                                __emit("  DIV")
                                *tk\spelling = StrD( ValD(*tk\spelling) / f2 )
                                *tk\spelling = __removeFloatEnding(*tk\spelling)
                                If FindString(*tk\spelling,".",1)
                                    *tk\type     = #tkFloat
                                Else
                                    *tk\type     = #tkInteger
                                EndIf
                            Else
                                *tk\spelling = "ERREUR"
                                *tk\type     = #tkFloat
                                __error(#evalError_DivisionWithNull)
                                ProcedureReturn 0
                            EndIf
                            Continue
                        Else
                            *tk\spelling = "ERREUR"
                            __error(#evalError_MissingExpression,"/")
                            ProcedureReturn 0
                        EndIf
                    Case #tkMod                                                         ; '%' MOD
                        __getToken(@tk)
                        If __parseExpression5(@tk)
                            Define q2.q = IntQ(ValD(tk\spelling))
                            If q2=0
                                *tk\spelling = "ERREUR" ; ERREUR, Modulo avec 0...
                                *tk\type     = #tkFloat
                                __error(#evalError_ModuloWithNull)
                                ProcedureReturn 0
                            Else
                                If *tk\type = #tkInteger And tk\type = #tkInteger
                                    __emit("  MOD")
                                    *tk\spelling = Str( Val(*tk\spelling) % Val(tk\spelling) )
                                    *tk\type     = #tkInteger
                                Else
                                    *tk\spelling = "ERREUR"
                                    __error(#evalError_BinaryNotWithFloats, "%")
                                    ProcedureReturn 0
                                EndIf
                            EndIf
                            Continue
                        Else
                            *tk\spelling = "ERREUR"
                            __error(#evalError_MissingExpression,"%")
                            ProcedureReturn 0
                        EndIf
                    Case #tkPow                                                         ; '^' POW
                        __getToken(@tk)
                        If __parseExpression5(@tk)
                            __emit("  POW")
                            *tk\spelling = StrD( Pow( ValD(*tk\spelling) , ValD(tk\spelling) ) )
                            *tk\spelling = __removeFloatEnding(*tk\spelling)
                            If FindString(*tk\spelling,".",1)
                                *tk\type     = #tkFloat
                            Else
                                *tk\type     = #tkInteger
                            EndIf
                            Continue
                        Else
                            *tk\spelling = "ERREUR"
                            __error(#evalError_MissingExpression,"^")
                            ProcedureReturn 0
                        EndIf
                    Default
                        Break
                EndSelect
            Else
                Break
            EndIf
        ForEver
    Else
        ProcedureReturn 0
    EndIf
    ProcedureReturn #True
EndProcedure

Procedure __parseExpression3(*tk.Token)
    Define tk.Token
    If __parseExpression4(*tk)
        Repeat
            If __getToken(@tk,#True)
                Select tk\type
                    Case #tkAdd                                                         ; '+' ADD
                        __getToken(@tk)
                        If __parseExpression4(@tk)
                            __emit("  ADD")
                            If *tk\type = #tkInteger And tk\type = #tkInteger
                                *tk\spelling = Str( Val(*tk\spelling) + Val(tk\spelling) )
                                *tk\type     = #tkInteger
                            Else
                                *tk\spelling = StrD( ValD(*tk\spelling) + ValD(tk\spelling) )
                                *tk\spelling = __removeFloatEnding(*tk\spelling)
                                If FindString(*tk\spelling,".",1)
                                    *tk\type     = #tkFloat
                                Else
                                    *tk\type     = #tkInteger
                                EndIf
                            EndIf
                            Continue
                        Else
                            *tk\spelling = "ERREUR"
                            __error(#evalError_MissingExpression,"+")
                            ProcedureReturn 0
                        EndIf
                    Case #tkSub                                                         ; '-' SUB
                        __getToken(@tk)
                        If __parseExpression4(@tk)
                            __emit("  SUB")
                            If *tk\type = #tkInteger And tk\type = #tkInteger
                                *tk\spelling = Str( Val(*tk\spelling) - Val(tk\spelling) )
                                *tk\type     = #tkInteger
                            Else
                                *tk\spelling = StrD( ValD(*tk\spelling) - ValD(tk\spelling) )
                                *tk\spelling = __removeFloatEnding(*tk\spelling)
                                If FindString(*tk\spelling,".",1)
                                    *tk\type     = #tkFloat
                                Else
                                    *tk\type     = #tkInteger
                                EndIf
                            EndIf
                            Continue
                        Else
                            *tk\spelling = "ERREUR"
                            __error(#evalError_MissingExpression,"-")
                            ProcedureReturn 0
                        EndIf
                    Default
                        Break
                EndSelect
            Else
                Break
            EndIf
        ForEver
    Else
        ProcedureReturn 0
    EndIf
    ProcedureReturn #True
EndProcedure

Procedure __parseExpression2(*tk.Token)
    Define tk.Token
    If __parseExpression3(*tk)
        Repeat
            If __getToken(@tk,#True)
                Select tk\type
                    Case #tkGreaterThan                                                 ; '>' CMP.GreaterThan
                        __getToken(@tk)
                        If __parseExpression3(@tk)
                            __emit("  CMP.GreaterThan")
                            If ValD(*tk\spelling) > ValD(tk\spelling)
                                *tk\spelling = "1"
                            Else
                                *tk\spelling = "0"
                            EndIf
                            *tk\type     = #tkInteger
                            Continue
                        Else
                            *tk\spelling = "ERREUR"
                            __error(#evalError_MissingExpression,">")
                            ProcedureReturn 0
                        EndIf
                    Case #tkSmallerThan                                                 ; '<' CMP.SmallerThan
                        __getToken(@tk)
                        If __parseExpression3(@tk)
                            __emit("  CMP.SmallerThan")
                            If ValD(*tk\spelling) < ValD(tk\spelling)
                                *tk\spelling = "1"
                            Else
                                *tk\spelling = "0"
                            EndIf
                            *tk\type     = #tkInteger
                            Continue
                        Else
                            *tk\spelling = "ERREUR"
                            __error(#evalError_MissingExpression,"<")
                            ProcedureReturn 0
                        EndIf
                    Case #tkGreaterEqual                                                ; '>=' '=>' CMP.GreaterEqual
                        __getToken(@tk)
                        If __parseExpression3(@tk)
                            __emit("  CMP.GreaterEqual")
                            If ValD(*tk\spelling) >= ValD(tk\spelling)
                                *tk\spelling = "1"
                            Else
                                *tk\spelling = "0"
                            EndIf
                            *tk\type     = #tkInteger
                            Continue
                        Else
                            *tk\spelling = "ERREUR"
                            __error(#evalError_MissingExpression,">=")
                            ProcedureReturn 0
                        EndIf
                    Case #tkSmallerEqual                                                ; '<=' '=<' CMP.SmallerEqual
                        __getToken(@tk)
                        If __parseExpression3(@tk)
                            __emit("  CMP.SmallerEqual")
                            If ValD(*tk\spelling) <= ValD(tk\spelling)
                                *tk\spelling = "1"
                            Else
                                *tk\spelling = "0"
                            EndIf
                            *tk\type     = #tkInteger
                            Continue
                        Else
                            *tk\spelling = "ERREUR"
                            __error(#evalError_MissingExpression,"<=")
                            ProcedureReturn 0
                        EndIf
                    Default
                        Break
                EndSelect
            Else
                Break
            EndIf
        ForEver
    Else
        ProcedureReturn 0
    EndIf
    ProcedureReturn #True
EndProcedure

Procedure __parseExpression1(*tk.Token)
    Define tk.Token
    If __parseExpression2(*tk)
        Repeat
            If __getToken(@tk,#True)
                Select tk\type
                    Case #tkEqual                                                       ; '=' CMP.Equal
                        __getToken(@tk)
                        If __parseExpression2(@tk)
                            __emit("  CMP.Equal")
                            *tk\spelling = __removeFloatEnding(*tk\spelling)
                             tk\spelling = __removeFloatEnding( tk\spelling)
                            If *tk\spelling = tk\spelling
                                *tk\spelling = "1"
                            Else
                                *tk\spelling = "0"
                            EndIf
                            *tk\type     = #tkInteger
                            Continue
                        Else
                            *tk\spelling = "ERREUR"
                            __error(#evalError_MissingExpression,"=")
                            ProcedureReturn 0
                        EndIf
                    Case #tkNotEqual                                                    ; '<>' CMP.NotEqual
                        __getToken(@tk)
                        If __parseExpression2(@tk)
                            __emit("  CMP.NotEqual")
                            *tk\spelling = __removeFloatEnding(*tk\spelling)
                             tk\spelling = __removeFloatEnding( tk\spelling)
                            If *tk\spelling = tk\spelling
                                *tk\spelling = "0"
                            Else
                                *tk\spelling = "1"
                            EndIf
                            *tk\type     = #tkInteger
                            Continue
                        Else
                            *tk\spelling = "ERREUR"
                            __error(#evalError_MissingExpression,"<>")
                            ProcedureReturn 0
                        EndIf
                    Default
                        Break
                EndSelect
            Else
                Break
            EndIf
        ForEver
    Else
        ProcedureReturn 0
    EndIf
    ProcedureReturn #True
EndProcedure

Procedure __parseExpression(*tk.Token)
    Define tk.Token
    If __parseExpression1(*tk)
        Repeat
            If __getToken(@tk,#True)
                Select tk\type
                    Case #tkLogicalOr                                                   ; 'OR' LOGICAL.OR
                        __getToken(@tk)
                        If __parseExpression1(@tk)
                            __emit("  LOGICAL.OR")
                            If ValD(*tk\spelling) Or ValD(tk\spelling)
                                *tk\spelling = "1"
                            Else
                                *tk\spelling = "0"
                            EndIf
                            *tk\type     = #tkInteger
                            Continue
                        Else
                            *tk\spelling = "ERREUR"
                            __error(#evalError_MissingExpression,"OR")
                            ProcedureReturn 0
                        EndIf
                    Case #tkLogicalAnd                                                  ; 'AND' LOGICAL.AND
                        __getToken(@tk)
                        If __parseExpression1(@tk)
                            __emit("  LOGICAL.AND")
                            If ValD(*tk\spelling) And ValD(tk\spelling)
                                *tk\spelling = "1"
                            Else
                                *tk\spelling = "0"
                            EndIf
                            *tk\type     = #tkInteger
                            Continue
                        Else
                            *tk\spelling = "ERREUR"
                            __error(#evalError_MissingExpression,"AND")
                            ProcedureReturn 0
                        EndIf
                    Case #tkLogicalXor                                                  ; 'XOR' LOGICAL.XOR
                        __getToken(@tk)
                        If __parseExpression1(@tk)
                            __emit("  LOGICAL.XOR")
                            If ValD(*tk\spelling) XOr ValD(tk\spelling)
                                *tk\spelling = "1"
                            Else
                                *tk\spelling = "0"
                            EndIf
                            *tk\type     = #tkInteger
                            Continue
                        Else
                            *tk\spelling = "ERREUR"
                            __error(#evalError_MissingExpression,"XOR")
                            ProcedureReturn 0
                        EndIf
                    Default
                        Break
                EndSelect
            Else
                Break
            EndIf
        ForEver
    Else
        ProcedureReturn 0
    EndIf
    ProcedureReturn #True
EndProcedure




Procedure.s  Evaluate(expression.s)
    Define tk1.Token, tk2.Token
    Define temp.s

    *start.Character = @expression

    Repeat
        If __parseExpression(@tk1) And tk1\spelling <> "ERREUR"
            If __getToken(@tk2)
                If tk2\type > #__firstOperator And tk2\type < #__lastOperator           ; Expression operator Expression ...
                    temp = tk1\spelling + PeekS(*start)
                    *start = @temp
                    Continue
                ElseIf tk2\type <> #tkError Or tk2\type <> #tkEndOfInput
                    tk1\spelling = "ERREUR"
                    __error(#evalError_MissingOperator)
                    Break
                EndIf
            EndIf
        EndIf
        Break
    ForEver
    temp = __removeFloatEnding(tk1\spelling)
    If temp = ""
        temp = "0"
    EndIf
    ProcedureReturn temp
EndProcedure

Procedure SetEvaluateErrorHandler(proc.EvaluateErrorHandler)
    evaluateErrorHandler = proc
EndProcedure

Procedure SetEvaluateAsmOutputHandler(proc.EvaluateAsmHandler)
    evaluateAsmOutput = proc
EndProcedure

;-[ END INCLUDE: Evaluate.pbi

Re: Editeur expression

Publié : lun. 13/févr./2017 11:26
par Demivec
Shadow a écrit :Existe t-il un code que je pourrais utiliser ?
Peut être:
http://www.purebasic.fr/english/viewtopic.php?f=12&t=42839
http://www.purebasic.fr/english/viewtopic.php?f=12&t=50207&p=382639

Re: Editeur expression

Publié : lun. 13/févr./2017 12:36
par Shadow
Merci Devimec :)

Cependant à quoi cela pourrais t-il bien me servir ?

Re: Editeur expression

Publié : lun. 13/févr./2017 12:56
par Ar-S

Code : Tout sélectionner

 un éditeur d'expression pour calculer une opération et aussi la vérifier
Salut,
Tu parles d'expression, Devimec te donne des liens vers des editeurs d'expression régulières..
Pour détecter les symboles + - / * etc ça me parait censé.

Maintenant je n'ai pas vraiment compris ce que tu veux faire... Et ton code (enfin l'include) ne fonctionne pas en PB5.60 (pas testé ailleurs je bosse sur du 5.60 en ce moment.

Explique avec un exemple (je parle pas de code mais de français) ce que tu souhaites exactement.

Re: Editeur expression

Publié : lun. 13/févr./2017 14:06
par Shadow
Salut Ar'S

Je travaille pas avec 5.50 car ya plus la gestion "ascii" et c'est le bordèle je trouve.

Je voudrait un éditeur d'expression, l'utilisateur entre son expression à calculer
puis l’éditeur vérifie que tous soit ok.

Mais j'ai aussi besoin que ça prenne en charge les fonctions Math de PB !

Je parle pas ici d'expression régulières bien que je suppose que ont
peu surement l'utiliser mais je ne sais pas faire cela.

Le code de Danilo fait déjà une bonne partie mais manque toutes les fonction de MATH.

Sur l'exemple de son code, il à créer un éditeur d'expression qui vérifie l’opération entré
puis affiche la sortie (Résultat) ainsi que une partie Asm mais ceci ne m’intéresse pas (Asm)

Exemple de calcule:
12.025 * 79.789 + ((8597 / (32.21 * CosH(4.698)) - %0110100101) * $A49D24 / (24.27 ^ 13.02) + Sqr(32)

Si une erreur survient, un message apparais indiquant l'erreur et si possible ça position.
Voilà, espérent avoir bien répondus à ta demande.

Re: Editeur expression

Publié : lun. 13/févr./2017 15:43
par Ar-S
Il faut que tu décomposes ta ligne.. On va dire que sans expression régulière c'est possible...
Tu stockes ta ligne dans un string

Code : Tout sélectionner

Ligne$ = "12.025 * 79.789 + ((8597 / (32.21 * CosH(4.698)) - %0110100101) * $A49D24 / (24.27 ^ 13.02) + Sqr(32)"
Tu cherches les expressions avec des findstring et tu stockes les différents nombres dans une liste chainée (par exemple)
Tu fais des replaceString pour les commandes que PB ne comprend pas telle quelles ex : remplacer 24.27 ^ 13.02 par Pow(24.27,13.02)
Une fois que tu as traduits ta ligne en PB tu lances l'opération..

Tu as besoin des commandes CountString, FindString, ReplaceString, Mid, probablement stringfield, NewList (et autres AddElement...)

Amuse toi bien.

Re: Editeur expression

Publié : lun. 13/févr./2017 15:58
par Shadow
Merci Ar'S de ton aide mais est ce que j'en suis capable étant donnée le travail que ça représente :?

Jveux bien essayer sachant que de toute façon tous seule c'est mort
Et en plus je connais rien aux expressions régulière...

Ceci peut être fun à faire mais je vais vraiment en ch.....
Jveu pas me lancer dans un truc que je pourrais pas finir car j'en est marre de faire ça.

Alors je demande conseil avant, j'aimerais bien le faire
mais la somme de travail est immense.

Permission de venir pleurniché mon générale si j'y arrive pas ? :lol:

Re: Editeur expression

Publié : lun. 13/févr./2017 16:29
par falsam
Shadow a écrit :est ce que j'en suis capable étant donnée le travail que ça représente
Shadow a écrit :Jveux bien essayer sachant que de toute façon tous seule c'est mort
Shadow a écrit :Et en plus je connais rien aux expressions régulière...
Tu comprendras que le sujet est clos.
Fuseau horaire sur UTC+01:00
Page 1 sur 1

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru