Approx

Approx.vb

Module Module1

  Sub Main()
    Dim args = {"ABCD", 12}
    Dim fs = "a:= {0} b:= {1}"
    Dim fsl = fs.Length
    Dim ArgCount = 0
    Dim CharCount = 0
    Dim Valid = Approx(fs, args, ArgCount, CharCount)
    Console.WriteLine(CharCount)
    fs = "a:= {0,-16} b:= {1,4:X4}"
    CharCount = 0
    ArgCount = 0
    Valid = Approx(fs, args, ArgCount, CharCount)
    Console.WriteLine(CharCount)

  End Sub

  Const UpperLimit = 1000000
  Const LowerLimit = -1000000

  Enum State
    [Continue]
    EoT
    Closing_Brace
    Opening_Brace
  End Enum

  Public Function BraceCheck(fs As String, q As Integer, ch As Char, ByRef ix As Integer, ByRef cc As Integer) As State
    Dim nx As Integer, nc As Char
    Select Case ch
      Case "}"c
        nx = ix + 1 : If nx >= q Then Return State.Closing_Brace
        nc = fs(nx)
        If nc <> "}"c Then Return State.Closing_Brace
        cc += 1 : ix = nx : Return State.Continue

      Case "{"c
        nx = ix + 1 : If nx >= q Then Return State.Opening_Brace
        nc = fs(nx)
        If nc <> "{"c Then Return State.Opening_Brace
        cc += 1 : ix = nx : Return State.Continue
      Case Else
        ix += 1 : cc += 1
    End Select
    Return State.Continue
  End Function

  Public Function Approx(fs As String, Args As Object(), ByRef ArgCount As Integer, ByRef CharCount As Integer) As Boolean
    If String.IsNullOrEmpty(fs) Then Return False
    Dim cc = 0, ix = 0, [end] = fs.Length
    Dim ch As Char
NextIteration:
    While ix < fs.Length
      ch = fs(ix)
      Dim s = BraceCheck(fs, [end], ch, ix, cc)
      Select Case s
        Case State.Continue
        Case State.Opening_Brace
          Dim HAS_Index = False
          Dim HAS_Align = False
          ix += 1 : If ix >= [end] Then Return False
          ' Arg.Index
          Dim INDEX = 0 : Dim ALIGN = 0
          If Parse_Digits(fs, ix, [end], ch, INDEX) = False Then Return False
          If ix >= [end] OrElse INDEX >= Args.Length Then Return False
          'cc+= MaxLength(Args(INDEX))
          HAS_Index = True
          Parse_Whitespace(fs, ix, [end], ch)
          If ix >= [end] Then Return False
          ch = fs(ix)
          ' Is there an arg.align?
          If ch = ","c Then
            ix += 1 : If ix >= [end] Then Return False
            Parse_Whitespace(fs, ix, [end], ch)
            If ix >= [end] Then Return False
            ch = fs(ix)
            Dim isNeg = False
            If ch = "-"c Then
              isNeg = True
              ix += 1 : If ix >= [end] Then Return False
            End If
            If Parse_Digits(fs, ix, [end], ch, ALIGN) = False Then Return False
            If ix >= [end] Then Return False
            '  cc += index
            HAS_Align = True
            Parse_Whitespace(fs, ix, [end], ch)
          End If
          If ch = ":"c Then
            ix += 1 : If ix >= [end] Then Return False
            While ix < [end]
              ch = fs(ix)
              s = BraceCheck(fs, [end], ch, ix, cc)
              Select Case s
                Case State.Continue
                Case State.Closing_Brace : Exit While
                Case Else
                  Return False
              End Select
            End While
          End If
          If ch <> "}"c Then Return False
          If HAS_Index AndAlso HAS_Align Then
            Dim IndexValue = MaxLength(Args(INDEX))
            If ALIGN > IndexValue Then cc += ALIGN Else cc += MaxLength(Args(INDEX))
          ElseIf HAS_Index Then
            cc += MaxLength(Args(INDEX))
          End If
          ix += 1 : ArgCount += 1
        Case Else
          Return False 'New New Exception
      End Select
    End While
    CharCount = cc
    Return True
  End Function

  Private Sub Parse_Whitespace(fs As String, ByRef ix As Integer, q As Integer, ByRef ch As Char)
    While ix < q
      ch = fs(ix)
      If ch <> " "c Then Exit While
      ix += 1
    End While
  End Sub

  Private Function Parse_Digits(fs As String, ByRef ix As Integer, q As Integer, ByRef ch As Char, ByRef value As Integer) As Boolean
    value = 0
    While ix < q
      ch = fs(ix)
      If Not ("0"c <= ch AndAlso ch <= "9"c) Then Exit While
      value = (10 * value) + DigitValue(ch)
      If value >= UpperLimit Then Return False
      ix += 1
    End While
    Return True
  End Function

  Function MaxLength(Of T)(obj As T) As Integer
    Select Case True
      Case TypeOf obj Is Boolean : Return 5
      Case TypeOf obj Is SByte : Return 4
      Case TypeOf obj Is Byte : Return 3
      Case TypeOf obj Is Char : Return 1
      Case TypeOf obj Is UInt16 : Return 5
      Case TypeOf obj Is Int16 : Return 6
      Case TypeOf obj Is UInt32 : Return 10
      Case TypeOf obj Is Int32 : Return 11
      Case TypeOf obj Is UInt64 : Return 20
      Case TypeOf obj Is Int64 : Return 20
      Case TypeOf obj Is String
        Dim s = TryCast(obj, String)
        If s Is Nothing Then Return 0
        Return s.Length
    End Select
    Return 0
  End Function

  Function DigitValue(ch As Char) As Integer
    Select Case ch
      Case "0"c : Return 0
      Case "1"c : Return 1
      Case "2"c : Return 2
      Case "3"c : Return 3
      Case "4"c : Return 4
      Case "5"c : Return 5
      Case "6"c : Return 6
      Case "7"c : Return 7
      Case "8"c : Return 8
      Case "9"c : Return 9
    End Select
    Return 0
  End Function
End Module