Tkabber plugins

Check-in [1243f0969a]
Login
Home Timeline Branches Tags Tickets Wiki

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Reformatted the code.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:1243f0969a5ff25e4204442c41802db4102bd022
User & Date: sgolovan 2015-05-09 11:33:05
Context
2015-05-09
11:38
Reformatted the code. check-in: 84ca19ccc0 user: sgolovan tags: trunk
11:33
Reformatted the code. check-in: 1243f0969a user: sgolovan tags: trunk
11:29
Reformatted the code. check-in: de7820aea2 user: sgolovan tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog. 

1


2
3
4
5
6
7
8

2015-05-09  Sergei Golovan  <sgolovan@nes.ru>



	* presencecmd/INSTALL, presencecmd/TODO, presencecmd/msgs/de.msg,
	  presencecmd/msgs/es.msg, presencecmd/msgs/pl.msg,
	  presencecmd/msgs/ru.msg, presencecmd/presencecmd.tcl: Reformatted
	  the code.

	* poker/poker.tcl: Adapted the Poker game plugin to the Ttk based


>
>








1
2
3
4
5
6
7
8
9
10

2015-05-09  Sergei Golovan  <sgolovan@nes.ru>

	* quiz/msgs/ru.msg, quiz/quiz.tcl: Reformatted the code.

	* presencecmd/INSTALL, presencecmd/TODO, presencecmd/msgs/de.msg,
	  presencecmd/msgs/es.msg, presencecmd/msgs/pl.msg,
	  presencecmd/msgs/ru.msg, presencecmd/presencecmd.tcl: Reformatted
	  the code.

	* poker/poker.tcl: Adapted the Poker game plugin to the Ttk based

Changes to quiz/msgs/ru.msg. 

1
2
3
4
5
6
7

8



# ru.msg --
#
#	Russian messages for the Quiz Tkabber plugin.
#
# Author: Sergei Golovan <sgolovan@nes.ru>

::msgcat::mcset ru "Whether the 'Quiz' plugin is loaded. The plugin implements a simple quiz in Russian."\

	"Загружено ли расширение 'Викторина'. Оно реализует простую викторину на русском языке."





|



|
>
|
>
>

1
2
3
4
5
6
7
8
9
10
11

# ru.msg --
#
#       Russian messages for the Quiz Tkabber plugin.
#
# Author: Sergei Golovan <sgolovan@nes.ru>

::msgcat::mcset ru "Whether the 'Quiz' plugin is loaded. The plugin\
        implements a simple quiz in Russian." "Загружено ли расширение\
        'Викторина'. Оно реализует простую викторину на русском языке."

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

Changes to quiz/quiz.tcl. 

1
2
3
4
5
6
7
8
9
10
11
12
13
14

15


16
17
18
19
20
21
22
23
24
25
..
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
..
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
...
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
...
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
...
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
...
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
...
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473


# 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 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}
................................................................................

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
................................................................................

    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
................................................................................

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





|







|
|
|
|
>
|
>
>
|
|
|







 







|
|

|
|
|








|
|
|
|
|
|
|
|
|
|





|


|







 







|


|


|
|
|







 







|
|
|












|












|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|







 







|
|
|
|
|





|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|


|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|

|
|





|
|
|
|

|
|
|
|
|
|
|











|
|
|
|
|
|

|












|
|
|
|

|
|
|
|
|
|

|







 







|
|
|
|
|
|
|
|
|
|

|
|
|

|
|
|
|
|
|
|
|
|

|







 







|







 







|
|




|
|



|
|












|
|
|
|
|
|
|
|
|













|

|
|
|
|
|
|
|
|
|
|
|

|
|


|







|





|
|
|
|
|
|


|





|

|



|

|



>

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
..
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
..
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
...
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
...
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
...
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
...
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
...
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477

# 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 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}
................................................................................

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
................................................................................

    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
................................................................................

    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
................................................................................
    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 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

This page was generated in about 0.046s by Fossil version [9aa9ba8bd2] 2018-09-22 17:40:11