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.