Attribute VB_Name = "Module3"
 '*************************************************************
 '* Compile a user defined function F(X) given as a string.   *
 '* Example: "10*sin(2*pi*X)+5"                               *
 '* --------------------------------------------------------- *
 '* Reference: "A book on C By Al Kelley and Ira Pohl,        *
 '*             The Benjamin/Cummings Publishing Company      *
 '*             Inc., 1984", program parser.c improved by     *
 '*             J-P Moreau, Paris [BIBLI 09].                 *
 '*                   (www.jpmoreau.fr)                       *
 '*************************************************************

 Const DELIMITER = 1, VARIABLE = 2, NUMBER = 3
 
 Public resultat As Double, toktype As Integer, token As String
 Public vrbl(4) As String, Formule(4) As String
 Public ii As Integer, num As Integer, prog As String
 Public ti As Double, tf As Double
 Public ndata As Integer
 
 
'******************************************************
'* convert a floating point number with coma into a   *
'* floating point number with dot before output to a  *
'* sequential file.                                   *
'******************************************************
Function CNumber$(X As Double)
  xx$ = Str$(X)
  For i% = 1 To Len(xx$)
    If Mid$(xx$, i%, 1) = "," Then Mid$(xx$, i%, 1) = "."
  Next
  CNumber$ = xx$
End Function



' *******************************************************
' * Store a curve F(x) or F(t) to disk at format *.SGN. *
' * Numbers with a coma are converted into numbers with *
' * a decimal dot by function CNumber$.                 *
' *******************************************************
Sub DiskWriteData(nom$, ByVal n%, ByVal xi#, ByVal xf#, titre$, nomx$, nomy$)
Dim nfich

  nfich = FreeFile
  Open nom$ For Output As nfich
  Print #nfich, n%, CNumber$(xi#), CNumber$(xf#)
  Print #nfich, titre$
  Print #nfich, nomx$
  Print #nfich, nomy$
  For i% = 0 To n% - 1
    Print #nfich, CNumber$(V(i%))
  Next
  Close nfich

End Sub


'current evaluation of F(X) at abscissa=X
Function AFunction(ByVal X As Double) As Double

  Formule(0) = Str$(X)
  prog = Formule(2)
  CalculeExp
  AFunction = resultat
  'Debug.Print "  "; X; "  "; prog; "  "; resultat

End Function

Function AFunction1(ByVal X As Double) As Double

  Formule(num - 1) = Str$(X)
  prog = Formule(3)
  CalculeExp
  AFunction1 = resultat
  'Debug.Print "  "; X; "  "; prog; "  "; resultat

End Function

'basic arithmetic operations '-,+,*,/,^,%)
Sub arith(o$, h)
Dim temp, ex
  Select Case o$
    Case "-"
      resultat = resultat - h
    Case "+"
      resultat = resultat + h
    Case "*"
      resultat = resultat * h
    Case "/"
      If Abs(h) > 0.000000000001 Then
        resultat = resultat / h
      Else
        Serror (3)   ' Division by zero!
      End If
    Case "%"
      temp = resultat / h: resultat = resultat - (temp * h)
    Case "^"
      resultat = resultat ^ h
  End Select

End Sub

' *******************************************************
' * The expression to evaluate is put in string prog,   *
' * result is put in real number resultat (Double).     *
' *******************************************************
Sub CalculeExp()
  ii = 1
  GetToken
  If token = "" Then    'string prog is empty!
    Serror (2)
    GoTo 100
  End If
  Level2
100:
End Sub



'return 1 if C$ is an operator or the first letter
'of an accepted function.
Function Deli%(C$)

  Deli% = 0
  If (C$ = "+") Or (C$ = "-") Or (C$ = "*") Or (C$ = "/") Then
    Deli% = 1
  ElseIf (C$ = "%") Or (C$ = "^") Or (C$ = "=") Or (C$ = "(") Then
    Deli% = 1
  ElseIf (C$ = ")") Or (C$ = "a") Or (C$ = "c") Or (C$ = "e") Then
    Deli% = 1
  ElseIf (C$ = "l") Or (C$ = "p") Or (C$ = "r") Or (C$ = "s") Then
    Deli% = 1
  ElseIf C$ = "t" Then
    Deli% = 1
  End If

End Function

'return 1 if C$ is a basic arithmetic operatoe,
'sign "=" or a parenthesis.
Function Delim%(C$)

  Delim% = 0
  If (C$ = "+") Or (C$ = "-") Or (C$ = "*") Or (C$ = "/") Then
    Delim% = 1
  ElseIf (C$ = "%") Or (C$ = "^") Or (C$ = "=") Or (C$ = "(") Then
    Delim% = 1
  ElseIf C$ = ")" Then
    Delim% = 1
  End If

End Function


'return 1 if C$ is a valid element for a real or integer number
'(coma not accepted).
Function Digit%(C$)

  Digit% = 0
  If (C$ = "+") Or (C$ = "-") Or (C$ = ".") Then
    Digit% = 1
  ElseIf (C$ >= "0") Or (C$ <= "9") Or (C$ = "e") Or (C$ = "E") Then
    Digit% = 1
  End If

End Function



' Draw a curve f(x) defined by its equation
Sub Equation()
  
  Dim t As Double, temp As Double
  
  Form4.Show 1                                'call dialog "curve f(x)"
  vrbl(0) = "x": num = 1                      'one predeclared variable
  Formule(0) = "0"
  
  ReDim V(ndata)                              'vector V is declared in graph2d.bas
  
  y1 = 0#: y2 = 0#
  dt = (tf - ti) / (ndata - 1)
  t = ti - dt
  For i = 0 To ndata - 1
    t = t + dt
    temp = AFunction(t)
    V(i) = temp
  Next i
  
  'Draw compiled curve in predefined window #10
  Form1.Cls
  Form1.AutoRedraw = True
  CurveXY 10, ndata, ti, tf, 0, 1 '10=window #10, 0=screen, 1=call InitWindow
  titre$ = "Y = " & prog
  Legends False, 10, titre$, vrbl(num - 1), " Y"
  'prepare display of ndata
  s$ = Str$(ndata) & " points."
  Display 0, MaxX - 500, 500, s$
    
  'Store curve to disk (format *.SGN)
  Form1.Dialogue.Filter = "Courbes F(t) ( *.SGN ) | *.sgn"
  Form1.Dialogue.Flags = cdlOFNCreatePrompt Or cdlOFNShowHelp
  Form1.Dialogue.ShowSave
  nom1$ = Form1.Dialogue.filename
  If Mid$(nom1$, Len(nom1$) - 3, 1) <> "." Then nom1$ = nom1$ + ".SGN"
  DiskWriteData nom1$, ndata, ti, tf, titre$, vrbl(num - 1), " Y"
  
  Form1.Command1.Caption = "Continue"
  
End Sub


'find a variable name in string Formule
Function FindVar()

  If Vari%(Left$(token, 1)) = 0 Then
    Serror (1)
    FindVar = 0!
    GoTo 150
  End If
  n = -1
  For i = 0 To num - 1
    If vrbl(i) = token Then n = i
  Next
  ' case of a new variable
  If n = -1 Then
    num = num + 1
    vrbl(num - 1) = token
    n = num
  End If
  If Formule(n) <> "" Then
     FindVar = Val(Formule(n))
  End If
  
150:
End Function


'return 1 if C$ is the first letter of an accepted
'function or "-" or "+"
'Accepted functions are: atan, cos, exp, ln, log, pi, root, sin, tan.
Function Fonc%(C$)
  Fonc% = 0
  If (C$ = "a") Or (C$ = "c") Or (C$ = "e") Then
    Fonc% = 1
  ElseIf (C$ = "l") Or (C$ = "p") Or (C$ = "r") Or (C$ = "s") Then
    Fonc% = 1
  ElseIf (C$ = "t") Or (C$ = "-") Or (C$ = "+") Then
    Fonc% = 1
  End If

End Function

Function Func%(C$)
'return 1 if C$ is the first letter of an accepted function.
'Accepted functions are: atan, cos, exp, ln, log, pi, root, sin, tan.
  Func% = 0
  If (C$ = "a") Or (C$ = "c") Or (C$ = "e") Then
    Func% = 1
  ElseIf (C$ = "l") Or (C$ = "p") Or (C$ = "r") Or (C$ = "s") Then
    Func% = 1
  ElseIf C$ = "t" Then
    Func% = 1
  End If

End Function

' ************************************************
' * Divide string to analyze into its elements   *
' *       (delimiter, variable or number)        *
' * -------------------------------------------- *
' * Example:  let us analyze the expression      *
' *           Mass+100-(Basis*S)/2               *
' * -------------------------------------------- *
' * Successive calls to GetToken will give the   *
' * following results:                           *
' *        token         toktype                 *
' *        -----         -------                 *
' *        Mass          VARIABLE                *
' *          +           DELIMITER               *
' *         100           NUMBER                 *
' *          -           DELIMITER               *
' *          (           DELIMITER               *
' *        Basis         VARIABLE                *
' *          *           DELIMITER               *
' *          S           VARIABLE                *
' *          )           DELIMITER               *
' *          /           DELIMITER               *
' *          2           NUMBER                  *
' ************************************************
Sub GetToken()
Dim fin As Integer, m, C$
  fin = 0
  toktype = 0
  temp$ = ""
  Do While Mid$(prog, ii, 1) = " "
    ii = ii + 1
  Loop
  If (Deli%(Mid$(prog, ii, 1)) <> 0) And (ii <= Len(prog)) Then
    toktype = DELIMITER
    If Func%(Mid$(prog, ii, 1)) <> 0 Then  'case of a function
      C$ = Mid$(prog, ii, 1): fin = 3
      Select Case C$
        Case "a"
          fin = 4
        Case "l"
          If Mid$(prog, ii + 1, 1) = "n" Then fin = 2 Else fin = 3
        Case "p"
          fin = 2
      End Select
      For m = 1 To fin
        temp$ = temp$ + Mid$(prog, ii, 1)
        ii = ii + 1
      Next
    Else
      temp$ = Mid$(prog, ii, 1)
      ii = ii + 1
    End If
  ElseIf Vari%(Mid$(prog, ii, 1)) <> 0 Then   'case of a variable
      Do While (Delim%(Mid$(prog, ii, 1)) = 0) And (ii <= Len(prog))
        temp$ = temp$ + Mid$(prog, ii, 1)
        ii = ii + 1
      Loop
      toktype = VARIABLE
  ElseIf Digit%(Mid$(prog, ii, 1)) <> 0 Then
      Do While (Deli%(Mid$(prog, ii, 1)) = 0) And (ii <= Len(prog))
        temp$ = temp$ + Mid$(prog, ii, 1)
        ii = ii + 1
      Loop
      toktype = NUMBER
  End If
  token = temp$

End Sub



' add or substract two terms
Sub Level2()
Dim hold, result

  Level3
  Do
    op$ = Left$(token, 1)
    If (op$ <> "+") And (op$ <> "-") Then Exit Sub
    GetToken
    result = resultat
    Level3
    hold = resultat
    resultat = result
    arith op$, hold
  Loop Until (op$ <> "+") And (op$ <> "-")

End Sub

' multiply or divide two terms
Sub Level3()
Dim hold, result

  Level4
  Do
    op$ = Left$(token, 1)
    If (op$ <> "*") And (op$ <> "/") And (op$ <> "%") Then Exit Sub
    GetToken
    result = resultat
    Level4
    hold = resultat
    resultat = result
    arith op$, hold
  Loop Until (op$ <> "*") And (op$ <> "/") And (op$ <> "%")

End Sub

' Power (integer or not)
Sub Level4()
Dim hold, result

  level5
  If token = "^" Then
    GetToken
    result = resultat
    Level4
    hold = resultat
    resultat = result
    arith "^", hold
  End If

End Sub

' unary operator "-", "+" or function
Sub level5()

  If (toktype = DELIMITER) And (Fonc%(Left$(token, 1)) <> 0) Then
    op$ = token
    GetToken
  End If
  ' no argument for constant pi!
  If Left$(op$, 1) <> "p" Then Level6
  If Fonc%(Left$(op$, 1)) <> 0 Then Unary op$

End Sub

' expression with parentheses
Sub Level6()
  If (Left$(token, 1) = "(") And (toktype = DELIMITER) Then
    GetToken
    Level2
    If (Left$(token, 1) <> ")") And (ii <= Len(prog)) Then Serror (1)
    GetToken
  Else
    Primitive
  End If
End Sub



' calculate value (number or variable)
Sub Primitive()

  Select Case toktype
    Case VARIABLE
      resultat = FindVar
      GetToken
    Case NUMBER
      resultat = Val(token)
      GetToken
    Case Else
      Serror (0)
  End Select

End Sub

'display an error message
Sub Serror(num%)
Dim E(8) As String

  E(0) = "Syntaxe error"
  E(1) = "Odd parentheses number"
  E(3) = "No expression"
  E(4) = "Argument for log negative or null"
  E(5) = "Argument for root negative"
  E(6) = "INFINITY"
  E(7) = "Memory allocation error"
  Debug.Print "  "; E(num%)

End Sub


'Unary operations
Sub Unary(op$)
Dim pi
  pi = 4# * Atn(1#)
  If op$ = "-" Then
    resultat = (-1!) * resultat
  ElseIf op$ = "atan" Then
    resultat = Atn(resultat)
  ElseIf op$ = "cos" Then
    resultat = Cos(resultat)
  ElseIf op$ = "exp" Then
    resultat = Exp(resultat)
  ElseIf op$ = "ln" Then
    If resultat > 0 Then
      resultat = Log(resultat)
    Else
      Serror (4)
    End If
  ElseIf op$ = "log" Then
    If resultat > 0 Then
      resultat = Log(resultat) / Log(10)
    Else
      Serror (4)
    End If
  ElseIf op$ = "pi" Then
    resultat = pi
  ElseIf op$ = "root" Then
    If resultat >= 0 Then
      resultat = Sqr(resultat)
    Else
      Serror (5)
    End If
  ElseIf op$ = "sin" Then
    resultat = Sin(resultat)
  ElseIf op$ = "tan" Then
    If Abs(resultat - (pi / 2#)) > 0.0000000001 Then
      resultat = Tan(resultat)
    Else
      Serror (6)
    End If
  End If

End Sub

'return 1 if C$ is a variable (beginning with uppercase
'letter, "x" and "t" accepted.
Function Vari%(C$)

  Vari% = 0
  If (C$ >= "A") And (C$ <= "Z") Then
    Vari% = 1
  ElseIf C$ = "x" Or C$ = "t" Then
    Vari% = 1
  End If

End Function