AI powered roleplay game in QB64

[SquirrelMonkey]

This program uses the LLama-API (a simple version of ChatGPT) in BASIC. In the first line you can set-up a character for your chat-bot.

1) First create a free API key on https://console.groq.com and put it in APIKEY.TXT. You can also use ChatGPT but their API is not free.
2) Be sure Curl is installed (I think this is installed on every Windows 10/11 PC, if not, download Curl and install it.)
3) Run the program.

Unfortunately the app crashes sometimes and I don't know why. Please help!

Code: (Select All)

 personality$ = "You live in the year 3000. People are now transhumans. You talk to a time traveler from 2025. Answer every question about the future, but give brief answers."
 
Screen _NewImage(1024, 768, 256)
_FullScreen , _Smooth
 
Declare Dynamic Library "user32"
    Function FindWindowA& (ByVal lpClassName As _Offset, Byval lpWindowName As _Offset)
    Function ShowWindow& (ByVal hWnd As _Unsigned Long, Byval nCmdShow As Long)
End Declare
 
Declare Dynamic Library "shell32"
    Function ShellExecuteA& (ByVal hwnd As _Unsigned Long, Byval lpOperation As _Offset, Byval lpFile As _Offset, Byval lpParameters As _Offset, Byval lpDirectory As _Offset, Byval nShowCmd As Long)
End Declare
 
Dim hwnd As _Unsigned Long
Dim winTitle$: winTitle$ = _Title$
hwnd = FindWindowA&(0, _Offset(winTitle$))
result& = ShowWindow&(hwnd, 0)
 
DECLARE FUNCTION EscapeQuotes$ (s$)
DECLARE FUNCTION Trim$ (s$)
DECLARE FUNCTION UnescapeJSON$ (s$)
 
Dim prompt$, key$, line$, antwoord$, systemmsg$
Dim curl1$, curl2$, curl3$, curl4$
 
systemmsg$ = personality$
 
result& = ShowWindow&(hwnd, 1)
 
Do
    Color 2
    Line Input ">"; prompt$
    If Len(Trim$(prompt$)) = 0 Then Exit Do
    GoSub VerstuurPrompt
    GoSub TypeAnimatie
Loop
 
End
 
VerstuurPrompt:
prompt$ = EscapeQuotes$(prompt$)
sys$ = EscapeQuotes$(systemmsg$)
 
Open "apikey.txt" For Input As #1
Line Input #1, key$
Close #1
 
Open "prompt.json" For Output As #1
Print #1, "{"
Print #1, "  " + Chr$(34) + "model" + Chr$(34) + ": " + Chr$(34) + "llama3-8b-8192" + Chr$(34) + ","
Print #1, "  " + Chr$(34) + "messages" + Chr$(34) + ": ["
Print #1, "    {" + Chr$(34) + "role" + Chr$(34) + ": " + Chr$(34) + "system" + Chr$(34) + ", " + Chr$(34) + "content" + Chr$(34) + ": " + Chr$(34); sys$; Chr$(34) + "},"
Print #1, "    {" + Chr$(34) + "role" + Chr$(34) + ": " + Chr$(34) + "user" + Chr$(34) + ", " + Chr$(34) + "content" + Chr$(34) + ": " + Chr$(34); prompt$; Chr$(34) + "}"
Print #1, "  ]"
Print #1, "}"
Close #1
 
curl1$ = "curl -s https://api.groq.com/openai/v1/chat/completions "
curl2$ = "-H " + Chr$(34) + "Content-Type: application/json" + Chr$(34) + " "
curl3$ = "-H " + Chr$(34) + "Authorization: Bearer " + key$ + Chr$(34) + " "
curl4$ = "-d @prompt.json > response.json"
 
If _FileExists("response.json") Then Kill "response.json"
 
Open "run_curl.bat" For Output As #1
Print #1, "@echo off"
Print #1, curl1$ + curl2$ + curl3$ + curl4$
Close #1
 
Open "run_curl.vbs" For Output As #1
Print #1, "Set WshShell = CreateObject(" + Chr$(34) + "WScript.Shell" + Chr$(34) + ")"
Print #1, "WshShell.Run chr(34) & " + Chr$(34) + "run_curl.bat" + Chr$(34) + " & chr(34), 0"
Close #1
 
Dim action$, file$, empty$, dummy&, zero&
action$ = "open"
file$ = "run_curl.vbs"
empty$ = ""
zero& = 0
 
dummy& = ShellExecuteA(zero&, _Offset(action$), _Offset(file$), _Offset(empty$), _Offset(empty$), zero&)
 
_Delay 0.5
 
Dim checkline$, checkDone As _Byte
Do While checkDone = 0
    If _FileExists("response.json") Then
        Open "response.json" For Input As #99
        If Not EOF(99) Then
            Line Input #99, checkline$
            If Len(Trim$(checkline$)) > 0 Then checkDone = -1
        End If
        Close #99
    End If
    _Delay 0.1
Loop
 
antwoord$ = ""
Dim fullResponse$
fullResponse$ = ""
Open "response.json" For Input As #1
Do While Not EOF(1)
    Line Input #1, line$
    fullResponse$ = fullResponse$ + line$
Loop
Close #1
 
Dim marker$, contentStart, contentEnd, c$
Dim i As Integer, inEscape As _Byte
 
marker$ = Chr$(34) + "role" + Chr$(34) + ":" + Chr$(34) + "assistant" + Chr$(34) + "," + Chr$(34) + "content" + Chr$(34) + ":" + Chr$(34)
contentStart = InStr(fullResponse$, marker$)
 
If contentStart > 0 Then
    contentStart = contentStart + Len(marker$)
    contentEnd = 0
    For i = contentStart To Len(fullResponse$)
        c$ = Mid$(fullResponse$, i, 1)
        If c$ = "\" And Not inEscape Then
            inEscape = -1
        ElseIf c$ = Chr$(34) And Not inEscape Then
            contentEnd = i - 1
            Exit For
        Else
            inEscape = 0
        End If
    Next
 
    If contentEnd > contentStart Then
        antwoord$ = Mid$(fullResponse$, contentStart, contentEnd - contentStart + 1)
        antwoord$ = UnescapeJSON$(antwoord$)
    End If
End If
 
If Trim$(antwoord$) = "" Then
    antwoord$ = "[No response]"
End If
Return
 
TypeAnimatie:
Color 10
Print ">";
 
Dim j%, typo%, letter$, pitch%
For j = 1 To Len(antwoord$)
    typo% = Int(Rnd * 100)
    letter$ = Mid$(antwoord$, j, 1)
 
    If typo% = 0 Then
        Sound 100, .4
        _Delay 0.04
    End If
 
    Print letter$;
    Sound 3000, .4
    _Delay 0.025 + Rnd * 0.01
Next
Print ""
Return
 
Function EscapeQuotes$ (s$)
    Dim result$, i, c$
    result$ = ""
    For i = 1 To Len(s$)
        c$ = Mid$(s$, i, 1)
        If c$ = Chr$(34) Then
            result$ = result$ + Chr$(34) + Chr$(34)
        Else
            result$ = result$ + c$
        End If
    Next
    EscapeQuotes$ = result$
End Function
 
Function Trim$ (s$)
    Dim i1, i2
    i1 = 1
    Do While Mid$(s$, i1, 1) = " " And i1 <= Len(s$)
        i1 = i1 + 1
    Loop
    i2 = Len(s$)
    Do While Mid$(s$, i2, 1) = " " And i2 >= 1
        i2 = i2 - 1
    Loop
    If i2 >= i1 Then
        Trim$ = Mid$(s$, i1, i2 - i1 + 1)
    Else
        Trim$ = ""
    End If
End Function
 
Function UnescapeJSON$ (s$)
    Dim i As Integer, c$, result$
    i = 1
    result$ = ""
    Do While i <= Len(s$)
        c$ = Mid$(s$, i, 1)
        If c$ = "\" Then
            i = i + 1
            If i <= Len(s$) Then
                c$ = Mid$(s$, i, 1)
                Select Case c$
                    Case "n": result$ = result$ + Chr$(13) + Chr$(10)
                    Case "t": result$ = result$ + Chr$(9)
                    Case Chr$(34): result$ = result$ + Chr$(34)
                    Case "\": result$ = result$ + "\"
                    Case Else: result$ = result$ + "\" + c$
                End Select
            Else
                result$ = result$ + "\"
            End If
        Else
            result$ = result$ + c$
        End If
        i = i + 1
    Loop
    UnescapeJSON$ = result$
End Function

[Pete]

Thanks but I think I'll wait for QB64 Magic 8-Ball. More reliable than AI today, and your cat can enjoy it, too.

Oh, maybe look into curl timeout switches to avoid the hanging.

Pete

[SierraKen]

Very interesting! I hope you can get it fixed soon. I haven't made an API key yet, but I'll wait until you fix it.