Port the `coin' plugin from VitaminA

This commit is contained in:
Přemysl Eric Janouch 2014-07-23 23:55:31 +02:00
parent 4bc674a559
commit 9d0a276f93
2 changed files with 127 additions and 3 deletions

124
plugins/coin Executable file
View 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())}]].
}
}
}

View File

@ -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)