Computer Hope

Software => Computer programming => Topic started by: jessiminica on December 19, 2008, 12:01:30 AM

Title: tcl bot help please?
Post by: jessiminica on December 19, 2008, 12:01:30 AM

Hey everyone. I'm VERY new to programming, and my first little project is playing around with a bot i have on aMSN. I'm trying to get it to respond to specific phrases rather than single keywords, but I'm not sure exactly what I have to do.

I'd also like to know if it's possible for me to have it respond to numerous wrds in any combination with any other words, just as long as they are in the same message. For example, if I could get it to say "my favourite country is australia" in response to "my least favourite country is australia", "the country i'd most like to go to is australia" And "I've been everywhere - Britain, America, Italy... the only country I really want to go to but havent yet is australia" because they all have australia and country in them... I hope I've explained that well enough.

Anyway. Here is the code:

Code: [Select]

namespace eval ::amsnEliza {

    global mydir
    global first
 
    proc amsnElizaStart { dir } {
global mydir
global first
set mydir $dir
set first 1
::plugins::RegisterPlugin amsnEliza
::plugins::RegisterEvent amsnEliza chat_msg_received answer
::plugins::RegisterEvent amsnEliza ChangeMyState online
::plugins::RegisterEvent amsnEliza user_leaves_chat leaves
array set ::amsnEliza::config {
    useperl {0}
    botname {Eliza}
    mystate {1}
    helptxt {I'm... a bot. Hear me roar. RAWR.}
}
set ::amsnEliza::configlist [list \
[list label "\"Use Perl\" needs Chatbot::Eliza Perl module.\nCheck CPAN"] \
  [list bool "Use Perl" useperl] \
[list bool "active" mystate] \
  [list str "Name" botname] \
[list str "Message for !help" helptxt] \
]
    }

    proc answer {event epvar} {
global mydir
global first
upvar 2 $epvar args
upvar 2 $args(msg) msg
upvar 2 $args(chatid) chatid
upvar 2 $args(user) user
set me [::abook::getPersonal login]
set win_name [::ChatWindow::For $chatid]
set mystate $::amsnEliza::config(mystate)
set useperl $::amsnEliza::config(useperl)
set mynick $::amsnEliza::config(botname)

# Commands for Eliza
# !on, switch her on. Only owner is allowed to do that
# !off, switch her off. Again only the owner can do that
# !state, everybody can ask her

if { $user==$me && $msg == "!on" } {
    set ::amsnEliza::config(mystate) 1
    plugins_log amsnEliza "amsnEliza activated"
    set first 1
    ::amsn::MessageSend $win_name 0 "$mynick: Awwwwww h**l yeah."
} elseif { $user==$me && $msg == "!off" } {
    set ::amsnEliza::config(mystate) 0
    plugins_log amsnEliza "amsnEliza deactivated"
    ::amsn::MessageSend $win_name 0 "$mynick: Fine, arsehole."
} elseif { $user!=$me && ($msg == "!off" || $msg == "!on") } {
    ::amsn::MessageSend $win_name 0 "$mynick: Don\'t touch me!"
} elseif { $msg == "!state" } {
    if { $mystate == 0 } {
::amsn::MessageSend $win_name 0 "$mynick: Just listening"
    } else {
::amsn::MessageSend $win_name 0 "$mynick: I'm allowed to talk"
    }
} elseif { $mystate == 1 } {
    if { $user==$me } {

    } elseif { $first == 1 } {
::amsn::MessageSend $win_name 0 "$mynick: Hi, I\'m $mynick. [::abook::getPersonal MFN] has buggered off leaving me in charge. You can try typing \"!help\", but it wont do much."
set first 0
    } elseif { $msg == "!help" } {
::amsn::MessageSend $win_name 0 "$mynick: $::amsnEliza::config(helptxt)"
    } elseif { $useperl == 0 } {
::amsn::MessageSend $win_name 0 "$mynick: [::TclEliza::replyto $msg]"
    } else {
::amsn::MessageSend $win_name 0 "$mynick: [exec [file join $mydir "perleliza.pl"] \"$msg\"]"
    }
}
    }
   

    proc online {event epvar} {
upvar 2 $epvar args
        set status $args(idx)
plugins_log "amsnEliza" "Changed State to $status"
if { $status == "AWY" } {
    plugins_log "amsnEliza" "Activating amsnEliza"
    set ::amsnEliza::config(mystate) 1
}
if { $status == "NLN" } {
    plugins_log "amsnEliza" "Deactivating amsnEliza"
    set ::amsnEliza::config(mystate) 0
}
    }
 
    proc leaves {event epvar} {
global first
set first 1
return
    }
}

namespace eval ::TclEliza {
    variable keywords [list]
    variable phrases  [list]
    variable dummies  [list]
   
    # Based on http://wiki.tcl.tk/9235 by Arjen Markus
    # response --
    #    Link a response to a keyword (group multiple responses to
    #    the same keyword)
    #
    # Arguments:
    #    keyword   Keyword to respond to
    #    phrase    The phrase to print
    # Result:
    #    None
    # Side effects:
    #    Update of the lists keywords and phrases
    #
    proc response { "keyword" "phrase" } {
variable keywords
variable phrases

set keyword [string tolower $keyword]
set idx [lsearch $keywords $keyword]

#
# The keyword is new, then add it.
# Otherwise only extend the list of responses
#
if { $idx == -1 } {
    lappend keywords $keyword
    lappend phrases  [list $phrase]
} else {
    set prev_phrases [lindex $phrases $idx]
    set new_phrases  [concat $prev_phrases [list $phrase]]
    set phrases      [lreplace $phrases $idx $idx $new_phrases]
}
    }
   
    # dummy --
    #    Register dummy phrases (used when no response is suitable)
    #
    # Arguments:
    #    phrase    The phrase to print
    # Result:
    #    None
    # Side effects:
    #    Update of the list dummies
    #
    proc dummy { phrase } {
variable dummies

lappend dummies $phrase
    }
   
    # replyto --
    #    Reply to the user (based on the given phrase)
    #
    # Arguments:
    #    phrase    The phrase the user typed in
    # Result:
    #    None
    # Side effects:
    #    Update of the lists keywords and phrases
    #
    proc replyto { phrase } {
variable keywords
variable phrases
variable dummies

regsub -all {[^A-Za-z]} $phrase " " phrase
set idx    -1
set phrase [string tolower $phrase]
foreach word $phrase {
    set idx [lsearch $keywords $word]
    if { $idx > -1 } {
set responses [lindex $phrases $idx]
set which     [expr {int([llength $responses]*rand())}]
set answer    [lindex $responses $which]
break
    }
}
if { $idx == -1 } {
    set which     [expr {int([llength $dummies]*rand())}]
    set answer    [lindex $dummies $which]
}

return $answer
    }
   
    # main code --
    #    Get the script going:
    #    - Create a little database of responses
    #

    response abcdefg "I'm okay."
    dummy    "So ... ?"
    dummy    "Shall we continue?"
    dummy    "What do you want to talk about?"
    dummy    "Anything specific?"
    dummy    "Talk about something more interesting?"

}
Down the bottom here, i want to have "how are you" in place of abcdefg, but no form of grouping seems to work, and I'm not sure what to do. Probably a very simple problem, but as I said, I'm fairly new to all this.

Any help is much appreciated :)

Title: Re: tcl bot help please?
Post by: ManneDyr on March 02, 2009, 11:28:26 AM

Sorry, A little late and bumping topic, but just in case somebody else would like to see how you can improve on amsneliza..
But as always, you can do better than this by learning to code yourself.
But here's what I did to make it work.
Below the "proc answer" section. Just search for "!state", it should be just a scroll away from the first time you search for it.

Code: [Select]

::amsn::MessageSend $win_name 0 "$mynick: I'm allowed to talk"
    }
here>>>
} elseif { $mystate == 1 } {
    if { $user==$me } {I placed this.

Code: [Select]

#Example more words blabla.
      } elseif { $user!=$me && [string match -nocase "*country*australia" $msg]} {
    ::amsn::MessageSend $win_name 0 "my favourite country is australia"
#An example containing a question.
      } elseif { $user!=$me && [string match -nocase "*how*you*doing\?" $msg]} {
    ::amsn::MessageSend $win_name 0 "I'm doing fine, how are you doing?"