xK/plugins/coin

#!/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 bytelength $line] }
		if {$i == 0} { break }

		if {[string index $line 0] == ":"} {
			lappend msg(param) [string range $line 1 [string bytelength $line]]
			break
		}
		lappend msg(param) [string range $line 0 [expr $i - 1]]
		set line [string range $line $i [string bytelength $line]]
	}
}

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
fconfigure stdout -translation crlf

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 bytelength $prefix] - 1]]
	if {$first_chars != $prefix} { continue }
	set input [string range $input \
		[string bytelength $prefix] [string bytelength $input]]

	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 [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())}]].
		}
	}
}