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.
This commit is contained in:
		
							
								
								
									
										128
									
								
								plugins/xB/coin
									
									
									
									
									
										Executable file
									
								
							
							
						
						
									
										128
									
								
								plugins/xB/coin
									
									
									
									
									
										Executable file
									
								
							@@ -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())}]].
 | 
			
		||||
		}
 | 
			
		||||
	}
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
		Reference in New Issue
	
	Block a user