# quiz.tcl --
#
#       This file implements Quiz game plugin for the Tkabber XMPP client.

package require msgcat

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

    if {![::plugins::is_registered quiz]} {
        ::plugins::register quiz \
                            -namespace [namespace current] \
                            -source [info script] \
                            -description [::msgcat::mc "Whether the 'Quiz'\
                                                        plugin is loaded.\
                                                        The plugin implements\
                                                        a simple quiz in\
                                                        Russian."] \
                            -loadcommand [namespace code load] \
                            -unloadcommand [namespace code unload]
        return
    }

    set prefix {[QUIZ]: }
}

proc quiz::load_file {filename {enc utf-8}} {
    variable questions

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

    set questions(qa) {}
    set questions(qpos) {}
    set n 0
    while {![eof $fd]} {
        set s [gets $fd]
        set s [string trim $s]

        lappend questions(qa) [split $s |]
        lappend questions(qpos) $n
        incr n
    }

    close $fd
}

namespace eval quiz {
    # A hack (reload the script in UTF-8 encoding)
    if {![info exists questions(qa)]} {
        set file [file join [file dirname [info script]] quizdata.txt]
        if {[catch {load_file $file utf-8}]} {
            puts "Can't load file $file"
            return
        }
        set fd [open [info script]]
        fconfigure $fd -encoding utf-8
        uplevel 1 [read $fd]
        close $fd
        return
    }
}

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

proc quiz::unload {} {
    variable prefix
    variable questions
    variable game
    variable question
    variable answer
    variable points
    variable asktime
    variable hint
    variable top
    variable stats

    hook::remove generate_completions_hook \
              [namespace current]::commands_comps
    hook::remove draw_message_hook [namespace current]::handle_messages 79
    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 questions}
    catch {unset game}
    catch {unset question}
    catch {unset answer}
    catch {unset points}
    catch {unset asktime}
    catch {unset hint}
    catch {unset top}
    catch {unset stats}
}

proc quiz::get_question {} {
    variable questions

    if {![info exists questions(qa)]} return

    if {![llength $questions(qpos)]} {
        for {set i 0} "\$i < [llength $questions(qa)]" {incr i} {
            lappend questions(qpos) $i
        }
    }

    set idx [rand [llength $questions(qpos)]]
    set qidx [lindex $questions(qpos) $idx]
    set questions(qpos) [lreplace $questions(qpos) $idx $idx]
    return [lindex $questions(qa) $qidx]
}

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

    if {!$wordstart} {
        lappend comps "/quizstart " "/quizstop " "/quiznext " "/quiztop "
    }
}

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

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

    set command [string trim $body]

    switch -- $command {
        /quizstart {
            start $chatid
            return stop
        }
        /quizstop {
            stop $chatid
            return stop
        }
        /quiznext {
            next $chatid
            return stop
        }
        /quiztop {
            top $chatid
            return stop
        }
    }

    return
}

proc quiz::handle_messages {chatid from type body x} {
    variable game
    variable question
    variable answer
    variable points
    variable asktime
    variable prefix

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

    set s [string trim $body]

    switch -- $s {
        !topscores -
        !topscore {
            top $chatid
            return
        }
    }

    if {![info exists game($chatid)] || ![info exists answer($chatid)]} return

    switch -- $s {
        !хинт -
        !hint {
            after 5000 [list [namespace current]::hint $chatid]
        }
        default {
            if {[filter $body] == [filter $answer($chatid)]} {
                set time [expr [clock seconds] - $asktime($chatid)]
                if {[catch { chat::get_nick $xlib $from $type } nick]} {
                    set nick [chat::get_nick $from $type]
                }
                set msg_time ""

                variable last
                if {[info exists last(nick,$chatid)] && \
                        $last(nick,$chatid) == $nick} {
                    incr last(num,$chatid)
                    if {$last(num,$chatid) > 2} {
                        set msg_cont "$nick отвечает на\
$last(num,$chatid) [lindex {. вопрос вопроса вопросов} [numgrp \
$last(num,$chatid)]] подряд!"
                    }
                } else {
                    set last(nick,$chatid) $nick
                    set last(num,$chatid) 1
                }

                variable stats
                if {![info exists stats(quick,$chatid/$nick)]} {
                    set stats(quick,$chatid/$nick) $time
                } elseif {$stats(quick,$chatid/$nick) > $time} {
                    set msg_time ", и это твой самый быстрый ответ,"
                    set stats(quick,$chatid/$nick) $time
                }
                if {![info exists stats(quick,$chatid)]} {
                    set stats(quick,$chatid) $time
                } elseif {$stats(quick,$chatid) > $time} {
                    set msg_time ", и это самый быстрый ответ за игру,"
                    set stats(quick,$chatid) $time
                }

                message::send_msg $xlib $group -type groupchat \
                    -body "${prefix}Молодец, $nick!  Правильный\
ответ \"$answer($chatid)\" был дан за $time [lindex {. секунду секунды \
секунд} [numgrp $time]]$msg_time\
и принёс тебе $points($chatid) [lindex {. очко очка очков} [numgrp \
$points($chatid)]]."

                if {[info exists msg_cont]} {
                    message::send_msg $xlib $group -type groupchat \
                        -body $msg_cont
                }

                add_score $chatid $nick $points($chatid) $time
                catch { unset question($chatid) }
                variable lost
                set lost($chatid) 0
                next $chatid
            }
        }
    }
}

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

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

    if {![info exists game($chatid)]} {
        set game($chatid) ""
        message::send_msg $xlib $group -type groupchat \
            -body "${prefix}Добро пожаловать на нашу викторину! Начинаем игру."
        variable lost
        set lost($chatid) 0
        next $chatid
    } else {
        chat::add_message $chatid $group error "Викторина уже запущена" {}
    }
}

proc quiz::stop {chatid} {
    variable game
    variable question
    variable prefix

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

    if {[info exists game($chatid)]} {
        after cancel [list [namespace current]::ask $chatid]
        after cancel [list [namespace current]::next $chatid]
        after cancel [list [namespace current]::hint $chatid]
        after cancel [list [namespace current]::hint $chatid 1]

        catch { unset question($chatid) }
        catch { unset answer($chatid) }
        unset game($chatid)
        message::send_msg $xlib $group -type groupchat \
            -body "${prefix}Викторина остановлена."
        top $chatid
    } else {
        chat::add_message $chatid $group error "Викторина не запущена" {}
    }
}

proc quiz::next {chatid} {
    variable game
    variable question
    variable answer
    variable hint
    variable prefix

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

    after cancel [list [namespace current]::ask $chatid]
    after cancel [list [namespace current]::next $chatid]
    after cancel [list [namespace current]::hint $chatid]
    after cancel [list [namespace current]::hint $chatid 1]

    if {[info exists game($chatid)]} {
        if {[info exists question($chatid)]} {
            variable lost
            incr lost($chatid)
            if {$lost($chatid) > 4} {
                message::send_msg $xlib $group -type groupchat \
                    -body "${prefix}Ну не хотите правильно отвечать\
                           -- и не надо :-/"
                stop $chatid
                return
            }

            variable last
            catch { unset last(nick,$chatid) }
            catch { unset last(num,$chatid) }

            message::send_msg $xlib $group -type groupchat \
                -body "${prefix}Никто не ответил на вопрос, следующий через\
                       5 секунд. Правильный ответ \"$answer($chatid)\"."
        }

        catch { unset question($chatid) }
        catch { unset answer($chatid) }
        catch { unset hint($chatid) }
        after 5000 [list [namespace current]::ask $chatid]
    } else {
        chat::add_message $chatid $group error "Викторина не запущена" {}
    }
}

proc quiz::ask {chatid} {
    variable game
    variable question
    variable answer
    variable points
    variable asktime
    variable prefix

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

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

    lassign [get_question] question($chatid) answer($chatid)
    set points($chatid) 3
    set asktime($chatid) [clock seconds]
    message::send_msg $xlib $group -type groupchat \
        -body "${prefix}$question($chatid)"

    after 60000 [list [namespace current]::next $chatid]
}

proc quiz::hint {chatid {cont 0}} {
    variable game
    variable answer
    variable hint
    variable points
    variable prefix

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

    if {![info exists game($chatid)] || \
            ![info exists answer($chatid)] || \
            ([info exists hint($chatid)] && !$cont)} return

    set hint($chatid) ""

    if {![incr points($chatid) -1]} {
        next $chatid
        return
    }

    message::send_msg $xlib $group -type groupchat \
        -body "${prefix}Подсказка: [string range $answer($chatid) \
               0 [expr 3 - $points($chatid)]]...?"

    after 20000 [list [namespace current]::hint $chatid 1]
}


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

proc quiz::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 quiz::top {chatid} {
    variable top
    variable prefix
    variable stats

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

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

        set ts ""
        foreach item $t {
            lassign $item nick score
            set avgp [format "%.4f" \
                          [expr $score * 1.0 / $stats(answ,$chatid/$nick)]]
            set answ $stats(answ,$chatid/$nick)
            set quick $stats(quick,$chatid/$nick)
            set avgt [format "%.4f" [expr $stats(time,$chatid/$nick) * 1.0 / \
                                         $stats(answ,$chatid/$nick)]]
            append ts "$score\t$avgp\t$answ\t$quick\t$avgt\t$nick\n"
        }

        message::send_msg $xlib $group -type groupchat \
            -body "${prefix}Top scores:
points\tavg p\tansw\tmin t\tavg t\tnick\n$ts"
    } else {
        chat::add_message $chatid $group error "Нет данных о top scores" {}
    }
}

proc quiz::add_score {chatid nick points time} {
    variable top

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

    set t {}
    set b 1
    foreach item $top($chatid) {
        lassign $item n s
        if {$n == $nick} {
            incr s $points
            set b 0
        }
        lappend t [list $n $s]
    }
    if {$b} {
        lappend t [list $nick $points]
    }
    set top($chatid) $t

    variable stats
    if {![info exists stats(answ,$chatid/$nick)]} {
        set stats(answ,$chatid/$nick) 1
    } else {
        incr stats(answ,$chatid/$nick)
    }

    if {![info exists stats(time,$chatid/$nick)]} {
        set stats(time,$chatid/$nick) $time
    } else {
        incr stats(time,$chatid/$nick) $time
    }
}

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