chatbot Danny in OxygenBasic

[ron77]

' ============================================================================
' Chatbot Danny for Oxygen Basic
' Version 1.0.0 - 2025
' Converted from QB64PE by Ronen Blumberg
' Using O2's built-in Windows GUI support
' ============================================================================

$ filename "danny.exe"
uses rtl32
uses MinWin

' Additional API declarations
! WinExec lib "kernel32.dll" (char*lpCmdLine, int nCmdShow) as dword
! GetWindowTextLengthA lib "user32.dll" (sys hWnd) as int
! GetWindowTextA lib "user32.dll" (sys hWnd, sys lpString, int nMaxCount) as int
! SetWindowTextA lib "user32.dll" (sys hWnd, char*lpString) as int
! SetFocus lib "user32.dll" (sys hWnd) as sys
! MoveWindow lib "user32.dll" (sys hWnd, int x, int y, int nWidth, int nHeight, int bRepaint) as int
! DestroyWindow lib "user32.dll" (sys hWnd) as int
! CreateFontA lib "gdi32.dll" (int nHeight, int nWidth, int nEscapement, int nOrientation, int fnWeight, dword fdwItalic, dword fdwUnderline, dword fdwStrikeOut, dword fdwCharSet, dword fdwOutputPrecision, dword fdwClipPrecision, dword fdwQuality, dword fdwPitchAndFamily, char* lpszFace) as sys
! GetFocus lib "user32.dll" () as sys

% FW_NORMAL = 400
% DEFAULT_CHARSET = 1
% OUT_DEFAULT_PRECIS = 0
% CLIP_DEFAULT_PRECIS = 0
% DEFAULT_QUALITY = 0
% DEFAULT_PITCH = 0
% VK_RETURN = 0x0D
% WM_KEYDOWN = 0x0100

#lookahead

' ============================================================================
' CONSTANTS
' ============================================================================

% ID_OUTPUT = 101
% ID_INPUT  = 102
% ID_SEND   = 103
% ID_ABOUT  = 104

% WS_OVERLAPPEDWINDOW = 0x00CF0000
% WS_VISIBLE = 0x10000000
% WS_CHILD   = 0x40000000
% WS_VSCROLL = 0x00200000
% WS_BORDER  = 0x00800000
% WS_TABSTOP = 0x00010000
% WS_EX_CLIENTEDGE = 0x00000200

% ES_MULTILINE    = 0x0004
% ES_AUTOVSCROLL  = 0x0040
% ES_AUTOHSCROLL  = 0x0080
% ES_READONLY     = 0x0800

% BS_PUSHBUTTON    = 0x00000000
% BS_DEFPUSHBUTTON = 0x00000001

% BN_CLICKED = 0
% WM_COMMAND = 0x0111
% WM_SIZE    = 0x0005
% WM_CLOSE   = 0x0010
% WM_DESTROY = 0x0002
% WM_CREATE  = 0x0001
% WM_SETFONT = 0x0030
% WM_GETMINMAXINFO = 0x0024

% EM_SETSEL     = 0x00B1
% EM_REPLACESEL = 0x00C2
% EM_SCROLLCARET = 0x00B7

% COLOR_BTNFACE = 15
% DEFAULT_GUI_FONT = 17

% SW_HIDE = 0
% SW_SHOW = 5

% MIN_WIDTH  = 500
% MIN_HEIGHT = 400

' ============================================================================
' GLOBAL VARIABLES
' ============================================================================

sys hMainWnd, hOutputEdit, hInputEdit, hSendButton, hAboutButton
sys hInstance, hFont

int useTTS = 1

' Database arrays - using O2 syntax
int numSwaps = 0
string swapFind[500]
string swapReplace[500]

int numGroups = 0
int numKeywords = 0
string keywords[2000]
int keywordGroup[2000]

int numReplies = 0
string replies[5000]
int replyGroup[5000]

int numDefaults = 0
string defaultReplies[200]

int numPrayerTriggers = 0
string prayerTriggers[50]

int numPrayer1 = 0
int numPrayer2 = 0
int numPrayer3 = 0
int numPrayer4 = 0
string prayerPart1[50]
string prayerPart2[50]
string prayerPart3[50]
string prayerPart4[50]

' ============================================================================
' STRING HELPER FUNCTIONS
' ============================================================================

function LTrimStr(string s) as string
    sys i = 1
    sys ln = len(s)
    if ln = 0 then return ""
    while i <= ln
        string ch = mid(s, i, 1)
        if ch <> " " and ch <> chr(9) then exit while
        i++
    wend
    if i > ln then return ""
    return mid(s, i)
end function

function RTrimStr(string s) as string
    sys i = len(s)
    if i = 0 then return ""
    while i >= 1
        string ch = mid(s, i, 1)
        if ch <> " " and ch <> chr(9) then exit while
        i--
    wend
    if i < 1 then return ""
    return left(s, i)
end function

function TrimStr(string s) as string
    return LTrimStr(RTrimStr(s))
end function

function StartsWith(string prefix, string s) as int
    sys plen = len(prefix)
    if plen > len(s) then return 0
    if left(s, plen) = prefix then return 1
    return 0
end function

function LowerCase(string s) as string
    string result = ""
    sys i, c
    sys slen = len(s)
    for i = 1 to slen
        c = asc(mid(s, i, 1))
        if c >= 65 and c <= 90 then
            result += chr(c + 32)
        else
            result += mid(s, i, 1)
        end if
    next
    return result
end function

function RandomInt(int maxVal) as int
    static sys seed = 0
    if seed = 0 then seed = GetTickCount()
    seed = (seed * 1103515245 + 12345) and 0x7FFFFFFF
    return (seed mod maxVal) + 1
end function

function IsolatePunctuation(string text) as string
    string result = ""
    string punctuation = "?!<>,."
    sys i
    sys tlen = len(text)
    
    for i = 1 to tlen
        string c = mid(text, i, 1)
        if instr(punctuation, c) > 0 then
            if len(result) > 0 and right(result, 1) <> " " then result += " "
            result += c + " "
        else
            result += c
        end if
    next
    
    ' Clean multiple spaces
    string cleaned = ""
    int prevSpace = 0
    sys rlen = len(result)
    for i = 1 to rlen
        string c = mid(result, i, 1)
        if c = " " then
            if prevSpace = 0 then cleaned += c : prevSpace = 1
        else
            cleaned += c : prevSpace = 0
        end if
    next
    return cleaned
end function

' ============================================================================
' DATABASE LOADING
' ============================================================================

sub ProcessDatabaseLine(string rawLine, byref int currentGroup)
    string ln = TrimStr(rawLine)
    sys iPos
    string part1, part2
    
    if len(ln) = 0 then return
    if StartsWith("###", ln) then return
    if StartsWith("===", ln) then return
    if StartsWith("---", ln) then return
    
    if StartsWith("s:", ln) then
        iPos = instr(ln, ">")
        if iPos > 3 then
            part1 = TrimStr(mid(ln, 3, iPos - 3))
            part2 = TrimStr(mid(ln, iPos + 1))
            numSwaps++ : swapFind[numSwaps] = part1 : swapReplace[numSwaps] = part2
        end if
    elseif StartsWith("k:", ln) then
        if currentGroup = 0 or numReplies > 0 then
            if numKeywords > 0 and keywordGroup[numKeywords] = currentGroup and currentGroup > 0 then
                int hasReplies = 0, ri
                for ri = 1 to numReplies
                    if replyGroup[ri] = currentGroup then hasReplies = 1 : exit for
                next
                if hasReplies then currentGroup++ : numGroups = currentGroup
            else
                currentGroup++ : numGroups = currentGroup
            end if
        end if
        numKeywords++
        keywords[numKeywords] = " " + LowerCase(TrimStr(mid(ln, 3))) + " "
        keywordGroup[numKeywords] = currentGroup
    elseif StartsWith("r:", ln) then
        if currentGroup > 0 then
            numReplies++ : replies[numReplies] = TrimStr(mid(ln, 3)) : replyGroup[numReplies] = currentGroup
        end if
    elseif StartsWith("d1:", ln) then
        numDefaults++ : defaultReplies[numDefaults] = TrimStr(mid(ln, 4))
    elseif StartsWith("c6:", ln) then
        numPrayerTriggers++ : prayerTriggers[numPrayerTriggers] = LowerCase(TrimStr(mid(ln, 4)))
    elseif StartsWith("p1:", ln) then
        numPrayer1++ : prayerPart1[numPrayer1] = TrimStr(mid(ln, 4))
    elseif StartsWith("p2:", ln) then
        numPrayer2++ : prayerPart2[numPrayer2] = TrimStr(mid(ln, 4))
    elseif StartsWith("p3:", ln) then
        numPrayer3++ : prayerPart3[numPrayer3] = TrimStr(mid(ln, 4))
    elseif StartsWith("p4:", ln) then
        numPrayer4++ : prayerPart4[numPrayer4] = TrimStr(mid(ln, 4))
    end if
end sub

sub LoadDatabase()
    int currentGroup = 0
    
    numSwaps = 0 : numGroups = 0 : numKeywords = 0 : numReplies = 0
    numDefaults = 0 : numPrayerTriggers = 0
    numPrayer1 = 0 : numPrayer2 = 0 : numPrayer3 = 0 : numPrayer4 = 0
    
    string fileContent = getfile("database.txt")
    if len(fileContent) = 0 then
        mbox "Cannot load database.txt file!"
        return
    end if
    
    ' Process file directly without storing all lines in array
    sys fileLen = len(fileContent)
    sys lineStart = 1
    sys i
    int lineCount = 0
    
    ' Use instr to find newlines instead of checking each character
    sys pos = 1
    sys nextNewline
    
    while pos <= fileLen
        nextNewline = instr(pos, fileContent, chr(10))
        if nextNewline = 0 then nextNewline = fileLen + 1
        
        sys lineLen = nextNewline - pos
        if lineLen > 0 then
            string ln = mid(fileContent, pos, lineLen)
            ' Remove CR if present
            if right(ln, 1) = chr(13) then
                ln = left(ln, len(ln) - 1)
            end if
            lineCount++
            ProcessDatabaseLine(ln, currentGroup)
        end if
        pos = nextNewline + 1
    wend
end sub

' ============================================================================
' CHATBOT LOGIC
' ============================================================================

function CheckPrayerTrigger(string userInput) as int
    string lowerInput = LowerCase(userInput)
    int i
    for i = 1 to numPrayerTriggers
        if instr(lowerInput, prayerTriggers[i]) > 0 then return 1
    next
    return 0
end function

function GeneratePrayer() as string
    string prayer = ""
    if numPrayer1 > 0 then prayer = prayerPart1[RandomInt(numPrayer1)]
    if numPrayer2 > 0 then
        if len(prayer) > 0 then prayer += " "
        prayer += prayerPart2[RandomInt(numPrayer2)]
    end if
    if numPrayer3 > 0 then
        if len(prayer) > 0 then prayer += " "
        prayer += prayerPart3[RandomInt(numPrayer3)]
    end if
    if numPrayer4 > 0 then
        if len(prayer) > 0 then prayer += " "
        prayer += prayerPart4[RandomInt(numPrayer4)]
    end if
    return prayer
end function

function SwapWords(string text) as string
    string result = ""
    string separators = " ,.!?;:" + chr(9) + chr(10) + chr(13)
    string currentWord = ""
    sys i
    int j, found
    sys tlen = len(text)
    
    for i = 1 to tlen
        string c = mid(text, i, 1)
        if instr(separators, c) > 0 then
            if len(currentWord) > 0 then
                found = 0
                for j = 1 to numSwaps
                    if LowerCase(currentWord) = LowerCase(swapFind[j]) then
                        result += swapReplace[j] : found = 1 : exit for
                    end if
                next
                if found = 0 then result += currentWord
                currentWord = ""
            end if
            result += c
        else
            currentWord += c
        end if
    next
    
    if len(currentWord) > 0 then
        found = 0
        for j = 1 to numSwaps
            if LowerCase(currentWord) = LowerCase(swapFind[j]) then
                result += swapReplace[j] : found = 1 : exit for
            end if
        next
        if found = 0 then result += currentWord
    end if
    return result
end function

sub FindAllKeywordMatches(string userInput, int *matches, byref int numMatches)
    string lowerInput = LowerCase(userInput)
    int foundGroups[500]
    int i, g
    numMatches = 0
    for i = 1 to 500 : foundGroups[i] = 0 : next
    for i = 1 to numKeywords
        g = keywordGroup[i]
        if foundGroups[g] = 0 then
            if instr(lowerInput, keywords[i]) > 0 then
                foundGroups[g] = 1 : numMatches++ : matches[numMatches] = g
            end if
        end if
    next
end sub

function GetReply(int groupId, string processedInput, string originalInput) as string
    string groupReplies[200]
    int numGroupReplies = 0, i
    string reply, lowerOriginal, kw, rest
    sys keywordPos, kwLen
    
    if groupId <= 0 or groupId > numGroups then
        if numDefaults > 0 then return defaultReplies[RandomInt(numDefaults)]
        return "I don't know what to say."
    end if
    
    for i = 1 to numReplies
        if replyGroup[i] = groupId then
            numGroupReplies++ : groupReplies[numGroupReplies] = replies[i]
        end if
    next
    
    if numGroupReplies = 0 then
        if numDefaults > 0 then return defaultReplies[RandomInt(numDefaults)]
        return "I don't know what to say."
    end if
    
    reply = groupReplies[RandomInt(numGroupReplies)]
    
    if right(reply, 1) = "*" then
        sys rlen = len(reply)
        reply = left(reply, rlen - 1)
        lowerOriginal = " " + LowerCase(originalInput) + " "
        for i = 1 to numKeywords
            if keywordGroup[i] = groupId then
                kw = keywords[i]
                keywordPos = instr(lowerOriginal, kw)
                if keywordPos > 0 then
                    kwLen = len(kw)
                    rest = mid(lowerOriginal, keywordPos + kwLen)
                    rest = TrimStr(rest)
                    if len(rest) > 0 then
                        rest = SwapWords(rest)
                        reply += " " + rest
                    end if
                    exit for
                end if
            end if
        next
    end if
    return reply
end function

function ProcessInput(string userInput) as string
    string processedInput, originalInput, lowerInput
    int matches[100], numMatches, i
    string reply, combinedReply, lastChar
    
    originalInput = userInput
    processedInput = IsolatePunctuation(userInput)
    processedInput = " " + TrimStr(processedInput) + " "
    lowerInput = LowerCase(processedInput)
    
    if CheckPrayerTrigger(userInput) then return GeneratePrayer()
    
    FindAllKeywordMatches(processedInput, @matches, numMatches)
    
    if numMatches = 0 then
        if numDefaults > 0 then return defaultReplies[RandomInt(numDefaults)]
        return "I don't know what to say."
    end if
    
    if numMatches > 16 then
        return "That's a lot to think about! Let's focus on one thing at a time."
    end if
    
    if numMatches = 1 then return GetReply(matches[1], processedInput, originalInput)
    
    combinedReply = ""
    for i = 1 to numMatches
        if i > 3 then exit for
        reply = GetReply(matches[i], processedInput, originalInput)
        if len(combinedReply) > 0 then
            lastChar = right(combinedReply, 1)
            if instr(".!?", lastChar) = 0 then combinedReply += "."
            combinedReply += " "
        end if
        combinedReply += reply
    next
    return combinedReply
end function

' ============================================================================
' TEXT-TO-SPEECH
' ============================================================================

sub Speak(string text)
    if useTTS = 0 then return
    if len(text) = 0 then return
    
    ' Simple clean - just replace quotes with nothing
    string cleanText = text
    sys i
    
    ' Replace problematic characters
    while instr(cleanText, chr(34)) > 0
        i = instr(cleanText, chr(34))
        cleanText = left(cleanText, i-1) + mid(cleanText, i+1)
    wend
    while instr(cleanText, "'") > 0
        i = instr(cleanText, "'")
        cleanText = left(cleanText, i-1) + mid(cleanText, i+1)
    wend
    while instr(cleanText, chr(13)) > 0
        i = instr(cleanText, chr(13))
        cleanText = left(cleanText, i-1) + " " + mid(cleanText, i+1)
    wend
    while instr(cleanText, chr(10)) > 0
        i = instr(cleanText, chr(10))
        cleanText = left(cleanText, i-1) + " " + mid(cleanText, i+1)
    wend
    
    if len(cleanText) = 0 then return
    
    string cmdLine = "voice.exe -r -1 -n " + chr(34) + "Microsoft David Desktop" + chr(34) + " -q " + chr(34) + cleanText + chr(34)
    WinExec(cmdLine, SW_HIDE)
end sub

' ============================================================================
' GUI FUNCTIONS
' ============================================================================

sub AddToOutput(string prefix, string text)
    string fullText = prefix + text + chr(13) + chr(10)
    sys textLen = GetWindowTextLengthA(hOutputEdit)
    SendMessage(hOutputEdit, EM_SETSEL, textLen, textLen)
    SendMessage(hOutputEdit, EM_REPLACESEL, 0, fullText)
    SendMessage(hOutputEdit, EM_SCROLLCARET, 0, 0)
end sub

sub HandleSend()
    int nLen = GetWindowTextLengthA(hInputEdit)
    if nLen = 0 then
        SetFocus(hInputEdit)
        return
    end if
    
    ' Get input text
    char inputBuffer[2048]
    GetWindowTextA(hInputEdit, @inputBuffer, 2048)
    string userInput = TrimStr(inputBuffer)
    
    if len(userInput) > 0 then
        AddToOutput("You: ", userInput)
        string response = ProcessInput(userInput)
        AddToOutput("Danny: ", response)
        AddToOutput("", "")
        SetWindowTextA(hInputEdit, "")
        if len(response) > 0 then
            Speak(response)
        end if
    end if
    SetFocus(hInputEdit)
end sub

sub ShowAbout()
    string txt
    txt = "Chatbot Danny" + chr(13) + chr(10)
    txt += "Version 1.0.0 - 2025" + chr(13) + chr(10) + chr(13) + chr(10)
    txt += "Developed by - Ronen Blumberg" + chr(13) + chr(10) + chr(13) + chr(10)
    txt += "A conversational chatbot based on" + chr(13) + chr(10)
    txt += "the developer's friend Danny Shaul" + chr(13) + chr(10) + chr(13) + chr(10)
    txt += "Features:" + chr(13) + chr(10)
    txt += "- Resizable window" + chr(13) + chr(10)
    txt += "- Scrollable chat history" + chr(13) + chr(10)
    txt += "- Text-to-Speech support" + chr(13) + chr(10) + chr(13) + chr(10)
    txt += "Oxygen Basic Port - 2025"
    MessageBox(hMainWnd, txt, "About Chatbot Danny", 0)
end sub

sub ResizeControls()
    RECT rc
    GetClientRect(hMainWnd, @rc)
    int w = rc.right - rc.left
    int h = rc.bottom - rc.top
    int margin = 10
    int btnW = 80, btnH = 40
    int inputH = 50
    int outputH = h - inputH - btnH - margin * 5
    
    MoveWindow(hOutputEdit, margin, margin, w - margin * 2, outputH, 1)
    MoveWindow(hInputEdit, margin, margin * 2 + outputH, w - btnW - margin * 3, inputH, 1)
    MoveWindow(hSendButton, w - btnW - margin, margin * 2 + outputH, btnW, inputH, 1)
    MoveWindow(hAboutButton, w - 60 - margin, h - btnH - margin, 60, btnH - 10, 1)
end sub

' ============================================================================
' WINDOW PROCEDURE
' ============================================================================

function WndProc(sys hwnd, wMsg, wParam, lParam) as sys callback
    select wMsg
        case WM_CREATE
            ' Create 20px font
            hFont = CreateFontA(-20, 0, 0, 0, FW_NORMAL, 0, 0, 0, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH, "Segoe UI")
            if hFont = 0 then hFont = GetStockObject(DEFAULT_GUI_FONT)
            
            hOutputEdit = CreateWindowEx(WS_EX_CLIENTEDGE, "EDIT", "",
                WS_CHILD or WS_VISIBLE or WS_VSCROLL or ES_MULTILINE or ES_AUTOVSCROLL or ES_READONLY,
                10, 10, 760, 400, hwnd, ID_OUTPUT, hInstance, 0)
            SendMessage(hOutputEdit, WM_SETFONT, hFont, 1)
            
            ' Single-line input so Enter submits
            hInputEdit = CreateWindowEx(WS_EX_CLIENTEDGE, "EDIT", "",
                WS_CHILD or WS_VISIBLE or ES_AUTOHSCROLL or WS_TABSTOP,
                10, 420, 670, 50, hwnd, ID_INPUT, hInstance, 0)
            SendMessage(hInputEdit, WM_SETFONT, hFont, 1)
            
            hSendButton = CreateWindowEx(0, "BUTTON", "Send",
                WS_CHILD or WS_VISIBLE or BS_DEFPUSHBUTTON or WS_TABSTOP,
                690, 420, 80, 50, hwnd, ID_SEND, hInstance, 0)
            SendMessage(hSendButton, WM_SETFONT, hFont, 1)
            
            hAboutButton = CreateWindowEx(0, "BUTTON", "About",
                WS_CHILD or WS_VISIBLE or BS_PUSHBUTTON,
                720, 480, 60, 30, hwnd, ID_ABOUT, hInstance, 0)
            SendMessage(hAboutButton, WM_SETFONT, hFont, 1)
            
            SetFocus(hInputEdit)
            
        case WM_SIZE
            ResizeControls()
            
        case WM_GETMINMAXINFO
            MINMAXINFO *mmi = lParam
            mmi.ptMinTrackSize.x = MIN_WIDTH
            mmi.ptMinTrackSize.y = MIN_HEIGHT
            
        case WM_COMMAND
            word wmId = loword(wParam)
            word wmEvent = hiword(wParam)
            if wmId = ID_SEND and wmEvent = BN_CLICKED then HandleSend()
            if wmId = ID_ABOUT and wmEvent = BN_CLICKED then ShowAbout()
            
        case WM_CLOSE
            DestroyWindow(hwnd)
            
        case WM_DESTROY
            PostQuitMessage(0)
            
        case else
            function = DefWindowProc(hwnd, wMsg, wParam, lParam)
            
    end select
end function

' ============================================================================
' MAIN PROGRAM
' ============================================================================

sub WinMain()
    hInstance = GetModuleHandle(0)
    LoadDatabase()
    
    WndClass wc
    MSG wm
    
    wc.style = CS_HREDRAW or CS_VREDRAW
    wc.lpfnWndProc = @WndProc
    wc.cbClsExtra = 0
    wc.cbWndExtra = 0
    wc.hInstance = hInstance
    wc.hIcon = LoadIcon(0, IDI_APPLICATION)
    wc.hCursor = LoadCursor(0, IDC_ARROW)
    wc.hbrBackground = COLOR_BTNFACE + 1
    wc.lpszMenuName = 0
    wc.lpszClassName = strptr "DannyChatbot"
    
    RegisterClass(@wc)
    
    ' Center window on screen
    int wwd = 800, wht = 600
    int wtx = (GetSystemMetrics(SM_CXSCREEN) - wwd) / 2
    int wty = (GetSystemMetrics(SM_CYSCREEN) - wht) / 2
    
    hMainWnd = CreateWindowEx(0, wc.lpszClassName, "Chatbot Danny",
        WS_OVERLAPPEDWINDOW,
        wtx, wty, wwd, wht,
        0, 0, hInstance, 0)
    
    if hMainWnd = 0 then
        mbox "Unable to create window"
        return
    end if
    
    ShowWindow(hMainWnd, SW_SHOW)
    UpdateWindow(hMainWnd)
    
    ' Welcome message
    AddToOutput("Danny: ", "Hello there, how are you doing today?")
    AddToOutput("", "")
    Speak("Hello there, how are you doing today?")
    
    sys bRet
    do while bRet := GetMessage(@wm, 0, 0, 0)
        if bRet = -1 then
            exit do
        else
            ' Check for Enter key in input edit
            if wm.message = WM_KEYDOWN and wm.wParam = VK_RETURN then
                if GetFocus() = hInputEdit then
                    HandleSend()
                    continue do
                end if
            end if
            TranslateMessage(@wm)
            DispatchMessage(@wm)
        end if
    loop
end sub

WinMain()