###########################    ACROMANIA v1.0   #################################
##
## First OFFICIAL release of something I was told that if I didn't make, the 
## ppl in #bor would annoy me until I did (oweff!! ;P). Plus dh asked me
## to. Based a little on Traveler's mirc (ugh) version of it, he is
## currently working on a VB version... Dunno how it will compare to this.
## It works for sure with Eggdrop and SHOULD work 100% with BitchX+tcl now.
## Please tell me of any bugs or any suggestions u may have.... Read thru 
## the script where there are comments (heh the few there are) and make changes
## as you wish.
##  -- |By-Tor|@EFNet
##
## Greetz to dh, Traveler, hammz, scoop, hammz, oweff, novalogic, Proxy,
## And all you little people (Yah, mr_bill is a `little people').
##
## Special (non-sexual) greets to Robey for Eggdrop and the devel-team for
## keeping it going. Also panasync for the (TCL) BitchX...
##
## WEWP, have fun and remember that Microsoft(c) is evil!






set scorefile "acro.score"
set round 0
proc init_acro { } {
	global acro
	if [info exists acro] { unset acro }
	if [info exists vote] { unset vote }
	set acro(progress) 0
	set acro(min) 3
	set acro(max) 5
	set acro(rounds) 10
	set acro(nym) ""
	set acro(players) 0
	set acro(maxpl) 10
	set acro(minpl) 2
	set acro(nicks) ""
}

proc read_score { } {
	global score scorefile
	if [info exists score] { unset score }
	set f [open $scorefile r]
	while ![eof $f] {
		set s [gets $f]
		set score([lindex $s 0]) [lindex $s 1]
	}
	close $f
}

proc write_score { } {
	global score scorefile
	set f [open $scorefile w]
	foreach s [lsort -decreasing -command sort_score [array names score]] {
		puts $f
		puts -nonewline $f "$s $score($s)"
	}
	close $f
}

proc sort_score {s1 s2} {
	global score
	if {$score($s1) > $score($s2)} { return 1 }
	if {$score($s1) < $score($s2)} { return -1 }
	if {$score($s1) == $score($s2)} { return 0 }
}

proc sort_games {s1 s2} {
	global gamescore
	if {$gamescore($s1) > $gamescore($s2)} { return 1 }
	if {$gamescore($s1) < $gamescore($s2)} { return -1 }
	if {$gamescore($s1) == $gamescore($s2)} { return 0 }
}

foreach t [utimers] {	if [string match *acro* [lindex $t 1]] { killutimer [lindex $t end] } }
	 
init_acro
if [file exists $scorefile] { read_score }
set letters "ABCDEFGHIJKLMNOPRSTUVWY"

if [string match *BitchX* $version] {
	bind pub -1 start start_acro
} { bind pub - start start_acro }

proc start_acro { n u h c a } {
	global acro botnick round
	if { $acro(progress) != 0 } { return 0 }
	init_acro
	set acro(progress) 1
	incr round
	putserv "privmsg $c :Round $round\($acro(rounds)\)"
	putserv "privmsg $c :The acronym for this round is [make_acro]. You have 60 seconds."
	putserv "privmsg $c :/msg $botnick \"acro your answer\". Good luck!"
	utimer 30 "warn_acro $c"
}

if [string match *BitchX* $version] {
	bind pub 90 stop stop_acro
} { bind pub m stop stop_acro }

proc stop_acro { n u h c a } {
	init_acro
	foreach t [utimers] {	if [string match *acro* [lindex $t 1]] { killutimer [lindex $t end] } }	
}

if [string match *BitchX* $version] {
	bind msg -1 acro msg_acro
} { bind msg - acro msg_acro }

proc msg_acro { n u h a } {
	global botnick acro
	set u [string tolower $u]
	regsub -nocase -all \[{}] $a "" a
	if {$acro(progress) == 1} {
		if {([llength $a] != [string length $acro(nym)]) || ([string length [join $a ""]] == [string length $acro(nym)]) } { putserv "notice $n :Invalid Acronym" ; return 0 }
		if [regexp -nocase {[^a-z]} [join $a ""]] { putserv "notice $n :Invalid Acronym" ; return 0 }
		if {[info exists acro($u)]} {
			if {$a == [lrange $acro($u) 2 end]} {
				putserv "notice $n :Your answer is already \"$a\""
				return 0
			}
			if {[lindex $acro($u) 1] == 0} {
				putserv "notice $n :You have already submitted an answer. Submit once more to change."
				set acro($u) "$n {$a} [lrange $acro($u) 2 end]"
				return 0
			}
			if {[lindex $acro($u) 1] == $a} {
				putserv "notice $n :Your answer has been changed to \"$a\""
				set acro($u) "$n 0 $a"
				return 0
			}
			putserv "notice $n :You have already submitted an answer. Submit once more to change."
			set acro($u) "$n {$a} [lrange $acro($u) 2 end]"
			return 0
		}
		if {$acro(players) >= $acro(maxpl)} {
			putserv "notice $n :Maximum players reached, please try again later."
			return 0
		}
		for { set r 0 } { $r <= [string length $acro(nym)] } { incr r } {
			if ![string match [string index $acro(nym) $r] [string toupper [string index [lindex $a $r] 0]]] {
				putserv "notice $n :Invalid Acronym"
				return 0
			}
		}
		putserv "notice $n :Answer set to \"$a\""
		set acro($u) "$n 0 $a"
		incr acro(players)
		putserv "notice $n :You are player #$acro(players)"
	}
	if {$acro(progress) == 2} {
		global vote
		if {[lsearch $vote(voters) $u] != -1} {
			putserv "notice $n :You already voted"
			return 0
		}
		set a [lindex $a 0]
		if ![info exists vote($a)] { 
			putserv "notice $n :No such answer."
			return 0
		}
		if {$n == [lindex $vote($a) 0]} {
			putserv "notice $n :You can't vote for yourself, stupid."
			return 0
		}
		set vote($a) "[lindex $vote($a) 0] [expr {[lindex $vote($a) 1] + 1}]"
		putserv "notice $n :Your vote has been recorded..."
		lappend vote(voters) $u
	}
}

proc make_acro { } {
	global acro letters
	set r [expr [rand [expr {$acro(max) - $acro(min) + 1}]] + $acro(min)]
	while { [string length $acro(nym)] < $r } {
		append acro(nym) [string index $letters [rand [string length $letters]]]
	}
	return $acro(nym)
}

proc warn_acro { c } {
	global acro
	utimer 30 "end_acro $c"
	putserv "privmsg $c :-=30 Seconds!=-"
}

proc end_acro { c } {
	global acro botnick vote
	if {$acro(players) < $acro(minpl)} {
		putserv "privmsg $c :Not enough players, extending deadline 30 seconds..."
		utimer 30 "end_acro $c"
		return 0
	}
	set acro(progress) 2
	if [info exists vote] { unset vote }
	set vote(voters) ""
	putserv "privmsg $c :Time expired, lets vote!"
	putserv "privmsg $c :/msg $botnick \"acro #\" to vote"
	set n 1
	foreach g [array names acro] {
		if {[llength $acro($g)] > 1} {
			putserv "privmsg $c :$n: [lrange $acro($g) 2 end]"
			set vote($n) "[lindex $acro($g) 0] 0"
			incr n
		}
	}
	utimer 30 "warn_vote $c"
}

proc warn_vote { c } {
	putserv "privmsg $c :30 seconds left to vote..."
	utimer 30 "end_vote $c"
}

proc end_vote { c } {
	global acro score vote gamescore round
	putserv "privmsg $c :Voting complete..."
	set acro(progress) 0
	foreach e [array names vote] {
		if ![regexp {[0-9]} $e] { continue }
		if ![info exists score([lindex $vote($e) 0])] {
			set score([lindex $vote($e) 0]) [lindex $vote($e) 1]
		} {	set score([lindex $vote($e) 0]) [expr {[lindex $vote($e) 1] + $score([lindex $vote($e) 0])}] }
		if ![info exists gamescore([lindex $vote($e) 0])] {
			set gamescore([lindex $vote($e) 0]) [lindex $vote($e) 1]
		} {	set gamescore([lindex $vote($e) 0]) [expr {[lindex $vote($e) 1] + $gamescore([lindex $vote($e) 0])}] }
	}
	write_score
	if {$round >= $acro(rounds)} {
		putserv "privmsg $c :Game over, tallying final scores..."
		putserv "privmsg $c :--= Nick =---= Score =--"
		set scorelist [lsort -decreasing -command sort_score [array names score]]
		for { set s 0 } { $s < [llength $scorelist] } { incr s } {
			putserv "privmsg $c :  [c 9 [lindex $scorelist $s]]   [c 7 $score([lindex $scorelist $s])]"
		}
		init_acro
		unset gamescore
		set round 0
	} {
		putserv "privmsg $c :Score totals as of round $round:"
		putserv "privmsg $c :--= Nick =---= Score =--"
		set scorelist [lsort -decreasing -command sort_games [array names gamescore]]
		for { set s 0 } { $s < [llength $scorelist] } { incr s } {
			putserv "privmsg $c :  [c 9 [lindex $scorelist $s]]   [c 7 $gamescore([lindex $scorelist $s])]"
		}
		start_acro blah blah blah $c ""
	}
}

proc c { c t } {
	set h [expr $c/2 - [string length $t]/2]
	for { set r 0 ; set s "" } {$r < $h} { incr r } { append s " " }
	set l [expr $c - [string length $t] - [string length $s]]
	for { set r 0 ; set v "" } {$r < $l} { incr r } { append v " " }
	return [append s $t $v]
}

# Microsoft is a registered trademark of the Evil Empire, er I mean Microsoft