aboutsummaryrefslogtreecommitdiff
path: root/plugins/xB/coin
diff options
context:
space:
mode:
authorPřemysl Eric Janouch <p@janouch.name>2021-08-06 16:12:15 +0200
committerPřemysl Eric Janouch <p@janouch.name>2021-08-06 16:43:59 +0200
commit50057d5149dda340b3b47aca4096f4a6ec66b9ee (patch)
tree79323d20b17c2c8e32942a1ac9b84d9da3041c6d /plugins/xB/coin
parent1f64710e795b0c5434d15813d4f1f568467ca087 (diff)
downloadxK-50057d5149dda340b3b47aca4096f4a6ec66b9ee.tar.gz
xK-50057d5149dda340b3b47aca4096f4a6ec66b9ee.tar.xz
xK-50057d5149dda340b3b47aca4096f4a6ec66b9ee.zip
Come up with sillier names for the binaries
I'm not entirely sure, but it looks like some people might not like jokes about the Holocaust. On a more serious note, the project has become more serious over the 7 or so years of its existence.
Diffstat (limited to 'plugins/xB/coin')
-rwxr-xr-xplugins/xB/coin128
1 files changed, 128 insertions, 0 deletions
diff --git a/plugins/xB/coin b/plugins/xB/coin
new file mode 100755
index 0000000..14cabb5
--- /dev/null
+++ b/plugins/xB/coin
@@ -0,0 +1,128 @@
+#!/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 "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())}]].
+ }
+ }
+}
+