# bc.tcl --
#
#       This file implements Bulls & Cows game plugin for the Tkabber XMPP
#       client. The word game variant is used. And currently, only Russian
#       words are to be guessed.

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 UTF-8 encoding)
    if {![info exists words]} {
        set file [file join [file dirname [info script]] ru.dic]
        load_file $file utf-8
        set fd [open [info script]]
        fconfigure $fd -encoding utf-8
        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"
    }
}

# vim:ft=tcl:ts=8:sw=4:sts=4:et
