# $Id: bc.tcl 1679 2009-02-20 21:16:56Z sergei $

package require msgcat

namespace eval bc {
    ::msgcat::mcload [file join [file dirname [info script]] msgs]

    if {![::plugins::is_registered bc]} {
	::plugins::register bc \
			    -namespace [namespace current] \
			    -source [info script] \
			    -description [::msgcat::mc "Whether the 'Bulls & Cows' plugin is loaded.\
							The plugin implements game variant where\
							players guess Russian words instead of numbers\
							as usual."] \
			    -loadcommand [namespace code load] \
			    -unloadcommand [namespace code unload]
	return
    }

    set prefix {[B&C]: }
}

package require textutil

proc bc::load_file {filename {enc utf-8}} {
    variable words

    set fd [open $filename]
    fconfigure $fd -encoding $enc

    set words {}
    while {![eof $fd]} {
	lappend words [string trim [gets $fd]]
    }

    close $fd
}

namespace eval bc {
    # A hack (reload the script in koi8-r encoding)
    if {![info exists words]} {
	set file [file join [file dirname [info script]] ru.dic]
	load_file $file koi8-r
	set fd [open [info script]]
	fconfigure $fd -encoding koi8-r
	uplevel 1 [read $fd]
	close $fd
	return
    }
}

proc bc::load {} {
    hook::add draw_message_hook [namespace current]::handle_messages 79
    hook::add generate_completions_hook \
	      [namespace current]::commands_comps
    hook::add chat_send_message_hook \
	      [namespace current]::handle_commands 50
}

proc bc::unload {} {
    variable prefix
    variable words
    variable game
    variable word
    variable attempts
    variable top

    hook::remove draw_message_hook [namespace current]::handle_messages 79
    hook::remove generate_completions_hook \
		 [namespace current]::commands_comps
    hook::remove chat_send_message_hook \
		 [namespace current]::handle_commands 50

    foreach chatid [chat::opened] {
	if {[info exists game($chatid)]} {
	    stop $chatid
	}
    }

    catch {unset prefix}
    catch {unset words}
    catch {unset game}
    catch {unset word}
    catch {unset attempts}
    catch {unset top}
}

proc bc::get_question {} {
    variable words

    if {![info exists words] || ![llength $words]} return

    while {![info exists w]} {
	set w [lindex $words [rand [llength $words]]]
	if {[regexp {(.).*\1} $w]} {
	    unset w
	}
    }
    return $w
}

proc bc::commands_comps {chatid compsvar wordstart line} {
    upvar 0 $compsvar comps

    if {!$wordstart} {
	lappend comps "/bcstart " "/bcstop " "/bcnext " "/bctop "
    }
}

proc bc::handle_commands {chatid user body type} {
    variable game

    if {$type != "groupchat"} return
    if {[string index $body 0] != "/"} return

    set jid [chat::get_jid $chatid]
    lassign [textutil::splitx [string trim $body] {[\t \r\n]+}] command nick

    switch -- $command {
	/bcstart {
	    start $chatid
	    return stop
	}
	/bcstop {
	    stop $chatid
	    return stop
	}
	/bcnext {
	    if {$nick != ""} {
		# Стоило бы проверить, что юзер в чате...
		next $chatid "$jid/$nick" $type
	    }
	    return stop
	}
	/bctop {
	    top $chatid
	    return stop
	}
    }

    return
}

proc bc::get_nick {chatid jid type} {
    if {[catch {chat::get_nick [chat::get_xlib $chatid] $jid $type} nick]} {
	return [chat::get_nick $jid $type]
    } else {
	return $nick
    }
}

proc bc::handle_messages {chatid from type body x} {
    variable game
    variable words
    variable word
    variable attempts
    variable prefix

    set xlib [chat::get_xlib $chatid]
    set jid [chat::get_jid $chatid]

    set s [string trim $body]

    switch -- $s {
	!bctop {
	    top $chatid
	    return
	}
	!bcrules {
	    printrules $chatid $from
	    return
	}
	!bcstart -
	!bsnext {
	    next $chatid $from $type
	}
    }

    if {![info exists game($chatid)] || ![info exists word($chatid,$from)]} return

    switch -- $s {
	default {
	    set nick [get_nick $chatid $from $type]
	    set w [filter $body]
	    if {[string length $w] != 5} {
		return
	    }
	    set ww [filter $word($chatid,$from)]
    	    if {$w == $ww} {
		incr attempts($chatid,$from)
		set at $attempts($chatid,$from)

		message::send_msg $xlib $jid -type groupchat \
		    -body "$nick: ${prefix}Молодец! Задуманное слово\
			   \"$word($chatid,$from)\" было отгадано за $at\
			   [lindex {. попытку попытки попыток} [numgrp $at]]."

		add_score $chatid $nick $ww $at
		unset word($chatid,$from)
		next $chatid $from $type
		return
	    }
	    if {[lsearch -exact $words $w] == -1} {
		message::send_msg $xlib $jid -type groupchat \
		    -body "$nick: ${prefix}Я не знаю слова \"$w\"."
		return
	    }
	    set l [string length $w]
	    set matches 0
	    for {set i 0} {$i < $l} {incr i} {
		incr matches [expr {[string first [string index $w $i] $ww] != -1}]
	    }
	    if {[info exists attempts($chatid,$from)]} {
		incr attempts($chatid,$from)
	    } else {
		set attempts($chatid,$from) 1
	    }
	    message::send_msg $xlib $jid -type groupchat \
		-body "$nick: ${prefix}$w: $matches"
	}
    }
}

proc bc::start {chatid} {
    variable game
    variable prefix

    set xlib [chat::get_xlib $chatid]
    set jid [chat::get_jid $chatid]

    if {![info exists game($chatid)]} {
	set game($chatid) ""
	message::send_msg $xlib $jid -type groupchat \
	    -body "${prefix}Добро пожаловать на игру \"Отгадай слово\"!\
		   Чтобы узнать правила игры, введите !bcrules."
    } else {
	chat::add_message $chatid $jid error "Игра уже запущена" {}
    }
}

proc bc::stop {chatid} {
    variable game
    variable word
    variable attempts
    variable prefix

    set xlib [chat::get_xlib $chatid]
    set jid [chat::get_jid $chatid]

    if {[info exists game($chatid)]} {
	foreach n [array names word "$chatid,*"] {
	    unset word($n)
	}
	foreach n [array names attempts "$chatid,*"] {
	    unset attempts($n)
	}

	foreach id [after info] {
	    if {[string first [list [namespace current]::ask $chatid] \
			      [lindex [after info $id] 0]] == 0} {
		after cancel $id
	    }
	}

	unset game($chatid)
	message::send_msg $xlib $jid -type groupchat \
	    -body "${prefix}Игра остановлена."
	top $chatid
    } else {
	chat::add_message $chatid $jid error "Игра не запущена" {}
    }
}

proc bc::next {chatid jid type} {
    variable game
    variable word
    variable prefix

    set xlib [chat::get_xlib $chatid]
    set jid1 [chat::get_jid $chatid]

    if {[info exists game($chatid)]} {
	if {[info exists word($chatid,$jid)]} {
	    set nick [get_nick $chatid $jid $type]
	    message::send_msg $xlib $jid1 -type $type \
		-body "$nick: ${prefix}Предыдущее слово: $word($chatid,$jid)."
	}
	
	catch {unset word($chatid.$jid)}
	after idle [list [namespace current]::ask $chatid $jid]
    } else {
	chat::add_message $chatid $jid1 error "Игра не запущена" {}
    }
}

proc bc::ask {chatid jid} {
    variable game
    variable word
    variable attempts
    variable prefix

    set xlib [chat::get_xlib $chatid]
    set jid1 [chat::get_jid $chatid]

    after cancel [list [namespace current]::ask $chatid $jid]

    set word($chatid,$jid) [get_question]
    set attempts($chatid,$jid) 0
    set nick [get_nick $chatid $jid groupchat]
    message::send_msg $xlib $jid1 -type groupchat \
	-body "$nick: ${prefix}Слово загадано. Угадывай."
}


proc bc::filter {text} {
    regsub -all {[;:()\[\]!?.,/\\{}]} [string tolower $text] "" text
    return [string trim $text]
}

proc bc::numgrp {number} {
    switch -glob -- $number {
	*11 {return 3}
	*12 {return 3}
	*13 {return 3}
	*14 {return 3}
	*1  {return 1}
	*2  {return 2}
	*3  {return 2}
	*4  {return 2}
	default {return 3}
    }
}

proc bc::top {chatid} {
    variable top
    variable prefix

    set xlib [chat::get_xlib $chatid]
    set jid [chat::get_jid $chatid]

    if {[info exists top($chatid)]} {
	set t [lsort -integer -increasing -index 2 $top($chatid)]

	set ts ""
	foreach item $t {
	    lassign $item nick word score
	    append ts "$score\t$word\t$nick\n"
	}

	message::send_msg $xlib $jid -type groupchat \
	    -body "${prefix}Top scores:\n$ts"
    } else {
	chat::add_message $chatid $jid error "Нет данных о top scores" {}
    }
}

proc bc::add_score {chatid nick word attempts} {
    variable top

    if {![info exists top($chatid)]} {
	set top($chatid) {}
    }

    set t {}
    set b 1
    foreach item $top($chatid) {
	lassign $item n w a
	if {$n == $nick} {
	    if {$a > $attempts} {
		set a $attempts
		set w $word
	    }
	    set b 0
	}
	lappend t [list $n $w $a]
    }
    if {$b} {
	lappend t [list $nick $word $attempts]
    }
    set top($chatid) $t
}

proc bc::printrules {chatid to} {
    variable game

    set xlib [chat::get_xlib $chatid]

    if {[info exists game($chatid)]} {
	message::send_msg $xlib $to -type chat \
	    -body "Правила игры \"Отгадай слово\"\n\
1) Водящий (бот) загадывает пятибуквенное слово\
(нарицательное существительное единственного числа) в котором\
буквы не повторяются.\n\
2) Пока слово не отгадано, игрок называет свой вариант\
(в оригинале слово любой длины, здесь пока тоже 5-буквенное)\
Водящий сообщает ему, сколько букв из задуманного слова содержится\
в названном.\n\
3) Если слово угадано, то игра заканчивается.\n\
\n\
Для того, чтобы запустить игру, вернитесь в конференцию и наберите !bcstart"
    }
}

