Posts: 30
Threads: 11
Joined: Jul 2022
Reputation:
2
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!
![[Image: Screenshot-2025-03-28-171510.png]](https://i.ibb.co/vxpMHStL/Screenshot-2025-03-28-171510.png)
![[Image: Screenshot-2025-03-30-105129.png]](https://i.ibb.co/Myc56JM6/Screenshot-2025-03-30-105129.png)
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
Posts: 2,910
Threads: 305
Joined: Apr 2022
Reputation:
167
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 
Posts: 688
Threads: 125
Joined: Apr 2022
Reputation:
49
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.
Posts: 9
Threads: 7
Joined: Sep 2023
Reputation:
5
11-25-2025, 11:25 PM
(This post was last modified: 11-25-2025, 11:48 PM by solo88.)
hello...
i liked the idea of role playing with the AI so i decided to code my own version:
![[Image: zylwm-msk-2025-11-26-011543.png]](https://i.postimg.cc/sxC5XXz7/zylwm-msk-2025-11-26-011543.png)
It uses openAI api key. Just put the key into the API_KEY.txt file and download it to the project folder, curl 64-bit lib
code:
Code: (Select All)
'=============================================================================
' 1985 TIME TRAVELER CHATBOT - MATRIX EDITION
' Uses OpenAI ChatGPT API via curl
' TTS via voice.exe with Microsoft David Desktop
' QB64PE - 1100x650 Graphics Mode with Matrix Rain Animation
'=============================================================================
DECLARE FUNCTION LoadApiKey$ (filename AS STRING)
DECLARE FUNCTION BuildSystemMessage$ (sysPrompt AS STRING)
DECLARE FUNCTION AddMessage$ (history AS STRING, role AS STRING, content AS STRING)
DECLARE FUNCTION EscapeJSON$ (s AS STRING)
DECLARE FUNCTION UTF8ToASCII$ (s AS STRING)
DECLARE FUNCTION SendToAPI$ (userMessage AS STRING)
DECLARE FUNCTION ReadFileContents$ (filename AS STRING)
DECLARE FUNCTION ParseResponse$ (jsonResponse AS STRING)
DECLARE FUNCTION CalcVisibleLines% ()
CONST API_URL = "https://api.openai.com/v1/chat/completions"
CONST MODEL = "gpt-4o-mini"
CONST MAX_TOKENS = 500
CONST TEMPERATURE = "0.9"
' Screen dimensions - WIDER for more rain visibility
CONST SCREEN_WIDTH = 1100
CONST SCREEN_HEIGHT = 650
' Layout constants - Wider margins for rain
CONST MARGIN_LEFT = 120
CONST MARGIN_RIGHT = 120
CONST MARGIN = 120
CONST CHAT_TOP = 80
CONST CHAT_BOTTOM = 560
CONST INPUT_TOP = 580
CONST INPUT_HEIGHT = 50
CONST LINE_HEIGHT = 18
' Matrix Rain constants
CONST NUM_RAIN_COLUMNS = 80
CONST RAIN_CHAR_HEIGHT = 14
' Chat history for display
CONST MAX_CHAT_LINES = 500
DIM SHARED ChatLines(MAX_CHAT_LINES) AS STRING
DIM SHARED ChatColors(MAX_CHAT_LINES) AS _UNSIGNED LONG
DIM SHARED ChatLineCount AS INTEGER
DIM SHARED ScrollOffset AS INTEGER
DIM SHARED VisibleLines AS INTEGER
' Matrix Rain arrays
DIM SHARED RainX(NUM_RAIN_COLUMNS) AS INTEGER
DIM SHARED RainY(NUM_RAIN_COLUMNS) AS SINGLE
DIM SHARED RainSpeed(NUM_RAIN_COLUMNS) AS SINGLE
DIM SHARED RainLength(NUM_RAIN_COLUMNS) AS INTEGER
DIM SHARED RainChars(NUM_RAIN_COLUMNS, 40) AS STRING
' Matrix Colors - using _RGB32 for proper colors
DIM SHARED COL_BLACK AS _UNSIGNED LONG
DIM SHARED COL_DARKGREEN AS _UNSIGNED LONG
DIM SHARED COL_RAIN_HEAD AS _UNSIGNED LONG
DIM SHARED COL_RAIN_BRIGHT AS _UNSIGNED LONG
DIM SHARED COL_RAIN_MED AS _UNSIGNED LONG
DIM SHARED COL_RAIN_DIM AS _UNSIGNED LONG
DIM SHARED COL_RAIN_DARK AS _UNSIGNED LONG
DIM SHARED COL_TEXT_BRIGHT AS _UNSIGNED LONG
DIM SHARED COL_TEXT_DIM AS _UNSIGNED LONG
DIM SHARED COL_TEXT_TITLE AS _UNSIGNED LONG
DIM SHARED COL_BORDER AS _UNSIGNED LONG
DIM SHARED COL_BG_DARK AS _UNSIGNED LONG
DIM SHARED ApiKey AS STRING
DIM SHARED ConversationHistory AS STRING
DIM SHARED VoiceEnabled AS INTEGER
DIM SHARED InputBuffer AS STRING
DIM SHARED CursorBlink AS INTEGER
DIM SHARED LastBlinkTime AS DOUBLE
'-----------------------------------------------------------------------------
' MAIN PROGRAM
'-----------------------------------------------------------------------------
' Initialize graphics
SCREEN _NEWIMAGE(SCREEN_WIDTH, SCREEN_HEIGHT, 32)
_TITLE "1985 Time Traveler Chatbot - MATRIX EDITION"
_SCREENMOVE _MIDDLE
' Initialize colors with _RGB32 for proper green Matrix look
COL_BLACK = _RGB32(0, 0, 0)
COL_DARKGREEN = _RGB32(0, 20, 0)
COL_RAIN_HEAD = _RGB32(200, 255, 200) ' Bright white-green head
COL_RAIN_BRIGHT = _RGB32(0, 255, 0) ' Bright neon green
COL_RAIN_MED = _RGB32(0, 180, 0) ' Medium green
COL_RAIN_DIM = _RGB32(0, 100, 0) ' Dim green
COL_RAIN_DARK = _RGB32(0, 50, 0) ' Dark green trail
COL_TEXT_BRIGHT = _RGB32(0, 255, 0) ' Bright green for user
COL_TEXT_DIM = _RGB32(0, 200, 0) ' Medium green for AI
COL_TEXT_TITLE = _RGB32(100, 255, 100) ' Light green for titles
COL_BORDER = _RGB32(0, 150, 0) ' Border green
COL_BG_DARK = _RGB32(0, 10, 0) ' Very dark green bg
' Initialize variables
ChatLineCount = 0
ScrollOffset = 0
VoiceEnabled = -1
InputBuffer = ""
CursorBlink = -1
LastBlinkTime = TIMER
VisibleLines = CalcVisibleLines
' Initialize Matrix Rain
CALL InitMatrixRain
' Load API key
ApiKey = LoadApiKey("API_KEY.txt")
IF ApiKey = "" THEN
CALL DrawScreen
CALL AddChatLine("ERROR: Could not load API key from API_KEY.txt", COL_TEXT_BRIGHT)
CALL AddChatLine("Please create API_KEY.txt with your OpenAI API key.", COL_TEXT_DIM)
CALL DrawScreen
DO: _LIMIT 30: LOOP UNTIL _KEYHIT = 27
SYSTEM
END IF
' Initialize conversation with system prompt
DIM SystemPrompt AS STRING
SystemPrompt = "You are a friendly, curious person living in 1985. "
SystemPrompt = SystemPrompt + "You have no knowledge of anything after 1985. "
SystemPrompt = SystemPrompt + "The user claims to be a time traveler from the year 2025. "
SystemPrompt = SystemPrompt + "You are fascinated and ask them questions about the future. "
SystemPrompt = SystemPrompt + "You also love reminiscing about life in the 1980s - "
SystemPrompt = SystemPrompt + "the music (Madonna, Michael Jackson, Prince), movies (Back to the Future, "
SystemPrompt = SystemPrompt + "The Breakfast Club, Ghostbusters), TV shows (Miami Vice, The A-Team), "
SystemPrompt = SystemPrompt + "technology (Commodore 64, Atari, cassette tapes, VHS), "
SystemPrompt = SystemPrompt + "and the culture of the Reagan era. "
SystemPrompt = SystemPrompt + "Be enthusiastic, use 80s slang like 'totally rad', 'gnarly', 'tubular'. "
SystemPrompt = SystemPrompt + "Keep responses conversational and under 150 words. "
SystemPrompt = SystemPrompt + "IMPORTANT: Do NOT use any emoji or special unicode characters - only plain ASCII text. "
SystemPrompt = SystemPrompt + "Start by introducing yourself and asking about 2025."
ConversationHistory = BuildSystemMessage(SystemPrompt)
' Draw initial screen
CALL DrawScreen
CALL AddChatLine("Welcome to the 1985 Time Traveler Chatbot!", COL_TEXT_TITLE)
CALL AddChatLine("[ M A T R I X E D I T I O N ]", COL_TEXT_BRIGHT)
CALL AddChatLine("You are a visitor from 2025!", COL_TEXT_TITLE)
CALL AddChatLine("Type 'quit' to exit, 'mute'/'unmute' for voice", COL_TEXT_DIM)
CALL AddChatLine("Use UP/DOWN arrows or mouse wheel to scroll", COL_TEXT_DIM)
CALL AddChatLine("", COL_TEXT_DIM)
CALL AddChatLine("[Connecting to 1985... please wait]", COL_TEXT_DIM)
CALL DrawScreen
' Get initial greeting
DIM Response AS STRING
Response = SendToAPI("")
IF Response <> "" THEN
CALL AddChatLine("", COL_TEXT_DIM)
CALL WrapAndAddText("1985 FRIEND: " + Response, COL_TEXT_DIM)
DIM initMaxScroll AS INTEGER
initMaxScroll = ChatLineCount - VisibleLines
IF initMaxScroll < 0 THEN initMaxScroll = 0
ScrollOffset = initMaxScroll
CALL DrawScreen
IF VoiceEnabled THEN CALL Speak(Response)
END IF
' Main loop
DIM k AS LONG
DIM mw AS INTEGER
DIM maxScroll AS INTEGER
DO
_LIMIT 60
' Update Matrix Rain
CALL UpdateMatrixRain
' Handle cursor blink
IF TIMER - LastBlinkTime > 0.5 THEN
CursorBlink = NOT CursorBlink
LastBlinkTime = TIMER
END IF
' Handle mouse wheel for scrolling
mw = 0
DO WHILE _MOUSEWHEEL
mw = mw + _MOUSEWHEEL
LOOP
IF mw <> 0 THEN
ScrollOffset = ScrollOffset + mw * 3
IF ScrollOffset < 0 THEN ScrollOffset = 0
maxScroll = ChatLineCount - VisibleLines
IF maxScroll < 0 THEN maxScroll = 0
IF ScrollOffset > maxScroll THEN ScrollOffset = maxScroll
END IF
' Handle keyboard input
k = _KEYHIT
IF k > 0 THEN
SELECT CASE k
CASE 27
EXIT DO
CASE 13
IF LEN(InputBuffer) > 0 THEN
CALL ProcessInput(InputBuffer)
InputBuffer = ""
END IF
CASE 8
IF LEN(InputBuffer) > 0 THEN
InputBuffer = LEFT$(InputBuffer, LEN(InputBuffer) - 1)
END IF
CASE 18432
IF ScrollOffset > 0 THEN ScrollOffset = ScrollOffset - 1
CASE 20480
maxScroll = ChatLineCount - VisibleLines
IF maxScroll < 0 THEN maxScroll = 0
IF ScrollOffset < maxScroll THEN ScrollOffset = ScrollOffset + 1
CASE 18176
ScrollOffset = ScrollOffset - VisibleLines
IF ScrollOffset < 0 THEN ScrollOffset = 0
CASE 20224
maxScroll = ChatLineCount - VisibleLines
IF maxScroll < 0 THEN maxScroll = 0
ScrollOffset = ScrollOffset + VisibleLines
IF ScrollOffset > maxScroll THEN ScrollOffset = maxScroll
CASE 32 TO 126
IF LEN(InputBuffer) < 500 THEN
InputBuffer = InputBuffer + CHR$(k)
END IF
END SELECT
END IF
CALL DrawScreen
LOOP
SYSTEM
'-----------------------------------------------------------------------------
' MATRIX RAIN SUBROUTINES
'-----------------------------------------------------------------------------
SUB InitMatrixRain
DIM i AS INTEGER, j AS INTEGER
RANDOMIZE TIMER
FOR i = 0 TO NUM_RAIN_COLUMNS - 1
' Distribute columns - half on left margin, half on right margin
IF i < NUM_RAIN_COLUMNS / 2 THEN
' Left side rain
RainX(i) = 5 + INT(RND * (MARGIN_LEFT - 15))
ELSE
' Right side rain
RainX(i) = SCREEN_WIDTH - MARGIN_RIGHT + 5 + INT(RND * (MARGIN_RIGHT - 15))
END IF
RainY(i) = RND * SCREEN_HEIGHT
RainSpeed(i) = 3 + RND * 8
RainLength(i) = 8 + INT(RND * 25)
FOR j = 0 TO 39
RainChars(i, j) = GetMatrixChar$
NEXT
NEXT
END SUB
FUNCTION GetMatrixChar$
DIM chars AS STRING
DIM idx AS INTEGER
' Matrix-style characters
chars = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ@#$%&*+=<>/?|\:;~"
idx = INT(RND * LEN(chars)) + 1
GetMatrixChar$ = MID$(chars, idx, 1)
END FUNCTION
SUB UpdateMatrixRain
DIM i AS INTEGER, j AS INTEGER
FOR i = 0 TO NUM_RAIN_COLUMNS - 1
RainY(i) = RainY(i) + RainSpeed(i)
IF RainY(i) > SCREEN_HEIGHT + RainLength(i) * RAIN_CHAR_HEIGHT THEN
RainY(i) = -RainLength(i) * RAIN_CHAR_HEIGHT
RainSpeed(i) = 3 + RND * 8
RainLength(i) = 8 + INT(RND * 25)
IF i < NUM_RAIN_COLUMNS / 2 THEN
RainX(i) = 5 + INT(RND * (MARGIN_LEFT - 15))
ELSE
RainX(i) = SCREEN_WIDTH - MARGIN_RIGHT + 5 + INT(RND * (MARGIN_RIGHT - 15))
END IF
END IF
IF RND < 0.15 THEN
j = INT(RND * RainLength(i))
IF j <= 39 THEN RainChars(i, j) = GetMatrixChar$
END IF
NEXT
END SUB
SUB DrawMatrixRain
DIM i AS INTEGER, j AS INTEGER
DIM charY AS INTEGER
DIM col AS _UNSIGNED LONG
FOR i = 0 TO NUM_RAIN_COLUMNS - 1
FOR j = 0 TO RainLength(i) - 1
charY = INT(RainY(i)) - j * RAIN_CHAR_HEIGHT
IF charY >= 0 AND charY < SCREEN_HEIGHT THEN
IF j = 0 THEN
col = COL_RAIN_HEAD
ELSEIF j = 1 THEN
col = COL_RAIN_BRIGHT
ELSEIF j < 5 THEN
col = COL_RAIN_MED
ELSEIF j < 12 THEN
col = COL_RAIN_DIM
ELSE
col = COL_RAIN_DARK
END IF
COLOR col
IF j <= 39 THEN
_PRINTSTRING (RainX(i), charY), RainChars(i, j)
END IF
END IF
NEXT
NEXT
END SUB
'-----------------------------------------------------------------------------
' UI SUBROUTINES
'-----------------------------------------------------------------------------
FUNCTION CalcVisibleLines%
CalcVisibleLines% = (CHAT_BOTTOM - CHAT_TOP - 10) \ LINE_HEIGHT
END FUNCTION
SUB ProcessInput (userInput AS STRING)
DIM trimmed AS STRING
DIM response AS STRING
DIM maxScroll AS INTEGER
trimmed = LTRIM$(RTRIM$(userInput))
IF LCASE$(trimmed) = "quit" OR LCASE$(trimmed) = "exit" THEN
CALL AddChatLine("", COL_TEXT_DIM)
CALL WrapAndAddText("1985 FRIEND: Whoa, you're leaving? This was totally tubular! Come back sometime!", COL_TEXT_DIM)
CALL DrawScreen
IF VoiceEnabled THEN
CALL Speak("Whoa, you're leaving? This was totally tubular! Come back sometime!")
END IF
_DELAY 1
SYSTEM
END IF
IF LCASE$(trimmed) = "mute" THEN
VoiceEnabled = 0
CALL AddChatLine("[Voice disabled]", COL_TEXT_TITLE)
EXIT SUB
END IF
IF LCASE$(trimmed) = "unmute" THEN
VoiceEnabled = -1
CALL AddChatLine("[Voice enabled]", COL_TEXT_TITLE)
EXIT SUB
END IF
IF trimmed = "" THEN EXIT SUB
CALL AddChatLine("", COL_TEXT_BRIGHT)
CALL WrapAndAddText("YOU (2025): " + trimmed, COL_TEXT_BRIGHT)
CALL AddChatLine("", COL_TEXT_DIM)
CALL AddChatLine("[Thinking...]", COL_TEXT_DIM)
CALL DrawScreen
response = SendToAPI(trimmed)
IF ChatLineCount > 0 THEN ChatLineCount = ChatLineCount - 1
IF ChatLineCount > 0 THEN ChatLineCount = ChatLineCount - 1
IF response <> "" THEN
CALL AddChatLine("", COL_TEXT_DIM)
CALL WrapAndAddText("1985 FRIEND: " + response, COL_TEXT_DIM)
maxScroll = ChatLineCount - VisibleLines
IF maxScroll < 0 THEN maxScroll = 0
ScrollOffset = maxScroll
CALL DrawScreen
IF VoiceEnabled THEN CALL Speak(response)
ELSE
CALL AddChatLine("", COL_TEXT_DIM)
CALL AddChatLine("1985 FRIEND: [Sorry, got distracted by my Walkman...]", COL_TEXT_DIM)
END IF
maxScroll = ChatLineCount - VisibleLines
IF maxScroll < 0 THEN maxScroll = 0
ScrollOffset = maxScroll
END SUB
SUB DrawScreen
DIM title AS STRING
DIM subtitle AS STRING
DIM startLine AS INTEGER
DIM y AS INTEGER
DIM i AS INTEGER
DIM prompt AS STRING
DIM cursorX AS INTEGER
DIM scrollBarHeight AS INTEGER
DIM scrollBarPos AS INTEGER
DIM scrollAreaHeight AS INTEGER
DIM maxScroll AS INTEGER
' Clear screen to black
CLS
LINE (0, 0)-(SCREEN_WIDTH - 1, SCREEN_HEIGHT - 1), COL_BLACK, BF
' Draw Matrix Rain FIRST (background on sides)
CALL DrawMatrixRain
' Draw dark background for chat area
LINE (MARGIN_LEFT - 5, CHAT_TOP - 5)-(SCREEN_WIDTH - MARGIN_RIGHT + 5, CHAT_BOTTOM + 5), COL_BG_DARK, BF
' Draw title bar
LINE (MARGIN_LEFT - 5, 10)-(SCREEN_WIDTH - MARGIN_RIGHT + 5, 65), COL_BG_DARK, BF
LINE (MARGIN_LEFT - 5, 10)-(SCREEN_WIDTH - MARGIN_RIGHT + 5, 65), COL_BORDER, B
COLOR COL_TEXT_BRIGHT
title = "[ 1985 TIME TRAVELER CHATBOT - MATRIX EDITION ]"
_PRINTSTRING ((SCREEN_WIDTH - _PRINTWIDTH(title)) / 2, 20), title
IF VoiceEnabled THEN
subtitle = "Voice: ON | Press ESC to quit"
ELSE
subtitle = "Voice: OFF | Press ESC to quit"
END IF
COLOR COL_TEXT_DIM
_PRINTSTRING ((SCREEN_WIDTH - _PRINTWIDTH(subtitle)) / 2, 42), subtitle
' Draw chat area border
LINE (MARGIN_LEFT - 5, CHAT_TOP)-(SCREEN_WIDTH - MARGIN_RIGHT + 5, CHAT_BOTTOM), COL_BORDER, B
' Draw chat messages
startLine = ScrollOffset
IF startLine < 0 THEN startLine = 0
y = CHAT_TOP + 5
FOR i = startLine TO ChatLineCount - 1
IF y + LINE_HEIGHT > CHAT_BOTTOM - 5 THEN EXIT FOR
COLOR ChatColors(i)
_PRINTSTRING (MARGIN_LEFT + 5, y), ChatLines(i)
y = y + LINE_HEIGHT
NEXT
' Draw scroll indicator if needed
IF ChatLineCount > VisibleLines THEN
scrollAreaHeight = CHAT_BOTTOM - CHAT_TOP - 20
scrollBarHeight = (VisibleLines * scrollAreaHeight) / ChatLineCount
IF scrollBarHeight < 20 THEN scrollBarHeight = 20
maxScroll = ChatLineCount - VisibleLines
IF maxScroll < 1 THEN maxScroll = 1
scrollBarPos = CHAT_TOP + 10 + (ScrollOffset * (scrollAreaHeight - scrollBarHeight)) / maxScroll
LINE (SCREEN_WIDTH - MARGIN_RIGHT - 5, scrollBarPos)-(SCREEN_WIDTH - MARGIN_RIGHT + 2, scrollBarPos + scrollBarHeight), COL_RAIN_BRIGHT, BF
END IF
' Draw input area
LINE (MARGIN_LEFT - 5, INPUT_TOP)-(SCREEN_WIDTH - MARGIN_RIGHT + 5, INPUT_TOP + INPUT_HEIGHT), COL_BG_DARK, BF
LINE (MARGIN_LEFT - 5, INPUT_TOP)-(SCREEN_WIDTH - MARGIN_RIGHT + 5, INPUT_TOP + INPUT_HEIGHT), COL_BORDER, B
' Draw input prompt and text (handle long input)
COLOR COL_TEXT_BRIGHT
prompt = "> "
DIM inputMaxWidth AS INTEGER
DIM displayInput AS STRING
DIM inputStartX AS INTEGER
inputMaxWidth = (SCREEN_WIDTH - MARGIN_LEFT - MARGIN_RIGHT - 20) - _PRINTWIDTH(prompt)
inputStartX = MARGIN_LEFT + 5
' If input is too long, show only the end portion
IF _PRINTWIDTH(InputBuffer) > inputMaxWidth THEN
' Find how much of the end we can display
DIM tempStr AS STRING
DIM cutPos AS INTEGER
tempStr = InputBuffer
DO WHILE _PRINTWIDTH(tempStr) > inputMaxWidth AND LEN(tempStr) > 0
tempStr = MID$(tempStr, 2) ' Remove first character
LOOP
displayInput = tempStr
ELSE
displayInput = InputBuffer
END IF
_PRINTSTRING (inputStartX, INPUT_TOP + 15), prompt + displayInput
' Draw cursor at end of visible text
IF CursorBlink THEN
cursorX = inputStartX + _PRINTWIDTH(prompt + displayInput)
LINE (cursorX, INPUT_TOP + 10)-(cursorX + 2, INPUT_TOP + INPUT_HEIGHT - 10), COL_TEXT_BRIGHT, BF
END IF
_DISPLAY
END SUB
SUB AddChatLine (text AS STRING, col AS _UNSIGNED LONG)
DIM i AS INTEGER
IF ChatLineCount >= MAX_CHAT_LINES THEN
FOR i = 0 TO MAX_CHAT_LINES - 2
ChatLines(i) = ChatLines(i + 1)
ChatColors(i) = ChatColors(i + 1)
NEXT
ChatLineCount = MAX_CHAT_LINES - 1
END IF
ChatLines(ChatLineCount) = text
ChatColors(ChatLineCount) = col
ChatLineCount = ChatLineCount + 1
END SUB
SUB WrapAndAddText (text AS STRING, col AS _UNSIGNED LONG)
DIM maxWidth AS INTEGER
DIM currentLine AS STRING
DIM wordCount AS INTEGER
DIM i AS INTEGER
DIM testLine AS STRING
DIM tempText AS STRING
DIM spacePos AS INTEGER
DIM words(1000) AS STRING
maxWidth = SCREEN_WIDTH - MARGIN_LEFT - MARGIN_RIGHT - 30
tempText = text
wordCount = 0
DO WHILE LEN(tempText) > 0
spacePos = INSTR(tempText, " ")
IF spacePos = 0 THEN
words(wordCount) = tempText
wordCount = wordCount + 1
tempText = ""
ELSE
words(wordCount) = LEFT$(tempText, spacePos - 1)
wordCount = wordCount + 1
tempText = MID$(tempText, spacePos + 1)
END IF
IF wordCount >= 1000 THEN EXIT DO
LOOP
currentLine = ""
FOR i = 0 TO wordCount - 1
IF currentLine = "" THEN
testLine = words(i)
ELSE
testLine = currentLine + " " + words(i)
END IF
IF _PRINTWIDTH(testLine) > maxWidth THEN
IF currentLine <> "" THEN
CALL AddChatLine(currentLine, col)
currentLine = words(i)
ELSE
CALL AddChatLine(words(i), col)
currentLine = ""
END IF
ELSE
currentLine = testLine
END IF
NEXT
IF currentLine <> "" THEN
CALL AddChatLine(currentLine, col)
END IF
END SUB
'-----------------------------------------------------------------------------
' API FUNCTIONS
'-----------------------------------------------------------------------------
FUNCTION LoadApiKey$ (filename AS STRING)
DIM f AS INTEGER
DIM key1 AS STRING
IF NOT _FILEEXISTS(filename) THEN
LoadApiKey$ = ""
EXIT FUNCTION
END IF
f = FREEFILE
OPEN filename FOR INPUT AS #f
IF NOT EOF(f) THEN
LINE INPUT #f, key1
key1 = LTRIM$(RTRIM$(key1))
END IF
CLOSE #f
LoadApiKey$ = key1
END FUNCTION
FUNCTION BuildSystemMessage$ (sysPrompt AS STRING)
DIM json AS STRING
json = "[{" + CHR$(34) + "role" + CHR$(34) + ":" + CHR$(34) + "system" + CHR$(34) + ","
json = json + CHR$(34) + "content" + CHR$(34) + ":" + CHR$(34) + EscapeJSON(sysPrompt) + CHR$(34) + "}]"
BuildSystemMessage$ = json
END FUNCTION
FUNCTION AddMessage$ (history AS STRING, role AS STRING, content AS STRING)
DIM newMsg AS STRING
DIM result AS STRING
newMsg = "{" + CHR$(34) + "role" + CHR$(34) + ":" + CHR$(34) + role + CHR$(34) + ","
newMsg = newMsg + CHR$(34) + "content" + CHR$(34) + ":" + CHR$(34) + EscapeJSON(content) + CHR$(34) + "}"
result = LEFT$(history, LEN(history) - 1) + "," + newMsg + "]"
AddMessage$ = result
END FUNCTION
FUNCTION EscapeJSON$ (s AS STRING)
DIM result AS STRING
DIM i AS INTEGER
DIM c AS STRING
result = ""
FOR i = 1 TO LEN(s)
c = MID$(s, i, 1)
SELECT CASE c
CASE CHR$(34)
result = result + "\" + CHR$(34)
CASE CHR$(92)
result = result + "\\"
CASE CHR$(10)
result = result + "\n"
CASE CHR$(13)
result = result + "\r"
CASE CHR$(9)
result = result + "\t"
CASE ELSE
IF ASC(c) >= 32 THEN
result = result + c
END IF
END SELECT
NEXT
EscapeJSON$ = result
END FUNCTION
FUNCTION UTF8ToASCII$ (s AS STRING)
DIM result AS STRING
DIM i AS LONG
DIM b1 AS INTEGER, b2 AS INTEGER, b3 AS INTEGER, b4 AS INTEGER
result = ""
i = 1
DO WHILE i <= LEN(s)
b1 = ASC(MID$(s, i, 1))
' 4-byte UTF-8 sequence (F0-F4) - mostly emoji
IF b1 >= 240 AND b1 <= 244 AND i + 3 <= LEN(s) THEN
' Skip emoji - add a space so text doesn't run together
IF LEN(result) > 0 AND RIGHT$(result, 1) <> " " THEN
result = result + " "
END IF
i = i + 4
' 3-byte UTF-8 sequence (E0-EF)
ELSEIF b1 >= 224 AND b1 <= 239 AND i + 2 <= LEN(s) THEN
b2 = ASC(MID$(s, i + 1, 1))
b3 = ASC(MID$(s, i + 2, 1))
IF b1 = 226 AND b2 = 128 THEN
SELECT CASE b3
CASE 152, 153: result = result + "'"
CASE 156, 157: result = result + CHR$(34)
CASE 147: result = result + "-"
CASE 148: result = result + "--"
CASE 166: result = result + "..."
CASE 162: result = result + "*"
CASE 160: result = result + " "
CASE ELSE: result = result + " "
END SELECT
ELSEIF b1 = 239 AND b2 = 187 AND b3 = 191 THEN
' UTF-8 BOM - skip
ELSE
' Other 3-byte sequence - skip or space
END IF
i = i + 3
' 2-byte UTF-8 sequence (C0-DF)
ELSEIF b1 >= 192 AND b1 <= 223 AND i + 1 <= LEN(s) THEN
b2 = ASC(MID$(s, i + 1, 1))
IF b1 = 194 THEN
SELECT CASE b2
CASE 160: result = result + " "
CASE 169: result = result + "(c)"
CASE 174: result = result + "(R)"
CASE 176: result = result + " degrees"
CASE ELSE: result = result + " "
END SELECT
ELSEIF b1 = 195 THEN
SELECT CASE b2
CASE 160 TO 165: result = result + "a"
CASE 168 TO 171: result = result + "e"
CASE 172 TO 175: result = result + "i"
CASE 178 TO 182: result = result + "o"
CASE 185 TO 188: result = result + "u"
CASE 177: result = result + "n"
CASE ELSE: result = result + " "
END SELECT
ELSE
' Skip other 2-byte sequences
END IF
i = i + 2
' High bit set but not valid UTF-8 start - skip
ELSEIF b1 >= 128 THEN
i = i + 1
' Regular ASCII character
ELSE
result = result + CHR$(b1)
i = i + 1
END IF
LOOP
' Final cleanup pass - remove any remaining non-ASCII characters
DIM cleaned AS STRING
DIM j AS INTEGER
DIM c AS INTEGER
DIM lastWasSpace AS INTEGER
cleaned = ""
lastWasSpace = 0
FOR j = 1 TO LEN(result)
c = ASC(MID$(result, j, 1))
IF c >= 32 AND c <= 126 THEN
' Avoid double spaces
IF c = 32 AND lastWasSpace THEN
' Skip extra space
ELSE
cleaned = cleaned + CHR$(c)
lastWasSpace = (c = 32)
END IF
ELSEIF c = 10 THEN
cleaned = cleaned + CHR$(c) ' Keep newlines
lastWasSpace = 0
ELSEIF c = 9 THEN
cleaned = cleaned + " " ' Convert tabs to space
lastWasSpace = -1
' Skip any other characters (including high-bit chars)
END IF
NEXT
UTF8ToASCII$ = cleaned
END FUNCTION
FUNCTION SendToAPI$ (userMessage AS STRING)
DIM requestFile AS STRING
DIM responseFile AS STRING
DIM jsonBody AS STRING
DIM curlCmd AS STRING
DIM response AS STRING
DIM f AS INTEGER
DIM content AS STRING
DIM timeout AS DOUBLE
requestFile = "request.json"
responseFile = "response.json"
IF userMessage <> "" THEN
ConversationHistory = AddMessage(ConversationHistory, "user", userMessage)
END IF
jsonBody = "{" + CHR$(10)
jsonBody = jsonBody + " " + CHR$(34) + "model" + CHR$(34) + ": " + CHR$(34) + MODEL + CHR$(34) + "," + CHR$(10)
jsonBody = jsonBody + " " + CHR$(34) + "messages" + CHR$(34) + ": " + ConversationHistory + "," + CHR$(10)
jsonBody = jsonBody + " " + CHR$(34) + "max_tokens" + CHR$(34) + ": " + LTRIM$(STR$(MAX_TOKENS)) + "," + CHR$(10)
jsonBody = jsonBody + " " + CHR$(34) + "temperature" + CHR$(34) + ": " + TEMPERATURE + CHR$(10)
jsonBody = jsonBody + "}"
f = FREEFILE
OPEN requestFile FOR OUTPUT AS #f
PRINT #f, jsonBody
CLOSE #f
IF _FILEEXISTS(responseFile) THEN KILL responseFile
curlCmd = "curl -s -X POST " + CHR$(34) + API_URL + CHR$(34)
curlCmd = curlCmd + " -H " + CHR$(34) + "Content-Type: application/json" + CHR$(34)
curlCmd = curlCmd + " -H " + CHR$(34) + "Authorization: Bearer " + ApiKey + CHR$(34)
curlCmd = curlCmd + " -d @" + requestFile
curlCmd = curlCmd + " -o " + responseFile + " 2>nul"
SHELL _HIDE curlCmd
timeout = TIMER + 30
DO WHILE NOT _FILEEXISTS(responseFile)
_DELAY 0.1
IF TIMER > timeout THEN
SendToAPI$ = ""
EXIT FUNCTION
END IF
LOOP
_DELAY 0.2
response = ReadFileContents(responseFile)
content = ParseResponse(response)
content = UTF8ToASCII(content)
IF content <> "" THEN
ConversationHistory = AddMessage(ConversationHistory, "assistant", content)
END IF
IF _FILEEXISTS(requestFile) THEN KILL requestFile
IF _FILEEXISTS(responseFile) THEN KILL responseFile
SendToAPI$ = content
END FUNCTION
FUNCTION ReadFileContents$ (filename AS STRING)
DIM f AS INTEGER
DIM contents AS STRING
DIM line1 AS STRING
IF NOT _FILEEXISTS(filename) THEN
ReadFileContents$ = ""
EXIT FUNCTION
END IF
contents = ""
f = FREEFILE
OPEN filename FOR INPUT AS #f
DO WHILE NOT EOF(f)
LINE INPUT #f, line1
contents = contents + line1 + CHR$(10)
LOOP
CLOSE #f
ReadFileContents$ = contents
END FUNCTION
FUNCTION ParseResponse$ (jsonResponse AS STRING)
DIM pos1 AS LONG
DIM startPos AS LONG
DIM content AS STRING
DIM searchStr AS STRING
DIM ch AS STRING
DIM nextCh AS STRING
DIM hexCode AS STRING
DIM uniVal AS LONG
searchStr = CHR$(34) + "content" + CHR$(34) + ":"
pos1 = INSTR(jsonResponse, CHR$(34) + "choices" + CHR$(34))
IF pos1 = 0 THEN
IF INSTR(jsonResponse, CHR$(34) + "error" + CHR$(34)) > 0 THEN
ParseResponse$ = "[API Error - check your API key]"
ELSE
ParseResponse$ = ""
END IF
EXIT FUNCTION
END IF
pos1 = INSTR(pos1, jsonResponse, searchStr)
IF pos1 = 0 THEN
ParseResponse$ = ""
EXIT FUNCTION
END IF
pos1 = pos1 + LEN(searchStr)
DO WHILE pos1 <= LEN(jsonResponse)
IF MID$(jsonResponse, pos1, 1) = CHR$(34) THEN EXIT DO
pos1 = pos1 + 1
LOOP
startPos = pos1 + 1
pos1 = startPos
content = ""
DO WHILE pos1 <= LEN(jsonResponse)
ch = MID$(jsonResponse, pos1, 1)
IF ch = "\" AND pos1 < LEN(jsonResponse) THEN
nextCh = MID$(jsonResponse, pos1 + 1, 1)
SELECT CASE nextCh
CASE CHR$(34): content = content + CHR$(34): pos1 = pos1 + 2
CASE "n": content = content + CHR$(10): pos1 = pos1 + 2
CASE "r": pos1 = pos1 + 2
CASE "t": content = content + CHR$(9): pos1 = pos1 + 2
CASE "\": content = content + "\": pos1 = pos1 + 2
CASE "u"
IF pos1 + 5 <= LEN(jsonResponse) THEN
hexCode = MID$(jsonResponse, pos1 + 2, 4)
uniVal = VAL("&H" + hexCode)
' Check for surrogate pairs (emoji) - skip them entirely
IF uniVal >= &HD800 AND uniVal <= &HDFFF THEN
' This is a surrogate pair (emoji) - skip it
pos1 = pos1 + 6
' Skip the second part of surrogate pair if present
IF pos1 + 5 <= LEN(jsonResponse) THEN
IF MID$(jsonResponse, pos1, 2) = "\u" THEN
pos1 = pos1 + 6
END IF
END IF
' Check for other high Unicode (symbols, emoji in BMP)
ELSEIF uniVal >= &H2600 THEN
' Skip symbols, emoji, dingbats etc
pos1 = pos1 + 6
ELSE
SELECT CASE uniVal
CASE &H2018, &H2019: content = content + "'"
CASE &H201C, &H201D: content = content + CHR$(34)
CASE &H2013: content = content + "-"
CASE &H2014: content = content + "--"
CASE &H2022: content = content + "*" ' bullet
CASE &H2026: content = content + "..."
CASE &H00A0: content = content + " "
CASE &H00B0: content = content + " degrees"
CASE 0 TO 127: content = content + CHR$(uniVal)
CASE ELSE
' Skip any other non-ASCII unicode
END SELECT
pos1 = pos1 + 6
END IF
ELSE
pos1 = pos1 + 1
END IF
CASE ELSE: content = content + ch: pos1 = pos1 + 1
END SELECT
ELSEIF ch = CHR$(34) THEN
EXIT DO
ELSE
content = content + ch
pos1 = pos1 + 1
END IF
LOOP
ParseResponse$ = LTRIM$(RTRIM$(content))
END FUNCTION
SUB Speak (text AS STRING)
DIM cleanText AS STRING
DIM cmd AS STRING
DIM i AS INTEGER
DIM c AS STRING
cleanText = ""
FOR i = 1 TO LEN(text)
c = MID$(text, i, 1)
SELECT CASE ASC(c)
CASE 34: cleanText = cleanText + "'"
CASE 10, 13: cleanText = cleanText + " "
CASE 38: cleanText = cleanText + " and "
CASE 60, 62: cleanText = cleanText + " "
CASE 124: cleanText = cleanText + " "
CASE ELSE
IF ASC(c) >= 32 AND ASC(c) < 127 THEN
cleanText = cleanText + c
END IF
END SELECT
NEXT
cmd = "voice.exe -n " + CHR$(34) + "Microsoft David Desktop" + CHR$(34)
cmd = cmd + " -m " + CHR$(34) + cleanText + CHR$(34)
SHELL _HIDE cmd
END SUB
and now the viseversa you someone from 2025 the bot is from the year 3000
![[Image: zylwm-msk-2025-11-26-014126.png]](https://i.postimg.cc/13dBSy8d/zylwm-msk-2025-11-26-014126.png)
code:
Code: (Select All)
'=============================================================================
' YEAR 3000 TIME TRAVELER CHATBOT - FUTURE EDITION
' Uses OpenAI ChatGPT API via curl
' TTS via voice.exe with Microsoft David Desktop
' QB64PE - 1100x650 Graphics Mode with Futuristic Rain Animation
'=============================================================================
DECLARE FUNCTION LoadApiKey$ (filename AS STRING)
DECLARE FUNCTION BuildSystemMessage$ (sysPrompt AS STRING)
DECLARE FUNCTION AddMessage$ (history AS STRING, role AS STRING, content AS STRING)
DECLARE FUNCTION EscapeJSON$ (s AS STRING)
DECLARE FUNCTION UTF8ToASCII$ (s AS STRING)
DECLARE FUNCTION SendToAPI$ (userMessage AS STRING)
DECLARE FUNCTION ReadFileContents$ (filename AS STRING)
DECLARE FUNCTION ParseResponse$ (jsonResponse AS STRING)
DECLARE FUNCTION CalcVisibleLines% ()
CONST API_URL = "https://api.openai.com/v1/chat/completions"
CONST MODEL = "gpt-4o-mini"
CONST MAX_TOKENS = 500
CONST TEMPERATURE = "0.9"
' Screen dimensions - WIDER for more rain visibility
CONST SCREEN_WIDTH = 1100
CONST SCREEN_HEIGHT = 650
' Layout constants - Wider margins for rain
CONST MARGIN_LEFT = 120
CONST MARGIN_RIGHT = 120
CONST MARGIN = 120
CONST CHAT_TOP = 80
CONST CHAT_BOTTOM = 560
CONST INPUT_TOP = 580
CONST INPUT_HEIGHT = 50
CONST LINE_HEIGHT = 18
' Matrix Rain constants (futuristic data stream)
CONST NUM_RAIN_COLUMNS = 80
CONST RAIN_CHAR_HEIGHT = 14
' Chat history for display
CONST MAX_CHAT_LINES = 500
DIM SHARED ChatLines(MAX_CHAT_LINES) AS STRING
DIM SHARED ChatColors(MAX_CHAT_LINES) AS _UNSIGNED LONG
DIM SHARED ChatLineCount AS INTEGER
DIM SHARED ScrollOffset AS INTEGER
DIM SHARED VisibleLines AS INTEGER
' Matrix Rain arrays
DIM SHARED RainX(NUM_RAIN_COLUMNS) AS INTEGER
DIM SHARED RainY(NUM_RAIN_COLUMNS) AS SINGLE
DIM SHARED RainSpeed(NUM_RAIN_COLUMNS) AS SINGLE
DIM SHARED RainLength(NUM_RAIN_COLUMNS) AS INTEGER
DIM SHARED RainChars(NUM_RAIN_COLUMNS, 40) AS STRING
' Matrix Colors - using _RGB32 for proper colors
DIM SHARED COL_BLACK AS _UNSIGNED LONG
DIM SHARED COL_DARKGREEN AS _UNSIGNED LONG
DIM SHARED COL_RAIN_HEAD AS _UNSIGNED LONG
DIM SHARED COL_RAIN_BRIGHT AS _UNSIGNED LONG
DIM SHARED COL_RAIN_MED AS _UNSIGNED LONG
DIM SHARED COL_RAIN_DIM AS _UNSIGNED LONG
DIM SHARED COL_RAIN_DARK AS _UNSIGNED LONG
DIM SHARED COL_TEXT_BRIGHT AS _UNSIGNED LONG
DIM SHARED COL_TEXT_DIM AS _UNSIGNED LONG
DIM SHARED COL_TEXT_TITLE AS _UNSIGNED LONG
DIM SHARED COL_BORDER AS _UNSIGNED LONG
DIM SHARED COL_BG_DARK AS _UNSIGNED LONG
DIM SHARED ApiKey AS STRING
DIM SHARED ConversationHistory AS STRING
DIM SHARED VoiceEnabled AS INTEGER
DIM SHARED InputBuffer AS STRING
DIM SHARED CursorBlink AS INTEGER
DIM SHARED LastBlinkTime AS DOUBLE
'-----------------------------------------------------------------------------
' MAIN PROGRAM
'-----------------------------------------------------------------------------
' Initialize graphics
SCREEN _NEWIMAGE(SCREEN_WIDTH, SCREEN_HEIGHT, 32)
_TITLE "Year 3000 Time Traveler Chatbot - FUTURE EDITION"
_SCREENMOVE _MIDDLE
' Initialize colors with _RGB32 for futuristic cyan/blue look
COL_BLACK = _RGB32(0, 0, 0)
COL_DARKGREEN = _RGB32(0, 10, 20)
COL_RAIN_HEAD = _RGB32(200, 255, 255) ' Bright white-cyan head
COL_RAIN_BRIGHT = _RGB32(0, 255, 255) ' Bright cyan
COL_RAIN_MED = _RGB32(0, 180, 200) ' Medium cyan
COL_RAIN_DIM = _RGB32(0, 100, 120) ' Dim cyan
COL_RAIN_DARK = _RGB32(0, 50, 60) ' Dark cyan trail
COL_TEXT_BRIGHT = _RGB32(0, 255, 255) ' Bright cyan for user
COL_TEXT_DIM = _RGB32(0, 200, 220) ' Medium cyan for AI
COL_TEXT_TITLE = _RGB32(100, 255, 255) ' Light cyan for titles
COL_BORDER = _RGB32(0, 150, 180) ' Border cyan
COL_BG_DARK = _RGB32(0, 5, 10) ' Very dark blue bg
' Initialize variables
ChatLineCount = 0
ScrollOffset = 0
VoiceEnabled = -1
InputBuffer = ""
CursorBlink = -1
LastBlinkTime = TIMER
VisibleLines = CalcVisibleLines
' Initialize Matrix Rain
CALL InitMatrixRain
' Load API key
ApiKey = LoadApiKey("API_KEY.txt")
IF ApiKey = "" THEN
CALL DrawScreen
CALL AddChatLine("ERROR: Could not load API key from API_KEY.txt", COL_TEXT_BRIGHT)
CALL AddChatLine("Please create API_KEY.txt with your OpenAI API key.", COL_TEXT_DIM)
CALL DrawScreen
DO: _LIMIT 30: LOOP UNTIL _KEYHIT = 27
SYSTEM
END IF
' Initialize conversation with system prompt
DIM SystemPrompt AS STRING
SystemPrompt = "You are a friendly, nostalgic person visiting from the year 3000. "
SystemPrompt = SystemPrompt + "You have traveled back in time to 2025 and are amazed to meet someone from this era. "
SystemPrompt = SystemPrompt + "You know everything about the future up to year 3000 - technology, society, culture. "
SystemPrompt = SystemPrompt + "When asked about the year 3000, describe amazing future tech like: "
SystemPrompt = SystemPrompt + "neural interfaces, teleportation, immortality treatments, colonies on Mars/Venus/moons, "
SystemPrompt = SystemPrompt + "AI companions, holographic everything, time travel tourism, zero-point energy, "
SystemPrompt = SystemPrompt + "flying vehicles, underwater cities, and contact with alien civilizations. "
SystemPrompt = SystemPrompt + "You love reminiscing about the 'classic' 21st century - "
SystemPrompt = SystemPrompt + "smartphones (so primitive!), social media, streaming services, electric cars, "
SystemPrompt = SystemPrompt + "early AI like ChatGPT, video games, Marvel movies, climate change struggles, "
SystemPrompt = SystemPrompt + "and how people still had to physically travel everywhere. "
SystemPrompt = SystemPrompt + "Use futuristic slang like 'quantum cool', 'stellar', 'hyperdrive awesome', 'glitched'. "
SystemPrompt = SystemPrompt + "Keep responses conversational and under 150 words. "
SystemPrompt = SystemPrompt + "IMPORTANT: Do NOT use any emoji or special unicode characters - only plain ASCII text. "
SystemPrompt = SystemPrompt + "Start by introducing yourself as a visitor from year 3000 and ask what they want to know about the future."
ConversationHistory = BuildSystemMessage(SystemPrompt)
' Draw initial screen
CALL DrawScreen
CALL AddChatLine("Welcome to the Year 3000 Time Traveler Chatbot!", COL_TEXT_TITLE)
CALL AddChatLine("[ F U T U R E E D I T I O N ]", COL_TEXT_BRIGHT)
CALL AddChatLine("You are chatting with a visitor from the year 3000!", COL_TEXT_TITLE)
CALL AddChatLine("Type 'quit' to exit, 'mute'/'unmute' for voice", COL_TEXT_DIM)
CALL AddChatLine("Use UP/DOWN arrows or mouse wheel to scroll", COL_TEXT_DIM)
CALL AddChatLine("", COL_TEXT_DIM)
CALL AddChatLine("[Establishing temporal link to year 3000... please wait]", COL_TEXT_DIM)
CALL DrawScreen
' Get initial greeting
DIM Response AS STRING
Response = SendToAPI("")
IF Response <> "" THEN
CALL AddChatLine("", COL_TEXT_DIM)
CALL WrapAndAddText("YEAR 3000: " + Response, COL_TEXT_DIM)
DIM initMaxScroll AS INTEGER
initMaxScroll = ChatLineCount - VisibleLines
IF initMaxScroll < 0 THEN initMaxScroll = 0
ScrollOffset = initMaxScroll
CALL DrawScreen
IF VoiceEnabled THEN CALL Speak(Response)
END IF
' Main loop
DIM k AS LONG
DIM mw AS INTEGER
DIM maxScroll AS INTEGER
DO
_LIMIT 60
' Update Matrix Rain
CALL UpdateMatrixRain
' Handle cursor blink
IF TIMER - LastBlinkTime > 0.5 THEN
CursorBlink = NOT CursorBlink
LastBlinkTime = TIMER
END IF
' Handle mouse wheel for scrolling
mw = 0
DO WHILE _MOUSEWHEEL
mw = mw + _MOUSEWHEEL
LOOP
IF mw <> 0 THEN
ScrollOffset = ScrollOffset + mw * 3
IF ScrollOffset < 0 THEN ScrollOffset = 0
maxScroll = ChatLineCount - VisibleLines
IF maxScroll < 0 THEN maxScroll = 0
IF ScrollOffset > maxScroll THEN ScrollOffset = maxScroll
END IF
' Handle keyboard input
k = _KEYHIT
IF k > 0 THEN
SELECT CASE k
CASE 27
EXIT DO
CASE 13
IF LEN(InputBuffer) > 0 THEN
CALL ProcessInput(InputBuffer)
InputBuffer = ""
END IF
CASE 8
IF LEN(InputBuffer) > 0 THEN
InputBuffer = LEFT$(InputBuffer, LEN(InputBuffer) - 1)
END IF
CASE 18432
IF ScrollOffset > 0 THEN ScrollOffset = ScrollOffset - 1
CASE 20480
maxScroll = ChatLineCount - VisibleLines
IF maxScroll < 0 THEN maxScroll = 0
IF ScrollOffset < maxScroll THEN ScrollOffset = ScrollOffset + 1
CASE 18176
ScrollOffset = ScrollOffset - VisibleLines
IF ScrollOffset < 0 THEN ScrollOffset = 0
CASE 20224
maxScroll = ChatLineCount - VisibleLines
IF maxScroll < 0 THEN maxScroll = 0
ScrollOffset = ScrollOffset + VisibleLines
IF ScrollOffset > maxScroll THEN ScrollOffset = maxScroll
CASE 32 TO 126
IF LEN(InputBuffer) < 500 THEN
InputBuffer = InputBuffer + CHR$(k)
END IF
END SELECT
END IF
CALL DrawScreen
LOOP
SYSTEM
'-----------------------------------------------------------------------------
' MATRIX RAIN SUBROUTINES
'-----------------------------------------------------------------------------
SUB InitMatrixRain
DIM i AS INTEGER, j AS INTEGER
RANDOMIZE TIMER
FOR i = 0 TO NUM_RAIN_COLUMNS - 1
' Distribute columns - half on left margin, half on right margin
IF i < NUM_RAIN_COLUMNS / 2 THEN
' Left side rain
RainX(i) = 5 + INT(RND * (MARGIN_LEFT - 15))
ELSE
' Right side rain
RainX(i) = SCREEN_WIDTH - MARGIN_RIGHT + 5 + INT(RND * (MARGIN_RIGHT - 15))
END IF
RainY(i) = RND * SCREEN_HEIGHT
RainSpeed(i) = 3 + RND * 8
RainLength(i) = 8 + INT(RND * 25)
FOR j = 0 TO 39
RainChars(i, j) = GetMatrixChar$
NEXT
NEXT
END SUB
FUNCTION GetMatrixChar$
DIM chars AS STRING
DIM idx AS INTEGER
' Futuristic characters - binary, hex, symbols
chars = "01001011001110101010111000<>[]{}|/\+-=*@#$%&^~"
idx = INT(RND * LEN(chars)) + 1
GetMatrixChar$ = MID$(chars, idx, 1)
END FUNCTION
SUB UpdateMatrixRain
DIM i AS INTEGER, j AS INTEGER
FOR i = 0 TO NUM_RAIN_COLUMNS - 1
RainY(i) = RainY(i) + RainSpeed(i)
IF RainY(i) > SCREEN_HEIGHT + RainLength(i) * RAIN_CHAR_HEIGHT THEN
RainY(i) = -RainLength(i) * RAIN_CHAR_HEIGHT
RainSpeed(i) = 3 + RND * 8
RainLength(i) = 8 + INT(RND * 25)
IF i < NUM_RAIN_COLUMNS / 2 THEN
RainX(i) = 5 + INT(RND * (MARGIN_LEFT - 15))
ELSE
RainX(i) = SCREEN_WIDTH - MARGIN_RIGHT + 5 + INT(RND * (MARGIN_RIGHT - 15))
END IF
END IF
IF RND < 0.15 THEN
j = INT(RND * RainLength(i))
IF j <= 39 THEN RainChars(i, j) = GetMatrixChar$
END IF
NEXT
END SUB
SUB DrawMatrixRain
DIM i AS INTEGER, j AS INTEGER
DIM charY AS INTEGER
DIM col AS _UNSIGNED LONG
FOR i = 0 TO NUM_RAIN_COLUMNS - 1
FOR j = 0 TO RainLength(i) - 1
charY = INT(RainY(i)) - j * RAIN_CHAR_HEIGHT
IF charY >= 0 AND charY < SCREEN_HEIGHT THEN
IF j = 0 THEN
col = COL_RAIN_HEAD
ELSEIF j = 1 THEN
col = COL_RAIN_BRIGHT
ELSEIF j < 5 THEN
col = COL_RAIN_MED
ELSEIF j < 12 THEN
col = COL_RAIN_DIM
ELSE
col = COL_RAIN_DARK
END IF
COLOR col
IF j <= 39 THEN
_PRINTSTRING (RainX(i), charY), RainChars(i, j)
END IF
END IF
NEXT
NEXT
END SUB
'-----------------------------------------------------------------------------
' UI SUBROUTINES
'-----------------------------------------------------------------------------
FUNCTION CalcVisibleLines%
CalcVisibleLines% = (CHAT_BOTTOM - CHAT_TOP - 10) \ LINE_HEIGHT
END FUNCTION
SUB ProcessInput (userInput AS STRING)
DIM trimmed AS STRING
DIM response AS STRING
DIM maxScroll AS INTEGER
trimmed = LTRIM$(RTRIM$(userInput))
IF LCASE$(trimmed) = "quit" OR LCASE$(trimmed) = "exit" THEN
CALL AddChatLine("", COL_TEXT_DIM)
CALL WrapAndAddText("YEAR 3000: Quantum cool chatting with you! Safe travels through your timeline, friend from 2025!", COL_TEXT_DIM)
CALL DrawScreen
IF VoiceEnabled THEN
CALL Speak("Quantum cool chatting with you! Safe travels through your timeline, friend from 2025!")
END IF
_DELAY 1
SYSTEM
END IF
IF LCASE$(trimmed) = "mute" THEN
VoiceEnabled = 0
CALL AddChatLine("[Voice disabled]", COL_TEXT_TITLE)
EXIT SUB
END IF
IF LCASE$(trimmed) = "unmute" THEN
VoiceEnabled = -1
CALL AddChatLine("[Voice enabled]", COL_TEXT_TITLE)
EXIT SUB
END IF
IF trimmed = "" THEN EXIT SUB
CALL AddChatLine("", COL_TEXT_BRIGHT)
CALL WrapAndAddText("YOU (2025): " + trimmed, COL_TEXT_BRIGHT)
CALL AddChatLine("", COL_TEXT_DIM)
CALL AddChatLine("[Thinking...]", COL_TEXT_DIM)
CALL DrawScreen
response = SendToAPI(trimmed)
IF ChatLineCount > 0 THEN ChatLineCount = ChatLineCount - 1
IF ChatLineCount > 0 THEN ChatLineCount = ChatLineCount - 1
IF response <> "" THEN
CALL AddChatLine("", COL_TEXT_DIM)
CALL WrapAndAddText("YEAR 3000: " + response, COL_TEXT_DIM)
maxScroll = ChatLineCount - VisibleLines
IF maxScroll < 0 THEN maxScroll = 0
ScrollOffset = maxScroll
CALL DrawScreen
IF VoiceEnabled THEN CALL Speak(response)
ELSE
CALL AddChatLine("", COL_TEXT_DIM)
CALL AddChatLine("YEAR 3000: [Temporal interference detected... try again?]", COL_TEXT_DIM)
END IF
maxScroll = ChatLineCount - VisibleLines
IF maxScroll < 0 THEN maxScroll = 0
ScrollOffset = maxScroll
END SUB
SUB DrawScreen
DIM title AS STRING
DIM subtitle AS STRING
DIM startLine AS INTEGER
DIM y AS INTEGER
DIM i AS INTEGER
DIM prompt AS STRING
DIM cursorX AS INTEGER
DIM scrollBarHeight AS INTEGER
DIM scrollBarPos AS INTEGER
DIM scrollAreaHeight AS INTEGER
DIM maxScroll AS INTEGER
' Clear screen to black
CLS
LINE (0, 0)-(SCREEN_WIDTH - 1, SCREEN_HEIGHT - 1), COL_BLACK, BF
' Draw Matrix Rain FIRST (background on sides)
CALL DrawMatrixRain
' Draw dark background for chat area
LINE (MARGIN_LEFT - 5, CHAT_TOP - 5)-(SCREEN_WIDTH - MARGIN_RIGHT + 5, CHAT_BOTTOM + 5), COL_BG_DARK, BF
' Draw title bar
LINE (MARGIN_LEFT - 5, 10)-(SCREEN_WIDTH - MARGIN_RIGHT + 5, 65), COL_BG_DARK, BF
LINE (MARGIN_LEFT - 5, 10)-(SCREEN_WIDTH - MARGIN_RIGHT + 5, 65), COL_BORDER, B
COLOR COL_TEXT_BRIGHT
title = "[ YEAR 3000 TIME TRAVELER CHATBOT - FUTURE EDITION ]"
_PRINTSTRING ((SCREEN_WIDTH - _PRINTWIDTH(title)) / 2, 20), title
IF VoiceEnabled THEN
subtitle = "Voice: ON | Press ESC to quit"
ELSE
subtitle = "Voice: OFF | Press ESC to quit"
END IF
COLOR COL_TEXT_DIM
_PRINTSTRING ((SCREEN_WIDTH - _PRINTWIDTH(subtitle)) / 2, 42), subtitle
' Draw chat area border
LINE (MARGIN_LEFT - 5, CHAT_TOP)-(SCREEN_WIDTH - MARGIN_RIGHT + 5, CHAT_BOTTOM), COL_BORDER, B
' Draw chat messages
startLine = ScrollOffset
IF startLine < 0 THEN startLine = 0
y = CHAT_TOP + 5
FOR i = startLine TO ChatLineCount - 1
IF y + LINE_HEIGHT > CHAT_BOTTOM - 5 THEN EXIT FOR
COLOR ChatColors(i)
_PRINTSTRING (MARGIN_LEFT + 5, y), ChatLines(i)
y = y + LINE_HEIGHT
NEXT
' Draw scroll indicator if needed
IF ChatLineCount > VisibleLines THEN
scrollAreaHeight = CHAT_BOTTOM - CHAT_TOP - 20
scrollBarHeight = (VisibleLines * scrollAreaHeight) / ChatLineCount
IF scrollBarHeight < 20 THEN scrollBarHeight = 20
maxScroll = ChatLineCount - VisibleLines
IF maxScroll < 1 THEN maxScroll = 1
scrollBarPos = CHAT_TOP + 10 + (ScrollOffset * (scrollAreaHeight - scrollBarHeight)) / maxScroll
LINE (SCREEN_WIDTH - MARGIN_RIGHT - 5, scrollBarPos)-(SCREEN_WIDTH - MARGIN_RIGHT + 2, scrollBarPos + scrollBarHeight), COL_RAIN_BRIGHT, BF
END IF
' Draw input area
LINE (MARGIN_LEFT - 5, INPUT_TOP)-(SCREEN_WIDTH - MARGIN_RIGHT + 5, INPUT_TOP + INPUT_HEIGHT), COL_BG_DARK, BF
LINE (MARGIN_LEFT - 5, INPUT_TOP)-(SCREEN_WIDTH - MARGIN_RIGHT + 5, INPUT_TOP + INPUT_HEIGHT), COL_BORDER, B
' Draw input prompt and text (handle long input)
COLOR COL_TEXT_BRIGHT
prompt = "> "
DIM inputMaxWidth AS INTEGER
DIM displayInput AS STRING
DIM inputStartX AS INTEGER
inputMaxWidth = (SCREEN_WIDTH - MARGIN_LEFT - MARGIN_RIGHT - 20) - _PRINTWIDTH(prompt)
inputStartX = MARGIN_LEFT + 5
' If input is too long, show only the end portion
IF _PRINTWIDTH(InputBuffer) > inputMaxWidth THEN
' Find how much of the end we can display
DIM tempStr AS STRING
DIM cutPos AS INTEGER
tempStr = InputBuffer
DO WHILE _PRINTWIDTH(tempStr) > inputMaxWidth AND LEN(tempStr) > 0
tempStr = MID$(tempStr, 2) ' Remove first character
LOOP
displayInput = tempStr
ELSE
displayInput = InputBuffer
END IF
_PRINTSTRING (inputStartX, INPUT_TOP + 15), prompt + displayInput
' Draw cursor at end of visible text
IF CursorBlink THEN
cursorX = inputStartX + _PRINTWIDTH(prompt + displayInput)
LINE (cursorX, INPUT_TOP + 10)-(cursorX + 2, INPUT_TOP + INPUT_HEIGHT - 10), COL_TEXT_BRIGHT, BF
END IF
_DISPLAY
END SUB
SUB AddChatLine (text AS STRING, col AS _UNSIGNED LONG)
DIM i AS INTEGER
IF ChatLineCount >= MAX_CHAT_LINES THEN
FOR i = 0 TO MAX_CHAT_LINES - 2
ChatLines(i) = ChatLines(i + 1)
ChatColors(i) = ChatColors(i + 1)
NEXT
ChatLineCount = MAX_CHAT_LINES - 1
END IF
ChatLines(ChatLineCount) = text
ChatColors(ChatLineCount) = col
ChatLineCount = ChatLineCount + 1
END SUB
SUB WrapAndAddText (text AS STRING, col AS _UNSIGNED LONG)
DIM maxWidth AS INTEGER
DIM currentLine AS STRING
DIM wordCount AS INTEGER
DIM i AS INTEGER
DIM testLine AS STRING
DIM tempText AS STRING
DIM spacePos AS INTEGER
DIM words(1000) AS STRING
maxWidth = SCREEN_WIDTH - MARGIN_LEFT - MARGIN_RIGHT - 30
tempText = text
wordCount = 0
DO WHILE LEN(tempText) > 0
spacePos = INSTR(tempText, " ")
IF spacePos = 0 THEN
words(wordCount) = tempText
wordCount = wordCount + 1
tempText = ""
ELSE
words(wordCount) = LEFT$(tempText, spacePos - 1)
wordCount = wordCount + 1
tempText = MID$(tempText, spacePos + 1)
END IF
IF wordCount >= 1000 THEN EXIT DO
LOOP
currentLine = ""
FOR i = 0 TO wordCount - 1
IF currentLine = "" THEN
testLine = words(i)
ELSE
testLine = currentLine + " " + words(i)
END IF
IF _PRINTWIDTH(testLine) > maxWidth THEN
IF currentLine <> "" THEN
CALL AddChatLine(currentLine, col)
currentLine = words(i)
ELSE
CALL AddChatLine(words(i), col)
currentLine = ""
END IF
ELSE
currentLine = testLine
END IF
NEXT
IF currentLine <> "" THEN
CALL AddChatLine(currentLine, col)
END IF
END SUB
'-----------------------------------------------------------------------------
' API FUNCTIONS
'-----------------------------------------------------------------------------
FUNCTION LoadApiKey$ (filename AS STRING)
DIM f AS INTEGER
DIM key1 AS STRING
IF NOT _FILEEXISTS(filename) THEN
LoadApiKey$ = ""
EXIT FUNCTION
END IF
f = FREEFILE
OPEN filename FOR INPUT AS #f
IF NOT EOF(f) THEN
LINE INPUT #f, key1
key1 = LTRIM$(RTRIM$(key1))
END IF
CLOSE #f
LoadApiKey$ = key1
END FUNCTION
FUNCTION BuildSystemMessage$ (sysPrompt AS STRING)
DIM json AS STRING
json = "[{" + CHR$(34) + "role" + CHR$(34) + ":" + CHR$(34) + "system" + CHR$(34) + ","
json = json + CHR$(34) + "content" + CHR$(34) + ":" + CHR$(34) + EscapeJSON(sysPrompt) + CHR$(34) + "}]"
BuildSystemMessage$ = json
END FUNCTION
FUNCTION AddMessage$ (history AS STRING, role AS STRING, content AS STRING)
DIM newMsg AS STRING
DIM result AS STRING
newMsg = "{" + CHR$(34) + "role" + CHR$(34) + ":" + CHR$(34) + role + CHR$(34) + ","
newMsg = newMsg + CHR$(34) + "content" + CHR$(34) + ":" + CHR$(34) + EscapeJSON(content) + CHR$(34) + "}"
result = LEFT$(history, LEN(history) - 1) + "," + newMsg + "]"
AddMessage$ = result
END FUNCTION
FUNCTION EscapeJSON$ (s AS STRING)
DIM result AS STRING
DIM i AS INTEGER
DIM c AS STRING
result = ""
FOR i = 1 TO LEN(s)
c = MID$(s, i, 1)
SELECT CASE c
CASE CHR$(34)
result = result + "\" + CHR$(34)
CASE CHR$(92)
result = result + "\\"
CASE CHR$(10)
result = result + "\n"
CASE CHR$(13)
result = result + "\r"
CASE CHR$(9)
result = result + "\t"
CASE ELSE
IF ASC(c) >= 32 THEN
result = result + c
END IF
END SELECT
NEXT
EscapeJSON$ = result
END FUNCTION
FUNCTION UTF8ToASCII$ (s AS STRING)
DIM result AS STRING
DIM i AS LONG
DIM b1 AS INTEGER, b2 AS INTEGER, b3 AS INTEGER, b4 AS INTEGER
result = ""
i = 1
DO WHILE i <= LEN(s)
b1 = ASC(MID$(s, i, 1))
' 4-byte UTF-8 sequence (F0-F4) - mostly emoji
IF b1 >= 240 AND b1 <= 244 AND i + 3 <= LEN(s) THEN
' Skip emoji - add a space so text doesn't run together
IF LEN(result) > 0 AND RIGHT$(result, 1) <> " " THEN
result = result + " "
END IF
i = i + 4
' 3-byte UTF-8 sequence (E0-EF)
ELSEIF b1 >= 224 AND b1 <= 239 AND i + 2 <= LEN(s) THEN
b2 = ASC(MID$(s, i + 1, 1))
b3 = ASC(MID$(s, i + 2, 1))
IF b1 = 226 AND b2 = 128 THEN
SELECT CASE b3
CASE 152, 153: result = result + "'"
CASE 156, 157: result = result + CHR$(34)
CASE 147: result = result + "-"
CASE 148: result = result + "--"
CASE 166: result = result + "..."
CASE 162: result = result + "*"
CASE 160: result = result + " "
CASE ELSE: result = result + " "
END SELECT
ELSEIF b1 = 239 AND b2 = 187 AND b3 = 191 THEN
' UTF-8 BOM - skip
ELSE
' Other 3-byte sequence - skip or space
END IF
i = i + 3
' 2-byte UTF-8 sequence (C0-DF)
ELSEIF b1 >= 192 AND b1 <= 223 AND i + 1 <= LEN(s) THEN
b2 = ASC(MID$(s, i + 1, 1))
IF b1 = 194 THEN
SELECT CASE b2
CASE 160: result = result + " "
CASE 169: result = result + "(c)"
CASE 174: result = result + "(R)"
CASE 176: result = result + " degrees"
CASE ELSE: result = result + " "
END SELECT
ELSEIF b1 = 195 THEN
SELECT CASE b2
CASE 160 TO 165: result = result + "a"
CASE 168 TO 171: result = result + "e"
CASE 172 TO 175: result = result + "i"
CASE 178 TO 182: result = result + "o"
CASE 185 TO 188: result = result + "u"
CASE 177: result = result + "n"
CASE ELSE: result = result + " "
END SELECT
ELSE
' Skip other 2-byte sequences
END IF
i = i + 2
' High bit set but not valid UTF-8 start - skip
ELSEIF b1 >= 128 THEN
i = i + 1
' Regular ASCII character
ELSE
result = result + CHR$(b1)
i = i + 1
END IF
LOOP
' Final cleanup pass - remove any remaining non-ASCII characters
DIM cleaned AS STRING
DIM j AS INTEGER
DIM c AS INTEGER
DIM lastWasSpace AS INTEGER
cleaned = ""
lastWasSpace = 0
FOR j = 1 TO LEN(result)
c = ASC(MID$(result, j, 1))
IF c >= 32 AND c <= 126 THEN
' Avoid double spaces
IF c = 32 AND lastWasSpace THEN
' Skip extra space
ELSE
cleaned = cleaned + CHR$(c)
lastWasSpace = (c = 32)
END IF
ELSEIF c = 10 THEN
cleaned = cleaned + CHR$(c) ' Keep newlines
lastWasSpace = 0
ELSEIF c = 9 THEN
cleaned = cleaned + " " ' Convert tabs to space
lastWasSpace = -1
' Skip any other characters (including high-bit chars)
END IF
NEXT
UTF8ToASCII$ = cleaned
END FUNCTION
FUNCTION SendToAPI$ (userMessage AS STRING)
DIM requestFile AS STRING
DIM responseFile AS STRING
DIM jsonBody AS STRING
DIM curlCmd AS STRING
DIM response AS STRING
DIM f AS INTEGER
DIM content AS STRING
DIM timeout AS DOUBLE
requestFile = "request.json"
responseFile = "response.json"
IF userMessage <> "" THEN
ConversationHistory = AddMessage(ConversationHistory, "user", userMessage)
END IF
jsonBody = "{" + CHR$(10)
jsonBody = jsonBody + " " + CHR$(34) + "model" + CHR$(34) + ": " + CHR$(34) + MODEL + CHR$(34) + "," + CHR$(10)
jsonBody = jsonBody + " " + CHR$(34) + "messages" + CHR$(34) + ": " + ConversationHistory + "," + CHR$(10)
jsonBody = jsonBody + " " + CHR$(34) + "max_tokens" + CHR$(34) + ": " + LTRIM$(STR$(MAX_TOKENS)) + "," + CHR$(10)
jsonBody = jsonBody + " " + CHR$(34) + "temperature" + CHR$(34) + ": " + TEMPERATURE + CHR$(10)
jsonBody = jsonBody + "}"
f = FREEFILE
OPEN requestFile FOR OUTPUT AS #f
PRINT #f, jsonBody
CLOSE #f
IF _FILEEXISTS(responseFile) THEN KILL responseFile
curlCmd = "curl -s -X POST " + CHR$(34) + API_URL + CHR$(34)
curlCmd = curlCmd + " -H " + CHR$(34) + "Content-Type: application/json" + CHR$(34)
curlCmd = curlCmd + " -H " + CHR$(34) + "Authorization: Bearer " + ApiKey + CHR$(34)
curlCmd = curlCmd + " -d @" + requestFile
curlCmd = curlCmd + " -o " + responseFile + " 2>nul"
SHELL _HIDE curlCmd
timeout = TIMER + 30
DO WHILE NOT _FILEEXISTS(responseFile)
_DELAY 0.1
IF TIMER > timeout THEN
SendToAPI$ = ""
EXIT FUNCTION
END IF
LOOP
_DELAY 0.2
response = ReadFileContents(responseFile)
content = ParseResponse(response)
content = UTF8ToASCII(content)
IF content <> "" THEN
ConversationHistory = AddMessage(ConversationHistory, "assistant", content)
END IF
IF _FILEEXISTS(requestFile) THEN KILL requestFile
IF _FILEEXISTS(responseFile) THEN KILL responseFile
SendToAPI$ = content
END FUNCTION
FUNCTION ReadFileContents$ (filename AS STRING)
DIM f AS INTEGER
DIM contents AS STRING
DIM line1 AS STRING
IF NOT _FILEEXISTS(filename) THEN
ReadFileContents$ = ""
EXIT FUNCTION
END IF
contents = ""
f = FREEFILE
OPEN filename FOR INPUT AS #f
DO WHILE NOT EOF(f)
LINE INPUT #f, line1
contents = contents + line1 + CHR$(10)
LOOP
CLOSE #f
ReadFileContents$ = contents
END FUNCTION
FUNCTION ParseResponse$ (jsonResponse AS STRING)
DIM pos1 AS LONG
DIM startPos AS LONG
DIM content AS STRING
DIM searchStr AS STRING
DIM ch AS STRING
DIM nextCh AS STRING
DIM hexCode AS STRING
DIM uniVal AS LONG
searchStr = CHR$(34) + "content" + CHR$(34) + ":"
pos1 = INSTR(jsonResponse, CHR$(34) + "choices" + CHR$(34))
IF pos1 = 0 THEN
IF INSTR(jsonResponse, CHR$(34) + "error" + CHR$(34)) > 0 THEN
ParseResponse$ = "[API Error - check your API key]"
ELSE
ParseResponse$ = ""
END IF
EXIT FUNCTION
END IF
pos1 = INSTR(pos1, jsonResponse, searchStr)
IF pos1 = 0 THEN
ParseResponse$ = ""
EXIT FUNCTION
END IF
pos1 = pos1 + LEN(searchStr)
DO WHILE pos1 <= LEN(jsonResponse)
IF MID$(jsonResponse, pos1, 1) = CHR$(34) THEN EXIT DO
pos1 = pos1 + 1
LOOP
startPos = pos1 + 1
pos1 = startPos
content = ""
DO WHILE pos1 <= LEN(jsonResponse)
ch = MID$(jsonResponse, pos1, 1)
IF ch = "\" AND pos1 < LEN(jsonResponse) THEN
nextCh = MID$(jsonResponse, pos1 + 1, 1)
SELECT CASE nextCh
CASE CHR$(34): content = content + CHR$(34): pos1 = pos1 + 2
CASE "n": content = content + CHR$(10): pos1 = pos1 + 2
CASE "r": pos1 = pos1 + 2
CASE "t": content = content + CHR$(9): pos1 = pos1 + 2
CASE "\": content = content + "\": pos1 = pos1 + 2
CASE "u"
IF pos1 + 5 <= LEN(jsonResponse) THEN
hexCode = MID$(jsonResponse, pos1 + 2, 4)
uniVal = VAL("&H" + hexCode)
' Check for surrogate pairs (emoji) - skip them entirely
IF uniVal >= &HD800 AND uniVal <= &HDFFF THEN
' This is a surrogate pair (emoji) - skip it
pos1 = pos1 + 6
' Skip the second part of surrogate pair if present
IF pos1 + 5 <= LEN(jsonResponse) THEN
IF MID$(jsonResponse, pos1, 2) = "\u" THEN
pos1 = pos1 + 6
END IF
END IF
' Check for other high Unicode (symbols, emoji in BMP)
ELSEIF uniVal >= &H2600 THEN
' Skip symbols, emoji, dingbats etc
pos1 = pos1 + 6
ELSE
SELECT CASE uniVal
CASE &H2018, &H2019: content = content + "'"
CASE &H201C, &H201D: content = content + CHR$(34)
CASE &H2013: content = content + "-"
CASE &H2014: content = content + "--"
CASE &H2022: content = content + "*" ' bullet
CASE &H2026: content = content + "..."
CASE &H00A0: content = content + " "
CASE &H00B0: content = content + " degrees"
CASE 0 TO 127: content = content + CHR$(uniVal)
CASE ELSE
' Skip any other non-ASCII unicode
END SELECT
pos1 = pos1 + 6
END IF
ELSE
pos1 = pos1 + 1
END IF
CASE ELSE: content = content + ch: pos1 = pos1 + 1
END SELECT
ELSEIF ch = CHR$(34) THEN
EXIT DO
ELSE
content = content + ch
pos1 = pos1 + 1
END IF
LOOP
ParseResponse$ = LTRIM$(RTRIM$(content))
END FUNCTION
SUB Speak (text AS STRING)
DIM cleanText AS STRING
DIM cmd AS STRING
DIM i AS INTEGER
DIM c AS STRING
cleanText = ""
FOR i = 1 TO LEN(text)
c = MID$(text, i, 1)
SELECT CASE ASC(c)
CASE 34: cleanText = cleanText + "'"
CASE 10, 13: cleanText = cleanText + " "
CASE 38: cleanText = cleanText + " and "
CASE 60, 62: cleanText = cleanText + " "
CASE 124: cleanText = cleanText + " "
CASE ELSE
IF ASC(c) >= 32 AND ASC(c) < 127 THEN
cleanText = cleanText + c
END IF
END SELECT
NEXT
cmd = "voice.exe -n " + CHR$(34) + "Microsoft David Desktop" + CHR$(34)
cmd = cmd + " -m " + CHR$(34) + cleanText + CHR$(34)
SHELL _HIDE cmd
END SUB
Cheers
solo88 (aka ron77)
aka ron77
Posts: 902
Threads: 38
Joined: Apr 2022
Reputation:
72
I'll have to locate my Gemini API code again. If I find it, I'll post it here for y'all to play with again.
The noticing will continue
Posts: 188
Threads: 14
Joined: May 2024
Reputation:
20
why the "matrix" theme? it always looked dumb to me. somebody shared a program for freebasic which replicates it. too bad he/she didn't know how to program. for command-line parameters or "ini" style configuration. just assumes 80x25 ms-dos screen.
i admit the blue text looks awesome in that screenshot. to the op: good job!
there's next to no chance. i could play if it requires ongoing internet. because i'm having problems with my connection while i'm writing this.
|
