129 lines
3.1 KiB
Tcl
Executable File
129 lines
3.1 KiB
Tcl
Executable File
#!/usr/bin/env tclsh
|
|
#
|
|
# xB coin plugin, random number-based utilities
|
|
#
|
|
# Copyright 2012, 2014 Přemysl Eric Janouch
|
|
# See the file LICENSE for licensing information.
|
|
#
|
|
|
|
# This is a terrible excuse for a programming language and I feel dirty.
|
|
|
|
proc parse {line} {
|
|
global msg
|
|
unset -nocomplain msg
|
|
|
|
if [regexp {^:([^ ]*) *(.*)} $line -> prefix rest] {
|
|
set msg(prefix) $prefix
|
|
set line $rest
|
|
}
|
|
if [regexp {^([^ ]*) *(.*)} $line -> command rest] {
|
|
set msg(command) $command
|
|
set line $rest
|
|
}
|
|
while {1} {
|
|
set line [string trimleft $line " "]
|
|
set i [string first " " $line]
|
|
if {$i == -1} { set i [string length $line] }
|
|
if {$i == 0} { break }
|
|
|
|
if {[string index $line 0] == ":"} {
|
|
lappend msg(param) [string range $line 1 end]
|
|
break
|
|
}
|
|
lappend msg(param) [string range $line 0 [expr $i - 1]]
|
|
set line [string range $line $i end]
|
|
}
|
|
}
|
|
|
|
proc get_config {key} {
|
|
global msg
|
|
puts "XB get_config :$key"
|
|
gets stdin line
|
|
parse $line
|
|
return [lindex $msg(param) 0]
|
|
}
|
|
|
|
proc pmrespond {text} {
|
|
global ctx
|
|
global ctx_quote
|
|
puts "PRIVMSG $ctx :$ctx_quote$text"
|
|
}
|
|
|
|
fconfigure stdin -translation crlf -encoding iso8859-1
|
|
fconfigure stdout -translation crlf -encoding iso8859-1
|
|
|
|
set prefix [get_config prefix]
|
|
puts "XB register"
|
|
|
|
set eightball [list \
|
|
"It is certain" \
|
|
"It is decidedly so" \
|
|
"Without a doubt" \
|
|
"Yes - definitely" \
|
|
"You may rely on it" \
|
|
"As I see it, yes" \
|
|
"Most likely" \
|
|
"Outlook good" \
|
|
"Yes" \
|
|
"Signs point to yes" \
|
|
"Reply hazy, try again" \
|
|
"Ask again later" \
|
|
"Better not tell you now" \
|
|
"Cannot predict now" \
|
|
"Concentrate and ask again" \
|
|
"Don't count on it" \
|
|
"My reply is no" \
|
|
"My sources say no" \
|
|
"Outlook not so good" \
|
|
"Very doubtful"]
|
|
|
|
while {[gets stdin line] != -1} {
|
|
parse $line
|
|
|
|
if {! [info exists msg(prefix)] || ! [info exists msg(command)]
|
|
|| $msg(command) != "PRIVMSG" || ! [info exists msg(param)]
|
|
|| [llength $msg(param)] < 2} { continue }
|
|
|
|
regexp {^[^!]*} $msg(prefix) ctx
|
|
if [regexp {^[#&+!]} [lindex $msg(param) 0]] {
|
|
set ctx_quote "$ctx: "
|
|
set ctx [lindex $msg(param) 0]
|
|
} else { set ctx_quote "" }
|
|
|
|
set input [lindex $msg(param) 1]
|
|
set first_chars [string range $input 0 \
|
|
[expr [string length $prefix] - 1]]
|
|
if {$first_chars != $prefix} { continue }
|
|
set input [string range $input [string length $prefix] end]
|
|
|
|
if {$input == "coin"} {
|
|
if {rand() < 0.5} {
|
|
pmrespond "Heads."
|
|
} else {
|
|
pmrespond "Tails."
|
|
}
|
|
} elseif {[regexp {^dice( +|$)(.*)} $input -> _ args]} {
|
|
if {! [string is integer -strict $args] || $args <= 0} {
|
|
pmrespond "Invalid or missing number."
|
|
} else {
|
|
pmrespond [expr {int($args * rand()) + 1}]
|
|
}
|
|
} elseif {[regexp {^(choose|\?)( +|$)(.*)} $input -> _ _ args]} {
|
|
if {$args == ""} {
|
|
pmrespond "Nothing to choose from."
|
|
} else {
|
|
set c [split $args ",|"]
|
|
pmrespond [string trim [lindex $c \
|
|
[expr {int([llength $c] * rand())}]]]
|
|
}
|
|
} elseif {[regexp {^eightball( +|$)(.*)} $input -> _ args]} {
|
|
if {$args == ""} {
|
|
pmrespond "You should, you know, ask something."
|
|
} else {
|
|
pmrespond [lindex $eightball \
|
|
[expr {int([llength $eightball] * rand())}]].
|
|
}
|
|
}
|
|
}
|
|
|