xK/plugins/coin

125 lines
3.1 KiB
Tcl
Executable File
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

#!/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())}]].
}
}
}