# checkers.tcl --
#
#       This file implements Checkers game plugin for the Tkabber XMPP client.
#       Quite a few game variants are supported.

package require msgcat

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

    if {![::plugins::is_registered checkers]} {
        ::plugins::register checkers \
                            -namespace [namespace current] \
                            -source [info script] \
                            -description [::msgcat::mc "Whether the Checkers\
                                                        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
    }

    set game_names_list \
        [list \
            straight  [::msgcat::mc "Straight checkers (English draughts)"] \
            russian   [::msgcat::mc "Russian checkers"] \
            pool      [::msgcat::mc "Pool checkers"] \
            brazilian [::msgcat::mc "Brazilian checkers"] \
            spanish   [::msgcat::mc "Spanish checkers"] \
            italian   [::msgcat::mc "Italian checkers"] \
        ]
    array set game_names $game_names_list
    array set short_game_names $game_names_list
    set short_game_names(straight) [::msgcat::mc "Straight checkers"]

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

    custom::defgroup Checkers [::msgcat::mc "Checkers plugin options."] \
        -group Plugins
    custom::defvar options(theme) Checkers \
        [::msgcat::mc "Checkers figures theme."] -group Checkers \
        -type options -values $values \
        -command [namespace current]::load_stored_theme
    custom::defvar options(game) russian \
        [::msgcat::mc "Default game variant."] -group Checkers \
        -type options \
        -values $game_names_list
    custom::defvar options(flip_black_view) 1 \
        [::msgcat::mc "Flip board view when playing black (Russian, Spanish,\
                       Italian) or white (Straight, Pool, Brazilian) by\
                       default."] \
        -type boolean -group Checkers
    custom::defvar options(show_last_move) 0 \
        [::msgcat::mc "Show last move by default."] \
        -type boolean -group Checkers
    custom::defvar options(show_tooltips) 1 \
        [::msgcat::mc "Show tooltips with short instructions."] \
        -type boolean -group Checkers \
        -command [list [namespace current]::set_tooltips]
    custom::defvar options(sound) "" \
        [::msgcat::mc "Sound to play after opponent's turn"] \
        -type file -group Checkers
    custom::defvar options(allow_illegal) 0 \
        [::msgcat::mc "Allow illegal moves (useful for debugging)."] \
        -type boolean -group Checkers
    custom::defvar options(accept_illegal) 0 \
        [::msgcat::mc "Accept opponent illegal moves (useful for\
                       debugging)."] \
        -type boolean -group Checkers
}

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

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

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

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

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

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

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

    set w .checkers_invite

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

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

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

    pack $wf.message -pady 2m
    variable game $options(game)
    Radiobutton $wf.straight \
        -text [::msgcat::mc "Straight checkers (English draughts)"] \
        -value straight -variable [namespace current]::game
    pack $wf.straight -padx 15m -anchor w
    Radiobutton $wf.russian -text [::msgcat::mc "Russian checkers"] \
        -value russian -variable [namespace current]::game
    pack $wf.russian -padx 15m -anchor w
    Radiobutton $wf.pool -text [::msgcat::mc "Pool checkers"] \
        -value pool -variable [namespace current]::game
    pack $wf.pool -padx 15m -anchor w
    Radiobutton $wf.brazilian -text [::msgcat::mc "Brazilian checkers"] \
        -value brazilian -variable [namespace current]::game
    pack $wf.brazilian -padx 15m -anchor w
    Radiobutton $wf.spanish -text [::msgcat::mc "Spanish checkers"] \
        -value spanish -variable [namespace current]::game
    pack $wf.spanish -padx 15m -anchor w
    Radiobutton $wf.italian -text [::msgcat::mc "Italian checkers"] \
        -value italian -variable [namespace current]::game
    pack $wf.italian -padx 15m -anchor w

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

    $w draw
}

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

    destroy .checkers_invite

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

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

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

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

    set w .checkers_invited

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

    Dialog $w -title [::msgcat::mc "Checkers 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 "Checkers 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 play white." $nick]
        }
        black {
            set message3 [::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
    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 checkers::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 checkers:$game \
                                                     id $id]] \
                       -to $jid \
                       -id $iqid
    } else {
        ::xmpp::sendIQ $xlib error \
                       -error [::xmpp::stanzaerror::error \
                                        modify not-acceptable] \
                       -to $jid \
                       -id $iqid
    }
}

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

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

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

    switch -- $game {
        straight {
            set flags(board_type) 0
            set flags(start) black
        }
        russian {
            set flags(board_type) 0
            set flags(start) white
        }
        pool {
            set flags(board_type) 0
            set flags(start) black
        }
        brazilian {
            set flags(board_type) 0
            set flags(start) black
        }
        spanish {
            set flags(board_type) 1
            set flags(start) white
        }
        italian {
            set flags(board_type) 1
            set flags(start) white
        }
    }

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

    make_default_position $gid

    open $gid
}

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

    switch -- $flags(start) {
        white {
            set p1 wp
            set p2 bp
        }
        black {
            set p1 bp
            set p2 wp
        }
    }

    for {set c 0} {$c < 8} {incr c} {
        for {set r 0} {$r < 8} {incr r} {
            set cr [list $c $r]
            set flags(position,$cr) ""
            if {($c + $r) % 2 == $flags(board_type)} {
                if {$r < 3} {
                    set flags(position,$cr) $p1
                } elseif {$r > 4} {
                    set flags(position,$cr) $p2
                }
            }
        }
    }

    set flags(position,turn) $flags(start)

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

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

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

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

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

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

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

    set move {}
    set draw 0

    foreach xml $xmlList {
        ::xmpp::xml::split $xml tag xmlns attrs cdata subels
        switch -- $tag {
            move {
                set pos [::xmpp::xml::getAttr $attrs pos]
                set poss [split $pos ";"]
                if {[llength $poss] >= 2} {
                    foreach pos1 $poss {
                        set pos2 [split $pos1  ","]
                        if {[llength $pos2] == 2} {
                            lappend move $pos2
                        } else {
                            return [list error modify not-acceptable]
                        }
                    }
                } else {
                    return [list error modify not-acceptable]
                }
                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 checkers:$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 checkers:$flags(game) \
                                                   id $flags(id)]]]
                } else {
                    return [list error modify not-acceptable]
                }
            }
            draw {
                set draw 1
            }
        }
    }

    if {[llength $move] > 0 && [do_move $gid $move $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 checkers:$flags(game) \
                                                 id $flags(id)]]]
    } else {
        return [list error modify not-acceptable]
    }
}


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

proc checkers::calc_moves {} {
    variable moves
    variable jumps

    for {set c 0} {$c < 8} {incr c} {
        for {set r 0} {$r < 8} {incr r} {
            set cr [list $c $r]
            set moves(up,$cr) {}
            if {$r <= 6} {
                if {$c <= 6} {
                    lappend moves(up,$cr) \
                            [list [expr {$c + 1}] [expr {$r + 1}]]
                }
                if {$c >= 1} {
                    lappend moves(up,$cr) \
                            [list [expr {$c - 1}] [expr {$r + 1}]]
                }
            }
            set moves(dn,$cr) {}
            if {$r >= 1} {
                if {$c <= 6} {
                    lappend moves(dn,$cr) \
                            [list [expr {$c + 1}] [expr {$r - 1}]]
                }
                if {$c >= 1} {
                    lappend moves(dn,$cr) \
                            [list [expr {$c - 1}] [expr {$r - 1}]]
                }
            }
            set jumps(up,$cr) {}
            if {$r <= 5} {
                if {$c <= 5} {
                    lappend jumps(up,$cr) \
                            [list [expr {$c + 1}] [expr {$r + 1}]] \
                            [list [expr {$c + 2}] [expr {$r + 2}]]
                }
                if {$c >= 2} {
                    lappend jumps(up,$cr) \
                            [list [expr {$c - 1}] [expr {$r + 1}]] \
                            [list [expr {$c - 2}] [expr {$r + 2}]]
                }
            }
            set jumps(dn,$cr) {}
            if {$r >= 2} {
                if {$c <= 5} {
                    lappend jumps(dn,$cr) \
                            [list [expr {$c + 1}] [expr {$r - 1}]] \
                            [list [expr {$c + 2}] [expr {$r - 2}]]
                }
                if {$c >= 2} {
                    lappend jumps(dn,$cr) \
                            [list [expr {$c - 1}] [expr {$r - 1}]] \
                            [list [expr {$c - 2}] [expr {$r - 2}]]
                }
            }

            for {set moves(d1,$cr) {}; \
                        set x [expr {$c+1}]; set y [expr {$r+1}]} \
                {($x < 8) && ($y < 8)} {incr x; incr y} {
                lappend moves(d1,$cr) [list $x $y]
            }
            for {set moves(d2,$cr) {}; \
                        set x [expr {$c-1}]; set y [expr {$r+1}]} \
                {($x >= 0) && ($y < 8)} {incr x -1; incr y} {
                lappend moves(d2,$cr) [list $x $y]
            }
            for {set moves(d3,$cr) {}; \
                        set x [expr {$c-1}]; set y [expr {$r-1}]} \
                {($x >= 0) && ($y >= 0)} {incr x -1; incr y -1} {
                lappend moves(d3,$cr) [list $x $y]
            }
            for {set moves(d4,$cr) {}; \
                        set x [expr {$c+1}]; set y [expr {$r-1}]} \
                {($x < 8) && ($y >= 0)} {incr x; incr y -1} {
                lappend moves(d4,$cr) [list $x $y]
            }
        }
    }
}

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

    array unset flags
}

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

proc checkers::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 checkers::open {gid} {
    variable options
    variable square_size
    variable line_width
    variable short_game_names
    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" \
        $short_game_names($flags(game)) [get_nick $flags(xlib) $jid chat]]
    add_win $w -title $title \
               -tabtitle $title \
               -class Checkers \
               -raise 1

    set board [canvas $w.board \
                   -borderwidth 0 \
                   -highlightthickness 0 \
                   -width [expr {8 * $square_size + 9 * $line_width}] \
                   -height [expr {8 * $square_size + 9 * $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

    set flags(flip) 0
    set slm [Button $w.flip -text [::msgcat::mc "Flip view"] \
                -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]
    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 < 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}]
            switch -- $flags(board_type) {
                0 {
                    set img [expr {($c+$r) % 2 ? "bf" : "wf"}]
                }
                1 {
                    set img [expr {($c+$r) % 2 ? "wf" : "bf"}]
                }
            }

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

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

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

    if {![is_same_color $flags(our_color) $flags(start)] && \
            $options(flip_black_view)} {
        toggle_flip_view $gid
    }

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

proc checkers::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 [list $c $r]]
            $board dtag [list cr [list $c $r]]
        }
    }

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

    button_update_relief $flags(flip_button) $flags(flip)
    draw_position $gid
    highlight_last_move $gid
}

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

    set opponent_score [expr {1 - $my_score}]

    if {[is_same_color $flags(our_color) $flags(start)]} {
        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 checkers::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} {
            set cr [list $c $r]
            if {$flags(position,$cr) != ""} {
                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 checkers/$flags(position,$cr) \
                    -tags [list figure $flags(position,$cr) [list cr $cr]]
            }
        }
    }
}

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

    set board $flags(board)

    lassign [lsearch -inline -regexp [$board gettags current] ^cr] \
        cr currentcr
    set flags(current_move) [list $currentcr]

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

    highlight_legal_moves $gid $flags(current_move)
}

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

    set board $flags(board)

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

    $board itemconfigure dst_sq&&square -outline {}
    $board dtag dst_sq
    $board itemconfigure intermediate1&&square -outline yellow
    $board itemconfigure intermediate2&&square -outline green
    $board itemconfigure legal&&square -outline blue
    $board addtag dst_sq overlapping $x $y $x $y
    lassign [lsearch -inline -regexp [$board gettags dst_sq&&background] ^cr] \
        -> cr
    $board addtag dst_sq withtag [list cr $cr]&&square

    $board itemconfigure dst_sq&&square -outline red
    $board itemconfigure dst_sq&&legal&&square -outline blue
    if {[lindex $flags(current_move) end] != $cr} {
        set current [concat $flags(current_move) [list $cr]]
        if {[is_move_prefix_legal $gid $current]} {
            set flags(current_move) $current
            highlight_legal_moves $gid $flags(current_move)
        } elseif {[is_move_legal $gid $current]} {
            $board itemconfigure dst_sq&&legal&&square -outline white
        }
    }
    $board itemconfigure dst_sq&&intermediate1&&square -outline yellow
    $board itemconfigure dst_sq&&intermediate2&&square -outline green
}

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

    set board $flags(board)

    set x [$board canvasx $x]
    set y [$board canvasy $y]
    $board itemconfigure dst_sq&&square -outline {}
    $board dtag dst_sq
    $board addtag dst_sq overlapping $x $y $x $y

    lassign [lsearch -inline -regexp [$board gettags dst_sq&&background] ^cr] \
        -> cr
    $board dtag dst_sq

    lappend flags(current_move) $cr

    if {$options(allow_illegal) || [is_my_move $gid]} {
        do_move $gid $flags(current_move) $flags(position,draw)
    }

    update_controls $gid
    draw_position $gid

    unhighlight_legal_moves $gid

    highlight_last_move $gid
}

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

    $flags(board) itemconfigure square -outline ""
    $flags(board) itemconfigure square -outline ""

    if {![info exists flags(position,last_move)]} {
        return
    }

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

    foreach pos [lrange $flags(position,last_move) 1 end-1] {
        $flags(board) itemconfigure [list cr $pos]&&square -outline $color
    }
    $flags(board) itemconfigure \
        [list cr [lindex $flags(position,last_move) 0]]&&square -outline $color
    $flags(board) itemconfigure \
        [list cr [lindex $flags(position,last_move) end]]&&square \
        -outline $color
}

proc checkers::do_move {gid move draw} {
    variable options
    variable $gid
    upvar 0 $gid flags

    if {([llength $move] < 2) || ([lindex $move 0] == [lindex $move 1])} {
        return 0
    }

    set endgame 0
    set opt "-"
    set suffix ""
    set my_move [is_my_move $gid]

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

    save_position $gid

    set figure $flags(position,[lindex $move 0])

    if {![is_move_legal $gid $move]} {
        set flags(position,[lindex $move end]) $figure
        set flags(position,[lindex $move 0]) ""
    } else {
        set origin [lindex $move 0]
        foreach step [lrange $move 1 end] {
            lassign $origin originx originy
            lassign $step stepx stepy
            set dx [expr {$originx < $stepx ? 1 : -1}]
            set dy [expr {$originy < $stepy ? 1 : -1}]
            for {set x $originx; set y $originy} \
                    {($x != $stepx) && ($y != $stepy)} \
                    {incr x $dx; incr y $dy} {
                set xy [list $x $y]
                if {![is_same_color $flags(position,$xy) $figure]} {
                    set opt ":"
                }
                set flags(position,$xy) ""
            }
            switch -- $flags(game) {
                straight {
                    switch -- $figure,$stepy {
                        bp,7 { set figure bk }
                        wp,0 { set figure wk }
                    }
                }
                pool -
                brazilian {
                    switch -- $figure,$stepy {
                        bp,7 {
                            if {[lindex $move end] == $step} {
                                set figure bk
                            }
                        }
                        wp,0 {
                            if {[lindex $move end] == $step} {
                                set figure wk
                            }
                        }
                    }
                }
                russian -
                spanish -
                italian {
                    switch -- $figure,$stepy {
                        wp,7 { set figure wk }
                        bp,0 { set figure bk }
                    }
                }
            }
            set flags(position,$step) $figure
            set origin $step
        }
    }

    set flags(position,last_move) $move

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

    find_legal_moves $gid $flags(position,turn)

    if {[llength $flags(legal_moves)] == 0} {
        set draw 0
        set endgame 1
    }
    if {$draw} {
        set suffix "="
    }
    add_move_to_history $gid $move $opt $suffix
    if {$draw && !$my_move} {
        attention_message $gid \
            [::msgcat::mc "\n\n Opponent proposes a draw\n\n"]
    }

    if {$my_move} {
        send_move $gid $move
    }

    if {$endgame} {
        if {$my_move} {
            # 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 checkers::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 checkers:$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 checkers::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 checkers:$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 checkers::send_move {gid move} {
    variable $gid
    upvar 0 $gid flags

    set move_tags [list [make_move_tag $gid $move]]
    if {$flags(position,draw)} {
        lappend move_tags [::xmpp::xml::create draw]
    }

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

proc checkers::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 checkers::make_move_tag {gid move} {
    set move1 {}
    foreach pos $move {
        lappend move1 [join $pos ","]
    }

    ::xmpp::xml::create move -attrs [list pos [join $move1 ";"]]
}

proc checkers::add_move_to_history {gid move opt suffix} {
    variable piece_name
    variable $gid
    upvar 0 $gid flags

    incr flags(position,halfmove) 1

    lappend flags(position,history) [list $move $opt $suffix]

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

    if {[is_white $flags(start)]} {
        $hw insert end "\t[::msgcat::mc White]\t[::msgcat::mc Black]\n"
    } else {
        $hw insert end "\t[::msgcat::mc Black]\t[::msgcat::mc White]\n"
    }
    set i 1
    foreach {w b} $flags(position,history) {
        $hw insert end "${i}.\t"
        if {$w != {}} {
            lassign $w move opt suffix
            set move1 {}
            foreach pos $move {
                lassign $pos c r
                incr r
                set l [format %c [expr {$c+97}]]
                lappend move1 "$l$r"
            }
            $hw insert end "[join $move1 $opt]$suffix\t"
        }
        if {$b != {}} {
            lassign $b move opt suffix
            set move1 {}
            foreach pos $move {
                lassign $pos c r
                incr r
                set l [format %c [expr {$c+97}]]
                lappend move1 "$l$r"
            }
            $hw insert end "[join $move1 $opt]$suffix\n"
        }
        incr i
    }
    $hw see end
    $hw configure -state disabled
}

proc checkers::find_legal_moves {gid color} {
    variable moves
    variable jumps
    variable $gid
    upvar 0 $gid flags

    set flags(legal_moves) {}
    find_legal_jumps $gid $color
    if {[llength $flags(legal_moves)] == 0} {
        find_legal_moves1 $gid $color
    }
}

proc checkers::find_legal_jumps {gid color} {
    variable moves
    variable $gid
    upvar 0 $gid flags

    for {set cf 0} {$cf < 8} {incr cf} {
        for {set rf 0} {$rf < 8} {incr rf} {
            set cr [list $cf $rf]
            if {![is_same_color $flags(position,$cr) $color]} {
                continue
            }

            set figure $flags(position,$cr)
            set flags(position,$cr) ""
            find_legal_jumps1 $gid $cr $figure [list $cr] {}
            set flags(position,$cr) $figure
        }
    }

    clean_jumps $gid
}

proc checkers::clean_jumps {gid} {
    variable $gid
    upvar 0 $gid flags

    switch -- $flags(game) {
        brazilian -
        spanish {
            set jumps {}
            set l 0
            foreach m $flags(legal_moves) {
                set l1 [llength $m]
                if {$l1 > $l} {
                    set jumps [list $m]
                    set l $l1
                } elseif {$l1 == $l} {
                    lappend jumps $m
                }
            }
            set flags(legal_moves) $jumps
        }
        italian {
            set jumps {}
            set l 0
            set captor b
            set nkings 0
            set pking 0
            foreach m $flags(legal_moves) {
                set l1 [llength $m]
                set captor1 [string index $flags(position,[lindex $m 0]) end]
                lassign [count_kings $gid $m] nkings1 pking1
                if {($l1 > $l) ||
                    (($l1 == $l) && ($captor1 == "k" && $captor == "b")) ||
                    (($l1 == $l) && ($captor1 == $captor) && \
                        ($nkings1 > $nkings)) ||
                    (($l1 == $l) && ($captor1 == $captor) && \
                        ($nkings1 == $nkings) && ($pking1 < $pking))} {
                    set jumps [list $m]
                    set l $l1
                    set captor $captor1
                    set nkings $nkings1
                    set pking $pking1
                } elseif {($l1 == $l) && ($captor == $captor1) && \
                                ($nkings1 == $nkings) && ($pking1 == $pking)} {
                    lappend jumps $m
                }
            }
            set flags(legal_moves) $jumps
        }
    }
}

proc checkers::count_kings {gid move} {
    variable $gid
    upvar 0 $gid flags

    set nkings 0
    set pking 0
    set crf [lindex $move 0]
    set i 1
    foreach crt [lrange $move 1 end] {
        lassign $crf cf rf
        lassign $crt ct rt
        set crm [list [expr {($cf + $ct)/2}] [expr {($rf + $rt)/2}]]
        if {[string index $flags(position,$crm) end] == "k"} {
            incr nkings
            if {$pking == 0} {
                set pking $i
            }
        }
        incr i
    }
    return [list $nkings $pking]
}

proc checkers::find_legal_jumps1 \
            {gid cr figure current forbidden {simulate 0}} {
    variable moves
    variable jumps
    variable $gid
    upvar 0 $gid flags

    set jump 0

    switch -- $figure {
        "" { continue }

        bp {
            switch -- $flags(game) {
                straight {
                    foreach {crdel crt} $jumps(up,$cr) {
                        if {[lsearch -exact $forbidden $crdel] < 0 && \
                                [is_white $flags(position,$crdel)] && \
                                $flags(position,$crt) == ""} {
                            find_legal_jumps1 $gid $crt $figure \
                                [concat $current [list $crt]] \
                                [concat $forbidden [list $crdel]]
                            set jump 1
                        }
                    }
                }
                spanish {
                    foreach {crdel crt} $jumps(dn,$cr) {
                        if {[lsearch -exact $forbidden $crdel] < 0 && \
                                [is_white $flags(position,$crdel)] && \
                                $flags(position,$crt) == ""} {
                            find_legal_jumps1 $gid $crt $figure \
                                [concat $current [list $crt]] \
                                [concat $forbidden [list $crdel]]
                            set jump 1
                        }
                    }
                }
                italian {
                    foreach {crdel crt} $jumps(dn,$cr) {
                        if {[lsearch -exact $forbidden $crdel] < 0 && \
                                $flags(position,$crdel) == "wp" && \
                                $flags(position,$crt) == ""} {
                            find_legal_jumps1 $gid $crt $figure \
                                [concat $current [list $crt]] \
                                [concat $forbidden [list $crdel]]
                            set jump 1
                        }
                    }
                }
                russian {
                    foreach {crdel crt} \
                            [concat $jumps(up,$cr) $jumps(dn,$cr)] {
                        if {[lsearch -exact $forbidden $crdel] < 0 && \
                                [is_white $flags(position,$crdel)] && \
                                $flags(position,$crt) == ""} {
                            find_legal_jumps1 $gid $crt \
                                [expr {[lindex $crt 1] == 0 ? "bk" : "bp"}] \
                                [concat $current [list $crt]] \
                                [concat $forbidden [list $crdel]]
                            set jump 1
                        }
                    }
                }
                pool -
                brazilian {
                    foreach {crdel crt} \
                            [concat $jumps(up,$cr) $jumps(dn,$cr)] {
                        if {[lsearch -exact $forbidden $crdel] < 0 && \
                                [is_white $flags(position,$crdel)] && \
                                $flags(position,$crt) == ""} {
                            find_legal_jumps1 $gid $crt $figure \
                                [concat $current [list $crt]] \
                                [concat $forbidden [list $crdel]]
                            set jump 1
                        }
                    }
                }
            }
        }

        wp {
            switch -- $flags(game) {
                straight {
                    foreach {crdel crt} $jumps(dn,$cr) {
                        if {[lsearch -exact $forbidden $crdel] < 0 && \
                                [is_black $flags(position,$crdel)] && \
                                $flags(position,$crt) == ""} {
                            find_legal_jumps1 $gid $crt $figure \
                                [concat $current [list $crt]] \
                                [concat $forbidden [list $crdel]]
                            set jump 1
                        }
                    }
                }
                spanish {
                    foreach {crdel crt} $jumps(up,$cr) {
                        if {[lsearch -exact $forbidden $crdel] < 0 && \
                                [is_black $flags(position,$crdel)] && \
                                $flags(position,$crt) == ""} {
                            find_legal_jumps1 $gid $crt $figure \
                                [concat $current [list $crt]] \
                                [concat $forbidden [list $crdel]]
                            set jump 1
                        }
                    }
                }
                italian {
                    foreach {crdel crt} $jumps(up,$cr) {
                        if {[lsearch -exact $forbidden $crdel] < 0 && \
                                $flags(position,$crdel) == "bp" && \
                                $flags(position,$crt) == ""} {
                            find_legal_jumps1 $gid $crt $figure \
                                [concat $current [list $crt]] \
                                [concat $forbidden [list $crdel]]
                            set jump 1
                        }
                    }
                }
                russian {
                    foreach {crdel crt} \
                            [concat $jumps(dn,$cr) $jumps(up,$cr)] {
                        if {[lsearch -exact $forbidden $crdel] < 0 && \
                                [is_black $flags(position,$crdel)] && \
                                $flags(position,$crt) == ""} {
                            find_legal_jumps1 $gid $crt \
                                [expr {[lindex $crt 1] == 7 ? "wk" : "wp"}] \
                                [concat $current [list $crt]] \
                                [concat $forbidden [list $crdel]]
                            set jump 1
                        }
                    }
                }
                pool -
                brazilian {
                    foreach {crdel crt} \
                            [concat $jumps(dn,$cr) $jumps(up,$cr)] {
                        if {[lsearch -exact $forbidden $crdel] < 0 && \
                                [is_black $flags(position,$crdel)] && \
                                $flags(position,$crt) == ""} {
                            find_legal_jumps1 $gid $crt $figure \
                                [concat $current [list $crt]] \
                                [concat $forbidden [list $crdel]]
                            set jump 1
                        }
                    }
                }
            }
        }

        wk -
        bk {
            switch -- $flags(game) {
                straight -
                italian {
                    foreach {crdel crt} \
                            [concat $jumps(dn,$cr) $jumps(up,$cr)] {
                        if {[lsearch -exact $forbidden $crdel] < 0 && \
                                ![is_same_color $flags(position,$crdel) \
                                                $figure] && \
                                $flags(position,$crt) == ""} {
                            find_legal_jumps1 $gid $crt $figure \
                                [concat $current [list $crt]] \
                                [concat $forbidden [list $crdel]]
                            set jump 1
                        }
                    }
                }
                russian -
                pool -
                brazilian -
                spanish {
                    set canjump {}
                    set cantjump {}
                    foreach d {d1 d2 d3 d4} {
                        set state empty
                        foreach crt $moves($d,$cr) {
                            switch -- $state {
                                empty {
                                    if {($flags(position,$crt) != "")} {
                                        if {[lsearch -exact $forbidden \
                                                            $crt] < 0 && \
                                                ![is_same_color \
                                                    $flags(position,$crt) \
                                                    $figure]} {
                                            set crdel $crt
                                            set state jump
                                        } else {
                                            break
                                        }
                                    }
                                }
                                jump {
                                    if {($flags(position,$crt) == "")} {
                                        if {[find_legal_jumps1 \
                                                $gid $crt $figure \
                                                [concat $current [list $crt]] \
                                                [concat $forbidden \
                                                        [list $crdel]] 1]} {
                                            lappend canjump $crdel $crt
                                        } else {
                                            lappend cantjump $crdel $crt
                                        }
                                    } else {
                                        break
                                    }
                                }
                            }
                        }
                    }
                    if {[llength $canjump] > 0} {
                        foreach {crdel crt} $canjump {
                            find_legal_jumps1 $gid $crt $figure \
                                [concat $current [list $crt]] \
                                [concat $forbidden [list $crdel]]
                            set jump 1
                        }
                    } else {
                        foreach {crdel crt} $cantjump {
                            find_legal_jumps1 $gid $crt $figure \
                                [concat $current [list $crt]] \
                                [concat $forbidden [list $crdel]]
                            set jump 1
                        }
                    }
                }
            }
        }
    }

    if {!$simulate && !$jump && [llength $current] >= 2} {
        lappend flags(legal_moves) $current
    }
    return $jump
}

proc checkers::find_legal_moves1 {gid color} {
    variable moves
    variable $gid
    upvar 0 $gid flags

    for {set cf 0} {$cf < 8} {incr cf} {
        for {set rf 0} {$rf < 8} {incr rf} {
            set cr [list $cf $rf]
            if {![is_same_color $flags(position,$cr) $color]} {
                continue
            }

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

                bp {
                    switch -- $flags(game) {
                        straight -
                        pool -
                        brazilian {
                            foreach crt $moves(up,$cr) {
                                if {$flags(position,$crt) == ""} {
                                    lappend flags(legal_moves) [list $cr $crt]
                                }
                            }
                        }
                        russian -
                        spanish -
                        italian {
                            foreach crt $moves(dn,$cr) {
                                if {$flags(position,$crt) == ""} {
                                    lappend flags(legal_moves) [list $cr $crt]
                                }
                            }
                        }
                    }
                }

                wp {
                    switch -- $flags(game) {
                        straight -
                        pool -
                        brazilian {
                            foreach crt $moves(dn,$cr) {
                                if {$flags(position,$crt) == ""} {
                                    lappend flags(legal_moves) [list $cr $crt]
                                }
                            }
                        }
                        russian -
                        spanish -
                        italian {
                            foreach crt $moves(up,$cr) {
                                if {$flags(position,$crt) == ""} {
                                    lappend flags(legal_moves) [list $cr $crt]
                                }
                            }
                        }
                    }
                }

                wk -
                bk {
                    switch -- $flags(game) {
                        straight -
                        italian {
                            foreach crt \
                                    [concat $moves(up,$cr) $moves(dn,$cr)] {
                                if {$flags(position,$crt) == ""} {
                                    lappend flags(legal_moves) [list $cr $crt]
                                }
                            }
                        }
                        russian -
                        pool -
                        brazilian -
                        spanish {
                            foreach d {d1 d2 d3 d4} {
                                foreach crt $moves($d,$cr) {
                                    if {$flags(position,$crt) == ""} {
                                        lappend flags(legal_moves) \
                                                [list $cr $crt]
                                    } else {
                                        break
                                    }
                                }
                            }
                        }
                    }
                }
            }
        }
    }
}

proc checkers::is_move_legal {gid move} {
    variable $gid
    upvar 0 $gid flags

    expr {[lsearch -exact $flags(legal_moves) $move] >= 0}
}

proc checkers::is_move_prefix_legal {gid move} {
    variable $gid
    upvar 0 $gid flags

    expr {[lsearch -glob $flags(legal_moves) "$move *"] >= 0}
}

proc checkers::highlight_legal_moves {gid prefix} {
    variable $gid
    upvar 0 $gid flags

    unhighlight_legal_moves $gid

    set len [llength $prefix]
    set lenm1 [expr {$len - 1}]
    foreach move $flags(legal_moves) {
        if {[lrange $move 0 $lenm1] != $prefix} {
            continue
        }
        foreach pos [lrange $move 1 $lenm1] {
            $flags(board) addtag intermediate1 withtag [list cr $pos]&&square
        }
        foreach pos [lrange $move $len end-1] {
            $flags(board) addtag intermediate2 withtag [list cr $pos]&&square
        }
        $flags(board) addtag legal withtag [list cr [lindex $move end]]&&square

    }
    $flags(board) itemconfigure legal&&square -outline blue
    $flags(board) itemconfigure intermediate1&&square -outline yellow
    $flags(board) itemconfigure intermediate2&&square -outline green
}

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

    $flags(board) itemconfigure square -outline {}
    $flags(board) dtag legal
    $flags(board) dtag intermediate1
    $flags(board) dtag intermediate2
}

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

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

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

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

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

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

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

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

    lassign [split [::xmpp::xml::getAttr $attrs type] ":"] category game

    if {$category != "checkers"} {
        return
    }

    switch -- $game {
        straight -
        russian -
        pool -
        brazilian -
        spanish -
        italian {
            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]
        }
    }
    return
}

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

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

    lassign [split [::xmpp::xml::getAttr $attrs type] ":"] category game

    if {$category != "checkers"} {
        return
    }

    switch -- $game {
        straight -
        russian -
        pool -
        brazilian -
        spanish -
        italian {
            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
}

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