# $Id$

package require msgcat

namespace eval chess {
    ::msgcat::mcload [file join [file dirname [info script]] msgs]

    if {![::plugins::is_registered chess]} {
	::plugins::register chess \
			    -namespace [namespace current] \
			    -source [info script] \
			    -description [::msgcat::mc "Whether the Chess plugin is loaded."] \
			    -loadcommand [namespace code load] \
			    -unloadcommand [namespace code unload]
	return
    }

    variable square_size 48
    variable line_width 1
    array set piece_name [list \
			      wk [::msgcat::mc "K"] \
			      wq [::msgcat::mc "Q"] \
			      wr [::msgcat::mc "R"] \
			      wb [::msgcat::mc "B"] \
			      wn [::msgcat::mc "N"] \
			      wp {} \
			      bk [::msgcat::mc "K"] \
			      bq [::msgcat::mc "Q"] \
			      br [::msgcat::mc "R"] \
			      bb [::msgcat::mc "B"] \
			      bn [::msgcat::mc "N"] \
			      bp {}]
    array set prom_name [list q queen r rook b bishop n knight]
    array set prom_rev [list queen q rook r bishop b knight n]

    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 Chess [::msgcat::mc "Chess plugin options."] \
	-group Plugins
    custom::defvar options(theme) Classic \
	[::msgcat::mc "Chess figures theme."] -group Chess \
	-type options -values $values \
	-command [namespace current]::load_stored_theme
    custom::defvar options(flip_black_view) 1 \
	[::msgcat::mc "Flip board view when playing black by default."] \
	-type boolean -group Chess
    custom::defvar options(show_last_move) 0 \
	[::msgcat::mc "Show last move by default."] \
	-type boolean -group Chess
    custom::defvar options(always_queen) 0 \
	[::msgcat::mc "Promote pawns always as queens."] \
	-type boolean -group Chess
    custom::defvar options(show_tooltips) 1 \
	[::msgcat::mc "Show tooltips with short instructions."] \
	-type boolean -group Chess \
	-command [list [namespace current]::set_tooltips]
    custom::defvar options(sound) "" \
        [::msgcat::mc "Sound to play after opponent's turn"] \
	-type file -group Chess
    custom::defvar options(allow_illegal) 0 \
	[::msgcat::mc "Allow illegal moves (useful for debugging)."] \
	-type boolean -group Chess
    custom::defvar options(accept_illegal) 0 \
	[::msgcat::mc "Accept opponent illegal moves (useful for\
		       debugging)."] \
	-type boolean -group Chess
}

proc chess::load {} {
    hook::add roster_create_groupchat_user_menu_hook \
              [namespace current]::add_groupchat_user_menu_item 48
    hook::add chat_create_user_menu_hook \
              [namespace current]::add_groupchat_user_menu_item 48
    hook::add roster_jid_popup_menu_hook \
              [namespace current]::add_groupchat_user_menu_item 48

    hook::add games_board_create_hook [namespace current]::iq_create
    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 turn games:board \
			 [namespace parent]::iq_games_board_turn

    load_stored_theme
    calc_moves
}

proc chess::unload {} {
    hook::remove roster_create_groupchat_user_menu_hook \
              [namespace current]::add_groupchat_user_menu_item 48
    hook::remove chat_create_user_menu_hook \
              [namespace current]::add_groupchat_user_menu_item 48
    hook::remove roster_jid_popup_menu_hook \
              [namespace current]::add_groupchat_user_menu_item 48

    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_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 chess/ $img] == 0} {
            image delete $img
        }
    }
}

proc chess::load_stored_theme {args} {
    variable options
    variable themes

    pixmaps::load_dir $themes($options(theme))
}

proc chess::get_nick {xlib jid type} {
    if {[catch {chat::get_nick $xlib $jid $type} nick]} {
	return [chat::get_nick $jid $type]
    } else {
	return $nick
    }
}

proc chess::invite_dialog {xlib jid} {
    set w .chess_invite

    if {[winfo exists $w]} {
	destroy $w
    }

    Dialog $w -title [::msgcat::mc "Chess Invitation"] \
	-modal none -separator 1 -anchor e -default 0

    set wf [$w getframe]
    message $wf.message -aspect 50000 \
	-text [::msgcat::mc "Sending chess game invitation to %s (%s)" \
		      [get_nick $xlib $jid chat] \
		      $jid]

    pack $wf.message -pady 2m

    $w add -text [::msgcat::mc "I want play white"] \
	-command [list [namespace current]::invite $xlib $jid white]
    $w add -text [::msgcat::mc "I want play black"] \
	-command [list [namespace current]::invite $xlib $jid black]
    $w add -text [::msgcat::mc "Cancel invitation"] \
	-command [list destroy $w]

    $w draw
}

proc chess::invite {xlib jid color} {
    destroy .chess_invite

    set id chess[rand 1000000000]

    # FIX
    #set rjid [get_jid_of_user $jid]

    ::xmpp::sendIQ $xlib set \
	-query [::xmpp::xml::create create \
			-xmlns games:board \
			-attrs [list type chess \
				     id $id \
				     color $color]] \
	-to $jid \
	-command [list [namespace current]::invite_res $xlib $jid $id $color]
}

proc chess::invite_res {xlib jid id color status xml} {
    if {![string equal $status ok]} {
	after idle [list NonmodalMessageDlg .chess_invite_error -aspect 50000 -icon error \
	    -message [::msgcat::mc "%s (%s) has refused chess invitation: %s" \
				   [get_nick $xlib $jid chat] \
				   $jid [error_to_string $xml]]]
	return ""
    }

    start_play $xlib $jid $id $color
}


proc chess::invited_dialog {xlib jid iqid id color} {
    set w .chess_invited

    if {[winfo exists $w]} {
	destroy $w
    }

    Dialog $w -title [::msgcat::mc "Chess 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 $color 0]]

    set nick [get_nick $xlib $jid chat]
    set message1 [::msgcat::mc "Chess game invitation from %s (%s) is received." \
			 $nick $jid]
    switch -- $color {
	white {
	    set message2 [::msgcat::mc "%s wants play white." $nick]
	}
	black {
	    set message2 [::msgcat::mc "%s wants play black." $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 $color 1]]
    $w add -text [::msgcat::mc "Refuse to play"] \
	   -command [namespace code [list invited_res $w $xlib $jid $iqid $id $color 0]]

    $w draw
    return
}

proc chess::invited_res {w xlib jid iqid id color res} {
    catch {
	set wf [$w getframe]
	bind $wf <Destroy> {}
	destroy $w
    }

    if {$res} {
	switch -- $color {
	    white {
		start_play $xlib $jid $id black
	    }
	    black {
		start_play $xlib $jid $id white
	    }
	    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 chess \
						     id $id]] \
                       -to $jid \
                       -id $iqid
    } else {
	::xmpp::sendIQ $xlib error \
		       -error [::xmpp::stanzaerror::error \
					modify not-acceptable] \
		       -to $jid \
		       -id $iqid
    }
    return
}

proc chess::start_play {xlib jid id color} {
    set gid [make_gid $jid $id]
    variable $gid
    variable options
    upvar 0 $gid flags

    set flags(window) [win_id chess $gid]
    set flags(xlib) $xlib
    set flags(opponent) $jid
    set flags(id) $id
    set flags(flip) 0
    set flags(our_color) $color

    trace variable [namespace current]::${gid}(position,turn) w \
	[list [namespace current]::set_label_move $gid]

    make_default_position $gid

    open $gid
}

proc chess::set_label_move {gid args} {
    variable $gid
    upvar 0 $gid flags

    switch -- $flags(position,turn) {
	white {
	    set flags(move_label) [::msgcat::mc "White"]
	    set move 1
	}
	black {
	    set flags(move_label) [::msgcat::mc "Black"]
	    set move 1
	}
	default {
	    set move 0
	}
    }
    if {$move && [is_my_move $gid]} {
	append flags(move_label) [::msgcat::mc " (You)"]
    } else {
	append flags(move_label) [::msgcat::mc " (Opponent)"]
    }
}

proc chess::make_default_position {gid} {
    variable $gid
    upvar 0 $gid flags

    for {set c 0} {$c < 8} {incr c} {
	for {set r 0} {$r < 8} {incr r} {
	    set flags(position,$c,$r) ""
	}
    }
    for {set c 0} {$c < 8} {incr c} {
	set flags(position,$c,1) wp
	set flags(position,$c,6) bp
    }
    set c 0
    foreach f {r n b q k b n r} {
	set flags(position,$c,0) w$f
	set flags(position,$c,7) b$f
	incr c
    }
    set flags(position,wk,c) 4
    set flags(position,wk,r) 0
    set flags(position,bk,c) 4
    set flags(position,bk,r) 7

    set flags(position,wk,kcastling) 1
    set flags(position,wk,qcastling) 1
    set flags(position,bk,kcastling) 1
    set flags(position,bk,qcastling) 1
    set flags(position,enpassant) {}

    set flags(position,turn) white

    catch {unset flags(position,last_move)}
    set flags(position,draw) 0
    set flags(position,halfmove) 0
    set flags(position,history) {}

    set flags(position,repetitions) [list [code_position $gid] 1]
}

proc chess::save_position {gid} {
    variable $gid
    upvar 0 $gid flags

    set flags(saved_position) [array get flags position,*]
}

proc chess::restore_position {gid} {
    variable $gid
    upvar 0 $gid flags

    array set flags $flags(saved_position)
    draw_position $gid
    unhighlight_legal_moves $gid
    update_controls $gid
    find_legal_moves $gid $flags(position,turn)
}

proc chess::code_position {gid} {
    variable $gid
    upvar 0 $gid flags

    set code ""
    for {set c 0} {$c < 8} {incr c} {
	for {set r 0} {$r < 8} {incr r} {
	    switch -- $flags(position,$c,$r) {
		wk {append code K}
		wq {append code Q}
		wr {append code R}
		wb {append code B}
		wn {append code N}
		wp {append code P}
		bk {append code k}
		bq {append code q}
		br {append code r}
		bb {append code b}
		bn {append code n}
		bp {append code p}
		default {append code .}
	    }
	}
    }

    append code $flags(position,wk,kcastling)
    append code $flags(position,wk,qcastling)
    append code $flags(position,bk,kcastling)
    append code $flags(position,bk,qcastling)

    if {[llength $flags(position,enpassant)] > 0} {
	lassign $flags(position,enpassant) c r
	set cp1 [expr {$c + 1}]
	set cm1 [expr {$c - 1}]
	if {$r == 2} {
	    if {($cp1 < 8 && $flags(position,$cp1,3) == "bp") || \
		    ($cm1 >= 0 && $flags(position,$cm1,3) == "bp")} {
		append code $c$r
	    }
	} elseif {$r == 5} {
	    if {($cp1 < 8 && $flags(position,$cp1,4) == "wp") || \
		    ($cm1 >= 0 && $flags(position,$cm1,4) == "wp")} {
		append code $c$r
	    }
	}
    }

    return $code
}

proc chess::make_gid {jid id} {
    jid_to_tag [concat $jid $id]
}

proc chess::turn_recv {gid xmlList} {
    variable options
    variable prom_rev
    variable $gid
    upvar 0 $gid flags

    set move 0
    set draw 0

    foreach xml $xmlList {
	::xmpp::xml::split $xml tag xmlns attrs cdata subels
	switch -- $tag {
	    move {
		set pos [::xmpp::xml::getAttr $attrs pos]
		set poss [split $pos ";"]
		if {[llength $poss] == 2} {
		    set pos1 [split [lindex $poss 0] ,]
		    set pos2 [split [lindex $poss 1] ,]
		    if {[llength $pos1] == 2 && [llength $pos2] == 2} {
			set cf [lindex $pos1 0]
			set rf [lindex $pos1 1]
			set ct [lindex $pos2 0]
			set rt [lindex $pos2 1]
			set prom ""
			foreach subel $subels {
			    ::xmpp::xml::split $subel stag sxmlns sattrs scdata ssubels
			    if {$stag == "promotion"} {
				if {[info exists prom_rev($scdata)]} {
				    set prom $prom_rev($scdata)
				}
			    }
			}
			set move 1
			if {$options(sound) != "" && ![::sound::is_mute]} {
			    ::sound::play $options(sound)
		        }
			    
		    }
		}
	    }
	    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 chess \
							 id $flags(id)]]]
	    }
	    accept {
		if {$flags(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 chess \
							     id $flags(id)]]]
		} else {
		    return [list error modify not-acceptable]
		}
	    }
	    draw {
		set draw 1
	    }
	}
    }

    if {$move && [do_move $gid $cf $rf $ct $rt $prom $draw]} {
	update_controls $gid $draw
	draw_position $gid
	highlight_last_move $gid

	return [list result [::xmpp::xml::create turn \
				    -xmlns games:board \
				    -attrs [list type chess \
						 id $flags(id)]]]
    } else {
	return [list error modify not-acceptable]
    }
}


###############################################################################

proc chess::calc_moves {} {
    variable moves

    for {set c 0} {$c < 8} {incr c} {
	for {set r 0} {$r < 8} {incr r} {
	    for {set moves(d1,$c,$r) {}; set x [expr {$c+1}]; set y [expr {$r+1}]} \
		{($x < 8) && ($y < 8)} {incr x; incr y} {
		lappend moves(d1,$c,$r) $x $y
	    }
	    for {set moves(d2,$c,$r) {}; set x [expr {$c-1}]; set y [expr {$r+1}]} \
		{($x >= 0) && ($y < 8)} {incr x -1; incr y} {
		lappend moves(d2,$c,$r) $x $y
	    }
	    for {set moves(d3,$c,$r) {}; set x [expr {$c-1}]; set y [expr {$r-1}]} \
		{($x >= 0) && ($y >= 0)} {incr x -1; incr y -1} {
		lappend moves(d3,$c,$r) $x $y
	    }
	    for {set moves(d4,$c,$r) {}; set x [expr {$c+1}]; set y [expr {$r-1}]} \
		{($x < 8) && ($y >= 0)} {incr x; incr y -1} {
		lappend moves(d4,$c,$r) $x $y
	    }
	    for {set moves(h1,$c,$r) {}; set x [expr {$c+1}]} {$x < 8} {incr x} {
		lappend moves(h1,$c,$r) $x $r
	    }
	    for {set moves(h2,$c,$r) {}; set x [expr {$c-1}]} {$x >= 0} {incr x -1} {
		lappend moves(h2,$c,$r) $x $r
	    }
	    for {set moves(v1,$c,$r) {}; set y [expr {$r+1}]} {$y < 8} {incr y} {
		lappend moves(v1,$c,$r) $c $y
	    }
	    for {set moves(v2,$c,$r) {}; set y [expr {$r-1}]} {$y >= 0} {incr y -1} {
		lappend moves(v2,$c,$r) $c $y
	    }
	    set moves(n,$c,$r) {}
	    foreach {dx dy} {1 2 -1 2 -2 1 -2 -1 -1 -2 1 -2 2 -1 2 1} {
	    	set x [expr {$c + $dx}]
	    	set y [expr {$r + $dy}]
		if {($x >= 0) && ($x < 8) && ($y >= 0) && ($y < 8)} {
		    lappend moves(n,$c,$r) $x $y
		}
	    }
	    set moves(wpt,$c,$r) {}
	    if {$r <= 6} {
		if {$c <= 6} {
		    lappend moves(wpt,$c,$r) [expr {$c + 1}] [expr {$r + 1}]
		}
		if {$c >= 1} {
		    lappend moves(wpt,$c,$r) [expr {$c - 1}] [expr {$r + 1}]
		}
	    }
	    set moves(bpt,$c,$r) {}
	    if {$r >= 1} {
		if {$c <= 6} {
		    lappend moves(bpt,$c,$r) [expr {$c + 1}] [expr {$r - 1}]
		}
		if {$c >= 1} {
		    lappend moves(bpt,$c,$r) [expr {$c - 1}] [expr {$r - 1}]
		}
	    }
	    set moves(k,$c,$r) {}
	    foreach {dx dy} {0 1 -1 1 -1 0 -1 -1 0 -1 1 -1 1 0 1 1} {
		set x [expr {$c + $dx}]
		set y [expr {$r + $dy}]
		if {($x >= 0) && ($x < 8) && ($y >= 0) && ($y < 8)} {
		    lappend moves(k,$c,$r) $x $y
		}
	    }
	}
    }
}

proc chess::center {c r} {
    variable square_size
    variable line_width

    set r [expr {7 - $r}]
    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 chess::close {gid} {
    variable $gid
    upvar 0 $gid flags

    array unset flags
}

proc chess::exists {gid} {
    variable $gid
    info exists $gid
}

proc chess::open {gid} {
    variable options
    variable square_size
    variable line_width
    variable piece_name
    variable $gid
    upvar 0 $gid flags

    set jid $flags(opponent)

    set w $flags(window)
    if {[winfo exists $w]} {
	raise_win $w
	return
    }

    set title [::msgcat::mc "Chess with %s" [get_nick $flags(xlib) $jid chat]]
    add_win $w -title $title \
	       -tabtitle $title \
	       -class Chess \
	       -raise 1

    set board [canvas $w.board \
		   -width [expr {($square_size + $line_width) * 8}] \
		   -height [expr {($square_size + $line_width) * 8}]]
    pack $board -side left -anchor w -padx 10

    set flags(board) $board

    set flags(show_last_move) $options(show_last_move)
    set relief [expr {$flags(show_last_move) ? "sunken" : "raised"}]
    set slm [Button $w.show_last_move -text [::msgcat::mc "Show last move"] \
		-relief $relief \
		-command [list [namespace current]::toggle_show_last_move $gid]]
    pack $slm -side top -anchor w -fill x
    set flags(show_last_move_button) $slm

    set flags(flip) 0
    set slm [Button $w.flip -text [::msgcat::mc "Flip view"] \
		-relief raised \
		-command [list [namespace current]::toggle_flip_view $gid]]
    pack $slm -side top -anchor w -fill x
    set flags(flip_button) $slm

    frame $w.move 
    pack $w.move -side top -anchor w
    label $w.move.title -text [::msgcat::mc "Move: "]
    pack $w.move.title -side left
    label $w.move.on_move -anchor w \
	-textvariable [namespace current]::${gid}(move_label)
    pack $w.move.on_move -side left -anchor w

    set bbox [ButtonBox $w.bbox -orient vertical -spacing 0]
    $bbox add -text [::msgcat::mc "Propose a draw"] \
	-command [list [namespace current]::toggle_draw $gid]
    $bbox add -text [::msgcat::mc "Accept the draw proposal"] \
	-state disabled \
	-command [list [namespace current]::accept_draw $gid]
    $bbox add -text [::msgcat::mc "Resign the game"] \
	-command [list [namespace current]::send_resign $gid]
    grid columnconfigure $bbox 0 -weight 1
    pack $bbox -side bottom -anchor w -fill x
    set flags(bbox) $bbox
    set_tooltips

    #label $w.history -text [::msgcat::mc "History"]
    #pack $w.history -side top -anchor w
    set hsw [ScrolledWindow $w.hsw]
    pack $hsw -side top -fill x -expand yes
    set ht [text $w.text -wrap word -height 60 -state disabled]
    set font [$ht cget -font]
    set tabstop1 [font measure $font "99.."]
    set tabstop2 [font measure $font "99..Qa8-a8+= "]
    $ht configure -tabs "$tabstop1 $tabstop2"
    $ht tag configure attention -foreground [option get $ht errorForeground Text]
    $hsw setwidget $ht
    set flags(hw) $ht

    set dsq_color #77a26d
    set lsq_color #c8c365

    for {set c 0} {$c < 8} {incr c} {
	for {set r 0} {$r < 8} {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)}]
	    set color [expr {($c+$r) % 2 ? $dsq_color : $lsq_color}]
	    set img [expr {($c+$r) % 2 ? "bf" : "wf"}]

	    $board create image $x1 $y1 -image chess/$img -anchor nw \
		-tags [list background [list cr $c [expr {7-$r}]]]
	    $board create rectangle $x1 $y1 $x2 $y2 \
		-outline {} \
		-tags [list square [list cr $c [expr {7-$r}]]]
	}
    }

    $board bind figure <1> \
	[list [namespace current]::start_drag_figure $gid %x %y]
    $board bind figure <B1-Motion> \
	[list [namespace current]::drag_figure $gid %x %y]
    $board bind figure <ButtonRelease-1> \
	[list [namespace current]::drag_end $gid %x %y]

    bind $w <Destroy> [list [namespace current]::close $gid]

    if {[is_black $flags(our_color)] && $options(flip_black_view)} {
	toggle_flip_view $gid
    }

    draw_position $gid
    update_controls $gid
    find_legal_moves $gid $flags(position,turn)
}

proc chess::toggle_flip_view {gid} {
    variable $gid
    upvar 0 $gid flags

    set flags(flip) [expr {!$flags(flip)}]

    set board $flags(board)

    for {set c 0} {$c < 8} {incr c} {
	for {set r 0} {$r < 8} {incr r} {
	    $board addtag [list temp [expr {7-$c}] [expr {7-$r}]] \
		   withtag [list cr $c $r]
	    $board dtag [list cr $c $r]
	}
    }

    for {set c 0} {$c < 8} {incr c} {
	for {set r 0} {$r < 8} {incr r} {
	    $board addtag [list cr $c $r] withtag [list temp $c $r]
	    $board dtag [list temp $c $r]
	}
    }
    
    set relief [expr {$flags(flip) ? "sunken" : "raised"}]
    $flags(flip_button) configure -relief $relief

    draw_position $gid
    highlight_last_move $gid
}

proc chess::set_tooltips {args} {
    variable options

    if {$options(show_tooltips)} {
	set tooltip0 [::msgcat::mc "Press button and make move if you want propose draw"]
	set tooltip1 [::msgcat::mc "Press button if you want accept the draw proposal"]
	set tooltip2 [::msgcat::mc "Press button if you want resign"]
    } else {
	set tooltip0 ""
	set tooltip1 ""
	set tooltip2 ""
    }

    foreach var [info vars [namespace current]::*] {
	upvar 0 $var flags
	if {[info exists flags(bbox)]} {
	    catch {
		$flags(bbox) itemconfigure 0 -helptext $tooltip0
		$flags(bbox) itemconfigure 1 -helptext $tooltip1
		$flags(bbox) itemconfigure 2 -helptext $tooltip2
	    }
	}
    }
}

proc chess::toggle_show_last_move {gid} {
    variable $gid
    upvar 0 $gid flags

    set flags(show_last_move) [expr {!$flags(show_last_move)}]

    set relief [expr {$flags(show_last_move) ? "sunken" : "raised"}]
    $flags(show_last_move_button) configure -relief $relief

    highlight_last_move $gid
}

proc chess::toggle_draw {gid} {
    variable $gid
    upvar 0 $gid flags

    set flags(position,draw) [expr {!$flags(position,draw)}]

    if {$flags(position,draw)} {
	$flags(bbox) itemconfigure 0 -relief sunken
    } else {
	$flags(bbox) itemconfigure 0 -relief raised
    }
}

proc chess::update_controls {gid {draw_proposed 0}} {
    variable $gid
    upvar 0 $gid flags

    $flags(bbox) itemconfigure 0 -relief raised

    if {[is_my_move $gid]} {
	$flags(board) config -cursor ""
	set flags(position,draw) 0
	if {$draw_proposed} {
	    $flags(bbox) itemconfigure 0 -state disabled
	    $flags(bbox) itemconfigure 1 -state normal
	    $flags(bbox) itemconfigure 2 -state disabled
	} else {
	    $flags(bbox) itemconfigure 0 -state normal
	    $flags(bbox) itemconfigure 1 -state disabled
	    $flags(bbox) itemconfigure 2 -state normal
	}
    } elseif {![is_white $flags(position,turn)] && \
	      ![is_black $flags(position,turn)]} {
	$flags(board) config -cursor ""
	$flags(bbox) itemconfigure 0 -state disabled
	$flags(bbox) itemconfigure 1 -state disabled
	$flags(bbox) itemconfigure 2 -state disabled
    } else {
	$flags(board) config -cursor watch
	$flags(bbox) itemconfigure 0 -state disabled
	$flags(bbox) itemconfigure 1 -state disabled
	$flags(bbox) itemconfigure 2 -state disabled
    }
}

proc chess::end_game {gid my_score message} {
    variable $gid
    upvar 0 $gid flags

    set opponent_score [expr {1 - $my_score}]

    if {[is_white $flags(our_color)]} {
	set score "$my_score : $opponent_score"
    } else {
	set score "$opponent_score : $my_score"
    }

    set flags(position,turn) none
    set flags(move_label) $message

    set hw $flags(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
}

proc chess::draw_position {gid} {
    variable $gid
    upvar 0 $gid flags

    $flags(board) delete figure

    for {set c 0} {$c < 8} {incr c} {
	for {set r 0} {$r < 8} {incr r} {
	    if {$flags(position,$c,$r) != ""} {
		if {$flags(flip)} {
		    set c1 [expr {7 - $c}]
		    set r1 [expr {7 - $r}]
		} else {
		    set c1 $c
		    set r1 $r
		}
		$flags(board) create image [center $c1 $r1] \
		    -image chess/$flags(position,$c,$r) \
		    -tags [list figure $flags(position,$c,$r) [list cr $c $r]]
	    }
	}
    }
}

proc chess::start_drag_figure {gid x y} {
    variable $gid
    upvar 0 $gid flags

    set board $flags(board)

    lassign [lindex [lmatch -regexp [$board gettags current] ^cr] 0] cr \
	flags(currentc) flags(currentr)

    set flags(last_x) [$board canvasx $x]
    set flags(last_y) [$board canvasy $y]
    $board raise current
    $board config -cursor hand2

    highlight_legal_moves $gid $flags(currentc) $flags(currentr)
}

proc chess::drag_figure {gid x y} {
    variable $gid
    upvar 0 $gid flags

    set board $flags(board)

    set x [$board canvasx $x]
    set y [$board canvasy $y]
    $board move current \
	[expr {$x - $flags(last_x)}] [expr {$y - $flags(last_y)}]
    set flags(last_x) $x
    set flags(last_y) $y

    $board itemconfigure dst_sq&&square -outline ""
    $board dtag dst_sq
    $board itemconfigure legal&&square -outline blue
    $board addtag dst_sq overlapping $x $y $x $y
    lassign [lindex [lmatch -regexp [$board gettags dst_sq&&background] ^cr] 0] \
	cr c r
    $board addtag dst_sq withtag [list cr $c $r]&&square
    $board itemconfigure dst_sq&&square -outline red
    $board itemconfigure dst_sq&&legal&&square -outline white
}

proc chess::drag_end {gid x y} {
    variable options
    variable $gid
    upvar 0 $gid flags

    set board $flags(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

    lassign [lindex [lmatch \
			 -regexp [$board gettags dst_sq&&background] \
			 ^cr] 0] cr c r
    $board dtag dst_sq

    if {$options(allow_illegal) || [is_my_move $gid]} {
	do_move $gid $flags(currentc) $flags(currentr) \
		$c $r "" $flags(position,draw)
    }
    
    update_controls $gid
    draw_position $gid

    unhighlight_legal_moves $gid

    highlight_last_move $gid
}

proc chess::highlight_last_move {gid} {
    variable $gid
    upvar 0 $gid flags

    $flags(board) itemconfigure square -outline ""
    $flags(board) itemconfigure square -outline ""
    
    if {[catch {lassign $flags(position,last_move) cf rf ct rt}]} {
	return
    }

    if {$flags(show_last_move)} {
	set color white
    } else {
	set color {}
    }

    $flags(board) itemconfigure [list cr $cf $rf]&&square -outline $color
    $flags(board) itemconfigure [list cr $ct $rt]&&square -outline $color
}

proc chess::do_move {gid cf rf ct rt prom draw} {
    variable options
    variable $gid
    upvar 0 $gid flags

    if {$cf == $ct && $rf == $rt || $ct == "" || $rt == ""} {
	return 0
    }

    set opts "-"
    set prm ""
    set suffix ""
    set checkmate 0
    set stalemate 0
    set my_move [is_my_move $gid]

    if {![is_move_legal $gid $cf $rf $ct $rt]} {
	if {$my_move && !$options(allow_illegal)} {
	    return 0
	}
	if {!$my_move && !$options(accept_illegal)} {
	    return 0
	}
    }

    save_position $gid

    if {$flags(position,$ct,$rt) != ""} {
	set opts ":"
    }
    set f $flags(position,$cf,$rf)
    set flags(position,$ct,$rt) $flags(position,$cf,$rf)
    set flags(position,$cf,$rf) ""

    if {$flags(position,$ct,$rt) == "wk"} {
	set flags(position,wk,c) $ct
	set flags(position,wk,r) $rt
    } elseif {$flags(position,$ct,$rt) == "bk"} {
	set flags(position,bk,c) $ct
	set flags(position,bk,r) $rt
    }
 	
    if {[is_white $flags(position,turn)]} {
 	set p "w"
 	set opp "b"
 	set r 0
    } else {
 	set p "b"
 	set opp "w"
 	set r 7
    }

    if {$rt == (7 - $r)} {
	if {$ct == 0} {
	    set flags(position,${opp}k,qcastling) 0
	} elseif {$ct == 7} {
	    set flags(position,${opp}k,kcastling) 0
	}
    }
    if {$flags(position,$ct,$rt) == "${p}k"} {
 	set flags(position,${p}k,kcastling) 0
 	set flags(position,${p}k,qcastling) 0
 	if {($ct - $cf) == 2} {
 	    set opts {0-0}
 	    set flags(position,5,$r) "${p}r"
 	    set flags(position,7,$r) ""
 	} elseif {($ct - $cf) == -2} {
 	    set opts {0-0-0}
 	    set flags(position,3,$r) "${p}r"
 	    set flags(position,0,$r) ""
 	}
    } elseif {$flags(position,$ct,$rt) == "${p}r"} {
 	if {($cf == 0) && ($rf == $r)} {
 	    set flags(position,${p}k,qcastling) 0
 	} elseif {($cf == 7) && ($rf == $r)} {
 	    set flags(position,${p}k,kcastling) 0
 	}
    }

    set enpassant 0
    if {$flags(position,$ct,$rt) == "${p}p"} {
	if {(($p == "w") && ($rt == 7)) || \
	    (($p == "b") && ($rt == 0))} {
	    if {$my_move} {
		set promote [promote_pawn $gid $p]
		if {$promote == -1} {
		    set flags(position,$ct,$rt) "${p}q"
		} else {
		    set flags(position,$ct,$rt) $promote
		}
	    } else {
		if {$prom != ""} {
		    set flags(position,$ct,$rt) "${p}$prom"
		}
		# If we are here, then it's an error...
	    }
	    set prm $flags(position,$ct,$rt)
 	} elseif {$flags(position,enpassant) == [list $ct $rt]} {
 	    if {[is_white $flags(position,turn)]} {
 		set flags(position,$ct,4) ""
 	    } else {
 		set flags(position,$ct,3) ""
 	    }
	    set opts ":"
 	} else {
 	    if {($rt - $rf) == 2} {
 		set flags(position,enpassant) [list $ct [expr {$rt - 1}]]
		set enpassant 1
 	    } elseif {($rt - $rf) == -2} {
 		set flags(position,enpassant) [list $ct [expr {$rt + 1}]]
		set enpassant 1
 	    }
 	}
    }

    if {!$enpassant} {
	set flags(position,enpassant) {}
    }

    set flags(position,last_move) [list $cf $rf $ct $rt]

    if {[is_white $flags(position,turn)]} {
	set flags(position,turn) black
	set check [test_check $gid $flags(position,bk,c) $flags(position,bk,r) \
				   $flags(position,bk,c) $flags(position,bk,r)]
    } else {
	set flags(position,turn) white
	set check [test_check $gid $flags(position,wk,c) $flags(position,wk,r) \
				   $flags(position,wk,c) $flags(position,wk,r)]
    }

    find_legal_moves $gid $flags(position,turn)

    if {$check} {
	if {[lempty $flags(legal_moves)]} {
	    set suffix "#"
	    set draw 0
	    set checkmate 1
	} else {
	    set suffix "+"
	}
    } else {
	if {[lempty $flags(legal_moves)]} {
	    set stalemate 1
	}
    }
    if {$draw} {
	append suffix "="
    }
    lappend opts $prm $suffix
    add_move_to_history $gid $cf $rf $ct $rt $f $opts

    set repetitions [add_to_repetitions $gid]

    if {$draw && !$my_move} {
	attention_message $gid \
	    [::msgcat::mc "\n\n Opponent proposes a draw\n\n"]
    }
	
    if {$my_move} {
	send_move $gid $cf $rf $ct $rt $prm
    }

    if {$stalemate} {
	# Draw by stalemate
	end_game $gid 0.5 [::msgcat::mc "Draw (Stalemate)"]
    } elseif {$repetitions >= 3} {
	# Draw by repetition
	end_game $gid 0.5 [::msgcat::mc "Draw (Repetition)"]
    } elseif {$checkmate} {
	if {$my_move} {
	    # I win
	    end_game $gid 1 [::msgcat::mc "You win (Checkmate)"]
	} else {
	    # Opponent wins
	    end_game $gid 0 [::msgcat::mc "Opponent wins (Checkmate)"]
	}
    }

    tab_set_updated [winfo parent $flags(board)] 1 mesg_to_user
    return 1
}

proc chess::promote_pawn {gid color} {
    variable options
    variable square_size
    variable line_width
    variable $gid
    upvar 0 $gid flags

    if {$options(always_queen)} {
	return -1
    }

    set w .promote
    if {[winfo exists $w]} {
	destroy $w
    }

    Dialog .promote -title [::msgcat::mc "Pawn promotion"] \
	-separator 0 -anchor e -default 0

    set fr [frame $w.fr]
    set select [canvas $w.select \
	-width [expr {($square_size + $line_width) * 4}] \
	-height [expr {($square_size + $line_width)}]]

    pack $fr -padx 3m -pady 1m
    pack $select -padx 3m -pady 1m

    set c 0
    foreach fig {q r b n} {
	set img [expr {$c % 2 ? "bf" : "wf"}]
	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) * 0)}]
	set y2 [expr {($square_size + $line_width) * (0 + 1)}]
	$select create image $x1 $y1 -image chess/$img -anchor nw \
	    -tags [list background fg$fig]
	$select create image $x1 $y1 -image chess/$color$fig -anchor nw \
	    -tags [list figure fg$fig]
	$select create rectangle $x1 $y1 $x2 $y2 \
		-outline {} \
		-tags [list square fg$fig]
	incr c
    }

    bind $select <Any-Enter> [list [namespace current]::promotion:motion %W %x %y]
    bind $select <Any-Motion> [list [namespace current]::promotion:motion %W %x %y]
    bind $select <Any-Leave> [list [namespace current]::promotion:leave %W %x %y]
    foreach fig {q r b n} {
	$select bind fg$fig <ButtonRelease-1> \
	    [list Dialog::enddialog $w $color$fig]
    }

    $w draw
}

proc chess::promotion:motion {c x y} {

    set x [$c canvasx $x]
    set y [$c canvasy $y]

    $c itemconfigure dst_sq&&square -outline ""
    $c dtag dst_sq
    
    $c addtag dst_sq overlapping $x $y $x $y
    set tags [$c gettags dst_sq&&background]
    set tag [lindex $tags [lsearch $tags fg*]]
    if {$tag != ""} {
	$c addtag dst_sq withtag $tag&&square
    }
    
    $c itemconfigure dst_sq&&square -outline blue
}

proc chess::promotion:leave {c x y} {
    $c itemconfigure dst_sq&&square -outline ""
    $c dtag dst_sq
}

proc chess::accept_draw {gid} {
    variable $gid
    upvar 0 $gid flags

    ::xmpp::sendIQ $flags(xlib) set \
	-query [::xmpp::xml::create turn \
			-xmlns games:board \
			-attrs [list type chess \
				     id $flags(id)] \
			-subelement [::xmpp::xml::create accept]] \
	-to $flags(opponent)

	end_game $gid 0.5 [::msgcat::mc "Draw (You accepted)"]
	update_controls $gid
	draw_position $gid
	highlight_last_move $gid
}

proc chess::send_resign {gid} {
    variable $gid
    upvar 0 $gid flags

    ::xmpp::sendIQ $flags(xlib) set \
	-query [::xmpp::xml::create turn \
			-xmlns games:board \
			-attrs [list type chess \
				     id $flags(id)] \
			-subelement [::xmpp::xml::create resign]] \
	-to $flags(opponent)

	end_game $gid 0 [::msgcat::mc "Opponent wins (You resigned)"]
	update_controls $gid
	draw_position $gid
	highlight_last_move $gid
}

proc chess::send_move {gid cf rf ct rt prom} {
    variable $gid
    upvar 0 $gid flags

    set move_tags [list [make_move_tag $gid $cf $rf $ct $rt $prom]]
    if {$flags(position,draw)} {
	lappend move_tags [::xmpp::xml::create draw]
    }

    ::xmpp::sendIQ $flags(xlib) set \
	-query [::xmpp::xml::create turn \
			-xmlns games:board \
			-attrs [list type chess \
				     id $flags(id)] \
			-subelements $move_tags] \
	-to $flags(opponent) \
	-command [list [namespace current]::send_result $gid]
}

proc chess::send_result {gid status xml} {
    if {$status == "error"} {
	attention_message $gid \
	    [::msgcat::mc "\n\n Opponent rejected move:\n %s\n\n" \
			  [error_to_string $xml]]
	restore_position $gid
    }
}

proc chess::make_move_tag {gid cf rf ct rt prom} {
    variable prom_name

    if {$prom == ""} {
	::xmpp::xml::create move \
		-attrs [list pos "$cf,$rf;$ct,$rt"]
    } else {
	set f [string index $prom 1]
	::xmpp::xml::create move \
		-attrs [list pos "$cf,$rf;$ct,$rt"] \
		-subelement [::xmpp::xml::create promotion \
				    -cdata $prom_name($f)]
    }
}

proc chess::add_to_repetitions {gid} {
    variable $gid
    upvar 0 $gid flags

    array set repetitions $flags(position,repetitions)
    set code [code_position $gid]
    if {[info exists repetitions($code)]} {
	incr repetitions($code)
    } else {
	set repetitions($code) 1
    }
    set flags(position,repetitions) [array get repetitions]
    return $repetitions($code)
}

proc chess::add_move_to_history {gid cf rf ct rt f opts} {
    variable piece_name
    variable $gid
    upvar 0 $gid flags

    incr flags(position,halfmove) 1

    lappend flags(position,history) [list $cf $rf $ct $rt $f $opts]

    set hw $flags(hw)
    $hw configure -state normal
    $hw delete 0.0 end

    $hw insert end "\t[::msgcat::mc White]\t[::msgcat::mc Black]\n"
    set i 1
    foreach {w b} $flags(position,history) {
	$hw insert end "${i}.\t"
	if {$w != {}} {
	    lassign $w cf rf ct rt f opts
	    lassign $opts opt prom check
	    if {$prom == ""} {
		set m ""
	    } else {
		set m $piece_name($prom)
	    }
	    if {($opt == "0-0") || ($opt == "0-0-0")} {
		$hw insert end "$opt$check\t"
	    } else {
		incr rf
		incr rt
		set lf [format %c [expr {$cf+97}]]
		set lt [format %c [expr {$ct+97}]]
		set n $piece_name($f)
		$hw insert end "$n${lf}$rf${opt}${lt}$rt$m$check\t"
	    }
	}
	if {$b != {}} {
	    lassign $b cf rf ct rt f opts
	    lassign $opts opt prom check
	    if {$prom == ""} {
		set m ""
	    } else {
		set m $piece_name($prom)
	    }
	    if {($opt == "0-0") || ($opt == "0-0-0")} {
		$hw insert end "$opt$check\n"
	    } else {
		incr rf
		incr rt
		set lf [format %c [expr {$cf+97}]]
		set lt [format %c [expr {$ct+97}]]
		set n $piece_name($f)
		$hw insert end "$n${lf}$rf${opt}${lt}$rt$m$check\n"
	    }
	}
	incr i
    }
    $hw see end
    $hw configure -state disabled
}

proc chess::find_pseudo_legal_moves {gid color callback} {
    variable moves
    variable $gid
    upvar 0 $gid flags

    set c [string index $color 0]

    for {set cf 0} {$cf < 8} {incr cf} {
	for {set rf 0} {$rf < 8} {incr rf} {
	    if {[string index $flags(position,$cf,$rf) 0] != $c} {
		continue
	    }

	    switch -- $flags(position,$cf,$rf) {
		"" { continue }

		wp {
		    set rt [expr {$rf + 1}]
		    if {$rf < 7 && $flags(position,$cf,$rt) == ""} {
			if {$rf == 6} {
			    eval $callback $gid $cf $rf $cf $rt promotion
			} else {
			    eval $callback $gid $cf $rf $cf $rt
			}
		    }

		    if {$rf == 1 && $flags(position,$cf,2) == "" && \
			    $flags(position,$cf,3) == ""} {
			eval $callback $gid $cf $rf $cf 3
		    }

		    foreach {ct rt} $moves(wpt,$cf,$rf) {
			if {[is_black $flags(position,$ct,$rt)] || \
				($flags(position,enpassant) == [list $ct $rt])} {
			    if {$rf == 6} {
				eval $callback $gid $cf $rf $ct $rt promotion
			    } else {
				eval $callback $gid $cf $rf $ct $rt
			    }
			}
		    }
		}

		bp {
		    set rt [expr {$rf - 1}]
		    if {$rf > 0 && $flags(position,$cf,$rt) == ""} {
			if {$rf == 1} {
			    eval $callback $gid $cf $rf $cf $rt promotion
			} else {
			    eval $callback $gid $cf $rf $cf $rt
			}
		    }

		    if {$rf == 6 && $flags(position,$cf,5) == "" && \
			    $flags(position,$cf,4) == ""} {
			eval $callback $gid $cf $rf $cf 4
		    }

		    foreach {ct rt} $moves(bpt,$cf,$rf) {
			if {[is_white $flags(position,$ct,$rt)] || \
				$flags(position,enpassant) == [list $ct $rt]} {
			    if {$rf == 1} {
				eval $callback $gid $cf $rf $ct $rt promotion
			    } else {
				eval $callback $gid $cf $rf $ct $rt
			    }
			}
		    }
		}

		wn -
		bn {
		    foreach {ct rt} $moves(n,$cf,$rf) {
			if {[is_same_color $flags(position,$cf,$rf) \
				 $flags(position,$ct,$rt)]} \
			    continue
			eval $callback $gid $cf $rf $ct $rt
		    }
		}

		wb -
		bb {
		    foreach d {d1 d2 d3 d4} {
			foreach {ct rt} $moves($d,$cf,$rf) {
			    if {[is_same_color $flags(position,$cf,$rf) \
				 $flags(position,$ct,$rt)]} \
				break
			    eval $callback $gid $cf $rf $ct $rt
			    if {$flags(position,$ct,$rt) != ""} \
				break
			}
		    }
		}

		wr -
		br {
		    foreach d {h1 h2 v1 v2} {
			foreach {ct rt} $moves($d,$cf,$rf) {
			    if {[is_same_color $flags(position,$cf,$rf) \
				$flags(position,$ct,$rt)]} \
				break
			    eval $callback $gid $cf $rf $ct $rt
			    if {$flags(position,$ct,$rt) != ""} \
				break
			}
		    }
		}

		wq -
		bq {
		    foreach d {d1 d2 d3 d4 h1 h2 v1 v2} {
			foreach {ct rt} $moves($d,$cf,$rf) {
			    if {[is_same_color $flags(position,$cf,$rf) \
				$flags(position,$ct,$rt)]} \
				break
			    eval $callback $gid $cf $rf $ct $rt
			    if {$flags(position,$ct,$rt) != ""} \
				break
			}
		    }
		}

 		wk {
 		    foreach {ct rt} $moves(k,$cf,$rf) {
 			if {[is_same_color $flags(position,$cf,$rf) \
				 $flags(position,$ct,$rt)]} \
 			    continue
 			eval $callback $gid $cf $rf $ct $rt
 		    }
 		    if {($cf == 4) && ($rf == 0)} {
 			if {$flags(position,wk,kcastling) && \
				$flags(position,5,0) == "" && \
				$flags(position,6,0) == ""} {
 			    eval $callback $gid 4 0 6 0 kcastling
 			}
 			if {$flags(position,wk,qcastling) && \
				$flags(position,3,0) == "" && \
				$flags(position,2,0) == "" && \
				$flags(position,1,0) == ""} {
 			    eval $callback $gid 4 0 2 0 qcastling
 			}
 		    }
 		}
 		bk {
 		    foreach {ct rt} $moves(k,$cf,$rf) {
 			if {[is_same_color $flags(position,$cf,$rf) \
				 $flags(position,$ct,$rt)]} \
 			    continue
 			eval $callback $gid $cf $rf $ct $rt
 		    }
 		    if {($cf == 4) && ($rf == 7)} {
 			if {$flags(position,bk,kcastling) && \
				$flags(position,5,7) == "" && \
				$flags(position,6,7) == ""} {
 			    eval $callback $gid 4 7 6 7 kcastling
 			}
 			if {$flags(position,bk,qcastling) && \
				$flags(position,3,7) == "" && \
				$flags(position,2,7) == "" && \
				$flags(position,1,7) == ""} {
 			    eval $callback $gid 4 7 2 7 qcastling
			}
		    }
		}
	    }
	}
    }
}

proc chess::find_legal_moves {gid color} {
    variable $gid
    upvar 0 $gid flags

    set flags(legal_moves) {}
    find_pseudo_legal_moves $gid $color check_legal_callback
}

proc chess::check_legal_callback {gid cf rf ct rt {opt ""}} {
    variable $gid
    upvar 0 $gid flags

    if {![test_check $gid $cf $rf $ct $rt $opt]} {
	lappend flags(legal_moves) [list $cf $rf $ct $rt $opt]
    }
}

proc chess::test_check {gid cf rf ct rt {opt ""}} {
    variable $gid
    upvar 0 $gid flags

    set enpassantback ""
    set enpassantx ""
    set enpassanty ""
    if {[is_white $flags(position,turn)]} {
	set color black
	set f wk
	set of bk
	if {($rf == 4) && \
		($flags(position,$cf,$rf) == "wp") && \
		($flags(position,enpassant) == [list $ct $rt])} {
	    set enpassantback "bp"
	    set enpassantx $ct
	    set enpassanty [expr {$rt - 1}]
	    set flags(position,$enpassantx,$enpassanty) ""
	}
    } else {
	set color white
	set f bk
	set of wk
	if {($rf == 3) && \
		($flags(position,$cf,$rf) == "bp") && \
		($flags(position,enpassant) == [list $ct $rt])} {
	    set enpassantback "wp"
	    set enpassantx $ct
	    set enpassanty [expr {$rt + 1}]
	    set flags(position,$enpassantx,$enpassanty) ""
	}
    }
    set checks 0

    set back $flags(position,$ct,$rt)
    set flags(position,$ct,$rt) $flags(position,$cf,$rf)
    set flags(position,$cf,$rf) ""
    if {$flags(position,$ct,$rt) == "wk"} {
	set flags(position,wk,c) $ct
	set flags(position,wk,r) $rt
    } elseif {$flags(position,$ct,$rt) == "bk"} {
	set flags(position,bk,c) $ct
	set flags(position,bk,r) $rt
    }

    set kc  $flags(position,$f,c)
    set kr  $flags(position,$f,r)
    set okc $flags(position,$of,c)
    set okr $flags(position,$of,r)


    if {$opt == "kcastling"} {
 	set kcs [list 4 5 6]
    } elseif {$opt == "qcastling"} {
 	set kcs [list 4 3 2]
    } else {
 	set kcs [list $kc]
    }

    foreach c $kcs {
 	incr checks [test_figures $gid $color $c $kr]
 	incr checks [test_pawns $gid $color $c $kr]
 	if {[info exists okc]} {
 	    set dx [expr {abs($c-$okc)}]
 	    set dy [expr {abs($kr-$okr)}]
 	    if {($dx <= 1) && ($dy <= 1)} {
     		incr checks
 	    }
 	}
    }

    set flags(position,$cf,$rf) $flags(position,$ct,$rt)
    set flags(position,$ct,$rt) $back
    if {$flags(position,$cf,$rf) == "wk"} {
	set flags(position,wk,c) $cf
	set flags(position,wk,r) $rf
    } elseif {$flags(position,$cf,$rf) == "bk"} {
	set flags(position,bk,c) $cf
	set flags(position,bk,r) $rf
    }
    if {$enpassantback != ""} {
	set flags(position,$enpassantx,$enpassanty) $enpassantback 
    }

    return $checks
}

proc chess::test_pawns {gid color c r} {
    variable moves
    variable $gid
    upvar 0 $gid flags

    if {[is_white $color]} {
	foreach {x y} $moves(bpt,$c,$r) {
	    if {$flags(position,$x,$y) == "wp"} {
	    	return 1
	    }
	}
    } else {
	foreach {x y} $moves(wpt,$c,$r) {
	    if {$flags(position,$x,$y) == "bp"} {
	    	return 1
	    }
	}
    }
    return 0
}

proc chess::test_figures {gid color c r} {
    variable moves
    variable $gid
    upvar 0 $gid flags

    if {[is_white $color]} {
    	foreach i {d1 d2 d3 d4} {
	    foreach {x y} $moves($i,$c,$r) {
    		switch -- $flags(position,$x,$y) {
		    "" {continue}
		    wq -
		    wb {return 1}
		    default {break}
		}
	    }
	}
    	foreach i {h1 h2 v1 v2} {
	    foreach {x y} $moves($i,$c,$r) {
    		switch -- $flags(position,$x,$y) {
		    "" {continue}
		    wq -
		    wr {return 1}
		    default {break}
		}
	    }
	}
	foreach {x y} $moves(n,$c,$r) {
    	    switch -- $flags(position,$x,$y) {
		wn {return 1}
		default {continue}
	    }
	}
    } else {
    	foreach i {d1 d2 d3 d4} {
	    foreach {x y} $moves($i,$c,$r) {
    		switch -- $flags(position,$x,$y) {
		    "" {continue}
		    bq -
		    bb {return 1}
		    default {break}
		}
	    }
	}
    	foreach i {h1 h2 v1 v2} {
	    foreach {x y} $moves($i,$c,$r) {
    		switch -- $flags(position,$x,$y) {
		    "" {continue}
		    bq -
		    br {return 1}
		    default {break}
		}
	    }
	}
	foreach {x y} $moves(n,$c,$r) {
    	    switch -- $flags(position,$x,$y) {
		bn {return 1}
		default {continue}
	    }
	}
    }
    return 0
}

proc chess::is_move_legal {gid cf rf ct rt} {
    variable $gid
    upvar 0 $gid flags

    expr {[lmatch -regexp $flags(legal_moves) ^[list $cf $rf $ct $rt]] != {}}
}

proc chess::highlight_legal_moves {gid cf rf} {
    variable $gid
    upvar 0 $gid flags

    foreach move [lmatch -regexp $flags(legal_moves) ^[list $cf $rf]] {
	lassign $move cft rft ct rt
	$flags(board) addtag legal withtag [list cr $ct $rt]&&square

    }
    $flags(board) itemconfigure legal&&square -outline blue
}

proc chess::unhighlight_legal_moves {gid} {
    variable $gid
    upvar 0 $gid flags

    foreach sq [$flags(board) find withtag legal&&square] {
	$flags(board) itemconfigure $sq \
	    -outline [$flags(board) itemcget $sq -fill]
    }
    $flags(board) dtag legal
}

proc chess::attention_message {gid message} {
    variable $gid
    upvar 0 $gid flags

    set hw $flags(hw)
    $hw configure -state normal
    $hw delete {end -1 char} end
    $hw insert end $message attention
    $hw see end
    $hw configure -state disabled
}

proc chess::is_my_move {gid} {
    variable $gid
    upvar 0 $gid flags

    is_same_color $flags(position,turn) $flags(our_color)
}

proc chess::is_white {f} {
    string equal -length 1 $f w
}

proc chess::is_black {f} {
    string equal -length 1 $f b
}

proc chess::is_same_color {f1 f2} {
    string equal -length 1 $f1 $f2
}

proc chess::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 "Chess..."] \
	-command [list [namespace current]::invite_dialog $xlib $jid]
}

proc chess::iq_create {varname xlib from iqid xml} {
    upvar 2 $varname var

    ::xmpp::xml::split $xml tag xmlns attrs cdata subels

    if {[::xmpp::xml::getAttr $attrs type] == "chess"} {
	if {[::xmpp::xml::isAttr $attrs color]} {
	    set color [::xmpp::xml::getAttr $attrs color]
	    switch -- $color {
		white -
		black { }
		default {
		    set var [list error modify bad-request]
		}
	    }
	} else {
	    set color white
	}
	set var [[namespace current]::invited_dialog \
		     $xlib $from $iqid \
		     [::xmpp::xml::getAttr $attrs id] \
		     $color]
    }
    return
}

proc chess::iq_turn {varname xlib from xml} {
    upvar 2 $varname var

    ::xmpp::xml::split $xml tag xmlns attrs cdata subels

    if {[::xmpp::xml::getAttr $attrs type] == "chess"} {
	set gid [make_gid $from [::xmpp::xml::getAttr $attrs id]]
	if {[exists $gid]} {
	    set var [[namespace current]::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_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
}