Option Explicit

Sub Main()

  MsgBox "Result = " & EvaluateExpression("[#10133 - #10132] / 2.")
  
End Sub




''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' G-code expression evaluator for the Mach3
'
' SOURCE: "Read-To-Run" Visual Basic Algorithms by ...
' (modified by Sittinduck for the G-codes )
'
'
Public Function EvaluateExpression(ByVal Expression As String) As Double
    Const PREC_NONE As Integer = 11
    Const PREC_UNARY As Integer = 10   ' Not actually used.
    Const PREC_POWER As Integer = 9
    Const PREC_TIMES As Integer = 8
    Const PREC_DIV As Integer = 7
    Const PREC_PLUS As Integer = 6
    
    Dim expr As String
    Dim is_unary As Boolean
    Dim next_unary As Boolean
    Dim parens As Integer
    Dim pos As Long
    Dim expr_len As Long
    Dim ch As String
    Dim ch2 As String
    Dim opr As String
    Dim lexpr As String
    Dim rexpr As String
    Dim status As Long
    Dim best_pos As Long
    Dim best_len As Integer
    Dim best_prec As Integer
    'Dim primatives As Object
    Dim operators As Variant
    Dim i As Long
    

    ' Setup primatives
'    Set primatives = CreateObject("Scripting.Dictionary")
'    primatives.Add "PI", (4 * Atn(1))
'    '(insert additional primatives here, as needed)

    ' Setup list of G-code operators
    operators = Array("**", "*", "/", "mod", "+", "-", "or", "xor", "mod")

    ' Remove all spaces.
    expr = Replace_(Expression, " ", "")
    expr_len = Len(expr)
    If expr_len = 0 Then
        EvaluateExpression = 0
        Exit Function
    End If

    ' If we find + or - now, it is a unary operator.
    is_unary = True

    ' So far we have nothing.
    best_prec = PREC_NONE

    ' Find the operator with the lowest precedence.
    ' Look for places where there are no open
    ' parentheses.
    For pos = 1 To expr_len
        ' Examine the next character.
        ch = LCase$(Mid$(expr, pos, 1))
        
        ' Assume we will not find an operator. In
        ' that case, the next operator will not
        ' be unary.
        next_unary = False

        If ch = " " Then
            ' Just skip spaces. We keep them here
            ' to make the error messages easier to
        ElseIf ch = "[" Then
            ' Increase the open parentheses count.
            parens = parens + 1

            ' A + or - after "[" is unary.
            next_unary = True
        ElseIf ch = "]" Then
            ' Decrease the open parentheses count.
            parens = parens - 1

            ' An operator after "]" is not unary.
            next_unary = False

            ' If parens < 0, too many ']'s.
            If parens < 0 Then
                RaiseError -1
            End If
        ElseIf parens = 0 Then
            ' Try to match an operator
            For i = LBound(operators) To UBound(operators)
              ch2 = LCase$(Mid$(expr, pos, Len(operators(i))))
              If ch2 = operators(i) Then
                Exit For
              Else
                ch2 = ""
              End If
            Next i

            If ch2 <> "" Then
              ' An operator after an operator
              ' is unary.
              next_unary = True
  
              ' See if this operator has higher
              ' precedence than the current one.
              If ch2 = "**" Then
                If best_prec >= PREC_POWER Then
                    best_prec = PREC_POWER
                    best_pos = pos
                    best_len = Len(ch2)
                    pos = pos + (best_len - 1)
                End If
              ElseIf ch2 = "*" Or ch2 = "/" Or ch2 = "mod" Then
                If best_prec >= PREC_TIMES Then
                    best_prec = PREC_TIMES
                    best_pos = pos
                    best_len = Len(ch2)
                    pos = pos + (best_len - 1)
                End If
              ElseIf ch2 = "+" Or ch2 = "-" Or ch2 = "or" Or ch2 = "xor" Or ch2 = "and" Then
                ' Ignore unary operators
                ' for now.
                If (Not is_unary) And _
                    best_prec >= PREC_PLUS _
                Then
                    best_prec = PREC_PLUS
                    best_pos = pos
                    best_len = Len(ch2)
                    pos = pos + (best_len - 1)
                End If
              End If
  
            End If
        End If
        is_unary = next_unary
    Next pos

    ' If the parentheses count is not zero,
    ' there's a ']' missing.
    If parens <> 0 Then
        RaiseError -1
    End If
    
    ' Hopefully we have the operator.
    If best_prec < PREC_NONE Then
        lexpr = Left$(expr, best_pos - 1)
        rexpr = Mid$(expr, best_pos + best_len)
        opr = LCase$(Mid$(expr, best_pos, best_len))



        If opr <> "" And lexpr = "" Or rexpr = "" Then
          ' Check for syntax error in expression
          RaiseError -1
        End If

        If opr = "**" Then
          EvaluateExpression = EvaluateExpression(lexpr) ^ EvaluateExpression(rexpr)
        ElseIf opr = "*" Then
          EvaluateExpression = EvaluateExpression(lexpr) * EvaluateExpression(rexpr)
        ElseIf opr = "/" Then


'??????????????????????????????????????????????????????????????????????????????????????????????????????
'??????????????????????????????????????????????????????????????????????????????????????????????????????
'??????????????????????????????????????????????????????????????????????????????????????????????????????
Dim LHS As Double
Dim RHS As Double

MsgBox "NOW YOU SEE IT:   " & lexpr
MsgBox "NOW YOU SEE IT:   " & rexpr
LHS = EvaluateExpression(lexpr)
MsgBox "NOW YOU DON'T SEE IT (WHEN RUN IN MACH3 CB):   " & lexpr
MsgBox "NOW YOU DON'T SEE IT (WHEN RUN IN MACH3 CB):   " & rexpr

RHS = EvaluateExpression(rexpr)
'??????????????????????????????????????????????????????????????????????????????????????????????????????
'??????????????????????????????????????????????????????????????????????????????????????????????????????
'??????????????????????????????????????????????????????????????????????????????????????????????????????

          EvaluateExpression = LHS / RHS
        ElseIf opr = "mod" Then
          EvaluateExpression = EvaluateExpression(lexpr) Mod EvaluateExpression(rexpr)
        ElseIf opr = "+" Then
          EvaluateExpression = EvaluateExpression(lexpr) + EvaluateExpression(rexpr)
        ElseIf opr = "-" Then
          EvaluateExpression = EvaluateExpression(lexpr) - EvaluateExpression(rexpr)
        ElseIf opr = "or" Then
          EvaluateExpression = Gcode_OR(EvaluateExpression(lexpr), EvaluateExpression(rexpr))
        ElseIf opr = "xor" Then
          EvaluateExpression = Gcode_XOR(EvaluateExpression(lexpr), EvaluateExpression(rexpr))
        ElseIf opr = "and" Then
          EvaluateExpression = Gcode_AND(EvaluateExpression(lexpr), EvaluateExpression(rexpr))
        End If

        Exit Function
    End If

    ' If we do not yet have an operator, there
    ' are several possibilities:
    '
    ' 1. expr is [expr2] for some expr2.
    ' 2. expr is #expr2 or -expr2 or +expr2 for some expr2.
    ' 3. expr is Fun(expr2) for a function Fun.
    ' 4. expr is a primitive.
    ' 5. It's a literal like "3.14159".

    ' Look for [expr2]
    If Left$(expr, 1) = "[" And Right$(expr, 1) = "]" Then
        ' Remove the parentheses.
        EvaluateExpression = EvaluateExpression( _
            Mid$(expr, 2, expr_len - 2))
        Exit Function
    End If

    ' Look for #expr2.
    If Left$(expr, 1) = "#" Then
        EvaluateExpression = Mach3_GetParameterValue(EvaluateExpression(Mid$(expr, 2)))
        Exit Function
    End If

    ' Look for -expr2.
    If Left$(expr, 1) = "-" Then
        EvaluateExpression = -EvaluateExpression(Mid$(expr, 2))
        Exit Function
    End If

    ' Look for +expr2.
    If Left$(expr, 1) = "+" Then
        EvaluateExpression = EvaluateExpression(Mid$(expr, 2))
        Exit Function
    End If
    
    ' Look for Fun(expr2).
    If expr_len > 5 And Right$(expr, 1) = "]" Then
        ' Find the first [.
        pos = InStr(expr, "[")

        If pos > 0 Then
            ' See what the function is.
            lexpr = LCase$(Left$(expr, pos - 1))
            rexpr = Mid$(expr, pos + 1, expr_len - pos - 1)
            Select Case lexpr
                Case "abs"
                    EvaluateExpression = _
                        Gcode_ABS(EvaluateExpression(rexpr))
                    Exit Function
                Case "sqrt"
                    EvaluateExpression = _
                        Gcode_SQRT(EvaluateExpression(rexpr))
                    Exit Function
                Case "exp"
                    EvaluateExpression = _
                        Gcode_EXP(EvaluateExpression(rexpr))
                    Exit Function
                Case "fix"
                    EvaluateExpression = _
                        Gcode_FIX(EvaluateExpression(rexpr))
                    Exit Function
                Case "fup"
                    EvaluateExpression = _
                        Gcode_FUP(EvaluateExpression(rexpr))
                    Exit Function
                Case "ln"
                    EvaluateExpression = _
                        Gcode_LN(EvaluateExpression(rexpr))
                    Exit Function
                Case "round"
                    EvaluateExpression = _
                        Gcode_ROUND(EvaluateExpression(rexpr))
                    Exit Function
                Case "sin"
                    EvaluateExpression = _
                        Gcode_SIN(EvaluateExpression(rexpr))
                    Exit Function
                Case "cos"
                    EvaluateExpression = _
                        Gcode_COS(EvaluateExpression(rexpr))
                    Exit Function
                Case "tan"
                    EvaluateExpression = _
                        Gcode_TAN(EvaluateExpression(rexpr))
                    Exit Function
                Case "asin"
                    EvaluateExpression = _
                        Gcode_ASIN(EvaluateExpression(rexpr))
                    Exit Function
                Case "acos"
                    EvaluateExpression = _
                        Gcode_ACOS(EvaluateExpression(rexpr))
                    Exit Function
                Case "atan"
                    EvaluateExpression = _
                        Gcode_ATAN(EvaluateExpression(rexpr))
                    Exit Function
                ' Add other functions (including
                ' program-defined functions) here.
            End Select
        End If
    End If

    ' See if it's a primitive.
'    If primatives.Exists(expr) Then
'      ' We found the primative.
'      EvaluateExpression = CDbl(primatives(expr))
'      Exit Function
'    End If

    ' It must be a literal like "2.71828".
    On Error Resume Next
    EvaluateExpression = CDbl(expr)
    status = Err.Number
    On Error GoTo 0
    If status <> 0 Then
        RaiseError -1
    End If
End Function

Private Function Mach3_GetParameterValue(ByVal VarNum As Long) As Double
  If VarNum > 32767 Then
    RaiseError -1
  End If
  
  ' this calls the Mach3 to get the parameter value
  Mach3_GetParameterValue = 777#  'GetVar(CInt(VarNum))
End Function


Private Function Radians(ByVal Value As Double) As Double
  Dim PI As Double: PI = 4 * Atn(1)
  Radians = Value * (PI / 180#)
End Function

Private Function Degrees(ByVal Value As Double) As Double
  Dim PI As Double: PI = 4 * Atn(1)
  Degrees = Value * (180# / PI)
End Function

' BINARY OPERATIONS
Private Function Gcode_AND(ByVal LHS As Double, _
                           ByVal RHS As Double) As Double
  If (LHS <> 0) And (RHS <> 0) Then
    Gcode_AND = 1
  Else
    Gcode_AND = 0
  End If
End Function

Private Function Gcode_OR(ByVal LHS As Double, _
                          ByVal RHS As Double) As Double
  If (LHS <> 0) Or (RHS <> 0) Then
    Gcode_OR = 1
  Else
    Gcode_OR = 0
  End If
End Function

Private Function Gcode_XOR(ByVal LHS As Double, _
                           ByVal RHS As Double) As Double
  If (LHS <> 0) Xor (RHS <> 0) Then
    Gcode_XOR = 1
  Else
    Gcode_XOR = 0
  End If
End Function

Private Function Gcode_MOD(ByVal LHS As Double, _
                           ByVal RHS As Double) As Double
  Gcode_MOD = LHS Mod RHS
End Function


' UNARY OPERATIONS
Private Function Gcode_ABS(ByVal Value As Double) As Double
  Gcode_ABS = Abs(Value)
End Function

Private Function Gcode_SQRT(ByVal Value As Double) As Double
  Gcode_SQRT = Sqr(Value)
End Function

Private Function Gcode_EXP(ByVal Value As Double) As Double
  Gcode_EXP = Exp(Value)
End Function

Private Function Gcode_LN(ByVal Value As Double) As Double
  Gcode_LN = Log(Value)
End Function

Private Function Gcode_ROUND(ByVal Value As Double) As Double
  Gcode_ROUND = Round(Value)
End Function

Private Function Gcode_FUP(ByVal Value As Double) As Double
  Gcode_FUP = Fix(Value + 0.5)
End Function

Private Function Gcode_FIX(ByVal Value As Double) As Double
  Gcode_FIX = Fix(Value - 0.5)
End Function

Private Function Gcode_SIN(ByVal Value As Double) As Double
  Gcode_SIN = Sin(Radians(Value))
End Function

Private Function Gcode_COS(ByVal Value As Double) As Double
  Gcode_COS = Cos(Radians(Value))
End Function

Private Function Gcode_TAN(ByVal Value As Double) As Double
  Gcode_TAN = Tan(Radians(Value))
End Function

Private Function Gcode_ASIN(ByVal Value As Double) As Double
  Dim PI As Double: PI = 4 * Atn(1)
  If (Sqr(1 - Value * Value) <= 0.000000000001) And _
      (Sqr(1 - Value * Value) >= -0.000000000001) Then
    Gcode_ASIN = Degrees(PI / 2)
  Else
    Gcode_ASIN = Degrees(Atn(Value / Sqr(-Value * Value + 1)))
  End If
End Function

Private Function Gcode_ACOS(ByVal Value As Double) As Double
  Dim PI As Double: PI = 4 * Atn(1)
  Dim x As Double: x = Round(Value, 8)
  If x = 1 Then
    Gcode_ACOS = 0
  ElseIf x = -1 Then
    Gcode_ACOS = Degrees(PI)
  Else
    Gcode_ACOS = Degrees(Atn(-Value / Sqr(-Value * Value + 1)) + 2 * Atn(1))
  End If
End Function

Private Function Gcode_ATAN(ByVal Value As Double) As Double
  Gcode_ATAN = Degrees(Atn(Value))
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Public Function Replace_(ByVal Expression As String, _
                         ByVal FindStr As String, _
                         ByVal ReplaceStr As String) As String
  Const Start As Long = -1
  Const Count As Long = -1
  Const Compare As Long = 0 'vbBinaryCompare

  Dim sResult As String
  sResult = ""
 
  Dim p As Long
  Dim lLengthExpression As Long
  Dim lLengthFindStr As Long
  Dim lLengthReplaceStr As Long
  Dim lAccumulatedPos As Long
  Dim lReplaceCount As Long

  lLengthExpression = Len(Expression)
  lLengthFindStr = Len(FindStr)
  lAccumulatedPos = 1
  
  If Count <> 0 And lLengthExpression > 0 And lLengthFindStr > 0 Then
    
    lLengthReplaceStr = Len(ReplaceStr)
    
    If Start = -1 Then
      p = 1
    Else
      p = Start
    End If
  
    Do While (p > 0 And p <= lLengthExpression)
      p = InStr(p, Expression, FindStr, Compare)
      If p > 0 Then
        sResult = sResult & Mid$(Expression, lAccumulatedPos, p - lAccumulatedPos) & ReplaceStr
        p = p + lLengthFindStr
        lAccumulatedPos = p
        If Count <> -1 Then
          lReplaceCount = lReplaceCount + 1
          If lReplaceCount >= Count Then
            Exit Do
          End If
        End If
      End If
    Loop
  End If

  If lAccumulatedPos > 1 Then
    If lAccumulatedPos <= lLengthExpression Then
      Replace_ = sResult & Mid$(Expression, lAccumulatedPos)
    Else
      Replace_ = sResult
    End If
  Else
    Replace_ = Expression
  End If
End Function


Private Sub RaiseError(ByVal ResultCode As Long)
  MsgBox ResultCode
End Sub