# $Id: reversi.tcl 1744 2009-03-25 19:39:09Z sergei $

package require msgcat

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

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

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

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

    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 reversi::unload {} {
    hook::remove roster_create_groupchat_user_menu_hook \
              [namespace current]::add_groupchat_user_menu_item 48.2
    hook::remove chat_create_user_menu_hook \
              [namespace current]::add_groupchat_user_menu_item 48.2
    hook::remove roster_jid_popup_menu_hook \
              [namespace current]::add_groupchat_user_menu_item 48.2

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

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

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

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

proc reversi::invite_dialog {xlib jid} {
    set w .reversi_invite

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

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

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

    pack $wf.message -pady 2m

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

    $w draw
}

proc reversi::invite {xlib jid color} {
    destroy .reversi_invite

    set id reversi[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 reversi \
				     id $id \
				     color $color]] \
	-to $jid \
	-command [list [namespace current]::invite_res $xlib $jid $id $color]
}

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

    start_play $xlib $jid $id $color
}


proc reversi::invited_dialog {xlib jid iqid id color} {
    set w .reversi_invited

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

    Dialog $w -title [::msgcat::mc "Reversi 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 "Reversi 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 reversi::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 reversi \
						     id $id]] \
                       -to $jid \
                       -id $iqid
    } else {
	::xmpp::sendIQ $xlib error \
		       -error [::xmpp::stanzaerror::error \
					modify not-acceptable] \
		       -to $jid \
		       -id $iqid
    }
}

proc reversi::start_play {xlib jid id color} {

    set gid [make_gid $jid $id]
    variable $gid
    upvar 0 $gid flags

    set flags(window) [win_id reversi $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 reversi::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 reversi::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) ""
	}
    }
    set flags(position,3,3) w
    set flags(position,4,4) w
    set flags(position,3,4) b
    set flags(position,4,3) b

    set flags(position,turn) black

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

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

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

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

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

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

proc reversi::turn_recv {gid xmlList} {
    variable options
    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 {
	    put {
		set pos [::xmpp::xml::getAttr $attrs pos]
		set poss [split $pos ","]
		if {[llength $poss] == 2} {
		    set ct [lindex $poss 0]
		    set rt [lindex $poss 1]
		    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 reversi \
							 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 reversi \
							     id $flags(id)]]]
		} else {
		    return [list error modify not-acceptable]
		}
	    }
	    draw {
		set draw 1
	    }
	}
    }

    if {$move && [do_move $gid $ct $rt $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 reversi \
						     id $flags(id)]]]
    } else {
	return [list error modify not-acceptable]
    }
}

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

proc reversi::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
	    }
	}
    }
}

proc reversi::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 reversi::close {gid} {
    variable $gid
    upvar 0 $gid flags

    array unset flags
}

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

proc reversi::open {gid} {
    variable options
    variable square_size
    variable line_width
    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 "Reversi with %s" [get_nick $flags(xlib) $jid chat]]
    add_win $w -title $title \
	       -tabtitle $title \
	       -class Reversi \
	       -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 reversi/$img -anchor nw \
		-tags [list background [list cr $c [expr {7-$r}]]]
	    $board create rectangle $x1 $y1 $x2 $y2 \
		-outline {} \
		-tags [list last [list cr $c [expr {7-$r}]]]
	    $board create rectangle $x1 $y1 $x2 $y2 \
		-outline {} \
		-tags [list square [list cr $c [expr {7-$r}]]]
	}
    }

    bind $board <Any-Enter> \
	[list [namespace current]::motion $gid %x %y]
    bind $board <Any-Motion> \
	[list [namespace current]::motion $gid %x %y]
    bind $board <Any-Leave> \
	[list [namespace current]::leave $gid %x %y]
    bind $board <ButtonRelease-1> \
	[list [namespace current]::release $gid %x %y]

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

    make_default_position $gid
    
    if {[is_white $flags(our_color)] && $options(flip_white_view)} {
	toggle_flip_view $gid
    }

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

proc reversi::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_legal_moves $gid
    highlight_last_move $gid
}

proc reversi::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 reversi::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 reversi::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 reversi::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 reversi::end_game {gid my_score message} {
    variable $gid
    upvar 0 $gid flags

    set opponent_score [expr {1 - $my_score}]

    if {[is_black $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 reversi::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 reversi/$flags(position,$c,$r) \
		    -tags [list figure $flags(position,$c,$r) [list cr $c $r]]
	    }
	}
    }
}

proc reversi::motion {gid x y} {
    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
    set tags [$board gettags dst_sq&&background]
    lassign [lindex $tags [lsearch $tags cr*]] cr c r
    $board addtag dst_sq withtag [list cr $c $r]&&square
    
    if {[info exists flags(position,$c,$r)] && $flags(position,$c,$r) == ""} {
	$board itemconfigure dst_sq&&square -outline red
	$board itemconfigure dst_sq&&legal&&square -outline blue
    }
}

proc reversi::leave {gid x y} {
    variable $gid
    upvar 0 $gid flags

    set board $flags(board)

    $board itemconfigure dst_sq&&square -outline ""
    $board dtag dst_sq
    highlight_last_move $gid
}

proc reversi::release {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

    set tags [$board gettags dst_sq&&background]
    lassign [lindex $tags [lsearch $tags cr*]] cr c r
    $board dtag dst_sq

    if {$options(allow_illegal) || [is_my_move $gid]} {
	if {[do_move $gid $c $r $flags(position,draw)]} {
	    $board itemconfigure [list cr $c $r]&&square -outline ""
	}
    }
    
    update_controls $gid
    draw_position $gid

    highlight_last_move $gid
}

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

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

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

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

proc reversi::do_move {gid ct rt draw} {
    variable options
    variable moves
    variable $gid
    upvar 0 $gid flags
    
    if {$ct == "" || $rt == ""} {
	return 0
    }

    set my_move [is_my_move $gid]

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

    save_position $gid

    if {[is_white $flags(position,turn)]} {
	set mover w
	set opp b
    } else {
	set mover b
	set opp w
    }

    set flags(position,$ct,$rt) $mover

    foreach dir {d1 d2 d3 d4 h1 h2 v1 v2} {
	set state opp
	foreach {x y} $moves($dir,$ct,$rt) {
	    set pos $flags(position,$x,$y)
	    switch -- $state {
		opp {
		    if {$pos != $opp} {
			break
		    } else {
			set state both
		    }
		}
		both {
		    if {$pos == ""} {
			break
		    } elseif {$pos == $mover} {
			foreach {x y} $moves($dir,$ct,$rt) {
			    set pos $flags(position,$x,$y)
			    if {$pos == $mover} {
				break
			    } else {
				set flags(position,$x,$y) $mover
			    }
			}
			break
		    }
		}
	    }
	}
    }

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

    add_move_to_history $gid $ct $rt

    if {$draw && !$my_move} {
	attention_message $gid \
	    [::msgcat::mc "\n\n Opponent proposes a draw\n\n"]
    }

    if {$my_move} {
	send_move $gid $ct $rt
    }

    if {[is_white $flags(position,turn)]} {
	find_legal_moves $gid black
    } else {
	find_legal_moves $gid white
    }
    set skip [lempty $flags(legal_moves)]

    if {!$skip} {
	if {[is_white $flags(position,turn)]} {
	    set flags(position,turn) black
	} else {
	    set flags(position,turn) white
	}
    }

    find_legal_moves $gid $flags(position,turn)

    set endgame 0
    if {$skip && [lempty $flags(legal_moves)]} {
	set endgame 1
	lassign [count_pieces $gid] bp wp
    } elseif {$skip} {
	add_move_to_history $gid
    }
	
    if {$endgame} {
	if {$bp == $wp} {
	    # Draw
	    end_game $gid 0.5 [::msgcat::mc "Draw"]
	} elseif {(($bp > $wp) && [is_black $flags(our_color)]) || \
	          (($bp < $wp) && [is_white $flags(our_color)])} {
	    # I win
	    end_game $gid 1 [::msgcat::mc "You win"]
	} else {
	    # Opponent wins
	    end_game $gid 0 [::msgcat::mc "Opponent wins"]
	}
    }

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

proc reversi::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 reversi \
				     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 reversi::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 reversi \
				     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 reversi::send_move {gid ct rt} {
    variable $gid
    upvar 0 $gid flags

    set put_tags [list [::xmpp::xml::create put -attrs [list pos "$ct,$rt"]]]
    if {$flags(position,draw)} {
	lappend put_tags [::xmpp::xml::create draw]
    }

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

proc reversi::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 reversi::count_pieces {gid} {
    variable $gid
    upvar 0 $gid flags

    set b 0
    set w 0
    for {set ct 0} {$ct < 8} {incr ct} {
	for {set rt 0} {$rt < 8} {incr rt} {
	    switch -- $flags(position,$ct,$rt) {
		b { incr b }
		w { incr w }
	    }
	}
    }
    return [list $b $w]
}

proc reversi::add_move_to_history {gid {ct ""} {rt ""}} {
    variable $gid
    upvar 0 $gid flags

    incr flags(position,halfmove)

    if {$ct != "" && $rt != ""} {
	lappend flags(position,history) [list $ct $rt]
    } else {
	lappend flags(position,history) skip
    }

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

    $hw insert end "\t[::msgcat::mc Black]\t[::msgcat::mc White]\n"
    set i 1
    foreach {b w} $flags(position,history) {
	$hw insert end "${i}.\t"
	if {$b == "skip"} {
	    $hw insert end "--\t"
	} elseif {$b != {}} {
	    lassign $b ct rt
	    incr rt
	    set lt [format %c [expr {$ct+97}]]
	    $hw insert end "$lt$rt\t"
	}
	if {$w == "skip"} {
	    $hw insert end "--\n"
	} elseif {$w != {}} {
	    lassign $w ct rt
	    incr rt
	    set lt [format %c [expr {$ct+97}]]
	    $hw insert end "$lt$rt\n"
	} else {
	    $hw insert end "\n"
	}
	incr i
    }
    lassign [count_pieces $gid] bp wp
    $hw insert end "\n\t$bp\t$wp\n"
    $hw see end
    $hw configure -state disabled
}

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

    set flags(legal_moves) {}

    for {set ct 0} {$ct < 8} {incr ct} {
	for {set rt 0} {$rt < 8} {incr rt} {
	    if {$flags(position,$ct,$rt) == "" && \
		    [check_legal $gid $ct $rt $color]} {
		lappend flags(legal_moves) [list $ct $rt]
	    }
	}
    }
    highlight_legal_moves $gid
}

proc reversi::check_legal {gid ct rt color} {
    variable moves
    variable $gid
    upvar 0 $gid flags

    set me [expr {[is_black $color] ? "b" : "w"}]
    set opp [expr {[is_black $color] ? "w" : "b"}]

    foreach dir {d1 d2 d3 d4 h1 h2 v1 v2} {
	set state opp
	foreach {x y} $moves($dir,$ct,$rt) {
	    set pos $flags(position,$x,$y)
	    switch -- $state {
		opp {
		    if {$pos != $opp} {
			break
		    } else {
			set state both
		    }
		}
		both {
		    if {$pos == ""} {
			break
		    } elseif {$pos == $me} {
			return 1
		    }
		}
	    }
	}
    }

    return 0
}

proc reversi::is_move_legal {gid ct rt} {
    variable $gid
    upvar 0 $gid flags

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

proc reversi::highlight_legal_moves {gid} {
    variable $gid
    upvar 0 $gid flags

    set board $flags(board)

    $board dtag legal
    foreach move $flags(legal_moves) {
	lassign $move ct rt
	$board addtag legal withtag [list cr $ct $rt]&&square

    }
}

proc reversi::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 reversi::is_my_move {gid} {
    variable $gid
    upvar 0 $gid flags
    is_same_color $flags(position,turn) $flags(our_color)
}

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

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

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

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

proc reversi::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] == "reversi"} {
	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 reversi::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] == "reversi"} {
	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
}

