# $Id: quiz.tcl 1183 2007-08-11 14:49:33Z sergei $

namespace eval quiz {
    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 koi8-r encoding)
    if {![info exists questions(qa)]} {
	set file [file join [file dirname [info script]] quizdata.txt]
	if {[catch {load_file $file koi8-r}]} {
	    puts "Can't load file $file"
	    return
	}
	set fd [open [info script]]
	fconfigure $fd -encoding koi8-r
	uplevel 1 [read $fd]
	close $fd
	return
    }
}

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 "
    }
}

hook::add generate_completions_hook \
    [namespace current]::quiz::commands_comps

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
}

hook::add chat_send_message_hook \
    [namespace current]::quiz::handle_commands 50


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

    set connid [chat::get_connid $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 $connid $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 $group -type groupchat \
		    -body "${prefix}Молодец, $nick!  Правильный\
ответ \"$answer($chatid)\" был дан за $time [lindex {. секунду секунды \
секунд} [numgrp $time]]$msg_time\
и принёс тебе $points($chatid) [lindex {. очко очка очков} [numgrp \
$points($chatid)]]." \
		    -connection $connid

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

		add_score $chatid $nick $points($chatid) $time
		catch { unset question($chatid) }
		variable lost
		set lost($chatid) 0
		next $chatid
	    }
	}
    }
}
hook::add draw_message_hook [namespace current]::quiz::handle_messages 79



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

    set connid [chat::get_connid $chatid]
    set group [chat::get_jid $chatid]

    if {![info exists game($chatid)]} {
	set game($chatid) ""
	message::send_msg $group -type groupchat \
	    -body "${prefix}Добро пожаловать на нашу викторину! Начинаем игру." \
	    -connection $connid
	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 connid [chat::get_connid $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 $group -type groupchat \
	    -body "${prefix}Викторина остановлена." \
	    -connection $connid
	top $chatid
    } else {
	chat::add_message $chatid $group error "Викторина не запущена" {}
    }
}

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

    set connid [chat::get_connid $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 $group -type groupchat \
		    -body "${prefix}Ну не хотите правильно отвечать\
			   -- и не надо :-/" \
		    -connection $connid
		stop $chatid
		return
	    }

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

	    message::send_msg $group -type groupchat \
		-body "${prefix}Никто не ответил на вопрос, следующий через\
		       5 секунд. Правильный ответ \"$answer($chatid)\"." \
		-connection $connid
	}
	
	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 connid [chat::get_connid $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 $group -type groupchat \
	-body "${prefix}$question($chatid)" \
	-connection $connid

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


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

    set connid [chat::get_connid $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 $group -type groupchat \
	-body "${prefix}Подсказка: [crange $answer($chatid) \
	       0 [expr 3 - $points($chatid)]]...?" \
	-connection $connid
    
    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 connid [chat::get_connid $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 $group -type groupchat \
	    -body "${prefix}Top scores:
points\tavg p\tansw\tmin t\tavg t\tnick\n$ts" \
	    -connection $connid
    } 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
    }
}

