stockage des blocs pour un langage interprété

Vous débutez et vous avez besoin d'aide ? N'hésitez pas à poser vos questions
Répondre
minirop
Messages : 321
Inscription : mer. 02/août/2006 21:06

stockage des blocs pour un langage interprété

Message par minirop »

bonjour,
j'aimerais faire un interprète DarkBasic (:p) et pour çà il me faudrait un moyen de pouvoir géré les boucles et fonctions. Comment celà ce fait ? stockage des commandes dans un arbres, mais après ?
merci.
++
Haut
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :
Contacter Thyphoon

Message par Thyphoon »

Dobro m'a déjà donné un coup de main sur un language interprété. Mais bon le pauvre, réexpliquer tout a chaque fois ça prend du temp Une chose est sur c'est pas aussi simple qu'on le pense. Si il est d'accord je posterais un code qu'il m'a aidé a faire, tu n'aura plus qu'a l'analyser !
Dobro je peux ?
Haut
Patrick88
Messages : 1564
Inscription : mer. 21/janv./2004 18:24

Message par Patrick88 »

[Emulation Dobro]

oui

[/Emulation Dobro]

:wink:

pat
Haut
minirop
Messages : 321
Inscription : mer. 02/août/2006 21:06

Message par minirop »

thyphoon > allez, balance, je pense pas que dobro soit contre (sinon il aurait pas un forum de stockage de code)
Haut
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :
Contacter Thyphoon

Message par Thyphoon »

Il reste beaucoup de chose a implémenté mais les IF imbriqué, les variables et quelques fonctions sont déjà là !! :)
le tout peux être amélioré ! En tout cas si vous améliorez le code partagez votre experience :P
Le code principal a été fait part moi avec l'aide de Dobro
la commande Eval m'a été fournit part Dobro et provient du forum Allemand.
Le code principal

Code : Tout sélectionner

IncludeFile "eval.pb"

#NbLigneMax=100;
#NbparametreMax=5
#NbScript=500
Global NbScript.l
Global Dim Script.s(#NbLigneMax) ; tableau contenant le script
Global NewList CommandList.s()

Structure PileStructure
  Cmd.s
  Param.s[#NbparametreMax]
  True.b
  en_cour.b
  pos_else.l
  pos_endif.l
  numero.l
EndStructure

Global Dim Pile.PileStructure(#NbScript,#NbLigneMax) ;

Structure variable
  nom.s
  valeur.f
EndStructure
#VarMax=100 ; on le droit a 100 variable Maxi

Global Dim variable.variable (#VarMax),NbVar.w

;-Déclaration
Declare   AddCommand(parametre.s)
Declare   InitScript()
Declare.b IsCommand(parametre.s)
Declare ReadScript(scr.l)
Declare ExecuteScript(scr.l)

;Un script histoire de dire ... :P
Script(1)="Let MaVariable=2"
Script(2)="Let B=(MaVariable+2)*2+1"
Script(3)="Let B=B+1"
Script(4)="Print B"
Script(5)="Let B=B+B+B"
Script(6)="If (B+MaVariable)*2+MaVariable >34+(B*2)/2+MaVariable"
Script(7)="Print vrai"
Script(8)="Else"
Script(9)="Print faux"
Script(10)="IF MaVariable=3"
Script(11)="Print variableembriqué"
Script(12)="Else"
Script(13)="Print variablepasbonne"
Script(14)="endif"
Script(15)="Endif"
Script(16)="Print Fin"

InitScript() ;On initialise
ReadScript(1)
ExecuteScript(1)


End
;-Procedure

;Pour rajouter les commandes connu part le language
Procedure AddCommand(parametre.s)
  AddElement(CommandList())
  CommandList()=UCase(parametre)
EndProcedure

;Initialisation des commandes connu
Procedure InitScript()
  ClearList(CommandList())
  AddCommand("LET")
  AddCommand("If")
  AddCommand("Else")
  AddCommand("EndIf")
  AddCommand("While")
  AddCommand("Wend")
  AddCommand("Print")
EndProcedure

;On verifie si il s'agit d'un commande qu'on connait
Procedure.b IsCommand(parametre.s)
  parametre=UCase(parametre)
  ForEach CommandList()
    If CommandList() = parametre
      ProcedureReturn 1
    EndIf 
  Next 
  ProcedureReturn 0
EndProcedure

Procedure ReadScript(scr.l=0)
  ; On traite toute les lignes du script
  CheckedLine=0
  For Line=0 To #NbLigneMax 
    
    ;Si on a des commentaires on les supprimes
    commentaire=FindString(Script(Line), ";", 0)
    If commentaire>0
      code.s=Left(Script(Line),commentaire)  
    ;Si pas de commentaire alors on prend tout la ligne
    Else
      code.s=Script(Line)  
    EndIf
    
    ;On traite uniquement si on a du code sur la ligne
    If Len(Trim(code))>0
      CheckedLine+1
      ;On ajoute les paramètres dans la pile
      For p=0 To #NbparametreMax-1
      
        ;le premier paramètre étant une commande alors c'est un peu spécial
        If p=0:
          parametre.s= StringField(code,1,",") ; recupere le 1 er  parametre apres la commande
          parametre= UCase(StringField(parametre,1," "))
          code=Right(code,Len(code)-Len(parametre)) ;On retir la commande de la ligne de code car on ne vas traiter apres que ses paramètres
          Pile(scr,CheckedLine)\Cmd=Trim(parametre)
          ;On verifie si la commande existe bien
          If IsCommand(parametre)=0:Debug parametre+": Invalid Command ligne "+Str(ligne):Break 2:EndIf
          ;preparation des si
          
          
       ;Si ce n'est pas une commande alors...
        Else
          Pile(scr,CheckedLine)\Param[p]=Trim(StringField(code,p,","))
        EndIf
        
        ;If parametre="":parametre="0":EndIf
      Next p
    EndIf    
  Next Line
 ;#########################
  Dim MemLine.l(#NbLigneMax)
  Ifcount.l=0
  For l=0 To CheckedLine
    If pile(scr,l)\Cmd="IF"
      Ifcount+1
      MemLine.l(Ifcount)=l
    ElseIf pile(scr,l)\Cmd="ELSE"
      pile(scr,MemLine(Ifcount))\pos_else=l
      
    
    ElseIf pile(scr,l)\Cmd="ENDIF"
      pile(scr,MemLine(Ifcount))\pos_endif=l
      If pile(scr,MemLine(Ifcount))\pos_else>0
        pile(scr,pile(scr,MemLine(Ifcount))\pos_else)\pos_endif=l
      EndIf
      
    EndIf
  Next
EndProcedure


Procedure.s TestParam(param.s)
  ;Debug"--------"
 ; Debug "traitement de param:"+param
  ;D'abord je test les variables
  word.s="";
  z=0;
  Repeat
    z+1 ;on incrémente
    c$=Mid(param,z,1)
    If Asc(c$)>=Asc("A") And Asc(c$)<=Asc("z") And  z <= Len(param)
      word+c$
    ElseIf word<>""
      Found=0
      ;On test si c'est une variable
      For n=1 To NbVar
        If word=variable(n)\nom
          ;Debug "Variable trouvé:"+variable(n)\nom+ " : "+StrF(variable(n)\valeur)
          param=Mid(param,1,z-Len(word)-1)+Str(variable(n)\Valeur)+Mid(param,z,Len(param)-z+1) ;on rempalce la variable part son contenu
          z=z-Len(word)+Len(Str(variable(n)\valeur)) ;On replace le curseur la ou il faut
          word="";
          Found=1
          Break;
        EndIf
      Next n
      
      ;On test si on une fonction ...
   
   
      ;Si on a toujours pas trouvé c'est qu'il y a une erreur
      If Found=0:Debug"Erreur Var:"+param:EndIf
    EndIf
   
  Until z > Len(param)
  ;Debug "Result >"+param
  ProcedureReturn param
EndProcedure


Procedure.b TestExpression(param.s)
  Symbol.s="=|>|>=|<|<=|<>";
  ;On separe la verification a savoir C1 / le symbole de comparaison / C2
  For z=1 To CountString(Symbol,"|")+1
    Symb.s=StringField(Symbol,z,"|")
    Pos=FindString(param.s, Symb, 0)
    If Pos>0
      Break
    EndIf
  Next
  ;On sépare nos 2 parties
  PartA.s=StringField(param,1,Symb)
  PartB.s=StringField(param,2,Symb)
  
  ;on verifie et remplace variable et autre fonction
  PartA=TestParam(PartA.s)
  PartB=TestParam(PartB.s)
  
  
  ;On verification si l'expression est vrai
  Select Symb
    Case "="
      If CalculateL(PartA)=CalculateL(PartB):ProcedureReturn 1:EndIf
     Case ">"
      If CalculateL(PartA)>CalculateL(PartB):ProcedureReturn 1:EndIf
     Case ">="
      If CalculateL(PartA)>=CalculateL(PartB):ProcedureReturn 1:EndIf
     Case "<"
      If CalculateL(PartA)<CalculateL(PartB):ProcedureReturn 1:EndIf  
     Case "<="
      If CalculateL(PartA)<=CalculateL(PartB):ProcedureReturn 1:EndIf   
     Case "<>"
      If CalculateL(PartA)<>CalculateL(PartB):ProcedureReturn 1:EndIf  
  EndSelect
  
  ProcedureReturn 0

  
EndProcedure

Procedure IsVariable(var.s)
For z=1 To NbVar
  If var=variable(z)\nom:ProcedureReturn z:EndIf
Next
ProcedureReturn 0
EndProcedure

Procedure CMD_Let(param.s)
 v.l=IsVariable(StringField(param,1,"="))
  If v= 0
    NbVar=NbVar+1
    v=Nbvar
  EndIf
  variable(v)\nom=StringField(param,1,"=")
  variable(v)\valeur=CalculateF(TestParam(StringField(param,2,"=")))
  ;Debug "Var>"+variable(v)\nom+"="+StrF(variable(v)\valeur)
EndProcedure


Procedure CMD_Print(param.s)
  Debug param
EndProcedure




Procedure ExecuteScript(scr)

Dim parametre.s(#NbparametreMax) ; On definie la variable qui vas récuperer les parametre
  For l=0 To #NbLigneMax
        
  If pile(scr,l)\Cmd<>""
    ;On gère les commandes de base
    ;Debug "Analyse commande:"+pile(l)\Cmd
    Select pile(scr,l)\Cmd
     Case "LET"
      CMD_Let(pile(scr,l)\Param[1])
     Case "IF"
        ;Si la condition n'est pas rempli alors on saute au prochain Else ou Endif
        If TestExpression(pile(scr,l)\Param[1])=1:
          Debug "La condition est Vrai"
            
        ElseIf pile(scr,l)\pos_else>0
          l=pile(scr,l)\pos_else
        Else
          l=pile(scr,l)\pos_endif
        EndIf
     Case "ELSE"
        l=pile(scr,l)\pos_endif        
     Case "WHILE"
     
     Case "WEND"
     
     Case "PRINT"
      CMD_Print(pile(scr,l)\Param[1])
     
     ;Ensuite on gère les autres fonction
     Default
      ;Appel de la procedure adequat
    EndSelect
  EndIf 
  
  Next l
EndProcedure
La commande Eval
Evals.pb

Code : Tout sélectionner

#NUM = "0123456789"
#STRIN ="abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_"

; *************************************************************
;-*** D E C L A R E ***




;Operanten-Codes
#OP_UNKNOWN         = -1
#OP_NONE            = 0
#OP_PLUS            = 1
#OP_MINUS           = 2
#OP_MULT            = 3
#OP_DIV             = 4
#OP_POT             = 5
#OP_FUNC            = 6

;Funktions-Codes
#FUNC_SQR           = 1
#FUNC_SIN           = 2
#FUNC_ASIN          = 3
#FUNC_COS           = 4
#FUNC_ACOS          = 5
#FUNC_TAN           = 6
#FUNC_ATAN          = 7
#FUNC_INT           = 8
#FUNC_ABS           = 9
#FUNC_LOG10         = 10
#FUNC_LOG           = 11

;Konstanten
#CONST_PI           = "3.1415926"   ;PI
#CONST_E            = "2.7182818"   ;Eulersche Zahl

;Error-Codes
#CALC_ERR_NONE          = 0         ;kein Fehler
#CALC_ERR_SYNTAX        = 1         ;Allgemeiner Syntax-Fehler (fehlender Wert)
#CALC_ERR_DIVNULL       = 2         ;Division / 0 aufgetreten
#CALC_ERR_OPNOTFOUND    = 3         ;Operant nicht gefunden
#CALC_ERR_FUNCNOTFOUND  = 4         ;Funktion nicht gefunden

#PRIORITY_STEP      = 4             ;entspricht der höchsten Prioritätsstufe der Operanten
#MAX_TREENODES      = 100           ;Maximale Anzahl an SyntaxBaum-Knoten

#OPERAND            = 1
#VALUE              = 2

Structure SyntaxTreeNode
    *parent.SyntaxTreeNode
    *child.SyntaxTreeNode[2]
    operand.l
    prior.l
    Value.f
EndStructure

Structure SyntaxTree
    *root.SyntaxTreeNode
    node.SyntaxTreeNode[#MAX_TREENODES]
    remark$ ;frei verwendbar
EndStructure





; *************************************************************************************
Declare.l Calc_Modulo(a.l, b.l)
Declare Calc_SetOperand(operand$, *node.SyntaxTreeNode)
Declare.s Calc_GetContent(*expression, type.l, *pos.Long)
Declare Calc_InsertNodeAsParent(*nodeTarget.SyntaxTreeNode, *nodeInsert.SyntaxTreeNode)
Declare Calc_InsertNodeAsChild(*nodeTarget.SyntaxTreeNode, child.l, *nodeInsert.SyntaxTreeNode)
Declare.f Calc_GetNodeValueF(*node.SyntaxTreeNode)
Declare Calc_ConsoleOutSyntaxNode(*node.SyntaxTreeNode, level.l)
Declare Calc_ConsoleOutSyntaxTree(*tree.SyntaxTree)
Declare CreateSyntaxTree(*tree.SyntaxTree, expression$)
Declare.f CalculateSyntaxTreeF(*tree.SyntaxTree)
Declare.l CalculateSyntaxTreeL(*tree.SyntaxTree)
Declare.l CalculateL(expression$)
Declare.f CalculateF(expression$)
Declare.l GetCalculationError()
Declare EnableFunctionCalculation(bool.b)
Declare EnableConstantCalculation(bool.b)
EnableFunctionCalculation(1)
EnableConstantCalculation(1)

; *************************************************************************************

Procedure.l Calc_Modulo(a.l, b.l)
    ProcedureReturn a - a / b * b
EndProcedure
 
Procedure Calc_SetOperand(operand$, *node.SyntaxTreeNode)
    Shared priorMod.l
   
    While PeekB(@operand$) = 41 ;Left(operand$, 1) = ")"
        operand$ = Mid(operand$, 2, Len(operand$))
        priorMod - #PRIORITY_STEP
    Wend
   
    While PeekB(@operand$ + Len(operand$) - 1) = 40 ;Right(operand$, 1) = "("
        operand$ = Left(operand$, Len(operand$) - 1)
        changePrior.l + #PRIORITY_STEP
    Wend
   
    Select operand$
        Case "+"
            *node\operand = #OP_PLUS
            *node\prior = priorMod + 1
        Case "-"
            *node\operand = #OP_MINUS
            *node\prior = priorMod + 1
        Case "*"
            *node\operand = #OP_MULT
            *node\prior = priorMod + 2
        Case "/"
            *node\operand = #OP_DIV
            *node\prior = priorMod + 2
        Case "^"
            *node\operand = #OP_POT
            *node\prior = priorMod + 3
           
           
        Case "~"
            *node\operand = #OP_FUNC
            ;ACHTUNG: Funktionen müssen IMMMER die höchste Priorität besitzen
            *node\prior = priorMod + 4
        Default
            *node\operand = #OP_UNKNOWN
    EndSelect
   
    priorMod + changePrior
EndProcedure
 
Procedure.s Calc_GetContent(*expression, type.l, *pos.Long)
    *pointer.Byte = *expression + *pos\l
   
    If type = #VALUE
        ;(-x) Ausrdrücke zulassen
        If PeekB(*pointer) = 45 ; '-'
            *pointer + 1
        EndIf
       
        ;) + - * / ^ ~ \0
        ;Ascii-Wert eines neuen Operators hier mit einfügen
        While (*pointer\b < 97 Or *pointer\b > 122) And *pointer\b <> 41 And *pointer\b <> 42 And *pointer\b <> 43  And *pointer\b <> 45 And *pointer\b <> 47 And *pointer\b <> 94 And *pointer\b <> 126 And *pointer\b <> 0
            *pointer + 1
        Wend
    Else
        ;0-9 .
        While (*pointer\b < 48 Or *pointer\b > 57) And *pointer\b <> 46 And *pointer\b <> 0
            *pointer + 1
        Wend
        ;(-x) Ausrdrücke zulassen
        If PeekB(*pointer - 1) = 45 And PeekB(*pointer - 2) = 40 ; '(-'
            *pointer - 1
        EndIf
    EndIf
   
    a_RET$ = PeekS(*expression + *pos\l, (*pointer - *expression) - *pos\l)
   
    If *pointer\b
        *pos\l = *pointer - *expression
    Else
        *pos\l = -1
    EndIf
   
    ProcedureReturn a_RET$
EndProcedure
 
Procedure Calc_InsertNodeAsParent(*nodeTarget.SyntaxTreeNode, *nodeInsert.SyntaxTreeNode)
    child.l
   
    If *nodeTarget\parent
        If *nodeTarget\parent\child[0] = *nodeTarget
            child = 0
        ElseIf *nodeTarget\parent\child[1] = *nodeTarget
            child = 1
        EndIf
        *nodeTarget\parent\child[child] = *nodeInsert
        *nodeInsert\parent = *nodeTarget\parent
    EndIf
    *nodeTarget\parent = *nodeInsert
    *nodeInsert\child[0] = *nodeTarget
EndProcedure
 
Procedure Calc_InsertNodeAsChild(*nodeTarget.SyntaxTreeNode, child.l, *nodeInsert.SyntaxTreeNode)
    If *nodeTarget\child[child]
        *nodeChild.SyntaxTreeNode = *nodeTarget\child[child]
        *nodeChild\parent = *nodeInsert
        *nodeInsert\child[0] = *nodeTarget\child[child]
    EndIf
   
    *nodeTarget\child[child] = *nodeInsert
    *nodeInsert\parent = *nodeTarget
EndProcedure
 
Procedure.f Calc_GetNodeValueF(*node.SyntaxTreeNode)
    Shared calculationErrorOccured.b
    Result.f
   
    If *node
        If *node\operand
            valueOne.f = Calc_GetNodeValueF(*node\child[0])
            valueTwo.f = Calc_GetNodeValueF(*node\child[1])
            Select *node\operand
                Case #OP_PLUS
                    Result = valueOne + valueTwo
                Case #OP_MINUS
                    Result = valueOne - valueTwo
                Case #OP_MULT
                    Result = valueOne * valueTwo
                Case #OP_DIV
                    Result = valueOne / valueTwo
                    If valueTwo = 0 And calculationErrorOccured = 0
                        calculationErrorOccured = #CALC_ERR_DIVNULL
                    EndIf
                Case #OP_POT
                    Result = Pow(valueOne, valueTwo)
                   
                Case #OP_FUNC
                    Select valueOne ;steht für den Funktionstyp
                        Case #FUNC_SQR
                            Result = Sqr(valueTwo)
                        Case #FUNC_SIN
                            Result = Sin(valueTwo)
                        Case #FUNC_ASIN
                            Result = ASin(valueTwo)
                        Case #FUNC_COS
                            Result = Cos(valueTwo)
                        Case #FUNC_ACOS
                            Result = ACos(valueTwo)
                        Case #FUNC_TAN
                            Result = Tan(valueTwo)
                        Case #FUNC_ATAN
                            Result = ATan(valueTwo)
                        Case #FUNC_INT
                            Result = Int(valueTwo)
                        Case #FUNC_ABS
                            Result = Abs(valueTwo)
                        Case #FUNC_LOG10
                            Result = Log10(valueTwo)
                        Case #FUNC_LOG
                            Result = Log(valueTwo)
                        Default
                            calculationErrorOccured = #CALC_ERR_FUNCNOTFOUND
                    EndSelect
                   
                Case #OP_UNKNOWN
                    calculationErrorOccured = #CALC_ERR_OPNOTFOUND
            EndSelect
            ProcedureReturn Result
        Else
            ProcedureReturn *node\Value
        EndIf
    Else
        calculationErrorOccured = 1
    EndIf
EndProcedure
 
Procedure Calc_ConsoleOutSyntaxNode(*node.SyntaxTreeNode, level.l)
    ;für Debugging und Veranschaulischungszwecke
    Shared isFunction.b
   
    If *node
       
        If  *node\operand
            If *node\operand = #OP_PLUS
                PrintN(Space(level * 2) + "+")
            ElseIf *node\operand = #OP_MINUS
                PrintN(Space(level * 2) + "-")
            ElseIf *node\operand = #OP_MULT
                PrintN(Space(level * 2) + "*")
            ElseIf *node\operand = #OP_DIV
                PrintN(Space(level * 2) + "/")
            ElseIf *node\operand = #OP_POT
                PrintN(Space(level * 2) + "^")
            ElseIf *node\operand = #OP_FUNC
                isFunction = 1
            EndIf
        Else
            If isFunction
                Print(Space((level-1) * 2))
                Select *node\Value
                    Case #FUNC_SQR
                        PrintN("SQR")
                    Case #FUNC_SIN
                        PrintN("SIN")
                    Case #FUNC_ASIN
                        PrintN("ASIN")
                    Case #FUNC_COS
                        PrintN("COS")
                    Case #FUNC_ACOS
                        PrintN("ACOS")
                    Case #FUNC_TAN
                        PrintN("TAN")
                    Case #FUNC_ATAN
                        PrintN("ATAN")
                    Case #FUNC_INT
                        PrintN("INT")
                    Case #FUNC_ABS
                        PrintN("ABS")
                    Case #FUNC_LOG10
                        PrintN("LOGTEN")
                    Case #FUNC_LOG
                        PrintN("LOG")
                EndSelect
            Else
                PrintN(Space(level * 2) + StrF(*node\Value))
            EndIf
        EndIf
       
        If *node\child[0]
            Calc_ConsoleOutSyntaxNode(*node\child[0], level + 1)
            isFunction = 0
        EndIf
        If *node\child[1]
            Calc_ConsoleOutSyntaxNode(*node\child[1], level + 1)
        EndIf
    EndIf
EndProcedure
 
Procedure Calc_ConsoleOutSyntaxTree(*tree.SyntaxTree)
    ;für Debugging und Veranschaulischungszwecke
    Calc_ConsoleOutSyntaxNode(*tree\root, 0)
EndProcedure
 
  ;--    Public
 
Procedure CreateSyntaxTree(*tree.SyntaxTree, expression$)
    Shared priorMod.l, functionCalculationEnabled.b, constantCalculationEnabled.b
   
    priorMod = 0
    nodeCount.l = 0
    Position.l = 0
   
    *nodeLastValue.SyntaxTreeNode
    *nodeCurrentValue.SyntaxTreeNode
    *nodeLastOperand.SyntaxTreeNode
    *nodeCurrentOperand.SyntaxTreeNode
   
    expression$ = LCase(ReplaceString(expression$, " ", ""))
   
    While Left(expression$, 1) = "("
        expression$ = Mid(expression$, 2, Len(expression$))
        priorMod + #PRIORITY_STEP
    Wend
    While Right(expression$, 1) = ")"
        expression$ = Left(expression$, Len(expression$) - 1)
    Wend
   
    If functionCalculationEnabled
        expression$ = ReplaceString(expression$, "sqr",   Str(#FUNC_SQR) + "~")
        expression$ = ReplaceString(expression$, "asin",  Str(#FUNC_ASIN) + "~")
        expression$ = ReplaceString(expression$, "sin",   Str(#FUNC_SIN) + "~")
        expression$ = ReplaceString(expression$, "acos",  Str(#FUNC_ACOS) + "~")
        expression$ = ReplaceString(expression$, "cos",   Str(#FUNC_COS) + "~")
        expression$ = ReplaceString(expression$, "atan",  Str(#FUNC_ATAN) + "~")
        expression$ = ReplaceString(expression$, "tan",   Str(#FUNC_TAN) + "~")
        expression$ = ReplaceString(expression$, "int",   Str(#FUNC_INT) + "~")
        expression$ = ReplaceString(expression$, "abs",   Str(#FUNC_ABS) + "~")
        expression$ = ReplaceString(expression$, "logten",Str(#FUNC_LOG10) + "~")
        expression$ = ReplaceString(expression$, "log",   Str(#FUNC_LOG) + "~")
    EndIf
   
    If constantCalculationEnabled
        expression$ = ReplaceString(expression$, "pi", #CONST_PI)
        expression$ = ReplaceString(expression$, "e",  #CONST_E)
    EndIf
   
    ;Debug expression$
   
    Repeat
        nodeCount + 1
       
        If Calc_Modulo(nodeCount, 2) ;Wert
            node$ = Calc_GetContent(@expression$, #VALUE, @Position)
            *tree\node[nodeCount]\Value = ValF(node$)
            *nodeCurrentValue = *tree\node[nodeCount]
            ;Debug node$
           
            If nodeCount > 1
                Calc_InsertNodeAsChild(*nodeLastOperand, 1, *nodeCurrentValue)
            EndIf
           
            *nodeLastValue = *nodeCurrentValue
        Else ;Operator
            node$ = Calc_GetContent(@expression$, #OPERAND, @Position)
            Calc_SetOperand(node$, *tree\node[nodeCount])
           
            *nodeCurrentOperand = *tree\node[nodeCount]
            ;Debug node$ + " :: " + Str(*nodeCurrentOperand\prior)
           
            If *nodeLastOperand
                If *nodeCurrentOperand\prior > *nodeLastOperand\prior
                    Calc_InsertNodeAsChild(*nodeLastOperand, 1, *nodeCurrentOperand)
                ElseIf *nodeCurrentOperand\prior = *nodeLastOperand\prior
                    Calc_InsertNodeAsParent(*nodeLastOperand, *nodeCurrentOperand)
                Else
                    *node.SyntaxTreeNode = *nodeLastOperand
                    While *node\parent And *node\prior > *nodeCurrentOperand\prior
                        *node = *node\parent
                    Wend
                   
                    If *node\prior = *nodeCurrentOperand\prior
                        Calc_InsertNodeAsParent(*node, *nodeCurrentOperand)
                    ElseIf *node\prior < *nodeCurrentOperand\prior
                        Calc_InsertNodeAsChild(*node, 1, *nodeCurrentOperand)
                    Else
                        Calc_InsertNodeAsParent(*node, *nodeCurrentOperand)
                    EndIf
                EndIf
            Else
                Calc_InsertNodeAsParent(*nodeLastValue, *nodeCurrentOperand)
            EndIf
           
            *nodeLastOperand = *nodeCurrentOperand
        EndIf
       
    Until Position = -1
   
    If *nodeLastOperand
        While *nodeLastOperand\parent
            *nodeLastOperand = *nodeLastOperand\parent
        Wend
        *tree\root = *nodeLastOperand
    ElseIf nodeCount = 1
        *tree\root = *nodeLastValue
    Else
        *tree\root = 0
    EndIf
   
EndProcedure
 
Procedure.f CalculateSyntaxTreeF(*tree.SyntaxTree)
    Shared calculationErrorOccured.b
    calculationErrorOccured = 0
   
    If *tree\root
        Result.f = Calc_GetNodeValueF(*tree\root)
    Else
        ;Fehler auslösen
        calculationErrorOccured = 1
        Result.f = 0 / Result
    EndIf
   
    ProcedureReturn Result
EndProcedure
 
Procedure.l CalculateSyntaxTreeL(*tree.SyntaxTree)
    Shared calculationErrorOccured.b
    calculationErrorOccured = 0
   
    If *tree\root
        Result.l = Calc_GetNodeValueF(*tree\root)
    Else
        ;Fehler auslösen
        calculationErrorOccured = 1
    EndIf
   
    ProcedureReturn Result
EndProcedure
 
Procedure.l CalculateL(expression$)
    Shared calculationErrorOccured.b
    calculationErrorOccured = 0
   
    tree.SyntaxTree
    CreateSyntaxTree(@tree, expression$)
   
    If tree\root
        Result.l = Calc_GetNodeValueF(tree\root)
    Else
        ;Fehler auslösen
        calculationErrorOccured = 1
    EndIf
   
    ProcedureReturn Result
EndProcedure
 
Procedure.f CalculateF(expression$)
    Shared calculationErrorOccured.b
    calculationErrorOccured = 0
   
    tree.SyntaxTree
    CreateSyntaxTree(tree, expression$)
   
    If tree\root 
        ;Shared-Variable und If-Abfrage ist nur für das Beispiel und kann rausgenommen werden
        Shared outputSyntaxTree.b
        If outputSyntaxTree
            Calc_ConsoleOutSyntaxTree(tree)
        EndIf
       
        Result.f = Calc_GetNodeValueF(tree\root)
    Else
        ;Fehler auslösen
        calculationErrorOccured = 1
        Result.f = 0 / Result
    EndIf
   
    ProcedureReturn Result
EndProcedure
 
Procedure.l GetCalculationError()
    Shared calculationErrorOccured.b
    ProcedureReturn calculationErrorOccured
EndProcedure
 
Procedure EnableFunctionCalculation(bool.b)
    Shared functionCalculationEnabled.b
    functionCalculationEnabled = bool
EndProcedure
 
Procedure EnableConstantCalculation(bool.b)
    Shared constantCalculationEnabled.b
    constantCalculationEnabled = bool
EndProcedure
 
  ; ******************************************************************************************
Dernière modification par Thyphoon le mer. 25/avr./2007 17:59, modifié 1 fois.
Haut
Thierryfr
Messages : 102
Inscription : mer. 04/avr./2007 16:28

Message par Thierryfr »

excuse moi Typhoon , il sert à quoi exactement le code que tu as posté?
Haut
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

Patrick88 a écrit :[Emulation Dobro]

oui

[/Emulation Dobro]

:wink:

pat
:lol: :lol: :lol: excellent !! :D
Haut
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

Thierryfr a écrit :excuse moi Typhoon , il sert à quoi exactement le code que tu as posté?
il sert a interpreter ce petit programme qui est dedans

Code : Tout sélectionner

;Un script histoire de dire ... :P
Script(1)="Let MaVariable=2"
Script(2)="Let B=(MaVariable+2)*2+1"
Script(3)="Let B=B+1"
Script(4)="Print B"
Script(5)="Let B=B+B+B"
Script(6)="If (B+MaVariable)*2+MaVariable >34+(B*2)/2+MaVariable"
Script(7)="Print vrai"
Script(8)="Else"
Script(9)="Print faux"
Script(10)="IF MaVariable=3"
Script(11)="Print variableembriqué"
Script(12)="Else"
Script(13)="Print variablepasbonne"
Script(14)="endif"
Script(15)="Endif"
Script(16)="Print Fin"

et La commande Eval , c'est un analyseur de ligne du genre

2*4+(3*2)-4/sin(5.6)
:D
Dernière modification par Backup le mer. 25/avr./2007 17:58, modifié 1 fois.
Haut
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :
Contacter Thyphoon

Message par Thyphoon »

Thierryfr a écrit :excuse moi Typhoon , il sert à quoi exactement le code que tu as posté?
Et bien c'est un début de langage interprété !
tu écris un script dans le tableau script(n) (n=numero de ligne)
et le code apres vas l'exécuter ...
perso ça me sert dans mon jeu.
J'ai des petits scripts qui sont exécutés en fonction des actions. Et j'écris ces scripts dans l'editeur de mon jeu ! exemple

IF Persosurlacase(x,y)
jouemusique("mamusique.ogg")
endif

EDIT : contrairement a ce que j'avais marqué (mais j'ai corrigé) les if imbriqués, les variables, et quelques fonctions sont déjà là !! :)
Haut
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :
Contacter Thyphoon

Message par Thyphoon »

D'ailleur en passant ! Encore merci Dobro pour ton coup de main... j'ai beaucoup appris :P
Haut
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

Thyphoon a écrit :D'ailleur en passant ! Encore merci Dobro pour ton coup de main... j'ai beaucoup appris :P
ce fus un plaisir, pour une fois que je peux montrer quelque chose a quelqu'un :lol:
Haut
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :
Contacter Thyphoon

Message par Thyphoon »

Dobro a écrit : ce fus un plaisir, pour une fois que je peux montrer quelque chose a quelqu'un :lol:
c'est pourtant pas la première fois que tu aides quelqu'un d'ailleur ;)
si on devait faire une liste de ceux qui on le plus contribuer au Purebasic en aidant les autres je penses que tu serais dans la tête de liste tout comme Comtois, Flype, Dr.Dri, Cpl.Bator, Le Soldat Inconnu (Toujours vivant ?) et ceux que j'oublie ...
Dernière modification par Thyphoon le mer. 25/avr./2007 19:03, modifié 2 fois.
Haut
minirop
Messages : 321
Inscription : mer. 02/août/2006 21:06

Message par minirop »

merci Thyp (et tondu ?) ainsi que dobro ;)

edit : il y a une petite erreur

Code : Tout sélectionner

Script(3)="Let B=B+1"
Script(4)="Print B"
çà affiche B et non çà valeur :-°
edit 2 : j'ai modifier cmd_print comme ceci :
Procedure CMD_Print(param.s)
v.l = IsVariable(param)
If v <> 0
Debug variable(v)\valeur
Else
Debug param
EndIf
EndProcedure
Haut
Anonyme

Message par Anonyme »

j'avais ouvert se post aussi concernant le langage interpréter, ca peut être un bon complément.

http://www.purebasic.fr/french/viewtopi ... 41&start=0
Haut
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :
Contacter Thyphoon

Message par Thyphoon »

Cpl.Bator a écrit :j'avais ouvert se post aussi concernant le langage interpréter, ca peut être un bon complément.

http://www.purebasic.fr/french/viewtopi ... 41&start=0
Oui j'avais commencé par là....mais j'étais resté coincé sur les if imbriqué !! :P
Haut
Répondre

Revenir à « Débutants »