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

    variable winid 0

    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 w [winfo children .] {
	if {[regexp {^\.battleship_invite} $w]} {
	    catch {
		set wf [$w getframe]
		bind $wf <Destroy> {}
	    }
	    destroy $w
	}
    }

    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} {
    variable winid

    set w .battleship_invite[incr winid]

    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 $w $xlib $jid true]]
    $w add -text [::msgcat::mc "I want to move second"] \
	-command [namespace code [list invite $w $xlib $jid false]]
    $w add -text [::msgcat::mc "Cancel invitation"] \
	-command [list destroy $w]

    $w draw
}

proc battleship::invite {w xlib jid first} {
    destroy $w

    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} {
    variable winid

    if {![string equal $status ok]} {
	set w .battleship_invite_error[incr winid]

	after idle [list NonmodalMessageDlg $w -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} {
    variable winid

    set w .battleship_invited[incr winid]

    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 [expr {$x-1}] [expr {$y-1}] $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 [expr {$x-1}] [expr {$y-1}] $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 [expr {$x-1}] [expr {$y-1}] $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 [expr {$x-1}] [expr {$y-1}] $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 [expr {$x-1}] [expr {$y-1}] $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
}

