# reversi.tcl --
#
#       This file implements Reversi (Othello) game for the Tkabber XMPP
#       client.

package require msgcat

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

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

    variable square_size [expr {48*$::icons_scale}]
    variable line_width $::icons_scale

    variable themes
    variable dirs \
        [glob -nocomplain -directory [file join [file dirname [info script]] \
                                                pixmaps] *]
    variable dir
    foreach dir $dirs {
        pixmaps::load_theme_name [namespace current]::themes $dir
    }
    variable values {}
    variable theme
    foreach theme [lsort [array names themes]] {
        lappend values $theme $theme
    }

    variable options

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

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

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

    hook::add games_board_create_hook [namespace current]::iq_create
    hook::add games_board_turn_hook [namespace current]::iq_turn

    ::xmpp::iq::register set create games:board \
                         [namespace parent]::iq_games_board_create
    ::xmpp::iq::register set turn games:board \
                         [namespace parent]::iq_games_board_turn

    load_stored_theme
    calc_moves
}

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

    hook::remove games_board_create_hook [namespace current]::iq_create
    hook::remove games_board_turn_hook [namespace current]::iq_turn

    if {[hook::is_empty games_board_create_hook]} {
        ::xmpp::iq::unregister set create games:board
        rename [namespace parent]::iq_games_board_create ""
    }

    if {[hook::is_empty games_board_turn_hook]} {
        ::xmpp::iq::unregister set turn games:board
        rename [namespace parent]::iq_games_board_turn ""
    }

    foreach var [info vars [namespace current]::*] {
        upvar #0 $var flags
        if {[info exists flags(window)]} {
            destroy_win $flags(window)
        }
    }

    foreach var [info vars [namespace current]::*] {
        if {$var ne "[namespace current]::options"} {
            unset $var
        }
    }

    foreach img [image names] {
        if {[string first reversi/ $img] == 0} {
            image delete $img
        }
    }
}

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

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

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

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

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

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

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

    pack $wf.message -pady 2m

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

    $w draw
}

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

    set id reversi[rand 1000000000]

    # FIX
    #set rjid [get_jid_of_user $jid]

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

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

    start_play $xlib $jid $id $color
}


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

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

    Dialog $w -title [::msgcat::mc "Reversi Invitation from %s" $jid] \
        -modal none -anchor e -default 0

    set wf [$w getframe]
    bind $wf <Destroy> [namespace code [list invited_res $w $xlib $jid \
                                             $iqid $id $color 0]]

    set nick [get_nick $xlib $jid chat]
    set message1 [::msgcat::mc "Reversi game invitation from %s (%s)\
                                is received." \
                         $nick $jid]
    switch -- $color {
        white {
            set message2 [::msgcat::mc "%s wants play white." $nick]
        }
        black {
            set message2 [::msgcat::mc "%s wants play black." $nick]
        }
        default {
            return [list error modify bad-request]
        }
    }
    Message $wf.message1 -aspect 50000 -text $message1
    Message $wf.message2 -aspect 50000 -text $message2
    pack $wf.message1 -pady 1m
    pack $wf.message2 -pady 1m

    $w add -text [::msgcat::mc "Agree to play"] \
           -command [namespace code [list invited_res $w $xlib $jid \
                                          $iqid $id $color 1]]
    $w add -text [::msgcat::mc "Refuse to play"] \
           -command [namespace code [list invited_res $w $xlib $jid \
                                          $iqid $id $color 0]]

    $w draw
    return
}

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

    if {$res} {
        switch -- $color {
            white {
                start_play $xlib $jid $id black
            }
            black {
                start_play $xlib $jid $id white
            }
            default {
                ::xmpp::sendIQ $xlib error \
                               -error [::xmpp::stanzaerror::error \
                                                modify bad-request] \
                               -to $jid \
                               -id $iqid
            }
        }

        ::xmpp::sendIQ $xlib result \
                       -query [::xmpp::xml::create create \
                                        -xmlns games:board \
                                        -attrs [list type reversi \
                                                     id $id]] \
                       -to $jid \
                       -id $iqid
    } else {
        ::xmpp::sendIQ $xlib error \
                       -error [::xmpp::stanzaerror::error \
                                        modify not-acceptable] \
                       -to $jid \
                       -id $iqid
    }
}

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

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

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

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

    make_default_position $gid

    open $gid
}

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

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

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

    for {set c 0} {$c < 8} {incr c} {
        for {set r 0} {$r < 8} {incr r} {
            set flags(position,$c,$r) ""
        }
    }
    set flags(position,3,3) w
    set flags(position,4,4) w
    set flags(position,3,4) b
    set flags(position,4,3) b

    set flags(position,turn) black

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

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

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

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

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

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

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

    set move 0
    set draw 0

    foreach xml $xmlList {
        ::xmpp::xml::split $xml tag xmlns attrs cdata subels
        switch -- $tag {
            put {
                set pos [::xmpp::xml::getAttr $attrs pos]
                set poss [split $pos ","]
                if {[llength $poss] == 2} {
                    set ct [lindex $poss 0]
                    set rt [lindex $poss 1]
                    set move 1
                    if {$options(sound) != "" && ![::sound::is_mute]} {
                        ::sound::play $options(sound)
                    }
                }
            }
            resign {
                end_game $gid 1 [::msgcat::mc "You win (Opponent resigned)"]
                update_controls $gid
                draw_position $gid
                highlight_last_move $gid
                return [list result [::xmpp::xml::create turn \
                                            -xmlns games:board \
                                            -attrs [list type reversi \
                                                         id $flags(id)]]]
            }
            accept {
                if {$flags(position,draw)} {
                    end_game $gid 0.5 [::msgcat::mc "Draw (Opponent accepted)"]
                    update_controls $gid
                    draw_position $gid
                    highlight_last_move $gid
                    return [list result [::xmpp::xml::create turn \
                                                -xmlns games:board \
                                                -attrs [list type reversi \
                                                             id $flags(id)]]]
                } else {
                    return [list error modify not-acceptable]
                }
            }
            draw {
                set draw 1
            }
        }
    }

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

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

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

proc reversi::calc_moves {} {
    variable moves

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

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

    set r [expr {7 - $r}]
    list [expr {$line_width + ($square_size * 0.5) + \
                    (($square_size + $line_width) * $c)}] \
        [expr {$line_width + ($square_size * 0.5) + \
                   (($square_size + $line_width) * $r)}]
}

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

    array unset flags
}

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

proc reversi::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 reversi::open {gid} {
    variable options
    variable square_size
    variable line_width
    variable $gid
    upvar 0 $gid flags

    set jid $flags(opponent)

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

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

    set board [canvas $w.board \
                   -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 2m

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

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

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

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

    make_default_position $gid

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

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

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

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

    set board $flags(board)

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

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

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

proc reversi::set_tooltips {args} {
    variable options

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

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

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

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

    button_update_relief $flags(show_last_move_button) $flags(show_last_move)

    highlight_last_move $gid
}

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

    set opponent_score [expr {1 - $my_score}]

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

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

    set hw $flags(hw)
    $hw configure -state normal
    catch {$hw delete attention.first attention.last}
    $hw delete {end -1 char} end
    $hw insert end "\n\t\t$score\n"
    $hw see end
    $hw configure -state disabled
}

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

    $flags(board) delete figure

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

proc reversi::motion {gid x y} {
    variable line_width
    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 "" -width $line_width
    $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 -width $line_width
        $board itemconfigure dst_sq&&legal&&square -outline blue -width $line_width
    }
}

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

    set board $flags(board)

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

proc reversi::release {gid x y} {
    variable options
    variable line_width
    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 "" -width $line_width
    $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 "" -width $line_width
        }
    }

    update_controls $gid
    draw_position $gid

    highlight_last_move $gid
}

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

    $flags(board) itemconfigure last -outline "" -width $line_width

    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 -width $line_width
}

proc reversi::do_move {gid ct rt draw} {
    variable options
    variable moves
    variable $gid
    upvar 0 $gid flags

    if {$ct == "" || $rt == ""} {
        return 0
    }

    set my_move [is_my_move $gid]

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

    save_position $gid

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

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

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

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

    add_move_to_history $gid $ct $rt

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

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

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

    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} {
        set endgame 1
        lassign [count_pieces $gid] bp wp
    } elseif {$skip} {
        add_move_to_history $gid
    }

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    incr flags(position,halfmove)

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

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

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

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

    set flags(legal_moves) {}

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

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

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

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

    return 0
}

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

    expr {[lsearch -regexp $flags(legal_moves) ^[list $ct $rt]] >= 0}
}

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

    set board $flags(board)

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

    }
}

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

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

proc reversi::is_my_move {gid} {
    variable $gid
    upvar 0 $gid flags
    is_same_color $flags(position,turn) $flags(our_color)
}

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

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

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

proc reversi::add_groupchat_user_menu_item {m xlib jid} {
    set mm $m.gamesmenu
    if {![winfo exists $mm]} {
        menu $mm -tearoff 0
        $m add cascade -label [::msgcat::mc "Games"] -menu $mm
    }
    $mm add command -label [::msgcat::mc "Reversi..."] \
        -command [list [namespace current]::invite_dialog $xlib $jid]
}

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

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

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

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

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

    if {[::xmpp::xml::getAttr $attrs type] == "reversi"} {
        set gid [make_gid $from [::xmpp::xml::getAttr $attrs id]]
        if {[exists $gid]} {
            set var [[namespace current]::turn_recv $gid $subels]
        } else {
            set var [list error cancel item-not-found]
        }
    }
    return
}


# Common games:board part
proc iq_games_board_create {xlib from xml args} {
    set res [list error cancel feature-not-implemented]
    set iqid [::xmpp::xml::getAttr $args -id]
    hook::run games_board_create_hook res $xlib $from $iqid $xml
    return $res
}

proc iq_games_board_turn {xlib from xml args} {
    set res [list error cancel feature-not-implemented]
    hook::run games_board_turn_hook res $xlib $from $xml
    return $res
}

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