# $Id$

package require msgcat

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

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

    variable square_size 31
    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
    }

    set game_names_list \
	[list \
	    renju             [::msgcat::mc "Renju"] \
	    gomoku:freestyle  [::msgcat::mc "Free-style Gomoku"] \
	    gomoku:standard   [::msgcat::mc "Standard Gomoku"] \
	    gomoku:tournament [::msgcat::mc "Tournament Gomoku"] \
	]
    array set game_names $game_names_list

    custom::defgroup Plugins [::msgcat::mc "Plugins options."] -group Tkabber

    custom::defgroup Gomoku/Renju [::msgcat::mc "Gomoku/Renju plugin options."] -group Plugins

    custom::defvar options(theme) Stones \
	[::msgcat::mc "Gomoku/Renju figures theme."] -group Gomoku/Renju \
	-type options -values $values \
	-command [namespace current]::load_stored_theme
    custom::defvar options(game) renju \
	[::msgcat::mc "Default game variant."] -group Gomoku/Renju \
	-type options \
	-values $game_names_list
    custom::defvar options(show_last_move) 0 \
	[::msgcat::mc "Show last move by default."] \
	-type boolean -group Gomoku/Renju
    custom::defvar options(show_tooltips) 1 \
	[::msgcat::mc "Show tooltips with short instructions."] \
	-type boolean -group Gomoku/Renju \
	-command [list [namespace current]::set_tooltips]
    custom::defvar options(sound) "" \
	[::msgcat::mc "Sound to play after opponent's turn"] \
	-type file -group Gomoku/Renju
    custom::defvar options(allow_illegal) 0 \
	[::msgcat::mc "Allow illegal moves (useful for debugging)."] \
	-type boolean -group Gomoku/Renju
    custom::defvar options(accept_illegal) 0 \
	[::msgcat::mc "Accept opponent illegal moves (useful for debugging)."] \
	-type boolean -group Gomoku/Renju
}

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

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

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

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

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

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

proc renju::invite_dialog {xlib jid} {
    variable options

    set w .renju_invite

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

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

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

    pack $wf.message -pady 2m

    variable game $options(game)
    radiobutton $wf.renju -text [::msgcat::mc "Renju"] \
	-value renju -variable [namespace current]::game
    pack $wf.renju -padx 15m -anchor w
    radiobutton $wf.freestyle -text [::msgcat::mc "Free-style Gomoku"] \
	-value gomoku:freestyle -variable [namespace current]::game
    pack $wf.freestyle -padx 15m -anchor w
    radiobutton $wf.standard -text [::msgcat::mc "Standard Gomoku"] \
	-value gomoku:standard -variable [namespace current]::game
    pack $wf.standard -padx 15m -anchor w
    radiobutton $wf.tournament -text [::msgcat::mc "Tournament Gomoku"] \
	-value gomoku:tournament -variable [namespace current]::game
    pack $wf.tournament -padx 15m -anchor w

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

    $w draw
}

proc renju::invite {xlib jid color} {
    variable game

    destroy .renju_invite

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

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

    start_play $game $xlib $jid $id $color
}

proc renju::invited_dialog {game xlib jid iqid id color} {
    variable game_names

    set w .renju_invited

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

    Dialog $w -title [::msgcat::mc "Gomoku/Renju 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 $game $xlib $jid $iqid $id $color 0]]

    set nick [get_nick $xlib $jid chat]
    set message1 [::msgcat::mc "Gomoku/Renju game invitation from %s (%s) is received." \
			 $nick $jid]
    set message2 [::msgcat::mc "%s wants play %s." $nick $game_names($game)]
    switch -- $color {
	white {
	    set message3 [::msgcat::mc "%s wants to move second." $nick]
	}
	black {
	    set message3 [::msgcat::mc "%s wants to move first." $nick]
	}
	default {
	    return [list error modify bad-request]
	}
    }
    message $wf.message1 -aspect 50000 -text $message1
    message $wf.message2 -aspect 50000 -text $message2
    message $wf.message3 -aspect 50000 -text $message3
    pack $wf.message1 -pady 1m
    pack $wf.message2 -pady 1m
    pack $wf.message3 -pady 1m
    
    $w add -text [::msgcat::mc "Agree to play"] \
	   -command [namespace code [list invited_res $w $game $xlib $jid $iqid $id $color 1]]
    $w add -text [::msgcat::mc "Refuse to play"] \
	   -command [namespace code [list invited_res $w $game $xlib $jid $iqid $id $color 0]]

    $w draw
    return
}

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

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

proc renju::start_play {game xlib jid id color} {

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

    set flags(window) [win_id renju $gid]
    set flags(xlib) $xlib
    set flags(opponent) $jid
    set flags(id) $id
    set flags(game) $game
    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 renju::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 renju::make_default_position {gid} {
    variable $gid
    upvar 0 $gid flags

    for {set c 0} {$c < 15} {incr c} {
	for {set r 0} {$r < 15} {incr r} {
	    set flags(position,$c,$r) ""
	}
    }

    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 renju::save_position {gid} {
    variable $gid
    upvar 0 $gid flags

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

proc renju::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 renju::make_gid {jid id} {
    jid_to_tag [concat $jid $id]
}

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

    set move 0
    set skip 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)
		    }
		}
	    }
	    skip {
		set skip 1
		add_move_to_history $gid
		if {[is_white $flags(position,turn)]} {
		    set flags(position,turn) black
		} else {
		    set flags(position,turn) white
		}
		find_legal_moves $gid $flags(position,turn)
	    }
	    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 $flags(game) \
							 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 $flags(game) \
							 id $flags(id)]]]
		} else {
		    return [list error modify not-acceptable]
		}
	    }
	    draw {
		set draw 1
	    }
	}
    }

    if {$skip || ($move && [do_move $gid $ct $rt $draw])} {
	if {[lindex $flags(position,history) end] == "skip" && \
		[lindex $flags(position,history) end-1] == "skip"} {
	    end_game $gid 0.5 [::msgcat::mc "Draw (Both players skipped move)"]
	}
	update_controls $gid $draw
	draw_position $gid
	highlight_last_move $gid

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

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

proc renju::calc_moves {} {
    variable moves

    for {set c 0} {$c < 15} {incr c} {
	for {set r 0} {$r < 15} {incr r} {
	    for {set moves(d1,$c,$r) {}; set x [expr {$c+1}]; set y [expr {$r+1}]} \
		{($x < 15) && ($y < 15)} {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 < 15)} {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 < 15) && ($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 < 15} {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 < 15} {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 renju::center {c r} {
    variable square_size
    variable line_width

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

    array unset flags
}

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

proc renju::open {gid} {
    variable options
    variable game_names
    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 "%s with %s" $game_names($flags(game)) \
			    [get_nick $flags(xlib) $jid chat]]
    add_win $w -title $title \
	       -tabtitle $title \
	       -class renju \
	       -raise 1

    set board [canvas $w.board \
		   -width [expr {($square_size + $line_width) * 15}] \
		   -height [expr {($square_size + $line_width) * 15}]]
    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

    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 "Skip the move"] \
	-command [list [namespace current]::send_skip $gid]
    $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 < 15} {incr c} {
	for {set r 0} {$r < 15} {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}]
	    if {$c == 0 && $r == 0} {
		set img "ltf"
	    } elseif {$c == 0 && $r == 14} {
		set img "lbf"
	    } elseif {$c == 0} {
		set img "lf"
	    } elseif {$c == 14 && $r == 0} {
		set img "rtf"
	    } elseif {$c == 14 && $r == 14} {
		set img "rbf"
	    } elseif {$c == 14} {
		set img "rf"
	    } elseif {$r == 0} {
		set img "tf"
	    } elseif {$r == 14} {
		set img "bf"
	    } elseif {($c == 7 && $r == 7)  || ($c == 3 && $r == 3)  || \
		      ($c == 3 && $r == 11) || ($c == 11 && $r == 3) || \
		      ($c == 11 && $r == 11)} {
		set img "cf"
	    } else {
		set img "mf"
	    }

	    $board create image $x1 $y1 -image renju/$img -anchor nw \
		-tags [list background [list cr $c [expr {14-$r}]]]
	    $board create rectangle $x1 $y1 $x2 $y2 \
		-outline {} \
		-tags [list last [list cr $c [expr {14-$r}]]]
	    $board create rectangle $x1 $y1 $x2 $y2 \
		-outline {} \
		-tags [list square [list cr $c [expr {14-$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
    
    draw_position $gid
    update_controls $gid
    find_legal_moves $gid $flags(position,turn)
}

proc renju::set_tooltips {args} {
    variable options

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

    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
		$flags(bbox) itemconfigure 3 -helptext $tooltip3
	    }
	}
    }
}

proc renju::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 renju::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 renju::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 disabled
	    $flags(bbox) itemconfigure 2 -state normal
	    $flags(bbox) itemconfigure 3 -state disabled
	} else {
	    $flags(bbox) itemconfigure 0 -state normal
	    $flags(bbox) itemconfigure 1 -state normal
	    $flags(bbox) itemconfigure 2 -state disabled
	    $flags(bbox) itemconfigure 3 -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
	$flags(bbox) itemconfigure 3 -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
	$flags(bbox) itemconfigure 3 -state disabled
    }
}

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

    $flags(board) delete figure

    for {set c 0} {$c < 15} {incr c} {
	for {set r 0} {$r < 15} {incr r} {
	    if {$flags(position,$c,$r) != ""} {
		$flags(board) create image [center $c $r] \
		    -image renju/$flags(position,$c,$r) \
		    -tags [list figure $flags(position,$c,$r) [list cr $c $r]]
	    }
	}
    }
}

proc renju::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 renju::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 renju::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 renju::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 renju::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
    set flags(position,last_move) [list $ct $rt]

    set checkmate [test_checkmate $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)]

    add_move_to_history $gid $ct $rt

    if {!$checkmate && $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 {!$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)]} {
	# Can't find any move for both sides
	set endgame 1
    } elseif {$skip} {
	add_move_to_history $gid
    }
	
    if {$checkmate} {
	if {$my_move} {
	    # I win
	    end_game $gid 1 [::msgcat::mc "You win"]
	} else {
	    # Opponent wins
	    end_game $gid 0 [::msgcat::mc "Opponent wins"]
	}
    } elseif {$endgame} {
	# Draw
	end_game $gid 0.5 [::msgcat::mc "Draw"]
    }

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

proc renju::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 $flags(game) \
				     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 renju::send_skip {gid} {
    variable $gid
    upvar 0 $gid flags

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

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

    if {[lindex $flags(position,history) end] == "skip" && \
	    [lindex $flags(position,history) end-1] == "skip"} {
	end_game $gid 0.5 [::msgcat::mc "Draw (Both players skipped move)"]
    }
    update_controls $gid
    draw_position $gid
    highlight_last_move $gid
}

proc renju::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 $flags(game) \
				     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 renju::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 $flags(game) \
				     id $flags(id)] \
			-subelements $put_tags] \
	-to $flags(opponent) \
	-command [list [namespace current]::send_result $gid]
}

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

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

proc renju::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
    }
    $hw see end
    $hw configure -state disabled
}

proc renju::test_checkmate {gid ct rt} {
    variable $gid
    upvar 0 $gid flags
    variable moves

    if {$flags(position,$ct,$rt) == ""} {
	return 0
    }
    set mover $flags(position,$ct,$rt)

    foreach dir {d1 d2 d3 d4 h1 h2 v1 v2} {
	set str($dir) 0
	foreach {x y} $moves($dir,$ct,$rt) {
	    if {$flags(position,$x,$y) == $mover} {
		incr str($dir)
	    } else {
		break
	    }
	}
    }
    set s1 [expr {1 + $str(d1) + $str(d3)}]
    set s2 [expr {1 + $str(d2) + $str(d4)}]
    set s3 [expr {1 + $str(h1) + $str(h2)}]
    set s4 [expr {1 + $str(v1) + $str(v2)}]

    switch -- $flags(game) {
	gomoku:freestyle -
	gomoku:tournament {
	    return [expr {$s1 >= 5 || $s2 >= 5 || $s3 >= 5 || $s4 >= 5}]
	}
	gomoku:standard {
	    return [expr {$s1 == 5 || $s2 == 5 || $s3 == 5 || $s4 == 5}]
	}
	renju {
	    if {[is_black $mover]} {
		return [expr {$s1 == 5 || $s2 == 5 || $s3 == 5 || $s4 == 5}]
	    } else {
		return [expr {$s1 >= 5 || $s2 >= 5 || $s3 >= 5 || $s4 >= 5}]
	    }
	}
    }
}

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

    set flags(legal_moves) {}

    for {set ct 0} {$ct < 15} {incr ct} {
	for {set rt 0} {$rt < 15} {incr rt} {
	    if {$flags(position,$ct,$rt) != "" && \
		    [test_checkmate $gid $ct $rt]} {
		highlight_legal_moves $gid
		return
	    }
	}
    }

    for {set ct 0} {$ct < 15} {incr ct} {
	for {set rt 0} {$rt < 15} {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 renju::is_overline {gid ct rt color} {
    variable moves
    variable $gid
    upvar 0 $gid flags

    # Assume that $ct $rt cell is empty

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

    foreach dir {d1 d2 d3 d4 h1 h2 v1 v2} {
	set str($dir) 0
	foreach {x y} $moves($dir,$ct,$rt) {
	    if {$flags(position,$x,$y) == $mover} {
		incr str($dir)
	    } else {
		break
	    }
	}
    }
    set s1 [expr {1 + $str(d1) + $str(d3)}]
    set s2 [expr {1 + $str(d2) + $str(d4)}]
    set s3 [expr {1 + $str(h1) + $str(h2)}]
    set s4 [expr {1 + $str(v1) + $str(v2)}]

    return [expr {$s1 > 5 || $s2 > 5 || $s3 > 5 || $s4 > 5}]
}

proc renju::five {gid ct rt color dir} {
    variable moves
    variable $gid
    upvar 0 $gid flags

    # Assume that $ct $rt cell is empty

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

    switch -- $dir {
	d1 { set dir2 d3 }
	d2 { set dir2 d4 }
	d3 { set dir2 d1 }
	d4 { set dir2 d2 }
	h1 { set dir2 h2 }
	h2 { set dir2 h1 }
	v1 { set dir2 v2 }
	v2 { set dir2 v1 }
    }

    set str {}
    foreach d [list $dir $dir2] {
	foreach {x y} $moves($d,$ct,$rt) {
	    if {$flags(position,$x,$y) == $mover} {
		lappend str [list $x $y]
	    } else {
		break
	    }
	}
    }

    # Return a list of row cells (all except $ct $rt)
    if {[llength $str] == 4} {
	return [lsort $str]
    } else {
	return {}
    }
}

proc renju::straight_four {gid ct rt color dir} {
    variable moves
    variable $gid
    upvar 0 $gid flags

    # Assume that $ct $rt cell is empty

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

    switch -- $dir {
	d1 { set dir2 d3 }
	d2 { set dir2 d4 }
	d3 { set dir2 d1 }
	d4 { set dir2 d2 }
	h1 { set dir2 h2 }
	h2 { set dir2 h1 }
	v1 { set dir2 v2 }
	v2 { set dir2 v1 }
    }

    set str {}
    foreach d [list $dir $dir2] {
	set open 0
	foreach {x y} $moves($d,$ct,$rt) {
	    if {!$open} {
		if {$flags(position,$x,$y) == $mover} {
		    lappend str [list $x $y]
		} elseif {$flags(position,$x,$y) == ""} {
		    # The row is open from $d side
		    set open 1
		} else {
		    # The row is blocked
		    return {}
		}
	    } else {
		if {$flags(position,$x,$y) == $mover} {
		    # The row is blocked by own stone
		    return {}
		} else {
		    break
		}
	    }
	}
	if {!$open} {
	    # The row is blocked by a border
	    return {}
	}
    }

    # Return a list of row cells (all except $ct $rt)
    if {[llength $str] == 3} {
	return [lsort $str]
    } else {
	return {}
    }
}

proc renju::threes_and_fours {gid ct rt color dir} {
    variable moves
    variable $gid
    upvar 0 $gid flags

    # Assume that $ct $rt cell is empty

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

    switch -- $dir {
	d1 { set dir2 d3 }
	d2 { set dir2 d4 }
	d3 { set dir2 d1 }
	d4 { set dir2 d2 }
	h1 { set dir2 h2 }
	h2 { set dir2 h1 }
	v1 { set dir2 v2 }
	v2 { set dir2 v1 }
    }

    foreach d [list $dir $dir2] {
	set str4($d) {}
	set str5($d) {}
	foreach {x y} $moves($d,$ct,$rt) {
	    if {$flags(position,$x,$y) == ""} {
		# The row is open from $d side
		set flags(position,$ct,$rt) $mover
		set str4($d) [straight_four $gid $x $y $color $d]
		if {$str4($d) == {}} {
		    set str5($d) [five $gid $x $y $color $d]
		}
		set flags(position,$ct,$rt) ""
		break
	    } elseif {$flags(position,$x,$y) != $mover} {
		break
	    }
	}
    }

    if {$str4($dir) == {} && $str4($dir2) == {}} {
	set th 0
    } elseif {$str4($dir) == $str4($dir2)} {
	set th 1
    } elseif {$str4($dir) == {} || $str4($dir2) == {}} {
	set th 1
    } else {
	set th 2
    }

    if {$str5($dir) == {} && $str5($dir2) == {}} {
	set fo 0
    } elseif {$str5($dir) == $str5($dir2)} {
	set fo 1
    } elseif {$str5($dir) == {} || $str5($dir2) == {}} {
	set fo 1
    } else {
	set fo 2
    }

    return [list $th $fo]
}

proc renju::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"}]

    switch -- $flags(game) {
	gomoku:freestyle {
	    return 1
	}
	gomoku:standard {
	    return 1
	}
	gomoku:tournament {
	    if {![is_black $color]} {
		return 1
	    } else {
		set hist [llength $flags(position,history)]
		if {$hist == 0} {
		    if {$ct == 7 && $rt == 7} {
			return 1
		    } else {
			return 0
		    }
		} elseif {$hist == 2} {
		    if {$ct >= 5 && $ct <= 9 && $rt >= 5 && $rt <= 9} {
			return 0
		    } else {
			return 1
		    }
		} else {
		    return 1
		}
	    }
	}
	renju {
	    if {![is_black $color]} {
		return 1
	    } else {
		set hist [llength $flags(position,history)]
		if {$hist == 0} {
		    if {$ct == 7 && $rt == 7} {
			return 1
		    } else {
			return 0
		    }
		}

		foreach dir {d1 d2 h1 v1} {
		    if {[llength [five $gid $ct $rt $color $dir]] == 4} {
			return 1
		    }
		}

		if {[is_overline $gid $ct $rt $color]} {
		    return 0
		}

		set threes 0
		set fours 0
		foreach dir {d1 d2 h1 v1} {
		    lassign [threes_and_fours $gid $ct $rt $color $dir] th fo
		    incr threes $th
		    incr fours $fo
		}
		if {$fours > 1 || $threes > 1} {
		    return 0
		} else {
		    return 1
		}
	    }
	}
    }
}

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

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


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

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

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

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

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

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

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

    set game [::xmpp::xml::getAttr $attrs type]

    switch -- $game {
	gomoku:freestyle -
	gomoku:standard -
	gomoku:tournament -
	renju {}
	default {
	    return
	}
    }

    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 \
		 $game $xlib $from $iqid \
		 [::xmpp::xml::getAttr $attrs id] \
		 $color]
}

proc renju::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] {
	gomoku:freestyle -
	gomoku:standard -
	gomoku:tournament -
	renju {}
	default {
	    return
	}
    }

    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]
    }
}


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

