Version 0 of tcl-dicebot

Updated 2007-02-01 01:23:33

set ::server irc.sorcery.net set ::chan #omen-heart set ::me "dicebot_expr round([expr rand() * 10000)]"

proc random {sides} { #sides=number of sides to a die

        return [expr round([expr rand() * $sides])]

}

#generates random numbers given 'sides' sided# #dice works #

proc roller {name number sides} { #name=person who called the function (get from irc) #number=Number of times to roll the dice

        set incriment 0
        set rolled "$name rolled"
        set total 0
        while {$incriment != $number} {
                append rolled " "
                set temp [random $sides]
                append rolled $temp
                incr incriment
                set total [expr $temp+$total]                
        }
        append rolled " total= $total"
        return $rolled

} #calls random proc 'number times and returns the results#

proc matcher {input} {

        if {[regexp {[0-9]*[dD][0-9]+} $input]} {

#searches for patterns matching (number)d(or)D(number), if found the if resolves as true

                split $input " "

#plits rolls at the spaces

                return [set input [lindex $input 0]]
        }

return 0 } #proc searches for a string matching (1d20, ect) and returns it if it exists, otherwise, it returns 0# # works! # # rolls using this dicebot must have the rolling info seperated by a comma #

proc roll_formater {input} {

        set input [string tolower $input]
        set input [split $input ""]
        set size [llength $input]
        set d_point [lsearch -exact $input "d"]
        set control 0
        set number ""
        set sides ""
        while {$control <= $d_point} {
                lappend number [lindex $input $control] 
                incr control
        }
        if {$control == $d_point} {
                incr control
        }
        while {$control <= $size} {
                lappend sides [lindex $input $control] 
                incr control
        }

set number lreplace $number [expr [llength $number - 1] expr [llength $number - 1] "" ] set number join $number set sides join $sides set result list $number $sides return $result } #preceding function splits the output of matcher (x*d/Dx* into a list # #that contains only the two rolling elements (number sides) #

##Start IRC client software##

proc recv {} {

         gets $::fd line ;#-- read a line from socket

        if {[lindex [split $line] 0] eq "PING"} {
                send "PONG [lindex [split $line] 1]" #--sorcery sends a 'key' that must be returned to the server in order to maintain connection#
                return 
                #ping/pong relationship with server
        }

        if {[regexp {:([^!]*)![^ ].* +PRIVMSG ([^ :]+) +:(.*)} $line} {
                set temp [split $line :]
                set message [split [lindex $temp 2] " "]
                set name_long [lindex $temp 1]
                set temp [split $line !]
                set name_short [lindex $line 0]

                if {[regexp {[0-9]*[dD][0-9]+} $message]} {
                                #call the dicebot when $message starts with a dicebot call
                                set roll [matcher $message]
                                set roll [roll_formater $roll]
                                set roll [roller $name_short [lindex $roll 0] [lindex $roll 1]]
                                send "PRIVMSG $::chan :$line"
                                }
        }
 }

# A very simple wrapper for sending a string, not forgetting to flush # # is called from within post procedure #

 proc send {str} {
        puts $::fd $str
        flush $::fd
 }

# And now, the action begins with "logging in" to the IRC server

 set ::fd [socket $::server 6667]
 send "NICK $::me"
 send "USER $::me 0 * :PicoIRC user"
 send "JOIN $::chan" 

# If the socket gets readable, recv will be called

 fileevent $::fd readable recv