Welcome to RetroCoders Community
' ============================================================================
' 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()
