From 50057d5149dda340b3b47aca4096f4a6ec66b9ee Mon Sep 17 00:00:00 2001
From: Přemysl Eric Janouch <p@janouch.name>
Date: Fri, 6 Aug 2021 16:12:15 +0200
Subject: 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.
---
 plugins/xB/coin | 128 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 128 insertions(+)
 create mode 100755 plugins/xB/coin

(limited to 'plugins/xB/coin')

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())}]].
+		}
+	}
+}
+
-- 
cgit v1.2.3-70-g09d2