Port the `coin' plugin from VitaminA
This commit is contained in:
parent
4bc674a559
commit
9d0a276f93
124
plugins/coin
Executable file
124
plugins/coin
Executable file
@ -0,0 +1,124 @@
|
|||||||
|
#!/usr/bin/env tclsh
|
||||||
|
#
|
||||||
|
# ZyklonB coin plugin, random number-based utilities
|
||||||
|
#
|
||||||
|
# Copyright 2012, 2014 Přemysl Janouch. All rights reserved.
|
||||||
|
# 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 bytelength $line] }
|
||||||
|
if {$i == 0} { break }
|
||||||
|
|
||||||
|
if {[string index $line 0] == ":"} {
|
||||||
|
lappend msg(param) [string range $line 1 [string bytelength $line]]
|
||||||
|
break
|
||||||
|
}
|
||||||
|
lappend msg(param) [string range $line 0 [expr $i - 1]]
|
||||||
|
set line [string range $line $i [string bytelength $line]]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
proc get_config {key} {
|
||||||
|
global msg
|
||||||
|
puts "ZYKLONB 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
|
||||||
|
fconfigure stdout -translation crlf
|
||||||
|
|
||||||
|
set prefix [get_config prefix]
|
||||||
|
puts "ZYKLONB 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 bytelength $prefix] - 1]]
|
||||||
|
if {$first_chars != $prefix} { continue }
|
||||||
|
set input [string range $input \
|
||||||
|
[string bytelength $prefix] [string bytelength $input]]
|
||||||
|
|
||||||
|
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 [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())}]].
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
@ -65,11 +65,11 @@ msg_command == "PRIVMSG" \
|
|||||||
ctx = substr(msg_prefix, RSTART, RLENGTH)
|
ctx = substr(msg_prefix, RSTART, RLENGTH)
|
||||||
if (msg_param[0] ~ /^[#&!+]/)
|
if (msg_param[0] ~ /^[#&!+]/)
|
||||||
{
|
{
|
||||||
ctxquote = ctx ": "
|
ctx_quote = ctx ": "
|
||||||
ctx = msg_param[0]
|
ctx = msg_param[0]
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
ctxquote = ""
|
ctx_quote = ""
|
||||||
|
|
||||||
|
|
||||||
if (substr(msg_param[1], 1, length(prefix)) == prefix)
|
if (substr(msg_param[1], 1, length(prefix)) == prefix)
|
||||||
@ -87,7 +87,7 @@ msg_command == "PRIVMSG" \
|
|||||||
|
|
||||||
function pmrespond (text)
|
function pmrespond (text)
|
||||||
{
|
{
|
||||||
print "PRIVMSG " ctx " :" ctxquote text
|
print "PRIVMSG " ctx " :" ctx_quote text
|
||||||
}
|
}
|
||||||
|
|
||||||
function process_request (input, res, x)
|
function process_request (input, res, x)
|
||||||
|
Loading…
Reference in New Issue
Block a user