1
#############################################################################
2
# ::Games => play games with aMSN. #
3
# ======================================================================== #
4
# Play games with aMSN. #
6
# Original author: JeeBee <jonne_z REM0VEatTH1S users.sourceforge.net> #
8
# - Thanks to Tjikkun for the many usefull tips about the protocol used #
9
# and for his time to discuss the plugin with me. #
10
# - Thanks to Scapor for testing with me, begin enthusiastic and having #
11
# such a long nickname I immediately knew I had to truncate this. #
12
# - Thanks to Billiob (and Tjikkun, who said just use 1500) for #
13
# determining the maximum packet size before the msn protocol fails #
14
# (Billiob determined it to be slightly more than 1660). I use 1500 #
15
# to be on the safe side (and I'm not counting exact). #
16
# - Thanks to Mary for testing with me, Spanish translation, #
17
# and sharing ideas to improve this plugin. #
18
# - Thanks to Youness for a very impressive ten minutes of testing #
19
# (Youness? You sure it was only 10 minutes???) #
20
# in which he suggested to use x-clientcaps, advertising when opponent #
21
# does not have the plugin and even tried playing with three players #
22
# in which he addressed some *multi*-player issues. #
23
# - Thanks to Jeroen for drawing the Hangman images. #
24
#############################################################################
26
# FIXME: Injecting code is not possible as I don't use eval/exec/file open etc on
27
# incoming data. However, how can I verify that messages are not duplicated (whether
28
# or not on purpose) or just that messages are sent that are valid but sended on
29
# purpose by malicious opponents or intruders that by some reason know the $gameID?
30
# E.g. it shouldn't be TOO easy to send a "PLAYER=me,SCORE=infinite" command.
31
# One way would be to implement a message counter that increments on both sides and
32
# must always be equal? Anyone reading this who thinks this is important?
34
# FIXME: In a conference, if 1 participant does not have the plugin loaded/installed,
35
# we do not get enough Pongs and do not send an invite. Should we set this to a minimum?
36
# Using x-clientcaps could solve this ...
38
#Youness: btw, JeeBee, how you know it's a user that supports it.. I (hoping the
39
#even exists) propose you send a message at user JOIN just like the
40
#x-clientcaps of type application/x-amsngames-init with games supportes,
41
#version info, etc.. just so you know whether the user has it or not, and
42
#which games /version he has... so you will always know (without need for
43
#timeout) if user supports it..
45
# FIXME: Use version checking to avoid starting games that don't exist
46
# and other games-plugin incompatibilities.
48
namespace eval ::Games {
49
# Where to obtain aMSN and the Games plugin?
50
variable amsn_url "http://amsn.sf.net"
51
variable games_url "http://sf.net/tracker/index.php?func=detail&aid=1414743&group_id=54091&atid=733148"
52
# games_url soon something like "http://amsn.sf.net/plugins.php#Games" or #games ?
55
variable TwoPlayerGames {"Dots_and_Boxes" "Hangman" "Chess"}
56
variable MultiPlayerGames {"Sketch"}
58
variable timeout_len 10000
59
variable max_nick_len 30
60
variable max_packet_size 1500
62
array set CurrentGames {}
63
array set OpenChallenges {}
64
# Game - "$gameID,game"
65
# GameInit - "$gameID,init"
66
# Opponent - "$gameID,chatid"
67
# Timeout - "$gameID,timeout"
69
###########################################################################
71
# ----------------------------------------------------------------------- #
72
# Registration & initialization of the plugin #
73
###########################################################################
75
variable TwoPlayerGames
76
variable MultiPlayerGames
80
if {[catch {::plugins::pluginVersion} version]} {
81
# Setting version number manually for aMSN 0.95
82
# Make sure this value matches the one used in plugininfo.xml
86
::plugins::RegisterPlugin "Games"
89
::plugins::RegisterEvent "Games" PacketReceived PacketReceived
90
::plugins::RegisterEvent "Games" chatmenu edit_menu
93
set langdir [file join $dir "lang"]
94
set lang [::config::getGlobalKey language]
96
load_lang $lang $langdir
99
foreach game [concat $TwoPlayerGames $MultiPlayerGames] {
100
if { [catch { source [file join $dir "$game.tcl"] } res] } {
101
msg_box "[trans load_game_failed] ($game.tcl):\n$res"
106
# Handle plugin configuration
107
::Games::config_array
108
::Games::configlist_values
110
log "Games plugin version $version loaded."
113
###########################################################################
115
# ----------------------------------------------------------------------- #
116
# Edit chat window menu #
117
###########################################################################
118
proc edit_menu { event evpar } {
119
upvar 2 $evpar newvar
120
set window_name $newvar(window_name)
121
set menu_name $newvar(menu_name)
124
menu ${menu_name}.gmenu -tearoff 0
125
menu ${menu_name}.gmenu.gmenu_two -tearoff 0
126
menu ${menu_name}.gmenu.gmenu_multi -tearoff 0
127
${menu_name} add cascade -label "[trans Games]" -menu ${menu_name}.gmenu
128
${menu_name}.gmenu add cascade -label "[trans TwoPlayerGames]" -menu ${menu_name}.gmenu.gmenu_two
129
${menu_name}.gmenu add cascade -label "[trans MultiPlayerGames]" -menu ${menu_name}.gmenu.gmenu_multi
130
# Add two-player games
131
foreach game $::Games::TwoPlayerGames {
132
${menu_name}.gmenu.gmenu_two add command -label "[trans $game]" \
133
-command "::Games::StartGame \[::ChatWindow::getCurrentTab $window_name\] $game p2"
135
# Add multi-player games
136
foreach game $::Games::MultiPlayerGames {
137
${menu_name}.gmenu.gmenu_multi add command -label "[trans $game]" \
138
-command "::Games::StartGame \[::ChatWindow::getCurrentTab $window_name\] $game pn"
140
# 0 or 1 disables TwoPlayerGames or MultiPlayerGames respectively
141
#${menu_name}.gmenu entryconfigure 1 -state disabled
144
###########################################################################
146
# ----------------------------------------------------------------------- #
147
# Because the individual games are not registered as plugins, they use #
148
# this namespace's language files and have to call proc trans via this #
149
# proc, so ::plugins::calledFrom knows it should use our language file. #
150
###########################################################################
151
proc trans { key args } {
152
# eval trans $key $args -->> DON'T USE THIS !!!
153
# (could be exploited by Tcl-code in a nickname!!!)
154
eval [linsert $args 0 ::trans $key]
157
###########################################################################
159
# ----------------------------------------------------------------------- #
160
# Some games want to have their own dictionaries and abuse language files #
161
# to achieve this. This function provides an easy wrapper to load a #
162
# language file (the issue here is the same als proc trans, see above). #
163
###########################################################################
164
proc load_lang {langKey langDir} {
165
::load_lang $langKey $langDir
168
###########################################################################
170
# ----------------------------------------------------------------------- #
171
# Start selected game #
172
###########################################################################
173
proc StartGame { windowtab game gametype } {
174
variable OpenChallenges
177
set chatid [::ChatWindow::Name $windowtab]
178
set gameID [GenerateGameID $chatid $gametype]
179
set user_list [::MSN::usersInChat $chatid]
181
if {[string first "p2" $gameID] == 0 && \
182
[string first "::MSN::SB" $chatid] == -1} {
184
set game_init [::Games::${game}::init_game $gameID \
185
[::config::getKey login] $chatid]
186
} elseif {[string first "pn" $gameID] == 0 && \
187
[string first "::MSN::SB" $chatid] > -1} {
189
set game_init [::Games::${game}::init_game $gameID [::config::getKey login]]
191
WrongGameType $chatid
195
if {"$game_init" != ""} {
196
# Set timers for Ping message to timeout_len milliseconds
198
foreach user $user_list {
199
lappend timeouts $user
200
lappend timeouts [after $timeout_len [list ::Games::pongReceived $gameID $user 0]]
203
# Add this Invite to OpenChallenges
204
array set OpenChallenges [list \
205
"$gameID,game" "$game" \
206
"$gameID,host" "[config::getKey login]" \
207
"$gameID,init" "$game_init" \
208
"$gameID,chatid" "$chatid" \
209
"$gameID,timeouts" "$timeouts" ]
211
# First thing to do is sent a Ping to see if your opponent has our
212
# Games plugin loaded as well.
213
send_via_queue $gameID "Ping"
217
###########################################################################
219
# ----------------------------------------------------------------------- #
220
# Opponent also has this (or compatible) plugin loaded. #
221
# Do a version check, warn if version differs, then continue #
222
# by sending our invitation #
223
###########################################################################
224
proc pongReceived { gameID sender success {oppVersion ""} } {
225
variable OpenChallenges
227
if {[info exists OpenChallenges($gameID,chatid)] && \
228
$OpenChallenges($gameID,host) == [config::getKey login]} {
230
# Turn off timer of sender
232
foreach {user timer} $OpenChallenges($gameID,timeouts) {
233
if {"$user" == "$sender"} {
235
set OpenChallenges($gameID,timeouts) \
236
[lreplace $OpenChallenges($gameID,timeouts) $i [expr {$i+1}]]
241
# If all timeouts are gone, all Pongs are received correctly
242
if {[llength $OpenChallenges($gameID,timeouts)] == 0} {
243
# Send the game invitation
244
send_via_queue $gameID "Invite" \
245
"$OpenChallenges($gameID,game),$OpenChallenges($gameID,init)"
246
::Games::InvitationSent $gameID
248
::Games::VersionConflict $gameID $sender $oppVersion
250
# Timout occured, apparantly sender doesn't have plugin loaded
251
::Games::PluginNotLoaded $gameID $sender $OpenChallenges($gameID,chatid)
253
# Remove from OpenChallenges
254
array unset OpenChallenges "$gameID,*"
259
###########################################################################
261
# ----------------------------------------------------------------------- #
262
# Send move to opponent #
263
###########################################################################
264
proc SendMove { gameID move } {
265
send_via_queue $gameID "Move" "$move"
268
###########################################################################
270
# ----------------------------------------------------------------------- #
271
# Inform opponent that we quit our game #
272
###########################################################################
273
proc SendQuit { gameID } {
274
send_via_queue $gameID "Quit"
277
###########################################################################
279
# ----------------------------------------------------------------------- #
280
# Plugin is unloaded #
281
###########################################################################
285
###########################################################################
287
# ----------------------------------------------------------------------- #
288
# Add a log message to plugins-log window #
289
# Type Alt-P to get that window #
290
###########################################################################
293
plugins_log Games $message
294
#puts "log: $message"
297
###########################################################################
299
# ----------------------------------------------------------------------- #
300
# Add config array with default values #
301
###########################################################################
302
proc config_array {} {
303
variable TwoPlayerGames
304
variable MultiPlayerGames
306
array set ::Games::config {}
307
foreach game [concat $TwoPlayerGames $MultiPlayerGames] {
308
set game_config [::Games::${game}::config_array]
309
foreach {key value} $game_config {
310
set ::Games::config($key) $value
315
###########################################################################
316
# ::configlist_values #
317
# ----------------------------------------------------------------------- #
318
# List of items for config window #
319
###########################################################################
320
proc configlist_values {} {
321
set ::Games::configlist \
322
[list [list frame ::Games::build_config_frame]]
325
# A tab for each individual game (that wants one)
326
proc build_config_frame { w } {
327
variable TwoPlayerGames
328
variable MultiPlayerGames
330
set nb [NoteBook $w.nb -side top]
333
foreach game [concat $TwoPlayerGames $MultiPlayerGames] {
334
$nb insert $p w$game -text [trans $game]
335
set pane [$w.nb getframe w$game]
336
if { [::Games::${game}::build_config $pane] == 1 } {
338
if {"$raised" == ""} {
342
# Oops, game did not want configuration items, remove pane
347
pack $nb -fill both -expand 1 -in $w
351
###########################################################################
353
# ----------------------------------------------------------------------- #
354
# Process incoming amsn-games packets #
355
###########################################################################
356
proc PacketReceived { event evpar } {
357
variable OpenChallenges
358
variable CurrentGames
361
upvar 2 $args(chatid) chatid
362
upvar 2 $args(msg) packet
363
# Find out who sended the message
364
if {[info exists evpar(typer)]} {
365
upvar 2 $args(typer) typer
370
# Check for the correct Content-type
371
set header "[$packet getHeader Content-Type]"
372
if {[string first "text/x-amsngames" $header] == -1} {
376
set oppVersion "[$packet getHeader VERSION]"
377
set gameID "[$packet getHeader GAMEID]"
378
set msgType "[encoding convertfrom utf-8 [$packet getHeader MSGTYPE]]"
379
set msgBody "[encoding convertfrom utf-8 [$packet getBody]]"
381
#log "Game command $msgType -> $msgBody"
383
if {[regexp {[a-zA-Z0-9 _,=@\.]*} $msgBody]} {
384
# Incoming message matches regular expression, continue processing
386
# FIXME: add a Withdraw message? But what do we do then in case
387
# our opponent accepts our challenge while the Withdraw message is
388
# under way? Idea: send a Withdraw message to remove the pending
389
# Invite and a Quit message right after that?
391
# FIXME: Unsupported msg not yet supported
393
switch -exact $msgType {
396
# If a ping is received, send a pong back to inform opponent that we
397
# indeed have this (or compatible) plugin loaded
399
array set OpenChallenges [list \
400
"$gameID,chatid" $chatid \
401
"$gameID,host" $typer ]
403
send_via_queue $gameID "Pong"
407
# Opponent sent a Pong, he has our (or compatible) plugin loaded.
408
pongReceived $gameID $typer 1 $oppVersion
411
# Invite(Game,GameInit)
412
set idx [string first "," $msgBody]
413
if { $idx == -1 } { return }
414
set game [string range $msgBody 0 [expr {$idx-1}]]
415
set game_init [string range $msgBody [expr {$idx+1}] end]
417
# Add this Invite to OpenChallenges
418
array set OpenChallenges [list \
419
"$gameID,game" "$game" \
420
"$gameID,init" "$game_init" \
421
"$gameID,chatid" "$chatid" \
422
"$gameID,host" "$typer" ]
424
AcceptOrRefuse $gameID $oppVersion
427
# Accept(Game,GameInit)
428
set idx [string first "," $msgBody]
429
if { $idx == -1 } { return }
430
set game [string range $msgBody 0 [expr {$idx-1}]]
431
set game_init [string range $msgBody [expr {$idx+1}] end]
432
::Games::InvitationResponse $gameID $typer 1 $game_init
435
# Decline(Game,GameInit)
436
::Games::InvitationResponse $gameID $typer 0
440
if {[info exists CurrentGames($gameID,chatid)]} {
441
set game $CurrentGames($gameID,game)
442
::Games::${game}::opponent_moves $gameID $typer $msgBody
444
log "Move $msgBody received for a non-existing game $gameID"
449
if {[info exists CurrentGames($gameID,chatid)]} {
450
set game $CurrentGames($gameID,game)
451
::Games::${game}::opponent_quits $gameID $typer
453
log "Quit message received for a non-existing game $gameID"
457
log "Unknown command: $msgType"
461
log "Message body does not match our regular expression: $msgBody"
465
proc InvitationSent { gameID } {
466
variable OpenChallenges
469
if {![info exists OpenChallenges($gameID,chatid)]} {
470
log "InvitationSent called with unknown gameID $gameID"
472
set chatid $OpenChallenges($gameID,chatid)
473
set game $OpenChallenges($gameID,game)
474
set game_init $OpenChallenges($gameID,init)
476
::amsn::WinWrite $chatid "\n" green
477
::amsn::WinWriteIcon $chatid greyline 3
478
::amsn::WinWrite $chatid "\n" green
479
::amsn::WinWriteIcon $chatid butinvite 3 2
480
::amsn::WinWrite $chatid "[timestamp] [trans invite_sent] " green
481
::amsn::WinWrite $chatid "[trans $game] " red
482
::amsn::WinWrite $chatid "(${game_init})\n" green
483
::amsn::WinWriteIcon $chatid greyline 3
487
proc VersionConflict { gameID opponent oppVersion } {
488
variable OpenChallenges
491
if {![info exists OpenChallenges($gameID,chatid)]} {
492
log "VersionConflict called with unknown gameID $gameID"
494
set chatid $OpenChallenges($gameID,chatid)
496
if {$version != $oppVersion} {
497
::amsn::WinWrite $chatid \
498
"[trans incompatible_version $version $opponent $oppVersion]\n" red
503
proc WrongGameType {chatid} {
504
::amsn::WinWrite $chatid "\n[trans wrong_game_type]\n" red
507
# Accept or Decline message received
508
proc InvitationResponse { gameID sender response { game_init "" } } {
509
variable OpenChallenges
510
variable CurrentGames
512
if {![info exists OpenChallenges($gameID,chatid)]} {
513
log "InvitationResponse called with unknown gameID $gameID"
515
set chatid $OpenChallenges($gameID,chatid)
516
set game $OpenChallenges($gameID,game)
517
set started [info exists CurrentGames($gameID,chatid)]
519
::amsn::WinWrite $chatid "\n" green
520
::amsn::WinWriteIcon $chatid greyline 3
521
::amsn::WinWrite $chatid "\n" green
522
::amsn::WinWriteIcon $chatid butinvite 3 2
523
if {$response == 1} {
524
# chatid accepted the invitation
525
::amsn::WinWrite $chatid "[timestamp] [trans accepted_invitation [getNick $sender]] " green
526
::amsn::WinWrite $chatid "[trans $game] " red
527
::amsn::WinWrite $chatid "(${game_init})\n" green
528
if {$OpenChallenges($gameID,host) == [::config::getKey login]} {
530
# Add game to CurrentGames
531
array set CurrentGames [list \
532
"$gameID,game" "$game" \
533
"$gameID,init" "$game_init" \
534
"$gameID,chatid" "$chatid" ]
536
if {[string first "p2" $gameID] == 0} {
538
array unset OpenChallenges "$gameID,*"
539
# Process opponent's init string
540
::Games::${game}::set_init_game $gameID $game_init \
541
[::config::getKey login] $chatid
542
::Games::${game}::start_game $gameID
543
} elseif {!$started} {
544
# Multi-player game (this is our first Accept)
545
::Games::${game}::start_game $gameID
546
::Games::${game}::add_player $gameID [::config::getKey login]
547
::Games::${game}::add_player $gameID $sender
549
# Multi-player game (already started)
550
::Games::${game}::add_player $gameID $sender
553
# We are not the host of the game
554
if {[string first "pn" $gameID] == 0} {
555
::Games::${game}::add_player $gameID $sender
559
# chatid declined the invitation
560
::amsn::WinWrite $chatid "[timestamp] [trans declined_invitation [getNick $sender]] " green
561
::amsn::WinWrite $chatid "[trans $game] " red
562
::amsn::WinWrite $chatid "($OpenChallenges($gameID,init))\n" green
564
::amsn::WinWriteIcon $chatid greyline 3
568
proc AcceptOrRefuse { gameID oppVersion } {
569
variable OpenChallenges
571
if {![info exists OpenChallenges($gameID,chatid)]} {
572
log "AcceptOrRefuse called with unknown gameID $gameID"
574
set chatid $OpenChallenges($gameID,chatid)
575
set host $OpenChallenges($gameID,host)
576
set game $OpenChallenges($gameID,game)
577
set game_init $OpenChallenges($gameID,init)
579
# Check whether we have our conversation window open for WinWrites
580
set win_name [::ChatWindow::For $chatid]
581
if { [::ChatWindow::For $chatid] == 0 || ![winfo exists $win_name]} {
582
set win_name [::ChatWindow::MakeFor $chatid]
585
::MSN::ChatQueue $chatid \
586
[list ::Games::AcceptOrRefuse_wrapped $gameID $chatid $host $game $game_init $oppVersion]
590
proc AcceptOrRefuse_wrapped { gameID chatid host game game_init oppVersion } {
594
::amsn::WinWrite $chatid "\n" green
595
::amsn::WinWriteIcon $chatid greyline 3
596
::amsn::WinWrite $chatid "\n" green
598
::amsn::WinWriteIcon $chatid butinvite 3 2
600
::amsn::WinWrite $chatid "[trans wants_to_play [getNick $host]] " green
601
::amsn::WinWrite $chatid "[trans $game] " red
602
::amsn::WinWrite $chatid "(${game_init})" green
604
# Accept and refuse actions
605
::amsn::WinWrite $chatid " - (" green
606
::amsn::WinWriteClickable $chatid "[trans Accept]" \
607
[list ::Games::InvitationAnswered $gameID $host 1] \
609
::amsn::WinWrite $chatid " / " green
610
::amsn::WinWriteClickable $chatid "[trans Reject]" \
611
[list ::Games::InvitationAnswered $gameID $host 0] \
613
::amsn::WinWrite $chatid ")\n" green
616
::amsn::WinWriteIcon $chatid greyline 3
618
if {$version != $oppVersion} {
619
::amsn::WinWrite $chatid \
620
"\n[trans incompatible_version $version $host $oppVersion]\n" red
624
proc PluginNotLoaded { gameID sender chatid } {
630
::amsn::WinWrite $chatid "\n" green
631
::amsn::WinWriteIcon $chatid greyline 3
632
::amsn::WinWrite $chatid "\n" green
634
::amsn::WinWriteIcon $chatid butinvite 3 2
636
::amsn::WinWrite $chatid "[trans missing_plugin [getNick $sender]] " green
637
::amsn::WinWrite $chatid "([trans timeout [expr {$timeout_len/1000}]])." green
640
::amsn::WinWriteIcon $chatid greyline 3
642
# Send aMSN/Games plugin advertisement
643
::MSN::messageTo $chatid \
644
"[trans advertise [getNick [::config::getKey login]] [getNick $sender] $amsn_url $games_url]" 0 ""
647
proc InvitationAnswered { gameID host answer } {
648
variable OpenChallenges
649
variable CurrentGames
651
if {![info exists OpenChallenges($gameID,chatid)]} {
652
log "InvitationAnswered called with unknown gameID $gameID"
654
set chatid $OpenChallenges($gameID,chatid)
655
set game $OpenChallenges($gameID,game)
656
set game_init $OpenChallenges($gameID,init)
658
# Get the chatwindow name
659
set win_name [::ChatWindow::For $chatid]
660
if { [::ChatWindow::For $chatid] == 0} {
664
# Disable items in the chatwindow
665
[::ChatWindow::GetOutText ${win_name}] tag configure "acceptgame$gameID" \
666
-foreground #808080 -font bplainf -underline false
667
[::ChatWindow::GetOutText ${win_name}] tag bind "acceptgame$gameID" <Enter> ""
668
[::ChatWindow::GetOutText ${win_name}] tag bind "acceptgame$gameID" <Leave> ""
669
[::ChatWindow::GetOutText ${win_name}] tag bind "acceptgame$gameID" <Button1-ButtonRelease> ""
671
[::ChatWindow::GetOutText ${win_name}] tag configure "rejectgame$gameID" \
672
-foreground #808080 -font bplainf -underline false
673
[::ChatWindow::GetOutText ${win_name}] tag bind "rejectgame$gameID" <Enter> ""
674
[::ChatWindow::GetOutText ${win_name}] tag bind "rejectgame$gameID" <Leave> ""
675
[::ChatWindow::GetOutText ${win_name}] tag bind "rejectgame$gameID" <Button1-ButtonRelease> ""
677
[::ChatWindow::GetOutText ${win_name}] conf -cursor left_ptr
680
# Add game to CurrentGames
681
array set CurrentGames [list \
682
"$gameID,game" "$game" \
683
"$gameID,host" "$host" \
684
"$gameID,init" "$game_init" \
685
"$gameID,chatid" "$chatid" ]
686
if {[string first "p2" $gameID] == 0} {
687
# Remove from OpenChallenges
688
array unset OpenChallenges "$gameID,*"
690
set game_init [::Games::${game}::set_init_game \
691
$gameID $game_init [::config::getKey login] $chatid]
694
::Games::${game}::set_init_game $gameID $host $game_init
695
::Games::${game}::add_player $gameID [::config::getKey login]
696
::Games::${game}::add_player $gameID $host
698
# Invitation accepted
699
send_via_queue $gameID "Accept" "${game},${game_init}"
700
::Games::${game}::start_game $gameID
702
# Invitation rejected
703
send_via_queue $gameID "Decline" "${game},${game_init}"
708
proc getNick { chatid } {
709
variable max_nick_len
711
if {$chatid == [::config::getKey login]} {
712
set nick [::abook::getPersonal MFN]
714
set nick [::abook::getDisplayNick $chatid]
717
# Now truncate nick so it is no longer than max_nick_len
718
if {[expr {[string length $nick] > $max_nick_len}]} {
719
set nick [string range $nick 0 [expr {$max_nick_len - 3}]]
726
###########################################################################
728
# ----------------------------------------------------------------------- #
729
# Send a message to the opponent #
730
###########################################################################
731
proc send_via_queue { gameID msgType {msgBody ""} } {
732
variable OpenChallenges
733
variable CurrentGames
735
if {[info exists CurrentGames($gameID,chatid)]} {
736
set chatid $CurrentGames($gameID,chatid)
737
} elseif {[info exists OpenChallenges($gameID,chatid)]} {
738
set chatid $OpenChallenges($gameID,chatid)
740
log "send_via_queue called with non-existing gameID $gameID"
743
::MSN::ChatQueue $chatid \
744
[list ::Games::send_packet $chatid $gameID $msgType $msgBody]
747
###########################################################################
749
# ----------------------------------------------------------------------- #
750
# Here we send a packet to our opponent(s). Also, we make sure here that #
751
# packets do not exceed the maximum length. For some types of messages #
752
# we split the message to multiple messages. #
753
###########################################################################
754
proc send_packet { chatid gameID msgType msgBody } {
756
variable max_packet_size
757
set sbn [::MSN::SBFor $chatid]
764
if {[string length $msgBody] < $max_packet_size} {
768
# Try to split the packet up in smaller ones
769
set coords_idx [string last "COORDS=" $msgBody]
770
if {$coords_idx > -1} {
771
# Rest of this message is space separated x y coordinates
772
set msg [string range $msgBody 0 [expr {$coords_idx + 6}]]
773
set coords [string range $msgBody [expr {$coords_idx + 7}] end]
776
foreach {x y} $coords {
777
if {$state == 0 && [string length $msg] < $max_packet_size} {
778
# We can still send more
779
set msg "${msg}${x} ${y} "
780
set last_x $x ; set last_y $y
785
# Duplicate last coordinate
786
set msgBody "${msgBody}${last_x} ${last_y} "
788
set msgBody "${msgBody}${x} ${y} "
792
log "Packet (size [string length $msgBody]) to large to send and I do not know \
793
how to split it up, packet type is $msgType."
798
set packet "MIME-Version: 1.0\r\n"
799
set packet "${packet}Content-Type: text/x-amsngames; charset=utf-8\r\n"
800
set packet "${packet}VERSION: $version\r\n"
801
set packet "${packet}GAMEID: $gameID\r\n"
802
set packet "${packet}MSGTYPE: [encoding convertto utf-8 $msgType]\r\n\r\n"
803
set packet "${packet}[encoding convertto utf-8 $msg]"
804
set packet_len [string length $packet]
806
::MSN::WriteSBNoNL $sbn "MSG" "U $packet_len\r\n$packet"
807
#log "Sending (size $packet_len): $packet"
811
###########################################################################
813
# ----------------------------------------------------------------------- #
814
# Generate a world-wide unique gameID #
815
###########################################################################
816
proc GenerateGameID { chatid gametype } {
817
# FIXME: I'm afraid this is tcl 8.4 specific
818
set gameID "$gametype$chatid[clock clicks -milliseconds]"
822
proc myRand {min max} {
823
return [expr {int($min + rand() * (1+$max-$min))}]
826
# Here's my resize-less version of aMSN's moveinscreen.
827
# I need this because the original version's resizing seems to
828
# interfere with "pack forget" and repack statements I want to use.
829
proc moveinscreen {window {mindist 0}} {
831
# Check whether window exists
832
if {![winfo exists $window]} {
835
set winx [winfo width $window]
836
set winy [winfo height $window]
837
set scrx [winfo screenwidth .]
838
set scry [winfo screenheight .]
839
set winpx [winfo x $window]
840
set winpy [winfo y $window]
842
# Check if the window is too large to fit on the screen
843
if { [expr {$winx > ($scrx-(2*$mindist))}] } {
844
set winx [expr {$scrx-(2*$mindist)}]
846
if { [expr {$winy > ($scry-(2*$mindist))}] } {
847
set winy [expr {$scry-(2*$mindist)}]
850
# Check if the window is positioned off the screen
851
if { [expr {$winpx + $winx > ($scrx-$mindist)}] } {
852
set winpx [expr {$scrx-$mindist-$winx}]
854
if { [expr {$winpx < $mindist}] } {
857
if { [expr {$winpy + $winy > ($scry-$mindist)}] } {
858
set winpy [expr {$scry-$mindist-$winy}]
860
if { [expr {$winpy < $mindist}] } {
864
wm geometry $window "+${winpx}+${winpy}"
added
removed
plugins/games/Games.tcl
