[Tkabber-dev] r2133 - in trunk/tkabber-plugins: . battleship battleship/msgs battleship/pixmaps battleship/pixmaps/copybook

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Fri Feb 7 11:11:37 MSK 2014


Author: sergei
Date: 2014-02-07 11:11:37 +0400 (Fri, 07 Feb 2014)
New Revision: 2133

Added:
   trunk/tkabber-plugins/battleship/
   trunk/tkabber-plugins/battleship/battleship.tcl
   trunk/tkabber-plugins/battleship/msgs/
   trunk/tkabber-plugins/battleship/msgs/ru.msg
   trunk/tkabber-plugins/battleship/pixmaps/
   trunk/tkabber-plugins/battleship/pixmaps/copybook/
   trunk/tkabber-plugins/battleship/pixmaps/copybook/battleship-h.gif
   trunk/tkabber-plugins/battleship/pixmaps/copybook/battleship-v.gif
   trunk/tkabber-plugins/battleship/pixmaps/copybook/carrier-h.gif
   trunk/tkabber-plugins/battleship/pixmaps/copybook/carrier-v.gif
   trunk/tkabber-plugins/battleship/pixmaps/copybook/cruiser-h.gif
   trunk/tkabber-plugins/battleship/pixmaps/copybook/cruiser-v.gif
   trunk/tkabber-plugins/battleship/pixmaps/copybook/destroyer-h.gif
   trunk/tkabber-plugins/battleship/pixmaps/copybook/destroyer-v.gif
   trunk/tkabber-plugins/battleship/pixmaps/copybook/field-shaded.gif
   trunk/tkabber-plugins/battleship/pixmaps/copybook/field.gif
   trunk/tkabber-plugins/battleship/pixmaps/copybook/hit.gif
   trunk/tkabber-plugins/battleship/pixmaps/copybook/icondef.xml
   trunk/tkabber-plugins/battleship/pixmaps/copybook/miss.gif
   trunk/tkabber-plugins/battleship/pixmaps/copybook/submarine-h.gif
   trunk/tkabber-plugins/battleship/pixmaps/copybook/submarine-v.gif
   trunk/tkabber-plugins/battleship/proto
Modified:
   trunk/tkabber-plugins/ChangeLog
   trunk/tkabber-plugins/Makefile
   trunk/tkabber-plugins/README
Log:
	* battleship/*, Makefile, README: Added a new battleship game plugin.


Modified: trunk/tkabber-plugins/ChangeLog
===================================================================
--- trunk/tkabber-plugins/ChangeLog	2014-02-02 18:58:58 UTC (rev 2132)
+++ trunk/tkabber-plugins/ChangeLog	2014-02-07 07:11:37 UTC (rev 2133)
@@ -1,3 +1,7 @@
+2014-02-07  Sergei Golovan <sgolovan at nes.ru>
+
+	* battleship/*, Makefile, README: Added a new battleship game plugin.
+
 2014-02-02  Sergei Golovan <sgolovan at nes.ru>
 
 	* otr/key.tcl, otr/tclotr/key.tcl: Moved key generation procedure to

Modified: trunk/tkabber-plugins/Makefile
===================================================================
--- trunk/tkabber-plugins/Makefile	2014-02-02 18:58:58 UTC (rev 2132)
+++ trunk/tkabber-plugins/Makefile	2014-02-07 07:11:37 UTC (rev 2133)
@@ -6,6 +6,7 @@
 
 SUBDIRS = aniemoticons    \
 	  attline         \
+	  battleship      \
 	  bc              \
 	  browser         \
 	  checkers        \

Modified: trunk/tkabber-plugins/README
===================================================================
--- trunk/tkabber-plugins/README	2014-02-02 18:58:58 UTC (rev 2132)
+++ trunk/tkabber-plugins/README	2014-02-07 07:11:37 UTC (rev 2133)
@@ -19,6 +19,13 @@
     message in a chat window where the window has lost keyboard focus. All
     messages after the line are unread messages.
 
+battleship
+    A paper & pencil board game of battleship where players try to sink
+    the opponent's ships. When installed, you can send an invitation
+    to your contact (contextual menu on the roster). If the other player
+    has also Tkabber and the plugin installed, he will recieve the
+    invitation. If he accepts, a window will open on both.
+
 bc
     A word game. Inludes a russian file.
 

Added: trunk/tkabber-plugins/battleship/battleship.tcl
===================================================================
--- trunk/tkabber-plugins/battleship/battleship.tcl	                        (rev 0)
+++ trunk/tkabber-plugins/battleship/battleship.tcl	2014-02-07 07:11:37 UTC (rev 2133)
@@ -0,0 +1,2122 @@
+# $Id$
+
+package require msgcat
+
+namespace eval battleship {
+    ::msgcat::mcload [file join [file dirname [info script]] msgs]
+
+    if {![::plugins::is_registered battleship]} {
+	::plugins::register battleship \
+			    -namespace [namespace current] \
+			    -source [info script] \
+			    -description [::msgcat::mc "Whether the Battleship plugin is loaded."] \
+			    -loadcommand [namespace code load] \
+			    -unloadcommand [namespace code unload]
+	return
+    }
+
+    package require sha1
+
+    variable square_size 27
+    variable line_width 1
+
+    variable board_size 10
+
+    variable ships \
+	{carrier 1 battleship 1 destroyer 1 cruiser 2 submarine 2}
+
+    variable sizes \
+	{carrier 5 battleship 4 destroyer 3 cruiser 2 submarine 1}
+
+    variable themes
+    set dirs \
+	[glob -nocomplain -directory [file join [file dirname [info script]] \
+						pixmaps] *]
+    foreach dir $dirs {
+	pixmaps::load_theme_name [namespace current]::themes $dir
+    }
+    set values {}
+    foreach theme [lsort [array names themes]] {
+	lappend values $theme $theme
+    }
+
+    custom::defgroup Plugins [::msgcat::mc "Plugins options."] -group Tkabber
+
+    custom::defgroup Battleship [::msgcat::mc "Battleship plugin options."] \
+	-group Plugins
+
+    custom::defvar options(theme) Copybook \
+	[::msgcat::mc "Battleship pixmaps theme."] \
+	-group Battleship \
+	-type options \
+	-values $values \
+	-command [namespace code load_stored_theme]
+    custom::defvar options(show_last_move) 0 \
+	[::msgcat::mc "Show last move by default."] \
+	-type boolean -group Battleship
+    custom::defvar options(show_tooltips) 1 \
+	[::msgcat::mc "Show tooltips with short instructions."] \
+	-type boolean -group Battleship \
+	-command [namespace code set_tooltips]
+}
+
+proc battleship::load {} {
+    hook::add postload_hook [namespace current]::load_stored_theme 70
+
+    hook::add roster_create_groupchat_user_menu_hook \
+              [namespace current]::add_groupchat_user_menu_item 48.5
+    hook::add chat_create_user_menu_hook \
+              [namespace current]::add_groupchat_user_menu_item 48.5
+    hook::add roster_jid_popup_menu_hook \
+              [namespace current]::add_groupchat_user_menu_item 48.5
+
+    hook::add games_board_create_hook [namespace current]::iq_create
+    hook::add games_board_init_hook [namespace current]::iq_init
+    hook::add games_board_turn_hook [namespace current]::iq_turn
+
+    ::xmpp::iq::register set create games:board \
+			 [namespace parent]::iq_games_board_create
+    ::xmpp::iq::register set board games:board \
+			 [namespace parent]::iq_games_board_init
+    ::xmpp::iq::register set turn games:board \
+			 [namespace parent]::iq_games_board_turn
+
+    load_stored_theme
+}
+
+proc battleship::unload {} {
+    hook::remove postload_hook [namespace current]::load_stored_theme 70
+
+    hook::remove finload_hook [namespace current]::calc_moves 100
+
+    hook::remove roster_create_groupchat_user_menu_hook \
+              [namespace current]::add_groupchat_user_menu_item 48.5
+    hook::remove chat_create_user_menu_hook \
+              [namespace current]::add_groupchat_user_menu_item 48.5
+    hook::remove roster_jid_popup_menu_hook \
+              [namespace current]::add_groupchat_user_menu_item 48.5
+
+    hook::remove games_board_create_hook [namespace current]::iq_create
+    hook::remove games_board_turn_hook [namespace current]::iq_turn
+
+    if {[hook::is_empty games_board_create_hook]} {
+        ::xmpp::iq::unregister set create games:board
+        rename [namespace parent]::iq_games_board_create ""
+    }
+
+    if {[hook::is_empty games_board_init_hook]} {
+        ::xmpp::iq::unregister set board games:board
+        rename [namespace parent]::iq_games_board_init ""
+    }
+
+    if {[hook::is_empty games_board_turn_hook]} {
+        ::xmpp::iq::unregister set turn games:board
+        rename [namespace parent]::iq_games_board_turn ""
+    }
+
+    foreach var [info vars [namespace current]::*] {
+        upvar #0 $var flags
+        if {[info exists flags(window)]} {
+            destroy_win $flags(window)
+        }
+    }
+
+    foreach var [info vars [namespace current]::*] {
+        if {$var ne "[namespace current]::options"} {
+            unset $var
+        }
+    }
+
+    foreach img [image names] {
+        if {[string first battleship/ $img] == 0} {
+            image delete $img
+        }
+    }
+}
+
+proc battleship::load_stored_theme {args} {
+    variable options
+    variable themes
+
+    pixmaps::load_dir $themes($options(theme))
+}
+
+proc battleship::invite_dialog {xlib jid} {
+    set w .battleship_invite
+
+    if {[winfo exists $w]} {
+	destroy $w
+    }
+
+    Dialog $w -title [::msgcat::mc "Battleship Invitation"] \
+	-separator 1 -anchor e -default 0
+
+    set wf [$w getframe]
+    message $wf.message -aspect 50000 \
+	    -text [::msgcat::mc "Sending Battleship game invitation to %s (%s)" \
+				[chat::get_nick $xlib $jid chat] \
+				$jid]
+    pack $wf.message -pady 2m
+
+    $w add -text [::msgcat::mc "I want to move first"] \
+	-command [namespace code [list invite $xlib $jid true]]
+    $w add -text [::msgcat::mc "I want to move second"] \
+	-command [namespace code [list invite $xlib $jid false]]
+    $w add -text [::msgcat::mc "Cancel invitation"] \
+	-command [list destroy $w]
+
+    $w draw
+}
+
+proc battleship::invite {xlib jid first} {
+    destroy .battleship_invite
+
+    set id battleship[random 1000000000]
+
+    # FIX
+    #set rjid [get_jid_of_user $jid]
+
+    ::xmpp::sendIQ $xlib set \
+	-query [::xmpp::xml::create create \
+			-xmlns games:board \
+			-attrs [list type battleship \
+				     id $id \
+				     first $first]] \
+	-to $jid \
+	-command [namespace code [list invite_res $xlib $jid $id $first]]
+}
+
+proc battleship::invite_res {xlib jid id first status xml} {
+    if {![string equal $status ok]} {
+	after idle [list NonmodalMessageDlg .battleship_invite_error -aspect 50000 -icon error \
+	    -message [::msgcat::mc "%s (%s) has refused Battleship invitation: %s" \
+				   [chat::get_nick $xlib $jid chat] \
+				   $jid [error_to_string $xml]]]
+	return ""
+    }
+
+    start_play $xlib $jid $id $first
+}
+
+proc battleship::invited_dialog {xlib jid iqid id first} {
+    set w .battleship_invited
+
+    if {[winfo exists $w]} {
+	destroy $w
+    }
+
+    Dialog $w -title [::msgcat::mc "Battleship Invitation from %s" $jid] \
+	      -modal none -separator 1 -anchor e -default 0
+
+    set wf [$w getframe]
+    bind $wf <Destroy> [namespace code [list invited_res $w $xlib $jid $iqid $id $first 0]]
+
+    set nick [chat::get_nick $xlib $jid chat]
+    set message1 [::msgcat::mc "Battleship game invitation from %s (%s) is received." \
+			       $nick $jid]
+    switch -- $first {
+	true -
+	1 {
+	    set message2 [::msgcat::mc "%s wants to move first." $nick]
+	}
+	false -
+	0 {
+	    set message2 [::msgcat::mc "%s wants to move second." $nick]
+	}
+	default {
+	    return [list error modify bad-request]
+	}
+    }
+    message $wf.message1 -aspect 50000 -text $message1
+    message $wf.message2 -aspect 50000 -text $message2
+    pack $wf.message1 -pady 1m
+    pack $wf.message2 -pady 1m
+    
+    $w add -text [::msgcat::mc "Agree to play"] \
+	   -command [namespace code [list invited_res $w $xlib $jid $iqid $id $first 1]]
+    $w add -text [::msgcat::mc "Refuse to play"] \
+	   -command [namespace code [list invited_res $w $xlib $jid $iqid $id $first 0]]
+
+    $w draw
+    return
+}
+
+proc battleship::invited_res {w xlib jid iqid id first result} {
+    catch {
+	set wf [$w getframe]
+	bind $wf <Destroy> {}
+	destroy $w
+    }
+
+    if {$result} {
+	switch -- $first {
+	    true -
+	    1 {
+		start_play $xlib $jid $id false
+	    }
+	    false -
+	    0 {
+		start_play $xlib $jid $id true
+	    }
+	    default {
+		::xmpp::sendIQ $xlib error \
+			       -error [::xmpp::stanzaerror::error \
+						modify bad-request] \
+			       -to $jid \
+			       -id $iqid
+	    }
+	}
+
+        ::xmpp::sendIQ $xlib result \
+                       -query [::xmpp::xml::create create \
+					-xmlns games:board \
+					-attrs [list type battleship \
+						     id $id]] \
+                       -to $jid \
+                       -id $iqid
+    } else {
+	::xmpp::sendIQ $xlib error \
+		       -error [::xmpp::stanzaerror::error \
+					modify not-acceptable] \
+		       -to $jid \
+		       -id $iqid
+    }
+    return
+}
+
+proc battleship::start_play {xlib jid id first} {
+    set gid [make_gid $jid $id]
+    variable $gid
+    upvar 0 $gid state
+
+    set state(window) [win_id battleship $gid]
+    set state(xlib) $xlib
+    set state(opponent) $jid
+    set state(id) $id
+    set state(move_first) $first
+
+    trace variable [namespace current]::${gid}(position,turn) w \
+		   [namespace code [list set_label_move $gid]]
+
+    open_win $gid
+}
+
+proc battleship::set_label_move {gid args} {
+    variable $gid
+    upvar 0 $gid state
+
+    switch -- $state(position,turn) {
+	first -
+	second {
+	    set move 1
+	}
+	default {
+	    set move 0
+	}
+    }
+    if {$move && [is_my_move $gid]} {
+	if {$state(board_is_sent) && $state(board_is_received)} {
+	    set state(move_label) [::msgcat::mc "You"]
+	} else {
+	    set state(move_label) [::msgcat::mc "You (after all parties freeze boards)"]
+	}
+    } else {
+	if {$state(board_is_sent) && $state(board_is_received)} {
+	    set state(move_label) [::msgcat::mc "Opponent"]
+	} else {
+	    set state(move_label) [::msgcat::mc "Opponent (after all parties freeze boards)"]
+	}
+    }
+}
+
+proc battleship::save_position {gid} {
+    variable $gid
+    upvar 0 $gid state
+
+    set state(saved_position) [array get state position,*]
+}
+
+proc battleship::restore_position {gid} {
+    variable $gid
+    upvar 0 $gid state
+
+    array set state $state(saved_position)
+    draw_position $gid
+    update_controls $gid
+    find_reasonable_moves $gid $state(position,turn)
+}
+
+proc battleship::make_gid {jid id} {
+    jid_to_tag [concat $jid $id]
+}
+
+proc battleship::board_recv {gid xmlElements} {
+    variable board_size
+    variable options
+    variable $gid
+    upvar 0 $gid state
+
+    if {[llength [array names state hash,*]] == 0} {
+	# Receiving hashes
+
+	set numhashes 0
+	set state(shiphashes) {}
+
+	foreach element $xmlElements {
+	    ::xmpp::xml::split $element tag xmlns attrs cdata subels
+	    switch -- $tag {
+		cell {
+		    set c [::xmpp::xml::getAttr $attrs col]
+		    set r [::xmpp::xml::getAttr $attrs row]
+		    set hash [::xmpp::xml::getAttr $attrs hash]
+
+		    if {![string is integer -strict $c] || \
+			    $c < 0 || $c >= $board_size} {
+			return [list error modify bad-request]
+		    }
+		    if {![string is integer -strict $r] || \
+			    $r < 0 || $r >= $board_size} {
+			return [list error modify bad-request]
+		    }
+		    if {$hash != "" && ![info exists state(hash,$c,$r)]} {
+			set state(hash,$c,$r) $hash
+			incr numhashes
+		    } else {
+			return [list error modify bad-request]
+		    }
+		}
+		ship {
+		    lappend state(shiphashes) [::xmpp::xml::getAttr $attrs hash]
+		}
+	    }
+	}
+
+	if {$numhashes == [expr {$board_size * $board_size}]} {
+	    set state(board_is_received) 1
+	    set_label_move $gid
+	    update_controls $gid
+	    find_reasonable_moves $gid $state(position,turn)
+
+	    return [list result {}]
+	} else {
+	    array unset state hash,*
+	    array unset state shiphashes
+
+	    return [list error modify bad-request]
+	}
+    } else {
+	# Checking hashes
+
+	set numhashes 0
+	set cells {}
+
+	foreach element $xmlElements {
+	    ::xmpp::xml::split $element tag xmlns attrs cdata subels
+	    switch -- $tag {
+		cell {
+		    set c [::xmpp::xml::getAttr $attrs col] 
+		    if {![string is integer -strict $c] || \
+			    $c < 0 || $c >= $board_size} {
+			attention_message $gid \
+				[::msgcat::mc "\n\n Opponent sent incorrect cell column"]
+			return [list error modify bad-request]
+		    }
+
+		    set r [::xmpp::xml::getAttr $attrs row]
+		    if {![string is integer -strict $r] || \
+			    $r < 0 || $r >= $board_size} {
+			attention_message $gid \
+				[::msgcat::mc "\n\n Opponent sent incorrect cell row"]
+			return [list error modify bad-request]
+		    }
+
+		    set seed [::xmpp::xml::getAttr $attrs seed]
+		    if {[::xmpp::xml::getAttr $attrs ship]} {
+			set ship 1
+		    } else {
+			set ship 0
+		    }
+
+		    if {![string equal [sha1::sha1 $seed$ship] $state(hash,$c,$r)]} {
+			attention_message $gid \
+				[::msgcat::mc "\n\n Opponent sent incorrect cell seed"]
+			return [list error modify bad-request]
+		    }
+
+		    lappend cells [list $c $r]
+		    set board($c,$r) $ship
+		    incr numhashes
+		}
+	    }
+	}
+
+	if {$numhashes != $board_size*$board_size ||
+		[llength [lsort -unique $cells]] != $board_size*$board_size} {
+	    attention_message $gid \
+		    [::msgcat::mc "\n\n Opponent sent incorrect number of cells"]
+	    return [list error modify bad-request]
+	}
+
+	if {![test_legal [array get board]]} {
+	    attention_message $gid \
+		    [::msgcat::mc "\n\n Opponent sent illegal board"]
+	    return [list error modify bad-request]
+	}
+
+	return [list result {}]
+    }
+}
+
+proc battleship::test_legal {boardlist} {
+    variable board_size
+    variable ships
+    variable sizes
+
+    array set board $boardlist
+    foreach c [list -1 $board_size] {
+	for {set r -1} {$r <= $board_size} {incr r} {
+	    set board($c,$r) 0
+	    set board($r,$c) 0
+	}
+    }
+    
+    array set size $sizes
+
+    foreach {name number} $ships {
+	for {set i 1} {$i <= $number} {incr i} {
+	    lassign [find_ship board $size($name)] status c1 r1 c2 r2
+
+	    if {!$status} {
+		return 0
+	    }
+
+	    for {set c $c1} {$c <= $c2} {incr c} {
+		for {set r $r1} {$r <= $r2} {incr r} {
+		    set board($c,$r) 0
+		}
+	    }
+	    for {set c [expr {$c1-1}]} {$c <= $c2+1} {incr c} {
+		for {set r [expr {$r1-1}]} {$r <= $r2+1} {incr r} {
+		    if {$board($c,$r) == 1} {
+			return 0
+		    }
+		}
+	    }
+	}
+    }
+    return 1
+}
+
+proc battleship::find_ship {vboard size} {
+    variable board_size
+    upvar $vboard board
+
+    for {set c1 0} {$c1 < $board_size} {incr c1} {
+	for {set r1 0} {$r1 <= $board_size} {incr r1} {
+	    if {$board($c1,$r1) == 0} continue
+
+	    set q 1
+	    set c2 $c1
+	    for {set r2 $r1} {$r2 < $r1+$size} {incr r2} {
+		if {$board($c2,$r2) == 0} {
+		    set q 0
+		    break
+		}
+	    }
+	    if {$q} {
+		return [list 1 $c1 $r1 $c2 [incr r2 -1]]
+	    }
+
+	    set q 1
+	    set r2 $r1
+	    for {set c2 $c1} {$c2 < $c1+$size} {incr c2} {
+		if {$board($c2,$r2) == 0} {
+		    set q 0
+		    break
+		}
+	    }
+	    if {$q} {
+		return [list 1 $c1 $r1 [incr c2 -1] $r2]
+	    }
+	}
+    }
+    return {0}
+}
+
+proc battleship::turn_recv {gid xmlElements} {
+    variable board_size
+    variable options
+    variable $gid
+    upvar 0 $gid state
+
+    set move 0
+    set draw 0
+
+    foreach element $xmlElements {
+	::xmpp::xml::split $element tag xmlns attrs cdata subels
+	switch -- $tag {
+	    shot {
+		set c [::xmpp::xml::getAttr $attrs col]
+		set r [::xmpp::xml::getAttr $attrs row]
+		if {![string is integer -strict $c] || ![string is integer -strict $r] || \
+			$c < 0 || $c >= $board_size || $r < 0 || $r >= $board_size} {
+		    return [list error modify not-acceptable]
+		}
+		set move 1
+	    }
+	    resign {
+		end_game $gid 1 [::msgcat::mc "You win (Opponent resigned)"]
+		update_controls $gid
+		draw_position $gid
+		highlight_last_move $gid
+		return [list result [::xmpp::xml::create turn \
+					    -xmlns games:board \
+					    -attrs [list type battleship \
+							 id $state(id)]]]
+	    }
+	    accept {
+		if {$state(position,draw)} {
+		    end_game $gid 0.5 [::msgcat::mc "Draw (Opponent accepted)"]
+		    update_controls $gid
+		    draw_position $gid
+		    highlight_last_move $gid
+		    return [list result [::xmpp::xml::create turn \
+					    -xmlns games:board \
+					    -attrs [list type battleship \
+							 id $state(id)]]]
+		} else {
+		    return [list error modify not-acceptable]
+		}
+	    }
+	    draw {
+		set draw 1
+	    }
+	}
+    }
+
+    if {$move} {
+	set hit 0
+	foreach ship $state(position,ships) {
+	    set sunk 1
+	    foreach {sc sr} [coordinates $ship] {
+		if {$c == $sc && $r == $sr} {
+		    set hit 1
+		} elseif {$state(position,oshot,$sc,$sr) != 1} {
+		    set sunk 0
+		}
+	    }
+	    if {$hit} {
+		break
+	    }
+	}
+
+	if {$hit && $sunk} {
+	    set result destroy
+	    lappend state(position,destroyed_my_ships) $ship
+	} elseif {$hit} {
+	    set result hit
+	} else {
+	    set result miss
+	}
+
+	if {[do_move $gid $c $r $result $draw]} {
+	    update_controls $gid $draw
+	    draw_position $gid
+	    highlight_last_move $gid
+
+	    set subel [::xmpp::xml::create shot \
+				-attrs [list result $result \
+					     seed $state(seed,$c,$r)]]
+	    return [list result [::xmpp::xml::create turn \
+					-xmlns games:board \
+					-attrs [list type battleship \
+						     id $state(id)] \
+					-subelement $subel]]
+	} else {
+	    return [list error modify not-acceptable]
+	}
+    } else {
+	return [list error modify not-acceptable]
+    }
+}
+
+###############################################################################
+
+proc battleship::center {c r} {
+    variable square_size
+    variable line_width
+
+    list [expr {$line_width + ($square_size * 0.5) + \
+		    (($square_size + $line_width) * $c)}] \
+	 [expr {$line_width + ($square_size * 0.5) + \
+		    (($square_size + $line_width) * $r)}]
+}
+
+proc battleship::nw {c r} {
+    variable square_size
+    variable line_width
+
+    list [expr {$line_width + ($square_size + $line_width) * $c}] \
+	 [expr {$line_width + ($square_size + $line_width) * $r}]
+}
+
+proc battleship::onw {c r} {
+    variable board_size
+    variable square_size
+    variable line_width
+
+    list [expr {($square_size + $line_width) * ($board_size + 1) + \
+		$line_width + ($square_size + $line_width) * $c}] \
+	 [expr {$line_width + ($square_size + $line_width) * $r}]
+}
+
+proc battleship::close {gid} {
+    variable $gid
+    upvar 0 $gid state
+
+    array unset state
+    catch {unset state}
+}
+
+proc battleship::exists {gid} {
+    variable $gid
+    info exists $gid
+}
+
+proc battleship::open_win {gid} {
+    variable options
+    variable board_size
+    variable square_size
+    variable line_width
+    variable $gid
+    upvar 0 $gid state
+
+    set jid $state(opponent)
+
+    set w $state(window)
+    if {[winfo exists $w]} {
+	return
+    }
+
+    set title [::msgcat::mc "Battleship with %s" \
+			    [chat::get_nick $state(xlib) $jid chat]]
+    add_win $w -title $title \
+	       -tabtitle $title \
+	       -class Battleship \
+	       -raise 1
+
+    catch {grid anchor $w center}
+
+    set mylabel [label $w.mylabel -text [::msgcat::mc "My ships"]]
+    set theirlabel [label $w.theirlabel -text [::msgcat::mc "Opponent ships"]]
+    grid $mylabel -row 0 -column 0 -sticky w
+    grid $theirlabel -row 0 -column 1 -sticky e
+    set board [canvas $w.board \
+		   -width [expr {($square_size + $line_width) * (2 * $board_size + 1)}] \
+		   -height [expr {($square_size + $line_width) * $board_size}]]
+    grid $board -row 1 -column 0 -columnspan 2 -sticky nw -padx 10 -pady 10
+
+    set state(board) $board
+
+    set state(show_last_move) $options(show_last_move)
+    set relief [expr {$state(show_last_move) ? "sunken" : "raised"}]
+
+    frame $w.move 
+    grid $w.move -row 2 -column 0 -columnspan 2 -sticky wn
+    label $w.move.title -text [::msgcat::mc "Move: "]
+    pack $w.move.title -side left
+    label $w.move.label -anchor w \
+			-textvariable [namespace current]::${gid}(move_label)
+    pack $w.move.label -side left -anchor w
+
+    set bbox [ButtonBox $w.bbox -orient vertical -spacing 0]
+    $bbox add -text [::msgcat::mc "Freeze ships position"] \
+	      -command [namespace code [list send_board $gid]]
+    set state(show_last_move_button) \
+	[$bbox add -text [::msgcat::mc "Show last move"] \
+		   -relief $relief \
+		   -command [namespace code [list toggle_show_last_move $gid]]]
+    $bbox add -text [::msgcat::mc "Propose a draw"] \
+	      -state disabled \
+	      -command [namespace code [list toggle_draw $gid]]
+    $bbox add -text [::msgcat::mc "Accept the draw proposal"] \
+	      -state disabled \
+	      -command [namespace code [list accept_draw $gid]]
+    $bbox add -text [::msgcat::mc "Resign the game"] \
+	      -state disabled \
+	      -command [namespace code [list send_resign $gid]]
+    grid columnconfigure $bbox 0 -weight 1
+    grid $bbox -row 3 -column 1 -sticky wen
+
+    set state(bbox) $bbox
+
+    set_tooltips
+
+    #label $w.history -text [::msgcat::mc "History"]
+    #pack $w.history -side top -anchor w
+    set hsw [ScrolledWindow $w.hsw]
+    grid $hsw -row 3 -column 0 -sticky nwes
+    set ht [text $w.text -wrap word -height 5 -width 25 -state disabled]
+    set font [$ht cget -font]
+    set tabstop1 [font measure $font "100.."]
+    set tabstop2 [font measure $font "100..[::msgcat::mc Opponent]   "]
+    $ht configure -tabs "$tabstop1 $tabstop2"
+    $ht tag configure attention -foreground [option get $ht errorForeground Text]
+    $hsw setwidget $ht
+    set state(hw) $ht
+
+    grid columnconfigure $w 0 -weight 0
+    grid columnconfigure $w 1 -weight 0
+    grid rowconfigure $w 0 -weight 0
+    grid rowconfigure $w 1 -weight 0
+    grid rowconfigure $w 2 -weight 0
+    grid rowconfigure $w 3 -weight 0
+
+    for {set c 0} {$c < $board_size} {incr c} {
+	for {set r 0} {$r < $board_size} {incr r} {
+	    set x1 [expr {$line_width + (($square_size + $line_width) * $c)}]
+	    set x2 [expr {($square_size + $line_width) * ($c + 1)}]
+	    set y1 [expr {$line_width + (($square_size + $line_width) * $r)}]
+	    set y2 [expr {($square_size + $line_width) * ($r + 1)}]
+
+	    $board create image $x1 $y1 -image battleship/field -anchor nw \
+		-tags [list mbackground [list cr $c $r]]
+	    $board create rectangle $x1 $y1 $x2 $y2 \
+		-outline {} \
+		-tags [list olast [list cr $c $r]]
+	}
+    }
+
+    for {set c 0} {$c < $board_size} {incr c} {
+	for {set r 0} {$r < $board_size} {incr r} {
+	    set x1 [expr {($square_size + $line_width) * ($board_size + 1) + \
+			  $line_width + (($square_size + $line_width) * $c)}]
+	    set x2 [expr {($square_size + $line_width) * ($board_size + 1) + \
+			  ($square_size + $line_width) * ($c + 1)}]
+	    set y1 [expr {$line_width + (($square_size + $line_width) * $r)}]
+	    set y2 [expr {($square_size + $line_width) * ($r + 1)}]
+
+	    $board create image $x1 $y1 -image battleship/field/shaded -anchor nw \
+		-tags [list obackground [list cr $c $r]]
+	    $board create rectangle $x1 $y1 $x2 $y2 \
+		-outline {} \
+		-tags [list mlast [list cr $c $r]]
+	    $board create rectangle $x1 $y1 $x2 $y2 \
+		-outline {} \
+		-tags [list square [list cr $c $r]]
+	}
+    }
+
+    $board bind figure <1> \
+		[namespace code [list start_drag_figure $gid %x %y]]
+    $board bind figure <B1-Motion> \
+		[namespace code [list drag_figure $gid %x %y]]
+    $board bind figure <ButtonRelease-1> \
+		[namespace code [list drag_end $gid %x %y]]
+    $board bind figure <<ContextMenu>> \
+		[namespace code [list flip_figure $gid %x %y]]
+
+    bind $w <Destroy> [namespace code [list close $gid]]
+
+    for {set c 0} {$c < $board_size} {incr c} {
+	for {set r 0} {$r < $board_size} {incr r} {
+	    set state(position,mshot,$c,$r) ""
+	    set state(position,oshot,$c,$r) ""
+	}
+    }
+
+    set state(board_is_sent) 0
+    set state(board_is_received) 0
+
+    set state(position,turn) first
+
+    catch {unset state(position,last_move)}
+    set state(position,draw) 0
+    set state(position,halfmove) 0
+    set state(position,history) {}
+    set state(position,ships) {}
+    set state(position,destroyed_ships) {}
+    set state(position,destroyed_my_ships) {}
+
+    for {set c 0} {$c < $board_size} {incr c} {
+	for {set r 0} {$r < $board_size} {incr r} {
+	    set state(seed,$c,$r) \
+		[rand 1000000000][rand 1000000000][rand 1000000000][rand 1000000000]
+	}
+    }
+
+    make_random_position $gid
+    
+    predraw_position $gid
+    update_controls $gid
+    attention_message $gid \
+	    [::msgcat::mc "\n Drag and drop ships to desired locations, then\
+			   click the 'Freeze ships position' button.\
+			   \n Right mouse button switches horizontal\
+			   and vertical ship orientation."]
+}
+
+proc battleship::predraw_position {gid} {
+    variable board_size
+    variable sizes
+    variable $gid
+    upvar 0 $gid state
+
+    $state(board) delete figure
+
+    foreach ship $state(position,ships) {
+	lassign $ship name dir c r
+
+	$state(board) create image [nw $c $r] \
+		      -anchor nw \
+		      -image battleship/$name/$dir \
+		      -tags [list figure [list ship $name $dir $c $r]]
+    }
+}
+
+proc battleship::flip_figure {gid x y} {
+    variable board_size
+    variable sizes
+    variable $gid
+    upvar 0 $gid state
+
+    array set size $sizes
+    set board $state(board)
+
+    lassign [lindex [lmatch -regexp [$board gettags current] ^ship] 0] ship \
+	    name dir c r
+
+    set x [$board canvasx $x]
+    set y [$board canvasy $y]
+    $board dtag dst
+    $board addtag dst overlapping $x $y $x $y
+    lassign [lindex [lmatch -regexp [$board gettags dst&&mbackground] ^cr] 0] cr \
+	    c1 r1
+    $board dtag dst
+
+    set c2 [expr {$c1 - $r1 + $r}]
+    if {$c2 < 0} { set c2 0 }
+    if {$dir == "vertical" && $c2 > $board_size - $size($name)} {
+	set c2 [expr {$board_size - $size($name)}]
+    }
+
+    set r2 [expr {$r1 - $c1 + $c}]
+    if {$r2 < 0} { set r2 0 }
+    if {$dir == "horizontal" && $r2 > $board_size - $size($name)} {
+	set r2 [expr {$board_size - $size($name)}]
+    }
+
+    if {$dir == "horizontal"} { set dir2 vertical } else { set dir2 horizontal }
+
+    set idx [lsearch -exact $state(position,ships) [list $name $dir $c $r]]
+    set state(position,ships) [lreplace $state(position,ships) $idx $idx]
+    lappend state(position,ships) [list $name $dir2 $c2 $r2]
+    predraw_position $gid
+
+    if {[position_is_legal $gid 0]} {
+	$state(bbox) itemconfigure 0 -state normal
+    } else {
+	$state(bbox) itemconfigure 0 -state disabled
+    }
+}
+
+proc battleship::start_drag_figure {gid x y} {
+    variable $gid
+    upvar 0 $gid state
+
+    set board $state(board)
+
+    set state(lastx) [$board canvasx $x]
+    set state(lasty) [$board canvasy $y]
+    $board dtag dst
+    $board addtag dst overlapping $x $y $x $y
+    lassign [lindex [lmatch -regexp [$board gettags dst&&mbackground] ^cr] 0] cr \
+	    state(startc) state(startr)
+    $board dtag dst
+
+    $board raise current
+    $board addtag drag withtag current
+    $board config -cursor hand2
+}
+
+proc battleship::drag_figure {gid x y} {
+    variable board_size
+    variable square_size
+    variable line_width
+    variable $gid
+    upvar 0 $gid state
+
+    set board $state(board)
+
+    set minx $line_width
+    set maxx [expr {($square_size + $line_width) * $board_size}]
+    set miny $line_width
+    set maxy [expr {($square_size + $line_width) * $board_size}]
+
+    set x [$board canvasx $x]
+    set y [$board canvasy $y]
+    set dx [expr {$x - $state(lastx)}]
+    set dy [expr {$y - $state(lasty)}]
+
+    lassign [$board bbox drag] x1 y1 x2 y2
+
+    if {$x1 + $dx < $minx} {
+	set dx [expr {$minx - $x1}]
+    }
+
+    if {$x2 + $dx > $maxx} {
+	set dx [expr {$maxx - $x2}]
+    }
+
+    if {$y1 + $dy < $miny} {
+	set dy [expr {$miny - $y1}]
+    }
+
+    if {$y2 + $dy > $maxy} {
+	set dy [expr {$maxy - $y2}]
+    }
+
+    $board move drag $dx $dy
+
+    if {$x < $minx} {
+	set state(lastx) $minx
+    } elseif {$x > $maxx} {
+	set state(lastx) $maxx
+    } else {
+	set state(lastx) $x
+    }
+    if {$y < $miny} {
+	set state(lasty) $miny
+    } elseif {$y > $maxy} {
+	set state(lasty) $maxy
+    } else {
+	set state(lasty) $y
+    }
+}
+
+proc battleship::drag_end {gid x y} {
+    variable square_size
+    variable $gid
+    upvar 0 $gid state
+
+    set board $state(board)
+
+    lassign [lindex [lmatch -regexp [$board gettags drag] ^ship] 0] ship \
+	    name dir c r
+    lassign [$board bbox drag] x1 y1
+    $board dtag drag
+
+    set x [expr {$x1 + $square_size/2}]
+    set y [expr {$y1 + $square_size/2}]
+    $board dtag dst
+    $board addtag dst overlapping $x $y $x $y
+    lassign [lindex [lmatch -regexp [$board gettags dst&&mbackground] ^cr] 0] cr \
+	    c1 r1
+    $board dtag dst
+
+    set idx [lsearch -exact $state(position,ships) [list $name $dir $c $r]]
+    set state(position,ships) [lreplace $state(position,ships) $idx $idx]
+    lappend state(position,ships) [list $name $dir $c1 $r1]
+
+    predraw_position $gid
+    if {[position_is_legal $gid 0]} {
+	$state(bbox) itemconfigure 0 -state normal
+    } else {
+	$state(bbox) itemconfigure 0 -state disabled
+    }
+}
+
+proc battleship::make_random_position {gid} {
+    variable board_size
+    variable ships
+    variable sizes
+    variable $gid
+    upvar 0 $gid state
+
+    array set tmp $sizes
+    set state(position,ships) {}
+
+    foreach {name num} $ships {
+	for {set i 0} {$i < $num} {incr i} {
+	    while {1} {
+		set c [rand $board_size]
+		set r [rand $board_size]
+		set dir [lindex {horizontal vertical} [rand 2]]
+		set ship [list $name $dir $c $r]
+
+		set saved $state(position,ships)
+		lappend state(position,ships) $ship
+		if {[position_is_legal $gid 0]} {
+		    break
+		} else {
+		    set state(position,ships) $saved
+		}
+	    }
+	}
+    }
+}
+
+proc battleship::position_is_legal {gid checkSizesOfShips} {
+    variable board_size
+    variable ships
+    variable sizes
+    variable $gid
+    upvar 0 $gid state
+
+    if {$checkSizesOfShips} {
+	array set tmp $ships
+
+	foreach ship $state(position,ships) {
+	    set name [lindex $ship 0]
+	    if {![info exists tmp($name)]} {
+		return 0
+	    }
+	    incr tmp($name) -1
+	}
+
+	foreach name [array names tmp] {
+	    if {$tmp($name) != 0} {
+		return 0
+	    }
+	}
+    }
+
+    set max -1
+    foreach ship $state(position,ships) {
+	foreach {c r} [coordinates $ship] {
+	    if {$c < 0 || $c >= $board_size || $r < 0 || $r >= $board_size} {
+		return 0
+	    }
+
+	    foreach ship2 [lrange $state(position,ships) 0 $max] {
+		foreach {c1 r1} [coordinates $ship2] {
+		    if {abs($c1 - $c) <= 1 && abs($r1 - $r) <= 1} {
+			return 0
+		    }
+		}
+	    }
+	}
+	incr max
+    }
+
+    return 1
+}
+
+proc battleship::coordinates {ship} {
+    variable sizes
+
+    array set tmp $sizes
+    lassign $ship name dir c r
+
+    set coords {}
+    for {set i 0} {$i < $tmp($name)} {incr i} {
+	lappend coords $c $r
+	switch -- $dir {
+	    horizontal {
+		incr c
+	    }
+	    vertical {
+		incr r
+	    }
+	    default {
+		return -code error
+	    }
+	}
+    }
+    return $coords
+}
+
+proc battleship::set_tooltips {args} {
+    variable options
+
+    if {$options(show_tooltips)} {
+	set tooltip0 ""
+	set tooltip1 ""
+	set tooltip2 [::msgcat::mc "Press button and make move if you want to propose draw"]
+	set tooltip3 [::msgcat::mc "Press button if you want to accept the draw proposal"]
+	set tooltip4 [::msgcat::mc "Press button if you want to resign"]
+    } else {
+	set tooltip0 ""
+	set tooltip1 ""
+	set tooltip2 ""
+	set tooltip3 ""
+	set tooltip4 ""
+    }
+
+    foreach var [info vars [namespace current]::*] {
+	upvar 0 $var state
+	if {[info exists state(bbox)]} {
+	    catch {
+		$state(bbox) itemconfigure 0 -helptext $tooltip0
+		$state(bbox) itemconfigure 1 -helptext $tooltip1
+		$state(bbox) itemconfigure 2 -helptext $tooltip2
+		$state(bbox) itemconfigure 3 -helptext $tooltip3
+		$state(bbox) itemconfigure 4 -helptext $tooltip4
+	    }
+	}
+    }
+}
+
+proc battleship::toggle_show_last_move {gid} {
+    variable $gid
+    upvar 0 $gid state
+
+    set state(show_last_move) [expr {!$state(show_last_move)}]
+
+    set relief [expr {$state(show_last_move) ? "sunken" : "raised"}]
+    $state(show_last_move_button) configure -relief $relief
+
+    highlight_last_move $gid
+}
+
+proc battleship::toggle_draw {gid} {
+    variable $gid
+    upvar 0 $gid state
+
+    set state(position,draw) [expr {!$state(position,draw)}]
+
+    if {$state(position,draw)} {
+	$state(bbox) itemconfigure 2 -relief sunken
+    } else {
+	$state(bbox) itemconfigure 2 -relief raised
+    }
+}
+
+proc battleship::update_controls {gid {draw_proposed 0}} {
+    variable $gid
+    upvar 0 $gid state
+
+    if {!$state(board_is_sent)} {
+	$state(bbox) itemconfigure 0 -state normal
+	return
+    } else {
+	$state(bbox) itemconfigure 0 -state disabled
+    }
+
+    if {!$state(board_is_received)} {
+	return
+    }
+
+    $state(bbox) itemconfigure 2 -relief raised
+
+    if {[is_my_move $gid]} {
+	$state(board) config -cursor ""
+	set state(position,draw) 0
+	if {$draw_proposed} {
+	    $state(bbox) itemconfigure 2 -state disabled
+	    $state(bbox) itemconfigure 3 -state normal
+	    $state(bbox) itemconfigure 4 -state disabled
+	} else {
+	    $state(bbox) itemconfigure 2 -state normal
+	    $state(bbox) itemconfigure 3 -state disabled
+	    $state(bbox) itemconfigure 4 -state normal
+	}
+    } elseif {$state(position,turn) != "first" && \
+		$state(position,turn) != "second"} {
+	$state(board) config -cursor ""
+	$state(bbox) itemconfigure 2 -state disabled
+	$state(bbox) itemconfigure 3 -state disabled
+	$state(bbox) itemconfigure 4 -state disabled
+    } else {
+	set state(position,draw) $draw_proposed
+	$state(board) config -cursor watch
+	$state(bbox) itemconfigure 2 -state disabled
+	$state(bbox) itemconfigure 3 -state disabled
+	$state(bbox) itemconfigure 4 -state disabled
+    }
+}
+
+proc battleship::end_game {gid my_score message} {
+    variable $gid
+    upvar 0 $gid state
+
+    set opponent_score [expr {1 - $my_score}]
+
+    if {$state(move_first)} {
+	set score "$my_score : $opponent_score"
+    } else {
+	set score "$opponent_score : $my_score"
+    }
+
+    set state(position,turn) none
+    set state(move_label) $message
+
+    set hw $state(hw)
+    $hw configure -state normal
+    catch {$hw delete attention.first attention.last}
+    $hw delete {end -1 char} end
+    $hw insert end "\n\t\t$score\n"
+    $hw see end
+    $hw configure -state disabled
+
+    after idle [namespace code [list send_board2 $gid]]
+}
+
+proc battleship::draw_position {gid} {
+    variable board_size
+    variable sizes
+    variable $gid
+    upvar 0 $gid state
+
+    $state(board) delete figure
+    $state(board) delete unshaded
+    $state(board) delete oshot
+    $state(board) delete mshot
+
+    foreach ship $state(position,ships) {
+	lassign $ship name dir c r
+
+	$state(board) create image [nw $c $r] \
+		      -anchor nw \
+		      -image battleship/$name/$dir \
+		      -tags [list figure [list ship $name $dir $c $r]]
+    }
+
+    for {set c 0} {$c < $board_size} {incr c} {
+	for {set r 0} {$r < $board_size} {incr r} {
+	    switch -- $state(position,oshot,$c,$r) {
+		1 { set image battleship/hit }
+		0 { set image battleship/miss }
+		default { continue }
+	    }
+	    $state(board) create image [nw $c $r] \
+			  -anchor nw \
+			  -image $image \
+			  -tags [list oshot [list cr $c $r]]
+	}
+    }
+
+    array set tmp $sizes
+
+    foreach ship $state(position,destroyed_ships) {
+	lassign $ship name dir c r
+
+	switch -- $dir {
+	    vertical {
+		for {set c1 [expr {$c - 1}]} {$c1 <= $c + 1} {incr c1} {
+		    if {$c1 < 0 || $c1 >= $board_size} continue
+		    for {set r1 [expr {$r - 1}]} {$r1 <= $r + $tmp($name)} {incr r1} {
+			if {$r1 < 0 || $r1 >= $board_size} continue
+
+			$state(board) create image [onw $c1 $r1] \
+				      -anchor nw \
+				      -image battleship/field \
+				      -tags [list unshaded $c1 $r1]
+			set unshaded($c1,$r1) 1
+		    }
+		}
+	    }
+	    horizontal {
+		for {set c1 [expr {$c - 1}]} {$c1 <= $c + $tmp($name)} {incr c1} {
+		    if {$c1 < 0 || $c1 >= $board_size} continue
+		    for {set r1 [expr {$r - 1}]} {$r1 <= $r + 1} {incr r1} {
+			if {$r1 < 0 || $r1 >= $board_size} continue
+
+			$state(board) create image [onw $c1 $r1] \
+				      -anchor nw \
+				      -image battleship/field \
+				      -tags [list unshaded $c1 $r1]
+			set unshaded($c1,$r1) 1
+		    }
+		}
+	    }
+	}
+
+	$state(board) create image [onw $c $r] \
+		      -anchor nw \
+		      -image battleship/$name/$dir \
+		      -tags [list figure [list ship $name $dir $c $r]]
+    }
+
+    for {set c 0} {$c < $board_size} {incr c} {
+	for {set r 0} {$r < $board_size} {incr r} {
+	    switch -- $state(position,mshot,$c,$r) {
+		1 { set image battleship/hit }
+		0 { set image battleship/miss }
+		default { continue }
+	    }
+	    if {![info exists unshaded($c,$r)]} {
+		$state(board) create image [onw $c $r] \
+			      -anchor nw \
+			      -image battleship/field \
+			      -tags [list unshaded $c $r]
+	    }
+	    $state(board) create image [onw $c $r] \
+			  -anchor nw \
+			  -image $image \
+			  -tags [list mshot [list cr $c $r]]
+	}
+    }
+
+    $state(board) raise mlast
+    $state(board) raise olast
+    $state(board) raise square
+}
+
+proc battleship::motion {gid x y} {
+    variable $gid
+    upvar 0 $gid state
+
+    set board $state(board)
+
+    set x [$board canvasx $x]
+    set y [$board canvasy $y]
+
+    $board itemconfigure dst_sq&&square -outline ""
+    $board dtag dst_sq
+    
+    $board addtag dst_sq overlapping $x $y $x $y
+    set tags [$board gettags dst_sq&&obackground]
+    lassign [lindex $tags [lsearch $tags cr*]] cr c r
+    $board addtag dst_sq withtag [list cr $c $r]&&square
+    
+    if {[is_my_move $gid] && [info exists state(position,mshot,$c,$r)] && \
+	    $state(position,mshot,$c,$r) == ""} {
+	$board itemconfigure dst_sq&&square -outline red
+	$board itemconfigure dst_sq&&reasonable&&square -outline blue
+    }
+}
+
+proc battleship::leave {gid x y} {
+    variable $gid
+    upvar 0 $gid state
+
+    set board $state(board)
+
+    $board itemconfigure dst_sq&&square -outline ""
+    $board dtag dst_sq
+    highlight_last_move $gid
+}
+
+proc battleship::release {gid x y} {
+    variable options
+    variable $gid
+    upvar 0 $gid state
+
+    set board $state(board)
+
+    set x [$board canvasx $x]
+    set y [$board canvasy $y]
+    $board dtag dst_sq
+    $board addtag dst_sq overlapping $x $y $x $y
+
+    set tags [$board gettags dst_sq&&obackground]
+    lassign [lindex $tags [lsearch $tags cr*]] cr c r
+    $board dtag dst_sq
+
+    if {[is_my_move $gid]} {
+	if {[start_do_move $gid $c $r $state(position,draw)]} {
+	    $board itemconfigure [list cr $c $r]&&square -outline ""
+	}
+    }
+    
+    update_controls $gid
+    draw_position $gid
+
+    highlight_last_move $gid
+}
+
+proc battleship::highlight_last_move {gid} {
+    variable $gid
+    upvar 0 $gid state
+
+    $state(board) itemconfigure mlast -outline ""
+    $state(board) itemconfigure olast -outline ""
+    
+    if {[catch {lassign $state(position,last_move) c r}]} {
+	return
+    }
+
+    if {$state(show_last_move)} {
+	set color white
+    } else {
+	set color {}
+    }
+
+    if {$state(position,my_last_move)} {
+	$state(board) itemconfigure [list cr $c $r]&&mlast -outline $color
+    } else {
+	$state(board) itemconfigure [list cr $c $r]&&olast -outline $color
+    }
+}
+
+proc battleship::start_do_move {gid c r draw} {
+    variable $gid
+    upvar 0 $gid state
+    
+    if {$c == "" || $r == ""} {
+	return 0
+    }
+
+    set my_move [is_my_move $gid]
+
+    if {!$my_move} {
+	return 0
+    }
+
+    save_position $gid
+
+    set state(position,mshot,$c,$r) -1
+    set state(position,last_move) [list $c $r]
+    set state(position,my_last_move) 1
+
+    update_controls $gid
+    draw_position $gid
+    highlight_last_move $gid
+    send_move $gid $c $r $draw
+    return 1
+}
+
+proc battleship::do_move {gid c r result draw} {
+    variable options
+    variable ships
+    variable $gid
+    upvar 0 $gid state
+    
+    if {$c == "" || $r == ""} {
+	return 0
+    }
+
+    switch -- $result {
+	destroy -
+	hit { set hit 1 }
+	default { set hit 0 }
+    }
+
+    set my_move [is_my_move $gid]
+
+    if {!$my_move} {
+	save_position $gid
+	set state(position,oshot,$c,$r) $hit
+	set state(position,last_move) [list $c $r]
+	set state(position,my_last_move) 0
+    } else {
+	set state(position,mshot,$c,$r) $hit
+	if {$result == "destroy"} {
+	    set ship [find_destroyed_ship $gid $c $r]
+	    if {[llength $ship] > 0} {
+		lappend state(position,destroyed_ships) $ship
+	    }
+	}
+    }
+
+    add_move_to_history $gid $c $r $result $draw
+
+    if {$draw && !$my_move} {
+	attention_message $gid \
+	    [::msgcat::mc "\n\n Opponent proposes a draw\n\n"]
+    }
+
+    switch -glob -- $state(position,turn)/$hit/$draw {
+	first/1/0 {
+	    # Add skipping move to history
+	    add_move_to_history $gid
+	    set state(position,turn) first
+	}
+	second/1/0 {
+	    # Add skipping move to history
+	    add_move_to_history $gid
+	    set state(position,turn) second
+	}
+	first/1/1 -
+	first/0/* {
+	    set state(position,turn) second
+	}
+	second/1/1 -
+	second/0/* {
+	    set state(position,turn) first
+	}
+    }
+
+    find_reasonable_moves $gid $state(position,turn)
+
+    set endgame 0
+    if {[llength $state(reasonable_moves)] == 0} {
+	set endgame 1
+    }
+	
+    if {$endgame} {
+	set total 0
+	foreach {name size} $ships {
+	    incr total $size
+	}
+	if {[llength $state(position,destroyed_ships)] >= $total &&
+		[llength $state(position,destroyed_my_ships)] < $total} {
+	    # I win
+	    end_game $gid 1 [::msgcat::mc "You win"]
+	} elseif {[llength $state(position,destroyed_my_ships)] >= $total &&
+		[llength $state(position,destroyed_ships)] < $total} {
+	    # Opponent wins
+	    end_game $gid 0 [::msgcat::mc "Opponent wins"]
+	} else {
+	    # Can't be here
+	    end_game $gid 0.5 [::msgcat::mc "Impossible draw"]
+	}
+    }
+
+    tab_set_updated [winfo parent $state(board)] 1 mesg_to_user
+    return 1
+}
+
+proc battleship::accept_draw {gid} {
+    variable $gid
+    upvar 0 $gid state
+
+    ::xmpp::sendIQ $state(xlib) set \
+	-query [::xmpp::xml::create turn \
+		    -xmlns games:board \
+		    -attrs [list type battleship \
+				 id $state(id)] \
+		    -subelement [::xmpp::xml::create accept]] \
+	-to $state(opponent) \
+	-command [namespace code [list accept_draw_result $gid]]
+
+	end_game $gid 0.5 [::msgcat::mc "Draw (You accepted)"]
+	update_controls $gid
+	draw_position $gid
+	highlight_last_move $gid
+}
+
+proc battleship::accept_draw_result {gid status xml} {
+    variable $gid
+    upvar 0 $gid state
+
+    if {![string equal $status ok]} {
+	attention_message $gid \
+		[::msgcat::mc "\n\n Opponent rejected accepted draw:\n %s\n\n" \
+			      [error_to_string $xml]]
+    }
+}
+
+proc battleship::send_resign {gid} {
+    variable $gid
+    upvar 0 $gid state
+
+    ::xmpp::sendIQ $state(xlib) set \
+	-query [::xmpp::xml::create turn \
+		    -xmlns games:board \
+		    -attrs [list type battleship \
+				 id $state(id)] \
+		    -subelement [::xmpp::xml::create resign]] \
+	-to $state(opponent)
+
+	end_game $gid 0 [::msgcat::mc "Opponent wins (You resigned)"]
+	update_controls $gid
+	draw_position $gid
+	highlight_last_move $gid
+}
+
+proc battleship::send_board {gid} {
+    variable board_size
+    variable $gid
+    upvar 0 $gid state
+
+    for {set c 0} {$c < $board_size} {incr c} {
+	for {set r 0} {$r < $board_size} {incr r} {
+	    set pos($c,$r) 0
+	}
+    }
+
+    set shipSubels {}
+    foreach ship $state(position,ships) {
+	set size 0
+	set seed ""
+	foreach {c r} [coordinates $ship] {
+	    incr size
+	    append seed $state(seed,$c,$r)
+	    set pos($c,$r) 1
+	}
+	lappend shipSubels [::xmpp::xml::create ship \
+				    -attrs [list length $size \
+						 hash [sha1::sha1 $seed]]]
+    }
+
+    set subels {}
+    for {set c 0} {$c < $board_size} {incr c} {
+	for {set r 0} {$r < $board_size} {incr r} {
+	    lappend subels [::xmpp::xml::create cell \
+				    -attrs [list col $c \
+						 row $r \
+						 hash [sha1::sha1 $state(seed,$c,$r)$pos($c,$r)]]]
+	}
+    }
+
+    set state(board_is_sent) 1
+    set_label_move $gid
+    draw_position $gid
+    update_controls $gid
+    find_reasonable_moves $gid $state(position,turn)
+
+    set hw $state(hw)
+    $hw configure -state normal
+    $hw delete 0.0 end
+    $hw configure -state disabled
+
+    $state(board) bind figure <1> {}
+    $state(board) bind figure <B1-Motion> {}
+    $state(board) bind figure <ButtonRelease-1> {}
+
+    bind $state(board) <Any-Enter>       [namespace code [list motion $gid %x %y]]
+    bind $state(board) <Any-Motion>      [namespace code [list motion $gid %x %y]]
+    bind $state(board) <Any-Leave>       [namespace code [list leave $gid %x %y]]
+    bind $state(board) <ButtonRelease-1> [namespace code [list release $gid %x %y]]
+
+    ::xmpp::sendIQ $state(xlib) set \
+	    -query [::xmpp::xml::create board \
+			    -xmlns games:board \
+			    -attrs [list type battleship \
+					 id $state(id)] \
+			    -subelements $subels \
+			    -subelements $shipSubels] \
+	    -to $state(opponent) \
+	    -command [namespace code [list send_result board $gid]]
+}
+
+proc battleship::send_board2 {gid} {
+    variable board_size
+    variable $gid
+    upvar 0 $gid state
+
+    for {set c 0} {$c < $board_size} {incr c} {
+	for {set r 0} {$r < $board_size} {incr r} {
+	    set pos($c,$r) 0
+	}
+    }
+
+    foreach ship $state(position,ships) {
+	foreach {c r} [coordinates $ship] {
+	    set pos($c,$r) 1
+	}
+    }
+
+    set subels {}
+    for {set c 0} {$c < $board_size} {incr c} {
+	for {set r 0} {$r < $board_size} {incr r} {
+	    lappend subels [::xmpp::xml::create cell \
+				    -attrs [list col $c \
+						 row $r \
+						 ship $pos($c,$r) \
+						 seed $state(seed,$c,$r)]]
+	}
+    }
+
+    ::xmpp::sendIQ $state(xlib) set \
+	    -query [::xmpp::xml::create board \
+			    -xmlns games:board \
+			    -attrs [list type battleship \
+					 id $state(id)] \
+			    -subelements $subels] \
+	    -to $state(opponent) \
+	    -command [namespace code [list send_result board2 $gid]]
+}
+
+proc battleship::send_move {gid c r draw} {
+    variable $gid
+    upvar 0 $gid state
+
+    set els [list [::xmpp::xml::create shot -attrs [list row $r col $c]]]
+    if {$draw} {
+	lappend els [::xmpp::xml::create draw]
+    }
+
+    ::xmpp::sendIQ $state(xlib) set \
+	    -query [::xmpp::xml::create turn \
+			    -xmlns games:board \
+			    -attrs [list type battleship \
+					 id $state(id)] \
+			    -subelements $els] \
+	    -to $state(opponent) \
+	    -command [namespace code [list send_turn_result $gid $c $r $draw]]
+}
+
+proc battleship::send_turn_result {gid c r draw status xml} {
+    variable $gid
+    upvar 0 $gid state
+
+    if {![string equal $status ok]} {
+	attention_message $gid \
+		[::msgcat::mc "\n\n Opponent rejected move:\n %s\n\n" \
+			      [error_to_string $xml]]
+	restore_position $gid
+    } else {
+	::xmpp::xml::split $xml tag xmlns attrs cdata subels
+
+	foreach subel $subels {
+	    ::xmpp::xml::split $subel stag sxmlns sattrs scdata ssubels
+
+	    switch -- $stag {
+		shot {
+		    set result [::xmpp::xml::getAttr $sattrs result]
+		    set seed [::xmpp::xml::getAttr $sattrs seed]
+		    set state(oseed,$c,$r) $seed
+
+		    switch -- $result {
+			hit {
+			    set hit 1
+			    set destroy 0
+			}
+			destroy {
+			    set hit 1
+			    set destroy 1
+			}
+			default {
+			    set hit 0
+			    set destroy 0
+			}
+		    }
+
+		    if {![string equal [sha1::sha1 $seed$hit] $state(hash,$c,$r)]} {
+			attention_message $gid \
+				[::msgcat::mc "\n\n Opponent returned incorrect cell seed"]
+			return
+		    }
+
+		    if {$hit} {
+			# Checking if the currenlty hit ship is destroyed
+
+			set ship [find_destroyed_ship $gid $c $r]
+			set acc ""
+			foreach {c1 r1} [coordinates $ship] {
+			    append acc $state(oseed,$c1,$r1)
+			}
+			set hash [sha1::sha1 $acc]
+			if {$destroy && [lsearch -exact $state(shiphashes) $hash] < 0} {
+			    attention_message $gid \
+				[::msgcat::mc "\n\n Opponent returned incorrect destroy answer"]
+			    return
+			} elseif {!$destroy && $hit && [lsearch -exact $state(shiphashes) $hash] >= 0} {
+			    attention_message $gid \
+				[::msgcat::mc "\n\n Opponent returned inconrrect hit answer"]
+			    return
+			}
+		    }
+
+		    do_move $gid $c $r $result $draw
+		    update_controls $gid $draw
+		    draw_position $gid
+		    highlight_last_move $gid
+		    return
+		}
+	    }
+	}
+
+	attention_message $gid \
+		[::msgcat::mc "\n\n Opponent returned incorrect answer"]
+    }
+}
+
+proc battleship::find_destroyed_ship {gid c r} {
+    variable sizes
+    variable board_size
+    variable $gid
+    upvar 0 $gid state
+
+    set r1 $r
+    while {$r1 >= 0 && ($state(position,mshot,$c,$r1) == 1 ||
+			$state(position,mshot,$c,$r1) == -1)} {
+	incr r1 -1
+    }
+    incr r1
+    set r2 $r
+    while {$r2 < $board_size && ($state(position,mshot,$c,$r2) == 1 ||
+				 $state(position,mshot,$c,$r2) == -1)} {
+	incr r2
+    }
+    incr r2 -1
+    if {$r2 > $r1} {
+	set size [expr {$r2 - $r1 + 1}]
+	foreach {name s} $sizes {
+	    if {$s == $size} {
+		return [list $name vertical $c $r1]
+	    }
+	}
+	return
+    }
+
+    set c1 $c
+    while {$c1 >= 0 && ($state(position,mshot,$c1,$r) == 1 ||
+			$state(position,mshot,$c1,$r) == -1)} {
+	incr c1 -1
+    }
+    incr c1
+    set c2 $c
+    while {$c2 < $board_size && ($state(position,mshot,$c2,$r) == 1 ||
+				 $state(position,mshot,$c2,$r) == -1)} {
+	incr c2
+    }
+    incr c2 -1
+    set size [expr {$c2 - $c1 + 1}]
+    foreach {name s} $sizes {
+	if {$s == $size} {
+	    return [list $name horizontal $c1 $r]
+	}
+    }
+    return
+}
+
+proc battleship::send_result {type gid status xml} {
+    variable $gid
+    upvar 0 $gid state
+
+    switch -- $type {
+	board {
+	    if {![string equal $status ok]} {
+		set state(board_is_sent) 0
+		set_label_move $gid
+		update_controls $gid
+		attention_message $gid \
+			[::msgcat::mc "\n\n Opponent rejected board:\n %s\n\n" \
+				      [error_to_string $xml]]
+	    }
+	}
+	board2 {
+	    if {![string equal $status ok]} {
+		attention_message $gid \
+			[::msgcat::mc "\n\n Opponent rejected board:\n %s\n\n" \
+				      [error_to_string $xml]]
+	    }
+	}
+    }
+}
+
+proc battleship::add_move_to_history {gid {c ""} {r ""} {result ""} {draw 0}} {
+    variable board_size
+    variable $gid
+    upvar 0 $gid state
+
+    incr state(position,halfmove)
+
+    if {$c != "" && $r != ""} {
+	lappend state(position,history) [list $c $r $result $draw]
+    } else {
+	lappend state(position,history) skip
+    }
+
+    set hw $state(hw)
+    $hw configure -state normal
+    $hw delete 0.0 end
+
+    if {$state(move_first)} {
+	$hw insert end "\t[::msgcat::mc You]\t[::msgcat::mc Opponent]\n"
+    } else {
+	$hw insert end "\t[::msgcat::mc Opponent]\t[::msgcat::mc You]\n"
+    }
+    set i 1
+    foreach {b w} $state(position,history) {
+	$hw insert end "${i}.\t"
+	if {$b == "skip"} {
+	    $hw insert end "--\t"
+	} elseif {$b != {}} {
+	    lassign $b c r res d
+	    set r [expr {$board_size - $r}]
+	    set l [format %c [expr {$c+97}]]
+	    switch -- $res {
+		destroy { set s # }
+		hit     { set s + }
+		default { set s "" }
+	    }
+	    if {$d} {
+		set e "="
+	    } else {
+		set e ""
+	    }
+	    $hw insert end "$l$r$s$e\t"
+	}
+	if {$w == "skip"} {
+	    $hw insert end "--\n"
+	} elseif {$w != {}} {
+	    lassign $w c r res d
+	    set r [expr {$board_size - $r}]
+	    set l [format %c [expr {$c+97}]]
+	    switch -- $res {
+		destroy { set s # }
+		hit     { set s + }
+		default { set s "" }
+	    }
+	    if {$d} {
+		set e "="
+	    } else {
+		set e ""
+	    }
+	    $hw insert end "$l$r$s$e\n"
+	} else {
+	    $hw insert end "\n"
+	}
+	incr i
+    }
+    $hw see end
+    $hw configure -state disabled
+}
+
+proc battleship::find_reasonable_moves {gid color} {
+    variable board_size
+    variable ships
+    variable $gid
+    upvar 0 $gid state
+
+    set state(reasonable_moves) {}
+
+    set total 0
+    foreach {name number} $ships {
+	incr total $number
+    }
+
+    if {[llength $state(position,destroyed_my_ships)] < $total &&
+		[llength $state(position,destroyed_ships)] < $total} {
+	for {set c 0} {$c < $board_size} {incr c} {
+	    for {set r 0} {$r < $board_size} {incr r} {
+		if {$state(position,mshot,$c,$r) == ""} {
+		    lappend state(reasonable_moves) [list $c $r]
+		}
+	    }
+	}
+    }
+    highlight_reasonable_moves $gid
+}
+
+proc battleship::is_move_reasonable {gid c r} {
+    variable $gid
+    upvar 0 $gid state
+
+    expr {[lmatch -regexp $state(reasonable_moves) ^[list $c $r]] != {}}
+}
+
+proc battleship::highlight_reasonable_moves {gid} {
+    variable $gid
+    upvar 0 $gid state
+
+    set board $state(board)
+
+    $board dtag reasonable
+    foreach move $state(reasonable_moves) {
+	lassign $move c r
+	$board addtag reasonable withtag [list cr $c $r]&&square
+    }
+}
+
+proc battleship::attention_message {gid message} {
+    variable $gid
+    upvar 0 $gid state
+
+    set hw $state(hw)
+    $hw configure -state normal
+    $hw delete {end -1 char} end
+    $hw insert end $message attention
+    $hw see end
+    $hw configure -state disabled
+}
+
+proc battleship::is_my_move {gid} {
+    variable $gid
+    upvar 0 $gid state
+    if {$state(move_first) && $state(position,turn) == "first"} {
+	return 1
+    } elseif {!$state(move_first) && $state(position,turn) == "second"} {
+	return 1
+    } else {
+	return 0
+    }
+}
+
+#######################################################################
+
+proc battleship::add_groupchat_user_menu_item {m xlib jid} {
+    set mm $m.gamesmenu
+    if {![winfo exists $mm]} {
+	menu $mm -tearoff 0
+	$m add cascade -label [::msgcat::mc "Games"] -menu $mm
+    }
+    $mm add command -label [::msgcat::mc "Battleship..."] \
+	-command [namespace code [list invite_dialog $xlib $jid]]
+}
+
+proc battleship::iq_create {varname xlib from iqid xml} {
+    upvar 2 $varname var
+
+    ::xmpp::xml::split $xml tag xmlns attrs cdata subels
+
+    switch -- [::xmpp::xml::getAttr $attrs type] {
+	battleship {
+	    if {[::xmpp::xml::isAttr $attrs first]} {
+		set first [::xmpp::xml::getAttr $attrs first]
+		switch -- $first {
+		    true -
+		    1 {
+			set first true
+		    }
+		    false -
+		    0 {
+			set first false
+		    }
+		    default {
+			set var [list error modify bad-request]
+		    }
+		}
+	    } else {
+		set first true
+	    }
+	    set var [invited_dialog $xlib $from $iqid \
+				    [::xmpp::xml::getAttr $attrs id] \
+				    $first]
+	}
+    }
+    return
+}
+
+proc battleship::iq_init {varname xlib from xml} {
+    upvar 2 $varname var
+
+    ::xmpp::xml::split $xml tag xmlns attrs cdata subels
+
+    switch -- [::xmpp::xml::getAttr $attrs type] {
+	battleship {
+	    set gid [make_gid $from [::xmpp::xml::getAttr $attrs id]]
+	    if {[exists $gid]} {
+		set var [board_recv $gid $subels]
+	    } else {
+		set var [list error cancel item-not-found]
+	    }
+	}
+    }
+    return
+}
+
+proc battleship::iq_turn {varname xlib from xml} {
+    upvar 2 $varname var
+
+    ::xmpp::xml::split $xml tag xmlns attrs cdata subels
+
+    switch -- [::xmpp::xml::getAttr $attrs type] {
+	battleship {
+	    set gid [make_gid $from [::xmpp::xml::getAttr $attrs id]]
+	    if {[exists $gid]} {
+		set var [turn_recv $gid $subels]
+	    } else {
+		set var [list error cancel item-not-found]
+	    }
+	}
+    }
+    return
+}
+
+
+# Common games:board part
+proc iq_games_board_create {xlib from xml args} {
+    set res [list error cancel feature-not-implemented]
+    set iqid [::xmpp::xml::getAttr $args -id]
+    hook::run games_board_create_hook res $xlib $from $iqid $xml
+    return $res
+}
+
+proc iq_games_board_init {xlib from xml args} {
+    set res [list error cancel feature-not-implemented]
+    hook::run games_board_init_hook res $xlib $from $xml
+    return $res
+}
+
+proc iq_games_board_turn {xlib from xml args} {
+    set res [list error cancel feature-not-implemented]
+    hook::run games_board_turn_hook res $xlib $from $xml
+    return $res
+}
+


Property changes on: trunk/tkabber-plugins/battleship/battleship.tcl
___________________________________________________________________
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
Added: svn:keywords
## -0,0 +1 ##
+Author Date Id Revision
\ No newline at end of property
Added: trunk/tkabber-plugins/battleship/msgs/ru.msg
===================================================================
--- trunk/tkabber-plugins/battleship/msgs/ru.msg	                        (rev 0)
+++ trunk/tkabber-plugins/battleship/msgs/ru.msg	2014-02-07 07:11:37 UTC (rev 2133)
@@ -0,0 +1,65 @@
+# $Id$
+
+::msgcat::mcset ru "Plugins options." "Параметры расширений."
+::msgcat::mcset ru "Show last move by default." "По умолчанию показывать последний ход."
+::msgcat::mcset ru "You" "Вы"
+::msgcat::mcset ru "Opponent" "Оппонент"
+::msgcat::mcset ru "Battleship plugin options." "Параметры расширения Морской бой."
+::msgcat::mcset ru "Battleship pixmaps theme." "Тема фигурок кораблей."
+::msgcat::mcset ru "Show tooltips with short instructions." "Показывать всплывающие подсказки к элементам интерфейса."
+::msgcat::mcset ru "Battleship Invitation" "Приглашение сыграть в морской бой"
+::msgcat::mcset ru "Sending Battleship game invitation to %s (%s)" "Посылаем приглашение сыграть в морской бой с %s (%s)"
+::msgcat::mcset ru "I want to move first" "Хочу ходить первым"
+::msgcat::mcset ru "I want to move second" "Хочу ходить вторым"
+::msgcat::mcset ru "Cancel invitation" "Отменить приглашение"
+::msgcat::mcset ru "%s (%s) has refused Battleship invitation: %s" "%s (%s) отказался играть в морской бой: %s"
+::msgcat::mcset ru "Battleship Invitation from %s" "Приглашение сыграть в морской бой с %s"
+::msgcat::mcset ru "Battleship game invitation from %s (%s) is received." "Получено приглашение сыграть в морской бой с %s (%s)"
+::msgcat::mcset ru "%s wants to move first." "%s хочет ходить первым."
+::msgcat::mcset ru "%s wants to move second." "%s хочет ходить вторым."
+::msgcat::mcset ru "Agree to play" "Согласиться играть"
+::msgcat::mcset ru "Refuse to play" "Отказаться играть"
+::msgcat::mcset ru "Battleship with %s" "Морской бой с %s"
+::msgcat::mcset ru "Show last move" "Показывать последний ход"
+::msgcat::mcset ru "Move: " "Ход: "
+::msgcat::mcset ru "Propose a draw" "Предложить ничью"
+::msgcat::mcset ru "Accept the draw proposal" "Принять предложенную ничью"
+::msgcat::mcset ru "Resign the game" "Сдать партию"
+::msgcat::mcset ru "History" "Запись партии"
+::msgcat::mcset ru "Battleship..." "Морской бой..."
+::msgcat::mcset ru "Opponent wins" "Оппонент выиграл"
+::msgcat::mcset ru "You win" "Вы выиграли"
+::msgcat::mcset ru "Opponent wins (You resigned)" "Оппонент выиграл (Вы сдались)"
+::msgcat::mcset ru "You win (Opponent resigned)" "Вы выиграли (Оппонент сдался)"
+::msgcat::mcset ru "Impossible draw" "Невозможная ничья"
+::msgcat::mcset ru "Draw (You accepted)" "Ничья (Вы приняли)"
+::msgcat::mcset ru "Draw (Opponent accepted)" "Ничья (Оппонент принял)"
+::msgcat::mcset ru "Press button and make move if you want to propose draw" "Нажмите кнопку и сделайте ход, если хотите предложить ничью"
+::msgcat::mcset ru "Press button if you want to accept the draw proposal" "Нажмите кнопку, если хотите принять предложенную ничью"
+::msgcat::mcset ru "Press button if you want to resign" "Нажмите кнопку, если хотите сдаться"
+::msgcat::mcset ru "\n\n Opponent proposes a draw\n\n" "\n\n Оппонент предлагает ничью\n\n"
+::msgcat::mcset ru "\n\n Opponent rejected move:\n %s\n\n" "\n\n Оппонент отверг ход:\n %s\n\n"
+::msgcat::mcset ru "Games" "Игры"
+::msgcat::mcset ru "Freeze ships position" "Зафиксировать положение кораблей"
+::msgcat::mcset ru "My ships" "Мои корабли"
+::msgcat::mcset ru "Opponent (after all parties freeze boards)" "Оппонент (после того, как все зафиксируют свои доски)"
+::msgcat::mcset ru "Opponent ships" "Корабли оппонента"
+::msgcat::mcset ru "Whether the Battleship plugin is loaded." "Загружено ли расширение Морской бой."
+::msgcat::mcset ru "You (after all parties freeze boards)" "Вы (после того, как все зафиксируют свои доски)"
+::msgcat::mcset ru "\n\n Opponent rejected board:\n %s\n\n" "\n\n Оппонент не принял доску:\n %s\n\n"
+::msgcat::mcset ru "\n\n Opponent returned inconrrect hit answer" "\n\n Оппонент вернул неправильный ответ 'попал'"
+::msgcat::mcset ru "\n\n Opponent returned incorrect answer" "\n\n Оппонент вернул неправильный ответ"
+::msgcat::mcset ru "\n\n Opponent returned incorrect cell seed" "\n\n Оппонент вернул неправильный сид ячейки"
+::msgcat::mcset ru "\n\n Opponent returned incorrect destroy answer" "\n\n Оппонент вернул неправильный ответ 'убил'"
+::msgcat::mcset ru "\n\n Opponent sent incorrect cell column" "\n\n Оппонент прислал неправильную колонку"
+::msgcat::mcset ru "\n\n Opponent sent incorrect cell row" "\n\n Оппонент вернул неправильную строку"
+::msgcat::mcset ru "\n\n Opponent sent incorrect cell seed" "\n\n Оппонент вернул неправильный сид ячейки"
+::msgcat::mcset ru "\n\n Opponent sent incorrect number of cells" "\n\n Оппонент вернул неправильное число ячеек"
+::msgcat::mcset ru "\n\n Opponent rejected accepted draw:\n %s\n\n" "\n\n Оппонент отверг принятие ничьей:\n %s\n\n"
+::msgcat::mcset ru "\n\n Opponent sent illegal board" "\n\n Оппонент прислал доску, не удовлетворяющую правилам"
+::msgcat::mcset ru "\n Drag and drop ships to desired locations, then click the 'Freeze ships\
+	position' button. \n Right mouse button switches\
+	horizontal and vertical ship orientation." "\n Передвиньте корабли, куда хотите, потом нажмите\
+	кнопку 'Зафиксировать положение кораблей'.\n Правая кнопка мыши переключает вертикальное и\
+	горизонтальное положение корабля."
+


Property changes on: trunk/tkabber-plugins/battleship/msgs/ru.msg
___________________________________________________________________
Added: svn:keywords
## -0,0 +1 ##
+Author Date Id Revision
\ No newline at end of property
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
Added: trunk/tkabber-plugins/battleship/pixmaps/copybook/battleship-h.gif
===================================================================
(Binary files differ)

Index: trunk/tkabber-plugins/battleship/pixmaps/copybook/battleship-h.gif
===================================================================
--- trunk/tkabber-plugins/battleship/pixmaps/copybook/battleship-h.gif	2014-02-02 18:58:58 UTC (rev 2132)
+++ trunk/tkabber-plugins/battleship/pixmaps/copybook/battleship-h.gif	2014-02-07 07:11:37 UTC (rev 2133)

Property changes on: trunk/tkabber-plugins/battleship/pixmaps/copybook/battleship-h.gif
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/tkabber-plugins/battleship/pixmaps/copybook/battleship-v.gif
===================================================================
(Binary files differ)

Index: trunk/tkabber-plugins/battleship/pixmaps/copybook/battleship-v.gif
===================================================================
--- trunk/tkabber-plugins/battleship/pixmaps/copybook/battleship-v.gif	2014-02-02 18:58:58 UTC (rev 2132)
+++ trunk/tkabber-plugins/battleship/pixmaps/copybook/battleship-v.gif	2014-02-07 07:11:37 UTC (rev 2133)

Property changes on: trunk/tkabber-plugins/battleship/pixmaps/copybook/battleship-v.gif
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/tkabber-plugins/battleship/pixmaps/copybook/carrier-h.gif
===================================================================
(Binary files differ)

Index: trunk/tkabber-plugins/battleship/pixmaps/copybook/carrier-h.gif
===================================================================
--- trunk/tkabber-plugins/battleship/pixmaps/copybook/carrier-h.gif	2014-02-02 18:58:58 UTC (rev 2132)
+++ trunk/tkabber-plugins/battleship/pixmaps/copybook/carrier-h.gif	2014-02-07 07:11:37 UTC (rev 2133)

Property changes on: trunk/tkabber-plugins/battleship/pixmaps/copybook/carrier-h.gif
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/tkabber-plugins/battleship/pixmaps/copybook/carrier-v.gif
===================================================================
(Binary files differ)

Index: trunk/tkabber-plugins/battleship/pixmaps/copybook/carrier-v.gif
===================================================================
--- trunk/tkabber-plugins/battleship/pixmaps/copybook/carrier-v.gif	2014-02-02 18:58:58 UTC (rev 2132)
+++ trunk/tkabber-plugins/battleship/pixmaps/copybook/carrier-v.gif	2014-02-07 07:11:37 UTC (rev 2133)

Property changes on: trunk/tkabber-plugins/battleship/pixmaps/copybook/carrier-v.gif
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/tkabber-plugins/battleship/pixmaps/copybook/cruiser-h.gif
===================================================================
(Binary files differ)

Index: trunk/tkabber-plugins/battleship/pixmaps/copybook/cruiser-h.gif
===================================================================
--- trunk/tkabber-plugins/battleship/pixmaps/copybook/cruiser-h.gif	2014-02-02 18:58:58 UTC (rev 2132)
+++ trunk/tkabber-plugins/battleship/pixmaps/copybook/cruiser-h.gif	2014-02-07 07:11:37 UTC (rev 2133)

Property changes on: trunk/tkabber-plugins/battleship/pixmaps/copybook/cruiser-h.gif
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/tkabber-plugins/battleship/pixmaps/copybook/cruiser-v.gif
===================================================================
(Binary files differ)

Index: trunk/tkabber-plugins/battleship/pixmaps/copybook/cruiser-v.gif
===================================================================
--- trunk/tkabber-plugins/battleship/pixmaps/copybook/cruiser-v.gif	2014-02-02 18:58:58 UTC (rev 2132)
+++ trunk/tkabber-plugins/battleship/pixmaps/copybook/cruiser-v.gif	2014-02-07 07:11:37 UTC (rev 2133)

Property changes on: trunk/tkabber-plugins/battleship/pixmaps/copybook/cruiser-v.gif
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/tkabber-plugins/battleship/pixmaps/copybook/destroyer-h.gif
===================================================================
(Binary files differ)

Index: trunk/tkabber-plugins/battleship/pixmaps/copybook/destroyer-h.gif
===================================================================
--- trunk/tkabber-plugins/battleship/pixmaps/copybook/destroyer-h.gif	2014-02-02 18:58:58 UTC (rev 2132)
+++ trunk/tkabber-plugins/battleship/pixmaps/copybook/destroyer-h.gif	2014-02-07 07:11:37 UTC (rev 2133)

Property changes on: trunk/tkabber-plugins/battleship/pixmaps/copybook/destroyer-h.gif
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/tkabber-plugins/battleship/pixmaps/copybook/destroyer-v.gif
===================================================================
(Binary files differ)

Index: trunk/tkabber-plugins/battleship/pixmaps/copybook/destroyer-v.gif
===================================================================
--- trunk/tkabber-plugins/battleship/pixmaps/copybook/destroyer-v.gif	2014-02-02 18:58:58 UTC (rev 2132)
+++ trunk/tkabber-plugins/battleship/pixmaps/copybook/destroyer-v.gif	2014-02-07 07:11:37 UTC (rev 2133)

Property changes on: trunk/tkabber-plugins/battleship/pixmaps/copybook/destroyer-v.gif
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/tkabber-plugins/battleship/pixmaps/copybook/field-shaded.gif
===================================================================
(Binary files differ)

Index: trunk/tkabber-plugins/battleship/pixmaps/copybook/field-shaded.gif
===================================================================
--- trunk/tkabber-plugins/battleship/pixmaps/copybook/field-shaded.gif	2014-02-02 18:58:58 UTC (rev 2132)
+++ trunk/tkabber-plugins/battleship/pixmaps/copybook/field-shaded.gif	2014-02-07 07:11:37 UTC (rev 2133)

Property changes on: trunk/tkabber-plugins/battleship/pixmaps/copybook/field-shaded.gif
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/tkabber-plugins/battleship/pixmaps/copybook/field.gif
===================================================================
(Binary files differ)

Index: trunk/tkabber-plugins/battleship/pixmaps/copybook/field.gif
===================================================================
--- trunk/tkabber-plugins/battleship/pixmaps/copybook/field.gif	2014-02-02 18:58:58 UTC (rev 2132)
+++ trunk/tkabber-plugins/battleship/pixmaps/copybook/field.gif	2014-02-07 07:11:37 UTC (rev 2133)

Property changes on: trunk/tkabber-plugins/battleship/pixmaps/copybook/field.gif
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/tkabber-plugins/battleship/pixmaps/copybook/hit.gif
===================================================================
(Binary files differ)

Index: trunk/tkabber-plugins/battleship/pixmaps/copybook/hit.gif
===================================================================
--- trunk/tkabber-plugins/battleship/pixmaps/copybook/hit.gif	2014-02-02 18:58:58 UTC (rev 2132)
+++ trunk/tkabber-plugins/battleship/pixmaps/copybook/hit.gif	2014-02-07 07:11:37 UTC (rev 2133)

Property changes on: trunk/tkabber-plugins/battleship/pixmaps/copybook/hit.gif
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/tkabber-plugins/battleship/pixmaps/copybook/icondef.xml
===================================================================
--- trunk/tkabber-plugins/battleship/pixmaps/copybook/icondef.xml	                        (rev 0)
+++ trunk/tkabber-plugins/battleship/pixmaps/copybook/icondef.xml	2014-02-07 07:11:37 UTC (rev 2133)
@@ -0,0 +1,67 @@
+<?xml version='1.0' encoding='UTF-8'?>
+<!-- $Id$ -->
+<icondef>
+  <meta>
+    <name>Copybook</name>
+    <version>1.0</version>
+    <description>Battleship Copybook Theme</description>
+    <creation>2006-02-02</creation>
+  </meta>
+  <icon>
+    <image xmlns='tkimage'>battleship/field</image>
+    <object mime="image/gif">field.gif</object>
+  </icon>
+  <icon>
+    <image xmlns='tkimage'>battleship/field/shaded</image>
+    <object mime="image/gif">field-shaded.gif</object>
+  </icon>
+  <icon>
+    <image xmlns='tkimage'>battleship/hit</image>
+    <object mime="image/gif">hit.gif</object>
+  </icon>
+  <icon>
+    <image xmlns='tkimage'>battleship/miss</image>
+    <object mime="image/gif">miss.gif</object>
+  </icon>
+  <icon>
+    <image xmlns='tkimage'>battleship/submarine/horizontal</image>
+    <object mime="image/gif">submarine-h.gif</object>
+  </icon>
+  <icon>
+    <image xmlns='tkimage'>battleship/submarine/vertical</image>
+    <object mime="image/gif">submarine-v.gif</object>
+  </icon>
+  <icon>
+    <image xmlns='tkimage'>battleship/cruiser/horizontal</image>
+    <object mime="image/gif">cruiser-h.gif</object>
+  </icon>
+  <icon>
+    <image xmlns='tkimage'>battleship/cruiser/vertical</image>
+    <object mime="image/gif">cruiser-v.gif</object>
+  </icon>
+  <icon>
+    <image xmlns='tkimage'>battleship/destroyer/horizontal</image>
+    <object mime="image/gif">destroyer-h.gif</object>
+  </icon>
+  <icon>
+    <image xmlns='tkimage'>battleship/destroyer/vertical</image>
+    <object mime="image/gif">destroyer-v.gif</object>
+  </icon>
+  <icon>
+    <image xmlns='tkimage'>battleship/battleship/horizontal</image>
+    <object mime="image/gif">battleship-h.gif</object>
+  </icon>
+  <icon>
+    <image xmlns='tkimage'>battleship/battleship/vertical</image>
+    <object mime="image/gif">battleship-v.gif</object>
+  </icon>
+  <icon>
+    <image xmlns='tkimage'>battleship/carrier/horizontal</image>
+    <object mime="image/gif">carrier-h.gif</object>
+  </icon>
+  <icon>
+    <image xmlns='tkimage'>battleship/carrier/vertical</image>
+    <object mime="image/gif">carrier-v.gif</object>
+  </icon>
+</icondef>
+


Property changes on: trunk/tkabber-plugins/battleship/pixmaps/copybook/icondef.xml
___________________________________________________________________
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
Added: svn:keywords
## -0,0 +1 ##
+Author Date Id Revision
\ No newline at end of property
Added: trunk/tkabber-plugins/battleship/pixmaps/copybook/miss.gif
===================================================================
(Binary files differ)

Index: trunk/tkabber-plugins/battleship/pixmaps/copybook/miss.gif
===================================================================
--- trunk/tkabber-plugins/battleship/pixmaps/copybook/miss.gif	2014-02-02 18:58:58 UTC (rev 2132)
+++ trunk/tkabber-plugins/battleship/pixmaps/copybook/miss.gif	2014-02-07 07:11:37 UTC (rev 2133)

Property changes on: trunk/tkabber-plugins/battleship/pixmaps/copybook/miss.gif
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/tkabber-plugins/battleship/pixmaps/copybook/submarine-h.gif
===================================================================
(Binary files differ)

Index: trunk/tkabber-plugins/battleship/pixmaps/copybook/submarine-h.gif
===================================================================
--- trunk/tkabber-plugins/battleship/pixmaps/copybook/submarine-h.gif	2014-02-02 18:58:58 UTC (rev 2132)
+++ trunk/tkabber-plugins/battleship/pixmaps/copybook/submarine-h.gif	2014-02-07 07:11:37 UTC (rev 2133)

Property changes on: trunk/tkabber-plugins/battleship/pixmaps/copybook/submarine-h.gif
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/tkabber-plugins/battleship/pixmaps/copybook/submarine-v.gif
===================================================================
(Binary files differ)

Index: trunk/tkabber-plugins/battleship/pixmaps/copybook/submarine-v.gif
===================================================================
--- trunk/tkabber-plugins/battleship/pixmaps/copybook/submarine-v.gif	2014-02-02 18:58:58 UTC (rev 2132)
+++ trunk/tkabber-plugins/battleship/pixmaps/copybook/submarine-v.gif	2014-02-07 07:11:37 UTC (rev 2133)

Property changes on: trunk/tkabber-plugins/battleship/pixmaps/copybook/submarine-v.gif
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/tkabber-plugins/battleship/proto
===================================================================
--- trunk/tkabber-plugins/battleship/proto	                        (rev 0)
+++ trunk/tkabber-plugins/battleship/proto	2014-02-07 07:11:37 UTC (rev 2133)
@@ -0,0 +1,145 @@
+# $Id$
+
+Request:
+
+<iq type='set' to='a at b.c' id='id1'>
+    <create xmlns='games:board' id='123' type='battleship' start='true'/>
+</iq>
+
+Positive response:
+
+<iq type='result' to='x at y.z' id='id1'/>?
+
+After that the encrypted field must be sent by both players.
+Hash is SHA1 digest of concatenated random string seed and symbol 0
+(if the field is empty) or 1 (if the field is occupied by a ship).
+
+Example1: seed qscercxifvrt gives 3ebe9d6974e3a2815271553605b3d3b74008e8d4 for
+free field and 7cdb05fd65cd3d943a7ff937cc0da5f31b990f76 for occupied field.
+
+Also, the ship hashes are to be included: each is a SHA1 hash of
+concatenated seeds for the positions where the ship is located.
+The cells go sequentially with one coordinate fixed and the other is growing.
+
+Seed MUST NOT be the same for different board cells.
+
+<iq type='set' to='a at b.c' id='id2'>
+    <board xmlns='games:board' type='battleship' id='123'>
+	<cell row='0' col='0' hash='3ebe9d6974e3a2815271553605b3d3b74008e8d4'/>
+	<cell row='0' col='1' hash='abc4481f0927f3c4a004314dc9c43999ed14d4f6'/>
+	<cell row='0' col='2' hash='7f1afdcdad4c980952580f85e35c21b6d7ba13ca'/>
+	<cell row='0' col='3' hash='4e14237c1458cfb3e755e30ff99bfab9dd883752'/>
+	...
+	<cell row='1' col='6' hash='97e471491d08463424b97ea495218a67cfc339ca'/>
+	...
+	<cell row='9' col='9' hash='79a2cecfcda630a268e955ccc3f60edec952b375'/>
+	<ship length='5' hash='1212312312312312312312312312313212121'/>
+	<ship length='4' hash='3423423423423423423423423423423423423'/>
+	<ship length='3' hash='3423423423423423423423423423423423423'/>
+	<ship length='2' hash='3423423423423423423423423423423423423'/>
+	<ship length='2' hash='3423423423423423423423423423423423423'/>
+	<ship length='1' hash='3423423423423423423423423423423423423'/>
+    </board>
+</iq>
+
+Response for the game board:
+
+<iq type='result' to='x at y.z' id='id2'/>
+
+Move:
+
+<iq type='set' to='x at y.z' id='id3'>
+    <turn xmlns='games:board' type='battleship' id='123'>
+	<shot row='1' col='6'/>
+    </turn>
+</iq>
+
+'row' and 'col' attributes contain coordinates of cell to be shot.
+Coordinate is an integer between 0 and 9.
+
+Response MUST include the result ('miss', 'hit' or 'destroy') and the seed of
+the cell to check the result.
+
+<iq type='result' to='a at b.c' id='id3'>
+    <turn xmlns='games:board' type='battleship' id='123'>
+	<shot result='miss' seed='qwerty'/>
+    </turn>
+</iq>
+
+Consistency check: SHA1(qwerty0) = 97e471491d08463424b97ea495218a67cfc339ca
+
+or:
+
+<iq type='result' to='a at b.c' id='id3'>
+    <turn xmlns='games:board' type='battleship' id='123'>
+	<shot result='hit' seed='qwerty'/>
+    </turn>
+</iq>
+
+or (some ship is destroyed):
+
+<iq type='result' to='a at b.c' id='id3'>
+    <turn xmlns='games:board' type='battleship' id='123'>
+	<shot result='destroy' seed='qwerty'/>
+    </turn>
+</iq>
+
+Proposing draw (if you want to terminate game before someone wins):
+
+<iq type='set' to='a at b.c' id='id4'>
+    <turn xmlns='games:board' type='battleship' id='123'>
+	<shot row='1' col='7'/>
+	<draw/>
+    </turn>
+</iq>
+
+The move turn then unconditionally goes to the opponent.
+
+Accepting draw proposal:
+
+<iq type='set' to='a at b.c' id='id5'>
+    <turn xmlns='games:board' type='battleship' id='123'>
+	<accept/>
+    </turn>
+</iq>
+
+Resigning:
+
+<iq type='set' to='a at b.c' id='id6'>
+    <turn xmlns='games:board' type='battleship' id='123'>
+	<resign/>
+    </turn>
+</iq>
+
+Response:
+
+<iq type='result' to='x at y.z' id='id*'/>
+
+if move accepted, or error 'Not Acceptable' if other side thinks that this move
+illegal.
+
+After the game is over (either someone have lost all his/her ships, or someone
+resigned, or game was tied) both players MUST send uncovered boards with seeds:
+
+<iq type='set' to='a at b.c' id='id7'>
+    <board xmlns='games:board' type='battleship' id='123'>
+	<cell row='0' col='0' ship='true' seed='qwert1'/>
+	<cell row='0' col='1' ship='false' seed='qwert2'/>
+	<cell row='0' col='2' ship='false' seed='qwert3'/>
+	<cell row='0' col='3' ship='false' seed='qwert4'/>
+	...
+	<cell row='1' col='6' ship='false' seed='qwerty'/>
+	...
+	<cell row='9' col='9' ship='true' seed='qwert12'/>
+    </board>
+</iq>
+
+Response:
+
+<iq type='result' to='x at y.z' id='id7'/>
+
+if the board is consistent with the initial hashes. Otherwise client should
+return error 'Not Acceptable'
+
+
+


Property changes on: trunk/tkabber-plugins/battleship/proto
___________________________________________________________________
Added: svn:keywords
## -0,0 +1 ##
+Author Date Id Revision
\ No newline at end of property
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property


More information about the Tkabber-dev mailing list