'
' Program Name: chatterbot3
' Description: this is an improved version of the previous chatterbot program "chatterbot2"
' this one will try a littlebit more to understand what the user is trying to say and will also
' try to avoid repeating himself too much.
'
' Author: Gonzales Cenelia
'

Option Explicit

Private KnowledgeBase As Variant
Private nNumOfLines As Integer

Const maxInput = 1
Const maxResp = 3
Const Delim = "?!.;,"
Const EM_LINESCROLL = &HB6

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _
                    ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long


Private Sub Form_Load()
    KnowledgeBase = Array(Array("WHAT IS YOUR NAME", "MY NAME IS CHATTERBOT3.", "YOU CAN CALL ME CHATTERBOT3.", "WHY DO YOU WANT TO KNOW MY NAME?"), _
                        Array("HI", "HI THERE!", "HOW ARE YOU?", "HI!"), _
                        Array("HOW ARE YOU", "I'M DOING FINE!", "I'M DOING WELL AND YOU?", "WHY DO YOU WANT TO KNOW HOW AM I DOING?"), _
                        Array("WHO ARE YOU", "I'M AN A.I PROGRAM.", "I THINK THAT YOU KNOW WHO I'M.", "WHY ARE YOU ASKING?"), _
                        Array("ARE YOU INTELLIGENT", "YES,OFCORSE.", "WHAT DO YOU THINK?", "ACTUALY,I'M VERY INTELLIGENT!"), _
                        Array("ARE YOU REAL", "DOES THAT QUESTION REALLY MATERS TO YOU?", "WHAT DO YOU MEAN BY THAT?", "I'M AS REAL AS I CAN BE."))
                        
                        'seed random generator
                        Randomize Timer
                        
                        Timer1.Enabled = False
                        Timer2.Enabled = False
End Sub

Private Sub Copy(Str As Variant, destArray As Variant, nPos As Integer)
    destArray(nPos) = Str
End Sub

Private Sub PrintLine(Str As String)
    Text2.Text = Text2.Text & Str & vbNewLine
    nNumOfLines = nNumOfLines + 1
    If nNumOfLines > 10 Then
        Call SendMessage(Text2.hwnd, EM_LINESCROLL, 0, (nNumOfLines - 10) * 4)
    End If
End Sub

Private Sub PreProcessInput(strInput As String)
    CleanString strInput
    strInput = UCase(strInput)
End Sub

Private Sub RemoveElement(sourceArray As Variant, nPos As Integer)
    Dim tempArray() As String
    Dim i As Integer
    ReDim tempArray(UBound(sourceArray))
    Call CopyArray(sourceArray, tempArray, 0, nPos)
    Call CopyArray(sourceArray, tempArray, nPos + 1, UBound(sourceArray))
    ReDim sourceArray(UBound(sourceArray) - 1)
    Call CopyArray(tempArray, sourceArray, 0, UBound(sourceArray))
End Sub

Private Sub CopyArray(sourceArray As Variant, destArray As Variant, startPos As Integer, endPos As Integer)
    Dim i As Integer
    For i = startPos To endPos Step 1
        destArray(i) = sourceArray(i)
    Next
End Sub

Private Function IsPunc(ch As String) As Boolean
    IsPunc = (InStr(Delim, ch) <> 0)
End Function

Private Sub CleanString(Str As String)
    Dim nLen As Integer
    Dim i As Integer
    Dim curChar As String
    Dim prevChar As String
    Dim temp As String
    prevChar = 0
    nLen = Len(Str)
    For i = 1 To nLen Step 1
        curChar = Mid(Str, i, 1)
        If ((curChar = " " And prevChar <> " ") Or Not IsPunc(curChar)) Then
            temp = temp & curChar
            prevChar = curChar
        ElseIf (prevChar <> " " And IsPunc(curChar)) Then
            temp = temp & " "
        End If
    Next i
    Str = RTrim(temp)
End Sub


Private Sub Respond(strInput As String)
    Static strResponse As String
    Dim strPrevResponse As String
    Dim respList As Variant
    Dim nSelection As Integer
    respList = FindMatch(strInput)
    If strInput = "BYE" Then
        strResponse = "IT WAS NICE TALKING TO YOU USER, SEE YOU NEXT TIME!"
        Timer2.Enabled = True
    ElseIf Len(respList(0)) = 0 Then
        strResponse = "I'M NOT SURE IF I UNDERSTAND WHAT YOU ARE TALKING ABOUT."
    Else
        'saving previous response
        strPrevResponse = strResponse
        nSelection = (Rnd * (UBound(respList) - 1))
        strResponse = respList(nSelection)
        'avoids repeating the same response
        If strResponse = strPrevResponse Then
            Call RemoveElement(respList, nSelection)
            nSelection = (Rnd * UBound(respList))
            strResponse = respList(nSelection)
        End If
    End If
    PrintLine (strResponse)
End Sub

Private Function FindMatch(strInput As String) As String()
    Dim i As Integer
    Dim j As Integer
    Dim respList() As String
    ReDim respList(maxResp)
    For i = 0 To UBound(KnowledgeBase) Step 1
        If KnowledgeBase(i)(j) = strInput Then
            For j = maxInput To maxResp Step 1
                Call Copy(KnowledgeBase(i)(j), respList, j - maxInput)
            Next
            Exit For
        End If
    Next
    FindMatch = respList
End Function

Private Sub Command1_Click()
    PrintLine (">" & Text1.Text)
    Timer1.Enabled = True
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        PrintLine (">" & Text1.Text)
        Timer1.Enabled = True
    End If
End Sub

Private Sub Timer1_Timer()
    Dim strUserInput As String
    strUserInput = Text1.Text
    Call PreProcessInput(strUserInput)
    Respond (strUserInput)
    Text1.Text = ""
    Timer1.Enabled = False
End Sub

Private Sub Timer2_Timer()
    Unload Chatterbot3
End Sub