125 lines
3.1 KiB
Tcl
Executable File
125 lines
3.1 KiB
Tcl
Executable File
#!/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 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 "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 -encoding iso8859-1
|
||
fconfigure stdout -translation crlf -encoding iso8859-1
|
||
|
||
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 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())}]].
|
||
}
|
||
}
|
||
}
|
||
|