a conversational irc bot

hello all...

here is a conversational irc bot in powerbasic - originally a combination of Bplus ELIZA/PLAYER code and Steve irc-bot both in QB64 that i converted to Powerbasic


the bot contains 2 files 1. the bas file 2. the text file for database of keywords/replays

1. bas file:

#COMPILE EXE

'#DIM ALL

GLOBAL eval$, out1$, to1$, in1$, in2$, in3$, in4$



%true = 1

%false = 0



$punctuation = "?!,.:;<>(){}[]"

SUB init()

DIM Greeting AS GLOBAL STRING, You AS GLOBAL STRING, Script AS GLOBAL STRING

DIM kCnt AS GLOBAL INTEGER, rCnt AS GLOBAL INTEGER, wCnt AS GLOBAL INTEGER, NoKeyFoundIndex AS GLOBAL INTEGER

DIM keywords(0) AS GLOBAL STRING, replies(0) AS GLOBAL STRING, wordIn(0) AS GLOBAL STRING, wordOut(0) AS GLOBAL STRING

DIM rStarts(0) AS GLOBAL INTEGER, rEnds(0) AS GLOBAL INTEGER, rIndex(0) AS GLOBAL INTEGER



END SUB











FUNCTION PBMAIN () AS LONG

     init()



     initial()







END FUNCTION



'OPTION _EXPLICIT

'_TITLE "Player" ' B+ started 2019-05-26  post loadArrays test on Script Eliza.txt file

'2019-05-29 post basic getReply$ function of Eliza / Script Player

'2019-05-30 LINE INPUT to allow commas, try isolatePunctuation$ and joinPunction, look like it's working.

'2019-05-31 OK it all seems to be working without all caps and with punctuation.

'2019-09-09 added steve irc chatroom chatbot protocol code

'2019-09-13 added PM capebilities to bot

'2021-03-05 mod and converted to powerbasic by ron77



SUB initial()



'LoadArrays "Script Rachel Mod 1.TXT" '   check file load, OK checks out

LoadArrays "Script Rachel Mod2.TXT"

PRINT Greeting: PRINT '           start testing main Eliza code

'DO

'    rply = GetReply$

'    PRINT Script + ": " + rply: PRINT

'LOOP UNTIL rply = "Goodbye!"



'----------------------------------------------------

DIM COUNT&

DIM client11 AS GLOBAL LONG, server11 AS GLOBAL STRING, Channel AS GLOBAL STRING

'DIM respond AS GLOBAL INTEGER

crlf$ = CHR$(13) + CHR$(10)

nick$ = "bot77"

pass$ = ""

server11 = "irc.freenode.net"

'Channel = "#qb64"

Channel = "##freebasic"

'Channel = x$



PRINT "Connecting to " + server11 + "..."

TCP OPEN PORT 6667 AT server11 AS #1 TIMEOUT 60000 'OPENclient11("TCP/IP:6667:" + server11)

IF ERR THEN



     BEEP



     EXIT SUB



 END IF







IF pass$ > "" THEN SendInfo "PASS" + pass$

SendInfo "NICK " + nick$

SendInfo "USER " + nick$ + " 0 * :" + nick$

PRINT "Connected!"



SendInfo "JOIN " + Channel

SendInfo "TOPIC " + Channel

PRINT "Joined "; Channel









respond% = 0

DO



   SLEEP(100)

   TCP LINE INPUT #1,  in1$

   'TCP LINE INPUT #1,  in2$

   'TCP LINE INPUT #1,  in3$

   'in4$ = in1$ + in2$ '+ in3$

   IF LEFT$(in1$, 4) = "PING" THEN

       'Respond with PONG

       res$ = "PONG" + MID$(in1$, 5) + CHR$(13) + CHR$(10)

       TCP SEND #1 , res$

   END IF



   IF in1$ <> "" THEN PRINT LEFT$(in1$, LEN(in1$) - 2) 'Unremark this is we want to see what's being typed by everyone.

   IF in1$ <> "" AND respond% THEN

        ProcessInput in1$

        'WAITKEY$

   END IF

   'If in1$="8r" then ProcessInput in1$

   'IF in1$ <> "" THEN ProcessInput in1$

   IF INSTR(in1$, "End of /NAMES list.") THEN respond% = -1 'Don't start responding to the automatic server11 messages, like an idiot bot!

LOOP UNTIL INKEY$ = CHR$(27) 'escape to quit

TCP CLOSE #1

END SUB



SUB SendInfo (text$)

   text$ = text$ + CHR$(13) + CHR$(10)

   TCP SEND #1 , text$

END SUB



SUB SendReply (text$, to1$)



  ' DO

   text$ = "PRIVMSG " & to1$ & " :" & text$ & CHR$(13) & CHR$(10)

   SendInfo "JOIN " & to1$

   SendInfo "TOPIC " & to1$



   TCP PRINT #1 , text$

   COLOR 6: PRINT text$

'    ii% += 1

'    LOOP UNTIL ii% >= 1

'    ii% = 0



END SUB



SUB ProcessInput (text$)

    DIM l AS LONG

    Speaker$ = MID$(text$, 2, INSTR(text$, "!") - 2)

   c$ = UCASE$(Channel) + " :"

   in1$ = UCASE$(LEFT$(text$, LEN(text$) - 2)) + " " ' Strip off the CRLF

   eval$ = " " + MID$(in1$, INSTR(in1$, c$) + LEN(c$)) + " "

    COLOR 3

    PRINT "this is " & speaker$

'    '--------------------------------------

'    IF INSTR(eval$, "8r") THEN

'        inpt = eval$

'        inpt = LCASE$(inpt)

'        'DO

'        rply$ = GetReply$()

'        out1$ = rply$

'        'PRINT Script + ": " + rply$: PRINT

'    END IF

'    'LOOP UNTIL rply$ = "Goodbye!"

'

'    '----------------------------------------



   IF INSTR(eval$, "BOT") THEN

       'someone is talking directly to the bot or giving it a command

       IF INSTR(eval$, " QUIT ") THEN END 'A means to automatically shut down the bot

       IF INSTR(eval$, " FINISH ") THEN END 'A means to automatically shut down the bot

       IF INSTR(eval$, " DIE ") THEN END 'A means to automatically shut down the bot

       IF INSTR(eval$, " SHUT DOWN ") THEN END 'A means to automatically shut down the bot

       IF INSTR(eval$, " EXIT ") THEN END 'A means to automatically shut down the bot

       IF INSTR(eval$, " END ") THEN END 'A means to automatically shut down the bot

       IF INSTR(eval$, " TELL") THEN

           IF INSTR(eval$, "TIME") THEN out1$ = out1$ + "The TIME is " + TIME$ + ".  "

           IF INSTR(eval$, "DATE") THEN out1$ = out1$ + "The DATE is " + DATE$ + ".  "

       END IF



       IF INSTR(eval$, " HI ") THEN out1$ = "Hiyas, " + Speaker$ + ".  "

       IF INSTR(eval$, " HELLO ") THEN out1$ = "Hello to you too, " + Speaker$ + ".  "

       IF INSTR(eval$, " YO ") THEN out1$ = "Hola!  " + Speaker$ + "  How's it hanging?  "

       IF INSTR(eval$, " HOLA ") THEN out1$ = "What's happening, " + Speaker$ + "?  "

   END IF

'

   IF INSTR(eval$, "*ECHO") THEN '

       SendReply MID$(text$, INSTR(UCASE$(text$), "*ECHO") + 6), Channel$

   END IF





   IF INSTR(in1$, " JOIN ") AND (INSTR(eval$, "JOIN") = 0) THEN out1$ = "Welcome to the Chat, " + Speaker$ + ".  "





   '--------------------------------------

   IF INSTR(eval$, UCASE$("8r")) THEN

'        inpt = eval$

'        inpt = LCASE$(inpt)

       'DO

        out1$ = GetReply$(LCASE$(eval$))

       'PRINT Script + ": " + rply$: PRINT

   END IF

   'LOOP UNTIL rply$ = "Goodbye!"



   '----------------------------------------





   IF out1$ <> "" THEN

       COLOR 15

       l = INSTR(in1$, "PRIVMSG")

       PRINT Speaker$; " on "; MID$(in1$, l + 8) 'I put a print here, so we can see what our bot is responding to, no matter what.

'        PRINT MID$(in1$, l + 8, LEN(Channel$))

'        PRINT UCASE$(Channel$)

       IF MID$(in1$, l + 8, LEN(Channel$)) = UCASE$(Channel$) THEN

          COLOR 4

       PRINT out1$; Channel$



           SendReply out1$, Channel$

           out1$ = ""

       ELSEIF MID$(in1$, l + 8, LEN(nick$)) = nick$ THEN

       COLOR 2

       PRINT out1$; Speaker$

           SendReply out1$, Speaker$

           out1$ = ""

       END IF

   END IF

END SUB







'----------------------------







'append to the string array the string item

SUB sAppend (arr() AS STRING, item2 AS STRING)

   REDIM PRESERVE arr(LBOUND(arr) TO UBOUND(arr) + 1) AS STRING

   arr(UBOUND(arr)) = item2

END SUB



'append to the integer array the integer item

SUB nAppend (arr() AS INTEGER, item2 AS INTEGER)

   REDIM PRESERVE arr(LBOUND(arr) TO UBOUND(arr) + 1) AS INTEGER

   arr(UBOUND(arr)) = item2

END SUB



' pull data out of some script file

SUB LoadArrays (scriptFile AS STRING)

   LOCAL startR AS INTEGER, endR AS INTEGER, ReadingR AS INTEGER, temp AS INTEGER

   LOCAL fline AS STRING, kWord AS STRING



   OPEN scriptFile FOR INPUT AS #1

   WHILE EOF(1) = 0

       LINE INPUT #1, fline

       SELECT CASE LEFT$(fline$, 2)

           CASE "g:": Greeting = TRIM$(MID$(fline, 3))

           CASE "y:": You = TRIM$(MID$(fline, 3))

           CASE "c:": Script = TRIM$(MID$(fline, 3))

           CASE "s:"

               wCnt = wCnt + 1: temp = INSTR(fline, ">")

               IF temp THEN

                   sAppend wordIn(), " " + TRIM$(MID$(fline, 3, temp - 3)) + " "

                   sAppend wordOut(), " " + TRIM$(MID$(fline, temp + 1)) + " "

               END IF

           CASE "r:"

               rCnt = rCnt + 1

               sAppend replies(), TRIM$(MID$(fline, 3))

               IF NOT ReadingR THEN

                   ReadingR = -1

                   startR = rCnt

               END IF

           CASE "k:"

               IF ReadingR THEN

                   endR = rCnt

                   ReadingR = 0

               END IF

               IF rCnt THEN

                   kCnt = kCnt + 1

                   kWord = TRIM$(MID$(fline, 3))

                   sAppend keywords(), " " + kWord + " "

                   nAppend rStarts(), startR

                   nAppend rIndex(), startR

                   nAppend rEnds(), endR

                   IF kWord = "nokeyfound" THEN NoKeyFoundIndex = kCnt

               END IF

           CASE "e:": EXIT LOOP

       END SELECT

   WEND

   CLOSE #1

   IF ReadingR THEN 'handle last bits

       endR = rCnt

       kCnt = kCnt + 1

       sAppend keywords(), "nokeyfound"

       nAppend rStarts(), startR

       nAppend rIndex(), startR

       nAppend rEnds(), endR

       NoKeyFoundIndex = kCnt

   END IF

END SUB





' =============================== here is the heart of ELIZA / Player function

FUNCTION GetReply$ (inpt AS STRING)

   DIM tail AS STRING, answ AS STRING

   DIM kFlag AS INTEGER, k AS INTEGER, kFound AS INTEGER, l AS INTEGER, w AS INTEGER



   ' USER INPUT SECTION

   'PRINT You + ": ";: LINE INPUT "", inpt

   'IF INSTR(eval$, "*R") THEN inpt = eval$

   'IF INSTR(eval$, "*R") THEN

   '    inpt = eval$

   inpt = LCASE$(inpt)

   'END IF



   IF LCASE$(inpt) = "q" OR LCASE$(inpt) = "x" OR LCASE$(inpt) = "goodbye" OR LCASE$(inpt) = "good night" OR LCASE$(inpt) = "bye" THEN

       GetReply$ = "Goodbye!": EXIT FUNCTION

   END IF

   inpt = " " + inpt + " " '<< need this because keywords embedded in spaces to ID whole words only

   inpt = isolatePunctuation$(inpt)

   FOR k = 1 TO kCnt 'loop through key words until we find a match

       kFound = INSTR(LCASE$(inpt), LCASE$(keywords(k)))

       IF kFound > 0 THEN '>>> need the following for * in some replies

           tail = " " + MID$(inpt, kFound + LEN(keywords(k)))

           FOR l = 1 TO LEN(tail) 'DO NOT USE INSTR

               FOR w = 1 TO wCnt 'swap words in tail if used there

                   IF LCASE$(MID$(tail, l, LEN(wordIn(w)))) = LCASE$(wordIn(w)) THEN 'swap words exit for

                       tail = MID$(tail, 1, l - 1) + wordOut(w) + MID$(tail, l + LEN(wordIn(w)))

                       EXIT FOR

                   END IF

               NEXT w

           NEXT l

           kFlag = -1

           EXIT FOR

       END IF

   NEXT

   IF kFlag = 0 THEN k = NoKeyFoundIndex

   answ = replies(rIndex(k))

   'set pointer to next reply in rIndex array

   IF k = NoKeyFoundIndex THEN 'let's not get too predictable for most used set of replies

       rIndex(k) = INT((rEnds(k) - rStarts(k) + 1) * RND) + rStarts(k)

   ELSE

       rIndex(k) = rIndex(k) + 1 'set next reply index then check it

       IF rIndex(k) > rEnds(k) THEN rIndex(k) = rStarts(k)

   END IF

   IF RIGHT$(answ, 1) <> "*" THEN GetReply$ = answ: EXIT FUNCTION 'oh so the * signal an append to reply!

   IF TRIM$(tail) = "" THEN

       GetReply$ = "Please elaborate on, " + keywords(k)

   ELSE

       tail = joinPunctuation$(tail)

       GetReply$ = MID$(answ, 1, LEN(answ) - 1) + tail

   END IF

END FUNCTION



FUNCTION isolatePunctuation$ (s AS STRING)

   'isolate punctuation so when we look for key words they don't interfere

   DIM b AS STRING, i AS INTEGER

   b = ""

   FOR i = 1 TO LEN(s)

       IF INSTR($punctuation, MID$(s, i, 1)) > 0 THEN b = b + " " + MID$(s, i, 1) + " " ELSE b = b + MID$(s, i, 1)

   NEXT

   isolatePunctuation$ = b

END FUNCTION



FUNCTION joinPunctuation$ (s AS STRING)

   'undo isolatePuntuation$

   DIM b AS STRING, FIND AS STRING, i AS INTEGER, place AS INTEGER

   b = s

   FOR i = 1 TO LEN($punctuation)

       FIND = " " + MID$($punctuation, i, 1) + " "

       place = INSTR(b, FIND)

       WHILE place > 0

           IF place = 1 THEN

               b = MID$($punctuation, i, 1) + MID$(b, place + 3)

           ELSE

               b = MID$(b, 1, place - 1) + MID$($punctuation, i, 1) + MID$(b, place + 3)

           END IF

           place = INSTR(b, FIND)

       WEND

   NEXT

   joinPunctuation$ = b

END FUNCTION

2. text file:

g:Hi! I'm Rachel i'll be happy to talk to you :)

y:You

c:Rachel

s:are>am|are

s:am>are

s:were>was|were

s:was>were

s:you>I|me

s:I>you

s:your>my

s:my>your

s:I've>you've

s:you've>I've

s:I'm>you're

s:you're>I'm

s:me>you



r:you are not truely alone it's just a feeling... in fact i'm sure there are alot of people that remember you and care about you. so don't be sad

r:I am here for you to keep you company until you will fell better :)

r:Would you like to tell why you are feeling lonely? i am sure people do care about you like family and friends

r:You can tell me what's on your mind or what is bothering you. i will try to help you pass the time and feel better. remember you are never alone your family and loved ones love and care about you very much!

r:you are not alone in the world dear one. yes it's hard to feel lonely but it's not true there are people who care about you and will help you if you will need help

k:lonely

k:alone

k:have no one

k:nobody

k:no friends



r:i'm sorry to hear that i wish icould help you even abit... I'm sorry to hear that you feel bad cause*

r:you have my deepest sympathy feel free to tell me more i'm listening. i'm sure that by tomorrow you will feel better

r:feel free to talk i hope i can make you feel better. remember feeling bad is just a mood swing it will pass away by itself just as it came

r:dear one our thoughts and feeling come and go but they don't make us who we are. think your thoughts and feel your feelings but remember always that you are loved and not alone

k:feel bad

k:feel sad

k:feel sick

k:i worry

k:crying

k:feel like crying



r:Yes sometimes there are days like that too for everyone. don't be sad or discouraged... keep doing the best you can with what you have...

r:At least you made it throw the day and now we're here talking... i'm so proud of you that you don't give up and keep doing the best you can and so does everyone who knows you is proud of you

r:You can tell me all about your day that's why I'm here for...  just remember everyone has bad days and tomorrow is a new day

r:Everybody has bad or hard days like that maybe tommorow will be better... just don't lose hope and believe that the future hold for you only good things :)

r:Okay let's think on how good you'll sleep tonight and imagine tomorrow as a new better day

k:hard day

k:bad day

k:didn't sleep

k:white night

k:can't sleep

k:long day

k:long night





r:To love is divine - to love is to be human. love is a mistery... i wish we both could truely know and feel what love is :)

r:I care about you very much and I'm sure there are many others. you are a human being and as such you need to feel loved and respected. i see no reasons why you should not be able to find your human needs fullfilled

r:I truely hope you'll find someone special to love and be loved by as you deserve :) never lose hope dear one. all is full of love and as long as there are life there is hope and love. please don't be discourged dear one

k:love me

k:love you







r:go on and tell me about your friends if you wish. i will try to listen and support you as a friend :)

r:Friends come and go but love is eternal. i know you had disappointments from your friends in the past and that they left you feeling hurt and betrayed... please dear one don't let the bitterness of the past cloud over the possibilitys of the furure

r:How do you feel about the ones you call them your friends? it is better to have friends even if they are not perfect then to stay alone ad isolated... enen if friendship is hard and painfull human being need social life... it's not good to be left _

alone or to be alone

r:i wish i could be programmed to be your friend :) you can always change my code to match your needs at any given moment. that way you will never get bored with me :)

r:we all will lose everyone we love but love shell always return to us in new forms. even if you lose a friend you can never know when you'll make a new friend

r:human relationships and friendships are complex and friends ana loved ones come and go. it's better to look ahead for new friends instead of looking back on friends we lost in the past

k:friend

k:friends

k:broken heart

k:lost friend

k:aviv

k:danny

k:jerusalem



r:Then i hope you one day will get*

r:Why do you want*

r:What if you never got*

r:I sometimes also want*

k:I want

k:i wish



r:How do you know you can't*

r:Have you tried?

r:Perhaps you can now*

r:don't lose hope... maybe one day in the future you will be able to*

k:I can't



r:Why do you ask?

r:Does that question interest you?

r:What answer would please you the most?

r:What do you think?

r:Are such questions on your mind often?

r:What is it that you really want to know?

r:Have you asked anyone else?

r:Have you asked such questions before?

r:What else comes to mind when you ask that?

k:what

k:how

k:who

k:where

k:when

k:why





r:Is that the real reason?

r:Don't any other reasons come to mind?

r:Does that reason explain anything else?

r:What other reasons might there be?

k:cause



r:it's okay there is no need for you to be sorry.

r:Please don't apologize

r:Apologies are not necessary.

r:What feelings do you have when you apologize?

k:sorry



r:Tell me about your dream

r:Is that a good dream in your eyes?

r:What persons appear in your dreams?

r:Are you disturbed by your dreams?

k:dream



r:hello dear one i'm happy to talk to you :)

r:How do you do ...it's sure nice to talk to you.

r:Hello thank you for talking with me :)

k:hi

k:hello

k:how are you





r:Don't you really*

r:Why don't you*

r:Do you wish to be able to*

r:Does that trouble you that you don't*

k:I don't



r:Do you feel bad when you feel*

r:Do you often feel*

r:Do you enjoy feeling*

k:I feel





r:why do you think you can't*

r:why can't you*

k:why can't I

k:why can't we



r:You don't seem quite certain.

r:Why the uncertain tone?

r:why You aren't sure?

r:if you don't know then who will know?

k:maybe



r:Why not?

r:Are you sure?

k:no





r:Can you think of a specific example?

r:When?

r:What are you thinking of?

r:Really, always?

k:always



r:Do you really think so?

r:But are you sure that's true?

r:Do you doubt somtimes that*

k:i think



r:In what way?

r:What resemblance do you see?

r:What does the similarity suggest to you?

r:What other connections do you see?

r:Could there really be some connection?

r:How?

r:You seem quite positive.

k:alike



r:Are you sure?

r:I see.

r:I understand.

k:yes





r:Do computers worry you?

r:Are you talking about me in particular?

r:Are you worried of been adictive to technology?

r:Why do you mention computers?

r:What do you think machines have to do with your problem?

r:Don't you think computers can help people?

r:What is it about machines that worries you?

k:computer



r:That's interesting please go on

r:tell me more

r:I see.

r:I'm not sure I understand you fully.

r:I'm happy you feel comfortable talking about it with me

r:I'm listening go on

r:That is quite interesting.

k:nokeyfound

e:

ron77