# renju.tcl --
#
#       This file implements Renju/Gomoku game plugin for the Tkabber XMPP
#       client.

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 -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 -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::button_update_relief {b flag} {
    set rstate [expr {$flag? {pressed} : {!$pressed}}]
    if {[catch {$b state $rstate}]} {
        set relief [expr {$flag? "sunken" : "raised"}]
        $b configure -relief $relief
    }
}

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 \
                   -borderwidth 0 \
                   -highlightthickness 0 \
                   -width [expr {15 * $square_size + 16 * $line_width}] \
                   -height [expr {15 * $square_size + 16 * $line_width}]]
    pack $board -side left -anchor w -padx 10

    set flags(board) $board

    set flags(show_last_move) $options(show_last_move)
    set slm [Button $w.show_last_move -text [::msgcat::mc "Show last move"] \
                -command [list [namespace current]::toggle_show_last_move \
                               $gid]]
    button_update_relief $slm $flags(show_last_move)
    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]
    set flags(propose_draw_button) \
        [$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)}]

    button_update_relief $flags(show_last_move_button) $flags(show_last_move)

    highlight_last_move $gid
}

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

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

    button_update_relief $flags(propose_draw_button) $flags(position,draw)
}

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

    button_update_relief $flags(propose_draw_button) 0

    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 [expr {[llength $flags(legal_moves)] == 0}]

    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 && [llength $flags(legal_moves)] == 0} {
        # 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 {[lsearch -regexp $flags(legal_moves) ^[list $ct $rt]] >= 0}
}


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
}

# vim:ft=tcl:ts=8:sw=4:sts=4:et
