# poker.tcl --
#
#       This file implements Poker game plugin for the Tkabber XMPP client.

# This plugin uses long arithmetics, so it requires Tcl 8.5

if {![package vsatisfies [package present Tcl] 8.5]} return

package require msgcat

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

    if {![::plugins::is_registered poker]} {
        ::plugins::register poker \
                            -namespace [namespace current] \
                            -source [info script] \
                            -description \
                                [::msgcat::mc "Whether the Poker (Texas\
                                               hold'em) plugin is loaded."] \
                            -loadcommand [namespace code load] \
                            -unloadcommand [namespace code unload]
        return
    }

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

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

    custom::defgroup Poker [::msgcat::mc "Poker (Texas hold'em) plugin\
                                          options."] \
        -group Plugins
    custom::defvar options(theme) Classic \
        [::msgcat::mc "Poker playing cards theme."] -group Poker \
        -type options -values $values \
        -command [namespace code load_stored_theme]
    custom::defvar options(show_tooltips) 1 \
        [::msgcat::mc "Show tooltips with short instructions."] \
        -type boolean -group Poker \
        -command [namespace code set_tooltips]
    custom::defvar options(sound) "" \
        [::msgcat::mc "Sound to play after opponent's deal or bet"] \
        -type file -group Poker

    variable prime1 \
             0x[join {FFFFFFFF FFFFFFFF C90FDAA2 2168C234 C4C6628B 80DC1CD1
                      29024E08 8A67CC74 020BBEA6 3B139B22 514A0879 8E3404DD
                      EF9519B3 CD3A431B 302B0A6D F25F1437 4FE1356D 6D51C245
                      E485B576 625E7EC6 F44C42E9 A63A3620 FFFFFFFF FFFFFFFF} \
                     ""]
    variable generator1 2
    variable bytesp1 96 ; # Prime1 length
    variable bytes1 40  ; # Key length

    option add *Poker*tableBackground #8fbc8f widgetDefault
    option add *Poker*tableForeground #cdddcd widgetDefault

    variable card_width 71
    variable card_height 96
    variable line_width 5
    variable line_pad 5
    variable line_margin 10
    variable text_height 20
}

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

    hook::add games_cards_create_hook [namespace current]::iq_create
    hook::add games_cards_turn_hook [namespace current]::iq_turn

    ::xmpp::iq::register set create games:cards \
                         [namespace parent]::iq_games_cards_create
    ::xmpp::iq::register set * games:cards \
                         [namespace parent]::iq_games_cards_turn

    load_stored_theme
}

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

    hook::remove games_cards_create_hook [namespace current]::iq_create
    hook::remove games_cards_turn_hook [namespace current]::iq_turn

    if {[hook::is_empty games_cards_create_hook]} {
        ::xmpp::iq::unregister set create games:cards
        rename [namespace parent]::iq_games_cards_create ""
    }

    if {[hook::is_empty games_cards_turn_hook]} {
        ::xmpp::iq::unregister set * games:cards
        rename [namespace parent]::iq_games_cards_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 poker/ $img] == 0} {
            image delete $img
        }
    }
}

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

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

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

proc poker::invite_dialog {xlib jid} {
    set w .poker_invite

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

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

    set wf [$w getframe]
    Message $wf.message -aspect 50000 \
                        -text [::msgcat::mc "Sending Poker (Texas hold'em)\
                                             game invitation to %s (%s)" \
                                            [chat::get_nick $xlib $jid chat] \
                                            $jid]
    pack $wf.message -pady 2m

    $w add -text [::msgcat::mc "I want to deal first"] \
           -command [namespace code [list invite $xlib $jid true]]
    $w add -text [::msgcat::mc "I want to deal second"] \
           -command [namespace code [list invite $xlib $jid false]]
    $w add -text [::msgcat::mc "Cancel invitation"] \
           -command [list destroy $w]

    $w draw
}

proc poker::invite {xlib jid deal} {
    destroy .poker_invite

    set id poker[rand 1000000000]

    # FIX
    #set rjid [get_jid_of_user $jid]

    set fields [concat [::xmpp::data::formField field \
                                -var FORM_TYPE \
                                -type hidden \
                                -value games:cards:dn] \
                       [::xmpp::data::formField field \
                                -var modp \
                                -type list-single \
                                -options {"" 1}]]
    set feature \
        [::xmpp::xml::create feature \
             -xmlns http://jabber.org/protocol/feature-neg \
             -subelement [::xmpp::data::form $fields]]

    ::xmpp::sendIQ $xlib set \
            -query [::xmpp::xml::create create \
                            -xmlns games:cards \
                            -attrs [list type poker:th:1 \
                                         id $id \
                                         deal $deal] \
                            -subelement $feature] \
            -to $jid \
            -command [namespace code [list invite_res $xlib $jid $id $deal]]
}

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

    # TODO: Parse negotiation submit form
    start_play $xlib $jid $id $deal 1
}

proc poker::invited_dialog {xlib jid iqid id deal modp} {
    set w .poker_invited

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

    Dialog $w -title [::msgcat::mc "Poker 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 $deal $modp 0]]

    set nick [chat::get_nick $xlib $jid chat]
    set message1 [::msgcat::mc "Poker (Texas hold'em) game invitation\
                                from %s (%s) is received." \
                               $nick $jid]
    switch -- $deal {
        true {
            set message2 [::msgcat::mc "%s wants to deal first." $nick]
        }
        false {
            set message2 [::msgcat::mc "%s wants to deal second." $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 $deal $modp 1]]
    $w add -text [::msgcat::mc "Refuse to play"] \
           -command [namespace code [list invited_res $w $xlib $jid $iqid \
                                                      $id $deal $modp 0]]

    $w draw
    return
}

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

    if {$res} {
        switch -- $deal {
            true {
                start_play $xlib $jid $id false $modp
            }
            false {
                start_play $xlib $jid $id true $modp
            }
            default {
                ::xmpp::sendIQ $xlib error \
                               -error [::xmpp::stanzaerror::error \
                                                modify bad-request] \
                               -to $jid \
                               -id $iqid
            }
        }

    set feature \
        [::xmpp::xml::create feature \
             -xmlns http://jabber.org/protocol/feature-neg \
             -subelement [::xmpp::data::submitForm \
                                    [list FORM_TYPE games:cards:dn \
                                          modp $modp]]]

        ::xmpp::sendIQ $xlib result \
                       -query [::xmpp::xml::create create \
                                        -xmlns games:cards \
                                        -attrs [list type poker:th:1 \
                                                     id $id] \
                                        -subelement $feature] \
                       -to $jid \
                       -id $iqid
    } else {
        ::xmpp::sendIQ $xlib error \
                       -error [::xmpp::stanzaerror::error \
                                        modify not-acceptable] \
                       -to $jid \
                       -id $iqid
    }
    return
}

proc poker::start_play {xlib jid id deal modp} {
    set gid [make_gid $jid $id]
    variable $gid
    variable options
    upvar 0 $gid flags

    set flags(window) [win_id poker $gid]
    set flags(xlib) $xlib
    set flags(opponent) $jid
    set flags(id) $id
    set flags(modp) $modp
    set flags(deal_first) $deal
    set flags(deals) 0
    set flags(stop) 0

    # TODO: Negotiate these values
    set flags(my_stack) 2000
    set flags(opp_stack) 2000
    set flags(small_blind) 10
    set flags(big_blind) 20
    set flags(double_blinds) 4

    trace variable [namespace current]::${gid}(state) w \
          [namespace code [list on_state_change $gid]]

    open $gid
}

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

    array unset flags
}

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

proc poker::open {gid} {
    variable line_margin
    variable line_width
    variable line_pad
    variable card_width
    variable card_height
    variable text_height
    variable options
    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 "Poker with %s" \
                            [chat::get_nick $flags(xlib) $jid chat]]
    add_win $w -title $title \
               -tabtitle $title \
               -class Poker \
               -raise 1

    variable board_width  \
        [expr {4*$line_margin + 6*$line_width + 8*$line_pad + 5*$card_width}]
    variable board_height \
        [expr {8*$line_margin + 6*$line_width + 6*$line_pad + 3*$card_height +
               2*$text_height}]

    set board [canvas $w.board \
                   -borderwidth 0\
                   -highlightthickness 0 \
                   -width $board_width \
                   -height $board_height]
    set background [option get $board tableBackground Poker]
    $board configure -background $background
    pack $board -side left -anchor w -padx 10

    set color [option get $board tableForeground Poker]
    set x1 \
        [expr {($board_width - 2*$line_width - 3*$line_pad - 2*$card_width)/2}]
    set y1 [expr {$board_height - $line_margin}]
    set x2 [expr {$board_width - $x1}]
    set y2 [expr {$y1 - 2*$line_width - 2*$line_pad - $card_height}]
    $board create polygon $x1 $y1 $x1 $y2 $x2 $y2 $x2 $y1 \
           -fill "" -outline $color -width $line_width -joinstyle round

    set y1 [expr {$board_height - $y1}]
    set y2 [expr {$board_height - $y2}]
    $board create polygon $x1 $y1 $x1 $y2 $x2 $y2 $x2 $y1 \
           -fill "" -outline $color -width $line_width -joinstyle round

    set x1 [expr {$line_margin}]
    set x2 [expr {$x1 + 2*$line_width + 4*$line_pad + 3*$card_width}]
    set y1 \
        [expr {($board_height - 2*$line_width - 2*$line_pad - $card_height)/2}]
    set y2 [expr {$board_height - $y1}]
    $board create polygon $x1 $y1 $x1 $y2 $x2 $y2 $x2 $y1 \
           -fill "" -outline $color -width $line_width -joinstyle round

    set x1 [expr {$x2 + $line_margin}]
    set x2 [expr {$x1 + 2*$line_width + 2*$line_pad + $card_width}]
    $board create polygon $x1 $y1 $x1 $y2 $x2 $y2 $x2 $y1 \
           -fill "" -outline $color -width $line_width -joinstyle round

    set x1 [expr {$x2 + $line_margin}]
    set x2 [expr {$x1 + 2*$line_width + 2*$line_pad + $card_width}]
    $board create polygon $x1 $y1 $x1 $y2 $x2 $y2 $x2 $y1 \
           -fill "" -outline $color -width $line_width -joinstyle round

    frame $w.mystack -background $background
    label $w.mystack.label \
        -text [::msgcat::mc "Stack: "] -background $background
    grid $w.mystack.label -row 1 -column 0 -sticky w
    label $w.mystack.stack -anchor w -background $background \
        -textvariable [namespace current]::${gid}(my_stack)
    grid $w.mystack.stack -row 1 -column 1 -sticky w
    label $w.mystack.lbet -text [::msgcat::mc "Bet:"] -background $background
    grid $w.mystack.lbet -row 0 -column 0 -sticky w
    label $w.mystack.bet -anchor w -background $background \
        -textvariable [namespace current]::${gid}(my_bet)
    grid $w.mystack.bet -row 0 -column 1 -sticky w
    set x [expr {($board_width - $line_pad)/2 -
                 $card_width - $line_pad - $line_width - $line_margin}]
    set y [expr {$board_height -
                 ($line_margin + 2*$line_width + 2*$line_pad + $card_height)}]
    $board create window $x $y -window $w.mystack -anchor ne

    frame $w.oppstack -background $background
    label $w.oppstack.label \
        -text [::msgcat::mc "Stack: "] -background $background
    grid $w.oppstack.label -row 0 -column 0 -sticky w
    label $w.oppstack.stack -anchor w -background $background \
        -textvariable [namespace current]::${gid}(opp_stack)
    grid $w.oppstack.stack -row 0 -column 1 -sticky w
    label $w.oppstack.lbet -text [::msgcat::mc "Bet:"] -background $background
    grid $w.oppstack.lbet -row 1 -column 0 -sticky w
    label $w.oppstack.bet -anchor w -background $background \
        -textvariable [namespace current]::${gid}(opp_bet)
    grid $w.oppstack.bet -row 1 -column 1 -sticky w
    set x [expr {($board_width - $line_pad)/2 -
                 $card_width - $line_pad - $line_width - $line_margin}]
    set y [expr {$line_margin + 2*$line_width + 2*$line_pad + $card_height}]
    $board create window $x $y -window $w.oppstack -anchor se

    set flags(board) $board

    Frame $w.info1
    pack $w.info1 -side top -anchor w
    Label $w.info1.ldealer -text [::msgcat::mc "Dealer: "]
    grid $w.info1.ldealer -row 0 -column 0 -sticky w
    Label $w.info1.dealer -anchor w \
        -textvariable [namespace current]::${gid}(dealer)
    grid $w.info1.dealer -row 0 -column 1 -sticky w

    Label $w.info1.lsblind -text [::msgcat::mc "Small blind: "]
    grid $w.info1.lsblind -row 1 -column 0 -sticky w
    Label $w.info1.sblind -anchor w \
        -textvariable [namespace current]::${gid}(small_blind)
    grid $w.info1.sblind -row 1 -column 1 -sticky w

    Label $w.info1.lbblind -text [::msgcat::mc "Big blind: "]
    grid $w.info1.lbblind -row 2 -column 0 -sticky w
    Label $w.info1.bblind -anchor w \
        -textvariable [namespace current]::${gid}(big_blind)
    grid $w.info1.bblind -row 2 -column 1 -sticky w

    set bbox [ButtonBox $w.bbox -orient vertical -spacing 0]
    $bbox add -text [::msgcat::mc "Bet"] \
              -state disabled \
              -command [namespace code [list bet $gid bet]]
    $bbox add -text [string trim [::msgcat::mc "Check "]] \
              -state disabled \
              -command [namespace code [list bet $gid check]]
    $bbox add -text [string trim [::msgcat::mc "Fold "]] \
              -state disabled \
              -command [namespace code [list bet $gid fold]]
    $bbox add -text [::msgcat::mc "Stop the game"] \
              -command [namespace code [list stop_game $gid]]
    grid columnconfigure $bbox 0 -weight 1
    pack $bbox -side bottom -anchor w -fill x
    set flags(bbox) $bbox
    #set_tooltips

    Frame $w.info5
    pack $w.info5 -side bottom -anchor w -fill x
    set flags(scale) \
        [Scale $w.info5.scale \
               -orient horizontal \
               -from $flags(big_blind) \
               -to $flags(my_stack) \
               -variable [namespace current]::${gid}(bet_or_raise_amount)]
    if {[catch {$flags(scale) state disabled}]} {
        $flags(scale) configure -state disabled -showvalue 0
    }
    pack $w.info5.scale -side left -anchor w -expand yes -fill x

    Frame $w.info4
    pack $w.info4 -side bottom -anchor w -fill x
    Label $w.info4.lamount -state disabled \
        -text [::msgcat::mc "Amount to bet: "]
    pack $w.info4.lamount -side left
    Entry $w.info4.amount -state disabled \
        -textvariable [namespace current]::${gid}(bet_or_raise_amount)
    pack $w.info4.amount -side left -anchor w -expand yes -fill x
    set flags(lentry) $w.info4.lamount
    set flags(entry) $w.info4.amount

    trace variable [namespace current]::${gid}(bet_or_raise_amount) w \
          [namespace code [list configure_raise_button $gid]]

    Button $w.allin -text [string trim [::msgcat::mc "All-In "]] \
                    -state disabled \
                    -command [namespace code [list bet $gid allin]]
    pack $w.allin -side bottom -anchor w -fill x
    set flags(button_allin) $w.allin

    set hsw [ScrolledWindow $w.hsw]
    pack $hsw -side top -fill x -expand yes
    set ht [Text $w.text -wrap word -height 60 -state disabled]
    $ht tag configure attention \
        -foreground [option get $ht errorForeground Text]
    $hsw setwidget $ht
    set flags(hw) $ht

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

    add_to_log $gid [::msgcat::mc "Starting the game"]
    add_to_log $gid [::msgcat::mc "Your stack is %s" $flags(my_stack)]
    add_to_log $gid [::msgcat::mc "Opponent's stack is %s" $flags(opp_stack)]
    add_to_log $gid [::msgcat::mc "Small blind is %s" $flags(small_blind)]
    add_to_log $gid [::msgcat::mc "Big blind is %s" $flags(big_blind)]
    add_to_log $gid [::msgcat::mc "Blinds are doubled every %s deals" \
                                  $flags(double_blinds)]
    if {$flags(deal_first)} {
        add_to_log $gid [::msgcat::mc "You deal first"]

        set_state $gid new
    } else {
        add_to_log $gid [::msgcat::mc "Opponent deals first"]

        # Can't use set_state here because of sync problem if the opponent is
        # already sent us a deck
        set flags(state) new
    }
}

proc poker::add_to_log {gid message} {
    variable $gid
    upvar 0 $gid flags

    $flags(hw) configure -state normal
    $flags(hw) insert end \
               "\[[clock format [clock seconds] -format %H:%M:%S]\] $message\n"
    $flags(hw) configure -state disabled
    $flags(hw) see end
}

proc poker::configure_raise_button {gid args} {
    variable $gid
    upvar 0 $gid flags

    if {$flags(state) eq "new"} return

    if {$flags(my_bet) == $flags(opp_bet)} {
        $flags(bbox) itemconfigure 0 \
              -text [::msgcat::mc "Bet %s" $flags(bet_or_raise_amount)] \
              -command [namespace code [list bet $gid bet \
                                             $flags(bet_or_raise_amount)]]
    } else {
        $flags(bbox) itemconfigure 0 \
              -text [::msgcat::mc "Raise %s" $flags(bet_or_raise_amount)] \
              -command [namespace code [list bet $gid raise \
                                             $flags(bet_or_raise_amount)]]
    }
}

proc poker::bet {gid tag {amount ""}} {
    variable $gid
    upvar 0 $gid flags

    if {$amount ne ""} {
        set attrs [list amount $amount]
    } else {
        set attrs {}
    }

    ::xmpp::sendIQ $flags(xlib) set \
            -query [::xmpp::xml::create bet \
                            -xmlns games:cards \
                            -attrs [list type poker:th:1 id $flags(id)] \
                            -subelement [::xmpp::xml::create $tag \
                                                -attrs $attrs]] \
            -to $flags(opponent) \
            -command [namespace code [list bet_result $gid $tag $amount]]
}

proc poker::bet_result {gid tag amount status xml} {
    variable $gid
    upvar 0 $gid flags

    if {![string equal $status ok]} {
        # TODO
        return
    }

    set state $flags(state)
    switch -- $flags(state) {
        preflop {
            set newstate flop-deal
        }
        flop {
            set newstate turn-deal
        }
        turn {
            set newstate river-deal
        }
        river {
            set newstate finish
        }
        default {
            # TODO: Some error message
            return
        }
    }

    set flags(bet) [expr {!$flags(bet)}]
    incr flags(bets)

    switch -- $tag {
        call {
            set call [expr {$flags(opp_bet) - $flags(my_bet)}]
            incr flags(my_stack) -$call
            incr flags(my_bet) $call
            draw_bet $gid 1 [::msgcat::mc "Call"]
            add_to_log $gid [::msgcat::mc "You call %s" $call]
        }
        allin {
            incr flags(my_bet) $flags(my_stack)
            set flags(my_stack) 0
            set flags(my_all_in) 1
            draw_bet $gid 1 [::msgcat::mc "All-In"]
            add_to_log $gid [::msgcat::mc "You go all-in"]
        }
        bet -
        raise {
            incr flags(my_stack) -$amount
            incr flags(my_bet) $amount
            draw_bet $gid 1 [::msgcat::mc "Raise"]
            add_to_log $gid [::msgcat::mc "You raise %s" $amount]
        }
        check {
            draw_bet $gid 1 [::msgcat::mc "Check"]
            add_to_log $gid [::msgcat::mc "You check"]
        }
        fold {
            draw_bet $gid 1 [::msgcat::mc "Fold"]
            draw_bet $gid 0 [::msgcat::mc "Winner"]
            add_to_log $gid [::msgcat::mc "You fold"]
            set pot [expr {$flags(my_bet) + $flags(opp_bet)}]
            incr flags(opp_stack) $pot
            add_to_log $gid [::msgcat::mc "Opponent won pot %s" $pot]
            set flags(my_bet) 0
            set flags(opp_bet) 0
            set_state $gid check
            return
        }
    }

    # Non-dealer sending call, or calling all-in, or closing check
    # should switch to the next state without after idle.

    switch -- $tag {
        check {
            if {$flags(bets) % 2 == 0} {
                if {$newstate eq "finish"} {
                    send_open_cards $gid
                }
                set flags(state) $newstate
            }
        }
        call {
            if {$flags(opp_all_in)} {
                set flags(showdown) 1
                send_open_cards $gid
            }
            if {$flags(bets) != 1} {
                if {$newstate eq "finish"} {
                    send_open_cards $gid
                }
                set flags(state) $newstate
            }
        }
        allin {
            # All-In is not always closing
            if {$flags(opp_all_in) || $flags(my_bet) <= $flags(opp_bet)} {
                set flags(showdown) 1
                send_open_cards $gid
                set flags(state) $newstate
            }
        }
    }

    if {$flags(state) eq $state} {
        start_betting $gid
    }
}

proc poker::stop_game {gid} {
    variable $gid
    upvar 0 $gid flags

    set flags(stop) 1
    disable_controls $gid
    add_to_log $gid [::msgcat::mc "The game is terminated by you"]

    ::xmpp::sendIQ $flags(xlib) set \
            -query [::xmpp::xml::create stop \
                            -xmlns games:cards \
                            -attrs [list type poker:th:1 \
                                         id $flags(id)]] \
            -to $flags(opponent)
}

proc poker::disable_controls {gid} {
    variable $gid
    upvar 0 $gid flags

    $flags(bbox) itemconfigure 0 -text [::msgcat::mc "Bet"] -state disabled
    $flags(bbox) itemconfigure 1 -text [string trim [::msgcat::mc "Check "]] \
                                 -state disabled
    $flags(bbox) itemconfigure 2 -state disabled
    $flags(bbox) itemconfigure 3 -state disabled
    $flags(button_allin) configure -state disabled
    if {[catch {$flags(scale) state disabled}]} {
        $flags(scale) configure -state disabled
    }
    $flags(lentry) configure -state disabled
    $flags(entry) configure -state disabled
}

proc poker::send_deck {gid} {
    variable prime1
    variable bytesp1
    variable $gid
    upvar 0 $gid flags

    set deck {}
    for {set i 0} {$i < 52} {incr i} {
        set msg [expr {([gen_rnd $bytesp1] & ~0x3f) | $i}]
        lappend deck $msg
    }

    set subels {}
    set ekey [ekey $flags(key)]
    foreach msg [shuffle $deck] {
        lappend subels \
                [::xmpp::xml::create card \
                    -attrs [list msg [dec2hex [encipher $ekey $msg]]]]
        update

        # During update many things may happen
        if {![exists $gid] || $flags(stop)} return
    }

    # We don't store the shuffled deck because there will be another
    # reshuffle at the other side, so this cards order will be useless.

    add_to_log $gid [::msgcat::mc "Sending shuffled deck"]

    ::xmpp::sendIQ $flags(xlib) set \
            -query [::xmpp::xml::create deck \
                            -xmlns games:cards \
                            -attrs [list type poker:th:1 \
                                         id $flags(id)] \
                            -subelements $subels] \
            -to $flags(opponent) \
            -command [namespace code [list send_deck_result $gid]]

    add_to_log $gid [::msgcat::mc "Waiting for reshuffled deck"]
}

proc poker::send_deck_result {gid status xml} {
    variable $gid
    upvar 0 $gid flags

    if {![string equal $status ok]} {
        # TODO
        return
    }

    set flags(deck) {}

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

    foreach subel $subels {
        ::xmpp::xml::split $subel stag sxmlns sattrs scdata ssubels

        if {[string equal $stag card]} {
            lappend flags(deck) [hex2dec [::xmpp::xml::getAttr $sattrs msg]]
        }
    }

    if {[llength $flags(deck)] != 52} {
        # TODO
        return
    }

    add_to_log $gid [::msgcat::mc "Received reshuffled deck"]

    send_deck2 $gid
}

proc poker::send_deck2 {gid} {
    variable prime1
    variable bytes1
    variable $gid
    upvar 0 $gid flags

    set flags(keys) {}
    for {set i 0} {$i < 52} {incr i} {
        lappend flags(keys) [gen_rnd $bytes1]
    }

    set subels {}
    set dkey [dkey $flags(key)]
    foreach msg $flags(deck) key $flags(keys) {
        set ekey [ekey $key]
        lappend subels \
                [::xmpp::xml::create card \
                    -attrs [list msg \
                                 [dec2hex [encipher $ekey \
                                                    [decipher $dkey $msg]]]]]
        update

        # During update many things may happen
        if {![exists $gid] || $flags(stop)} return
    }

    # We don't store the shuffled deck because there will be another
    # reshuffle at the other side, so this cards order will be useless.

    add_to_log $gid [::msgcat::mc "Sending reencrypted deck"]

    ::xmpp::sendIQ $flags(xlib) set \
            -query [::xmpp::xml::create redeck \
                            -xmlns games:cards \
                            -attrs [list type poker:th:1 \
                                         id $flags(id)] \
                            -subelements $subels] \
            -to $flags(opponent) \
            -command [namespace code [list send_deck2_result $gid]]

    add_to_log $gid [::msgcat::mc "Waiting for doubly reencrypted deck"]
}

proc poker::send_deck2_result {gid status xml} {
    variable $gid
    upvar 0 $gid flags

    if {![string equal $status ok]} {
        # TODO
        return
    }

    set flags(deck) {}

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

    foreach subel $subels {
        ::xmpp::xml::split $subel stag sxmlns sattrs scdata ssubels

        if {[string equal $stag card]} {
            lappend flags(deck) [hex2dec [::xmpp::xml::getAttr $sattrs msg]]
        }
    }

    if {[llength $flags(deck)] != 52} {
        # TODO
        return
    }

    add_to_log $gid [::msgcat::mc "Received doubly reencrypted deck"]

    set_state $gid preflop-deal
}

proc poker::send_open_cards {gid} {
    variable $gid
    upvar 0 $gid flags

    set subels {}

    foreach {seq card} $flags(mvisible_cards) {
        if {[lsearch -exact $flags(hole_cards) $card] >= 0} {
            lappend subels \
                [::xmpp::xml::create card \
                        -attrs [list seq $seq \
                                     msg [dec2hex $card]]]
            lappend flags(ovisible_cards) $seq
        }
    }

    ::xmpp::sendIQ $flags(xlib) set \
            -query [::xmpp::xml::create open \
                            -xmlns games:cards \
                            -attrs [list type poker:th:1 \
                                         id $flags(id)] \
                            -subelements $subels] \
            -to $flags(opponent) \
            -command [namespace code [list send_open_cards_result $gid]]
}

proc poker::send_open_cards_result {gid status xml} {
    variable $gid
    upvar 0 $gid flags

    if {![string equal $status ok]} {
        # TODO
        return
    }

    add_to_log $gid [::msgcat::mc "You opened pocket cards to opponent"]

    switch -- $flags(state) {
        preflop {
            set_state $gid flop-deal
        }
        flop {
            set_state $gid turn-deal
        }
        turn {
            set_state $gid river-deal
        }
        river {
            set_state $gid finish
        }
    }
}

proc poker::send_hole_cards {gid} {
    variable $gid
    upvar 0 $gid flags

    set subels {}

    # Opponent's cards

    foreach seq {0 1} {
        set dkey [dkey [lindex $flags(keys) $seq]]
        lappend subels \
                [::xmpp::xml::create card \
                        -attrs [list seq [expr {$seq + 1}] \
                                     hold true \
                                     msg \
                                     [dec2hex \
                                        [decipher $dkey \
                                                 [lindex $flags(deck) $seq]]]]]
    }

    lappend flags(ovisible_cards) 1 2

    # Dealer's cards

    foreach seq {2 3} {
        lappend subels \
                [::xmpp::xml::create card \
                        -attrs [list seq [expr {$seq + 1}] \
                                     hold false \
                                     msg [dec2hex [lindex $flags(deck) $seq]]]]
    }

    ::xmpp::sendIQ $flags(xlib) set \
            -query [::xmpp::xml::create deal \
                            -xmlns games:cards \
                            -attrs [list type poker:th:1 \
                                         id $flags(id)] \
                            -subelements $subels] \
            -to $flags(opponent) \
            -command [namespace code [list send_hole_cards_result $gid {3 4}]]
}

proc poker::send_hole_cards_result {gid seqlist status xml} {
    variable $gid
    upvar 0 $gid flags

    if {![string equal $status ok]} {
        # TODO
        return
    }

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

    foreach subel $subels {
        ::xmpp::xml::split $subel stag sxmlns sattrs scdata ssubels

        if {[string equal $stag card]} {
            set seq [::xmpp::xml::getAttr $sattrs seq]
            set dkey [dkey [lindex $flags(keys) [expr {$seq - 1}]]]
            if {[set idx [lsearch -exact $seqlist $seq]] < 0} {
                # TODO
                return
            }
            set seqlist [lreplace $seqlist $idx $idx]
            set card [expr {[decipher $dkey \
                                      [hex2dec [::xmpp::xml::getAttr \
                                                        $sattrs msg]]] & 0x3f}]
            lappend flags(mvisible_cards) $seq $card
            lappend flags(hole_cards) $card
        }
    }

    if {[llength $flags(hole_cards)] != 2 || [llength $seqlist] != 0} {
        # TODO
        return
    }

    add_to_log $gid [::msgcat::mc "You got pocket cards %s" \
                                  [join [lmap [namespace current]::num2card \
                                              $flags(hole_cards)] ", "]]

    # We're not using set_state here to ensure that immediate bet will
    # be processed if any.

    set flags(state) preflop
}

proc poker::draw_hole_cards {gid} {
    variable board_height
    variable board_width
    variable card_height
    variable card_width
    variable line_margin
    variable line_width
    variable line_pad
    variable $gid
    upvar 0 $gid flags

    set x [expr {$board_width/2 - $card_width - $line_pad/2}]
    set y1 [expr {$board_height - $line_margin - $line_width -
                  $line_pad - $card_height}]
    set y2 [expr {$line_margin + $line_width + $line_pad}]

    foreach card $flags(hole_cards) {
        set c [num2card $card]
        $flags(board) create image $x $y1 -anchor nw -image poker/$c -tags card
        $flags(board) create image $x $y2 -anchor nw -image poker/back \
                                          -tags card
        set x [expr {$x + $line_pad + $card_width}]
    }

    set x [expr {$board_width/2 - $card_width - $line_pad/2}]

    foreach card $flags(opp_hole_cards) {
        set c [num2card $card]
        $flags(board) create image $x $y2 -anchor nw -image poker/$c -tags card
        set x [expr {$x + $line_pad + $card_width}]
    }

    catch {$flags(board) lower card bet}
}

proc poker::draw_flop {gid} {
    variable board_height
    variable board_width
    variable card_height
    variable card_width
    variable line_margin
    variable line_width
    variable line_pad
    variable $gid
    upvar 0 $gid flags

    set x [expr {$line_margin + $line_width + $line_pad}]
    set y [expr {($board_height - $card_height)/2}]

    foreach card $flags(flop) {
        set c [num2card $card]
        $flags(board) create image $x $y -anchor nw -image poker/$c -tags card
        set x [expr {$x + $line_pad + $card_width}]
    }
}

proc poker::draw_turn {gid} {
    variable board_height
    variable board_width
    variable card_height
    variable card_width
    variable line_margin
    variable line_width
    variable line_pad
    variable $gid
    upvar 0 $gid flags

    set x [expr {2*$line_margin + 3*$line_width + 5*$line_pad + 3*$card_width}]
    set y [expr {($board_height - $card_height)/2}]

    foreach card $flags(turn) {
        set c [num2card $card]
        $flags(board) create image $x $y -anchor nw -image poker/$c -tags card
        set x [expr {$x + $line_pad + $card_width}]
    }
}

proc poker::draw_river {gid} {
    variable board_height
    variable board_width
    variable card_height
    variable card_width
    variable line_margin
    variable line_width
    variable line_pad
    variable $gid
    upvar 0 $gid flags

    set x [expr {3*$line_margin + 5*$line_width + 7*$line_pad + 4*$card_width}]
    set y [expr {($board_height - $card_height)/2}]

    foreach card $flags(river) {
        set c [num2card $card]
        $flags(board) create image $x $y -anchor nw -image poker/$c -tags card
        set x [expr {$x + $line_pad + $card_width}]
    }
}

proc poker::draw_best_hand {gid} {
    variable board_height
    variable board_width
    variable card_height
    variable card_width
    variable line_margin
    variable line_width
    variable line_pad
    variable text_height
    variable $gid
    upvar 0 $gid flags

    $flags(board) delete hand
    set color [option get $flags(board) tableForeground Poker]
    set x [expr {$board_width/2}]

    set msg [score2msg [select_best_hand [concat $flags(hole_cards) \
                                                 $flags(flop) \
                                                 $flags(turn) \
                                                 $flags(river)]]]
    set y [expr {($board_height + $card_height)/2 + $text_height +
                 $line_width + $line_pad + $line_margin}]
    $flags(board) create text $x $y -anchor center -tags hand \
                  -text $msg -fill $color -font {Arial 20 bold}

    if {[llength $flags(opp_hole_cards)] == 2} {
        # Opponent reveared his cards, so we can evaluate his hand

        set msg [score2msg [select_best_hand [concat $flags(opp_hole_cards) \
                                                     $flags(flop) \
                                                     $flags(turn) \
                                                     $flags(river)]]]

        set y [expr {($board_height - $card_height)/2 - $text_height -
                     $line_width - $line_pad - $line_margin}]
        $flags(board) create text $x $y -anchor center -tags hand \
                      -text $msg -fill $color -font {Arial 20 bold}
    }
}

proc poker::send_community_cards {gid seqlist} {
    variable $gid
    upvar 0 $gid flags

    # This proc is calld from after command, so checking the game existence
    if {![exists $gid]} return

    set flags(ovisible_cards) [concat $flags(ovisible_cards) $seqlist]
    set subels {}

    foreach seq $seqlist {
        set dkey [dkey [lindex $flags(keys) [expr {$seq - 1}]]]
        lappend subels \
                [::xmpp::xml::create card \
                        -attrs [list seq $seq \
                                     community true \
                                     msg \
                                     [dec2hex \
                                        [decipher $dkey \
                                                 [lindex $flags(deck) \
                                                         [expr {$seq - 1}]]]]]]
    }

    ::xmpp::sendIQ $flags(xlib) set \
            -query [::xmpp::xml::create deal \
                            -xmlns games:cards \
                            -attrs [list type poker:th:1 \
                                         id $flags(id)] \
                            -subelements $subels] \
            -to $flags(opponent) \
            -command [namespace code [list send_community_cards_result \
                                           $gid $seqlist]]
}

proc poker::send_community_cards_result {gid seqlist status xml} {
    variable $gid
    upvar 0 $gid flags

    if {![string equal $status ok]} {
        # TODO
        return
    }

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

    foreach subel $subels {
        ::xmpp::xml::split $subel stag sxmlns sattrs scdata ssubels

        if {[string equal $stag card]} {
            set seq [::xmpp::xml::getAttr $sattrs seq]
            if {[set idx [lsearch -exact $seqlist $seq]] < 0} {
                # TODO
                return
            }
            set seqlist [lreplace $seqlist $idx $idx]
            set card \
                [expr {[hex2dec [::xmpp::xml::getAttr $sattrs msg]] & 0x3f}]
            switch -- $flags(state) {
                flop-deal {
                    lappend flags(flop) $card
                }
                turn-deal {
                    lappend flags(turn) $card
                }
                river-deal {
                    lappend flags(river) $card
                }
            }
            lappend flags(mvisible_cards) $seq $card
        }
    }

    if {[llength $seqlist] != 0} {
        # TODO
        return
    }

    # We're not using set_state here to ensure that immediate bet will
    # be processed if any.

    switch -- $flags(state) {
        flop-deal {
            set flags(state) flop
        }
        turn-deal {
            set flags(state) turn
        }
        river-deal {
            set flags(state) river
        }
    }
}

proc poker::start_betting {gid} {
    variable $gid
    upvar 0 $gid flags

    if {$flags(bet) && !$flags(my_all_in)} {
        if {$flags(my_bet) == $flags(opp_bet)} {
            if {$flags(my_stack) < $flags(big_blind)} {
                set flags(bet_or_raise_amount) $flags(big_blind)
                $flags(bbox) itemconfigure 0 -text [::msgcat::mc "Bet"] \
                                             -state disabled
                $flags(lentry) configure -state disabled
                $flags(entry) configure -state disabled
            } else {
                $flags(bbox) itemconfigure 0 -text [::msgcat::mc "Bet"] \
                                             -state normal
                set flags(bet_or_raise_amount) $flags(big_blind)
                $flags(lentry) configure -state normal
                $flags(entry) configure -state normal
            }
            $flags(bbox) itemconfigure 1 \
                         -text [string trim [::msgcat::mc "Check "]] \
                         -state normal \
                         -command [namespace code [list bet $gid check]]
        } elseif {$flags(my_bet) < $flags(opp_bet)} {
            set call [expr {$flags(opp_bet) - $flags(my_bet)}]
            set raise [expr {2*$call}]
            if {$flags(my_stack) < $call} {
                set flags(bet_or_raise_amount) $raise
                $flags(bbox) itemconfigure 0 \
                             -text [string trim [::msgcat::mc "Raise "]] \
                             -state disabled
                $flags(bbox) itemconfigure 1 \
                             -text [string trim [::msgcat::mc "Call "]] \
                             -state disabled
                $flags(lentry) configure -state disabled
                $flags(entry) configure -state disabled
            } elseif {$flags(my_stack) < $raise} {
                set flags(bet_or_raise_amount) $raise
                $flags(bbox) itemconfigure 0 \
                             -text [string trim [::msgcat::mc "Raise "]] \
                             -state disabled
                $flags(bbox) itemconfigure 1 \
                             -text [::msgcat::mc "Call %s" $call] \
                             -state normal \
                             -command [namespace code [list bet $gid call]]
                $flags(lentry) configure -state disabled
                $flags(entry) configure -state disabled
            } else {
                $flags(bbox) itemconfigure 0 \
                             -text [string trim [::msgcat::mc "Raise "]] \
                             -state normal
                set flags(bet_or_raise_amount) $raise
                $flags(bbox) itemconfigure 1 \
                             -text [::msgcat::mc "Call %s" $call] \
                             -state normal \
                             -command [namespace code [list bet $gid call]]
                $flags(lentry) configure -state normal
                $flags(entry) configure -state normal
            }
        } else {
            # Can't happen
        }
        $flags(button_allin) configure -state normal
        $flags(bbox) itemconfigure 2 -state normal
    } else {
        if {$flags(bets) == 0} {
            $flags(bbox) itemconfigure 0 \
                         -text [::msgcat::mc "Bet"] \
                         -state disabled
            $flags(bbox) itemconfigure 1 \
                         -text [string trim [::msgcat::mc "Check "]] \
                         -state disabled
        } else {
            $flags(bbox) itemconfigure 0 \
                         -text [string trim [::msgcat::mc "Raise "]] \
                         -state disabled
            $flags(bbox) itemconfigure 1 \
                         -text [string trim [::msgcat::mc "Call "]] \
                         -state disabled
        }
        $flags(lentry) configure -state disabled
        $flags(entry) configure -state disabled
        $flags(button_allin) configure -state disabled
        $flags(bbox) itemconfigure 2 -state disabled
    }
}

proc poker::turn_recv {gid tag xmllist} {
    variable bytes1
    variable $gid
    upvar 0 $gid flags

    if {$flags(stop)} {
        # Return error if the game is terminated

        return [list error cancel not-acceptable]
    }

    switch -- $tag {
        deck {
            add_to_log $gid [::msgcat::mc "Received shuffled deck"]

            switch -- $flags(state) {
                new {
                    # We are ready to reshuffle and return the deck
                    if {$flags(button)} {
                        return [list error cancel not-acceptable]
                    }
                }
                default {
                    # The deck has come not in time.
                    return [list error cancel not-acceptable]
                }
            }

            set deck {}
            foreach xml $xmllist {
                ::xmpp::xml::split $xml tag xmlns attrs cdata subels

                if {[string equal $tag card]} {
                    lappend deck [hex2dec [::xmpp::xml::getAttr $attrs msg]]
                }
            }

            add_to_log $gid [::msgcat::mc "Reshuffling deck"]

            # Saving flags(deck) for checking for cheaters
            # at the end of the deal
            set flags(deck) [shuffle $deck]

            if {[llength $flags(deck)] != 52} {
                return [list error modify bad-request]
            }

            set subelements {}
            set ekey [ekey $flags(key)]
            foreach message $flags(deck) {
                lappend subelements \
                        [::xmpp::xml::create card \
                            -attrs [list msg \
                                         [dec2hex [encipher $ekey $message]]]]
                update

                # During update many things may happen
                if {![exists $gid] || $flags(stop)} return
            }

            set_state $gid renew

            add_to_log $gid [::msgcat::mc "Returning reshuffled deck"]

            return [list result [::xmpp::xml::create deck \
                                    -xmlns games:cards \
                                    -attrs [list type poker:th:1 \
                                                 id $flags(id)] \
                                    -subelements $subelements]]
        }
        redeck {
            add_to_log $gid [::msgcat::mc "Received reencrypted deck"]

            switch -- $flags(state) {
                renew {
                    # We are ready to reshuffle and return the deck
                    if {$flags(button)} {
                        return [list error cancel not-acceptable]
                    }
                }
                default {
                    # The deck has come not in time.
                    return [list error cancel not-acceptable]
                }
            }

            set deck {}
            foreach xml $xmllist {
                ::xmpp::xml::split $xml tag xmlns attrs cdata subels

                if {[string equal $tag card]} {
                    lappend deck [hex2dec [::xmpp::xml::getAttr $attrs msg]]
                }
            }

            add_to_log $gid [::msgcat::mc "Reencrypting deck"]

            if {[llength $deck] != 52} {
                return [list error modify bad-request]
            }

            set flags(keys) {}
            for {set i 0} {$i < 52} {incr i} {
                lappend flags(keys) [gen_rnd $bytes1]
            }

            set subelements {}
            set flags(deck) {}
            set dkey [dkey $flags(key)]
            foreach message $deck key $flags(keys) {
                set ekey [ekey $key]
                set message2 [decipher $dkey $message]
                # Saving flags(deck) for checking for cheaters
                # at the end of the deal
                lappend flags(deck) $message2
                lappend subelements \
                        [::xmpp::xml::create card \
                            -attrs [list msg \
                                         [dec2hex [encipher $ekey $message2]]]]
                update

                # During update many things may happen
                if {![exists $gid] || $flags(stop)} return
            }

            set_state $gid preflop-deal

            add_to_log $gid [::msgcat::mc "Returning doubly reencrypted deck"]

            return [list result [::xmpp::xml::create redeck \
                                    -xmlns games:cards \
                                    -attrs [list type poker:th:1 \
                                                 id $flags(id)] \
                                    -subelements $subelements]]
        }
        deal {
            if {$flags(button)} {
                return [list error cancel not-acceptable]
            }
            switch -- $flags(state) {
                preflop-deal {
                    if {[llength $flags(hole_cards)] > 0} {
                        return [list error cancel not-acceptable]
                    }
                }
                flop-deal {
                    if {[llength $flags(flop)] > 0} {
                        return [list error cancel not-acceptable]
                    }
                }
                turn-deal {
                    if {[llength $flags(turn)] > 0} {
                        return [list error cancel not-acceptable]
                    }
                }
                river-deal {
                    if {[llength $flags(river)] > 0} {
                        return [list error cancel not-acceptable]
                    }
                }
                default {
                    return [list error cancel not-acceptable]
                }
            }

            set subelements {}

            foreach xml $xmllist {
                ::xmpp::xml::split $xml tag xmlns attrs cdata subels

                if {[string equal $tag card]} {
                    if {![::xmpp::xml::isAttr $attrs seq]} {
                        return [list error cancel not-acceptable]
                    }
                    set seq [::xmpp::xml::getAttr $attrs seq]

                    if {[::xmpp::xml::isAttr $attrs hold]} {
                        set hold [::xmpp::xml::getAttr $attrs hold]
                    } else {
                        set hold false
                    }

                    if {[::xmpp::xml::isAttr $attrs community]} {
                        set community [::xmpp::xml::getAttr $attrs community]
                    } else {
                        set community false
                    }

                    set dkey [dkey [lindex $flags(keys) [expr {$seq - 1}]]]
                    set msg [decipher $dkey \
                                      [hex2dec [::xmpp::xml::getAttr $attrs \
                                                                     msg]]]

                    if {$community} {
                        lappend subelements \
                                [::xmpp::xml::create card \
                                        -attrs [list seq $seq \
                                                     msg [dec2hex $msg]]]
                        set card [expr {$msg & 0x3f}]
                        lappend flags(ovisible_cards) $seq
                        lappend flags(mvisible_cards) $seq $card
                        switch -- $flags(state) {
                            flop-deal {
                                lappend flags(flop) $card
                            }
                            turn-deal {
                                lappend flags(turn) $card
                            }
                            river-deal {
                                lappend flags(river) $card
                            }
                            default {
                                return [list error cancel not-acceptable]
                            }
                        }
                    } elseif {$hold} {
                        set card [expr {$msg & 0x3f}]
                        lappend flags(mvisible_cards) $seq $card
                        switch -- $flags(state) {
                            preflop-deal {
                                lappend flags(hole_cards) $card
                            }
                            default {
                                return [list error cancel not-acceptable]
                            }
                        }
                    } else {
                        lappend flags(ovisible_cards) $seq
                        lappend subelements \
                                [::xmpp::xml::create card \
                                        -attrs [list seq $seq \
                                                     msg [dec2hex $msg]]]
                        switch -- $flags(state) {
                            preflop-deal {}
                            default {
                                return [list error cancel not-acceptable]
                            }
                        }
                    }
                }
            }

            switch -- $flags(state) {
                preflop-deal {
                    add_to_log $gid [::msgcat::mc "You got pocket cards: %s" \
                                    [join [lmap [namespace current]::num2card \
                                                $flags(hole_cards)] ", "]]

                    set_state $gid preflop
                }
                flop-deal {
                    set_state $gid flop
                }
                turn-deal {
                    set_state $gid turn
                }
                river-deal {
                    set_state $gid river
                }
            }

            return [list result [::xmpp::xml::create deal \
                                    -xmlns games:cards \
                                    -attrs [list type poker:th:1 \
                                                 id $flags(id)] \
                                    -subelements $subelements]]
        }
        bet {
            ::xmpp::xml::split [lindex $xmllist 0] tag xmlns attrs cdata subels

            switch -- $flags(state) {
                preflop -
                flop -
                turn -
                river {
                    if {$flags(bet)} {
                        return [list error cancel not-acceptable]
                    }
                }
                default {
                    return [list error cancel not-acceptable]
                }
            }

            set state $flags(state)
            switch -- $flags(state) {
                preflop {
                    set newstate flop-deal
                }
                flop {
                    set newstate turn-deal
                }
                turn {
                    set newstate river-deal
                }
                river {
                    set newstate finish
                }
            }

            set flags(bet) [expr {!$flags(bet)}]
            incr flags(bets)

            switch -- $tag {
                call {
                    set call [expr {$flags(my_bet) - $flags(opp_bet)}]
                    incr flags(opp_stack) -$call
                    incr flags(opp_bet) $call
                    draw_bet $gid 0 [::msgcat::mc "Call"]
                    add_to_log $gid [::msgcat::mc "Opponent calls %s" $call]
                }
                allin {
                    incr flags(opp_bet) $flags(opp_stack)
                    set flags(opp_stack) 0
                    set flags(opp_all_in) 1
                    draw_bet $gid 0 [::msgcat::mc "All-In"]
                    add_to_log $gid [::msgcat::mc "Opponent goes all-in"]
                }
                bet -
                raise {
                    set amount [::xmpp::xml::getAttr $attrs amount]
                    incr flags(opp_stack) -$amount
                    incr flags(opp_bet) $amount
                    draw_bet $gid 0 [::msgcat::mc "Raise"]
                    add_to_log $gid [::msgcat::mc "Opponent raises %s" $amount]
                }
                check {
                    draw_bet $gid 0 [::msgcat::mc "Check"]
                    add_to_log $gid [::msgcat::mc "Opponent checks"]
                }
                fold {
                    draw_bet $gid 0 [::msgcat::mc "Fold"]
                    draw_bet $gid 1 [::msgcat::mc "Winner"]
                    add_to_log $gid [::msgcat::mc "Opponent folds"]
                    set pot [expr {$flags(my_bet) + $flags(opp_bet)}]
                    incr flags(my_stack) $pot
                    add_to_log $gid [::msgcat::mc "You won pot %s" $pot]
                    set flags(my_bet) 0
                    set flags(opp_bet) 0
                    set_state $gid check
                    return [list result {}]
                }
            }

            switch -- $tag {
                check {
                    if {$flags(bets) % 2 == 0} {
                        if {$newstate eq "finish"} {
                            send_open_cards $gid
                        }
                        set flags(state) $newstate
                    }
                }
                call {
                    if {$flags(my_all_in)} {
                        set flags(showdown) 1
                        send_open_cards $gid
                    }
                    if {$flags(bets) != 1} {
                        if {$newstate eq "finish"} {
                            send_open_cards $gid
                        }
                        set flags(state) $newstate
                    }
                }
                allin {
                    # All-In is not always closing
                    if {$flags(my_all_in) ||
                                $flags(opp_bet) <= $flags(my_bet)} {
                        set flags(showdown) 1
                        send_open_cards $gid
                        set flags(state) $newstate
                    }
                }
            }

            if {$flags(state) eq $state} {
                start_betting $gid
            }

            return [list result {}]
        }
        open {
            set flags(opp_hole_cards) {}
            foreach xml $xmllist {
                ::xmpp::xml::split $xml tag xmlns attrs cdata subels

                if {[string equal $tag card]} {
                    if {![::xmpp::xml::isAttr $attrs seq]} {
                        return [list error cancel not-acceptable]
                    }
                    set seq [::xmpp::xml::getAttr $attrs seq]
                    set msg [hex2dec [::xmpp::xml::getAttr $attrs msg]]
                    set card [expr {$msg & 0x3f}]
                    lappend flags(mvisible_cards) $seq $card
                    lappend flags(opp_hole_cards) $card
                }
            }

            if {[llength $flags(opp_hole_cards)] != 2} {
                return [list error cancel not-acceptable]
            } else {
                draw_hole_cards $gid
                add_to_log $gid \
                        [::msgcat::mc "Opponent revealed pocket cards: %s" \
                                [join [lmap [namespace current]::num2card \
                                            $flags(opp_hole_cards)] ", "]]
                return [list result {}]
            }
        }
        check {
            add_to_log $gid [::msgcat::mc "Received deck for checking"]

            switch -- $flags(state) {
                check {}
                default {
                    # The deck has come not in time.
                    return [list error cancel not-acceptable]
                }
            }

            set deck {}
            foreach {seq card} $flags(mvisible_cards) {
                lappend deck $card
            }
            foreach xml $xmllist {
                ::xmpp::xml::split $xml tag xmlns attrs cdata subels

                if {[string equal $tag card]} {
                    set seq [::xmpp::xml::getAttr $attrs seq]
                    set dkey [dkey [lindex $flags(keys) [expr {$seq - 1}]]]
                    set msg [decipher $dkey \
                                      [hex2dec [::xmpp::xml::getAttr $attrs \
                                                                     msg]]]
                    lappend deck [expr {$msg & 0x3f}]
                }
                update

                # During update many things may happen
                if {![exists $gid] || $flags(stop)} return
            }

            set sorted [lsort -integer $deck]
            if {[llength $deck] != 52 || [llength $sorted] != 52 || \
                    [lindex $sorted 0] != 0 || [lindex $sorted 51] != 51} {
                add_to_log $gid [::msgcat::mc "The opponent is cheating"]

                return [list error cancel not-acceptable]
            }

            add_to_log $gid \
                [::msgcat::mc "The opponent's deck is checked successfully"]

            set flags(opp_deck_checked) 1

            if {$flags(my_deck_checked)} {
                set_state $gid new
            }

            return [list result {}]
        }
        stop {
            set flags(stop) 1
            disable_controls $gid
            add_to_log $gid [::msgcat::mc "The game is terminated by opponent"]
        }
    }
}

proc poker::draw_deck_and_buttons {gid} {
    variable board_width
    variable board_height
    variable card_width
    variable card_height
    variable line_width
    variable line_pad
    variable line_margin
    variable $gid
    upvar 0 $gid flags

    set x [expr {$board_width - $line_margin - 4*$line_width - $card_width}]
    set x1 [expr {$board_width/2 - $card_width - 3*$line_pad/2 -
                  $line_width - $line_margin}]
    set x2 [expr {$x1 - [image width poker/smallblind] - $line_pad}]
    if {$flags(button)} {
        set y [expr {$board_height - $line_margin - $line_width -
                     $line_pad - $card_height}]
        set y1 [expr {$board_height - $line_margin - $line_width - $line_pad}]
        set a1 se
        set a2 ne
    } else {
        set y [expr {$line_margin + $line_width + $line_pad}]
        set y1 [expr {$line_margin + $line_width + $line_pad}]
        set a1 ne
        set a2 se
    }
    set y2 [expr {$board_height - $y1}]

    #foreach i {1 2 3 4} {
    #    $flags(board) create image $x $y -anchor nw -image poker/back \
    #                                     -tags card
    #    incr x $line_width
    #}

    $flags(board) create image $x2 $y1 -anchor $a1 -image poker/button \
                                       -tags button
    $flags(board) create image $x1 $y1 -anchor $a1 -image poker/smallblind \
                                       -tags chip
    $flags(board) create image $x1 $y2 -anchor $a2 -image poker/bigblind \
                                       -tags chip
}

proc poker::draw_bet {gid my {message ""}} {
    variable board_width
    variable board_height
    variable card_width
    variable card_height
    variable line_width
    variable line_pad
    variable line_margin
    variable $gid
    upvar 0 $gid flags

    if {$my} {
        set tag my_bet
    } else {
        set tag opp_bet
    }

    $flags(board) delete $tag

    if {$message eq ""} return

    set font {Arial 20 bold}
    set x [expr {$board_width/2}]
    set y [expr {$line_margin + $line_width + $line_pad + $card_height/2}]
    if {$my} {
        set y [expr {$board_height - $y}]
    }

    for {set i 0} {$i < 16} {incr i} {
        set x1 [expr {$x + 4*cos(3.141592*$i/8)}]
        set y1 [expr {$y + 4*sin(3.141592*$i/8)}]
        $flags(board) create text $x1 $y1 -text $message -font $font \
                                          -tags [list bet $tag] -fill black
    }
    $flags(board) create text $x $y -text $message -font $font \
                                    -tags [list bet $tag] -fill white
}

proc poker::set_state {gid state} {
    after idle [list [namespace current]::set_state_aux $gid $state]
}

proc poker::set_state_aux {gid state} {
    variable $gid
    upvar 0 $gid flags

    set flags(state) $state
}

proc poker::on_state_change {gid args} {
    variable bytes1
    variable $gid
    upvar 0 $gid flags

    # This proc is called from after command, so checking the game existence
    if {![exists $gid]} return

    #add_to_log $gid [::msgcat::mc "New state %s" $flags(state)]

    switch -- $flags(state) {
        new {
            if {$flags(my_stack) <= 0} {
                add_to_log $gid [::msgcat::mc "You lost all chips"]
                add_to_log $gid [::msgcat::mc "The game is finished"]
                disable_controls $gid
                return
            }
            if {$flags(opp_stack) <= 0} {
                add_to_log $gid [::msgcat::mc "Opponent lost all chips"]
                add_to_log $gid [::msgcat::mc "The game is finished"]
                disable_controls $gid
                return
            }

            $flags(board) delete card||button||chip||hand||bet
            if {$flags(deals) == 0} {
                set flags(button) $flags(deal_first)
            } else {
                set flags(button) [expr {!$flags(button)}]
            }

            draw_deck_and_buttons $gid

            incr flags(deals)
            add_to_log $gid [::msgcat::mc "Starting deal %s" $flags(deals)]
            add_to_log $gid [::msgcat::mc "Your stack is %s" $flags(my_stack)]
            add_to_log $gid \
                    [::msgcat::mc "Opponent's stack is %s" $flags(opp_stack)]
            if {($flags(deals) % $flags(double_blinds)) == 0} {
                set flags(small_blind) [expr {2*$flags(small_blind)}]
                set flags(big_blind) [expr {2*$flags(big_blind)}]
            }
            add_to_log $gid \
                    [::msgcat::mc "Small blind is %s" $flags(small_blind)]
            add_to_log $gid [::msgcat::mc "Big blind is %s" $flags(big_blind)]

            set flags(my_deck_checked) 0
            set flags(opp_deck_checked) 0

            set flags(dealer) \
                [expr {$flags(button) ? [::msgcat::mc "You"] :
                                        [::msgcat::mc "Opponent"]}]
            set flags(bet_or_raise_amount) $flags(big_blind)
            set flags(key) [gen_rnd $bytes1]
            set flags(deck) {}
            set flags(hole_cards) {}
            set flags(opp_hole_cards) {}
            set flags(flop) {}
            set flags(turn) {}
            set flags(river) {}
            # Cards visible by me in form 'seq' 'card'
            set flags(mvisible_cards) {}
            # Cards visible by the opponent (only sequence numbers)
            set flags(ovisible_cards) {}

            set flags(my_all_in) 0
            set flags(opp_all_in) 0
            set flags(showdown) 0

            if {$flags(button)} {
                set my_bet $flags(small_blind)
                set my_bet_name [::msgcat::mc "small blind"]
                set opp_bet $flags(big_blind)
                set opp_bet_name [::msgcat::mc "big blind"]
                set flags(bet) 1
            } else {
                set my_bet $flags(big_blind)
                set my_bet_name [::msgcat::mc "big blind"]
                set opp_bet $flags(small_blind)
                set opp_bet_name [::msgcat::mc "small blind"]
                set flags(bet) 0
            }
            if {$flags(my_stack) <= $my_bet} {
                set flags(my_bet) $flags(my_stack)
                set flags(my_stack) 0
                set flags(my_all_in) 1
                draw_bet $gid 1 [::msgcat::mc "All-In"]
                set flags(bet) 0
                add_to_log $gid \
                      [::msgcat::mc "You have to go all-in (stack equals %s)" \
                                    $flags(my_bet)]
            } else {
                set flags(my_bet) $my_bet
                set flags(my_stack) [expr {$flags(my_stack) - $my_bet}]
                add_to_log $gid \
                        [::msgcat::mc "You bet %s equals to %s" \
                                      $my_bet_name $my_bet]
            }
            if {$flags(opp_stack) <= $opp_bet} {
                set flags(opp_bet) $flags(opp_stack)
                set flags(opp_stack) 0
                set flags(opp_all_in) 1
                draw_bet $gid 0 [::msgcat::mc "All-In"]
                if {!$flags(my_all_in)} {
                    set flags(bet) 1
                }
                add_to_log $gid \
                        [::msgcat::mc "Opponent has to go all-in (stack\
                                      equals %s)" $flags(opp_bet)]
            } else {
                set flags(opp_bet) $opp_bet
                set flags(opp_stack) [expr {$flags(opp_stack) - $opp_bet}]
                add_to_log $gid \
                        [::msgcat::mc "Opponent bets %s equals to %s" \
                                      $opp_bet_name $opp_bet]
            }
            set flags(bets) 0

            if {$flags(button)} {
                add_to_log $gid [::msgcat::mc "Shuffling deck"]
                send_deck $gid
            } else {
                add_to_log $gid [::msgcat::mc "Waiting for shuffled deck"]
            }
        }
        preflop-deal {
            if {$flags(button)} {
                send_hole_cards $gid
            }
        }
        preflop {
            draw_hole_cards $gid
            if {$flags(my_all_in) && ($flags(my_bet) <= $flags(opp_bet))} {
                # Opponent automagically calls

                set flags(showdown) 1
                send_open_cards $gid
            } elseif {$flags(opp_all_in) &&
                                ($flags(opp_bet) <= $flags(my_bet))} {
                # Me automagically call

                set flags(showdown) 1
                send_open_cards $gid
            } else {
                if {$flags(button)} {
                    set flags(bet) 1
                } else {
                    set flags(bet) 0
                }
                set flags(bets) 0
                start_betting $gid
            }
        }
        flop-deal {
            if {$flags(button)} {
                if {$flags(showdown)} {
                    set delay 4000
                } else {
                    set delay 0
                }
                after $delay [namespace code [list send_community_cards \
                                                   $gid {5 6 7}]]
            }

            if {!$flags(showdown)} {
                # Erasing the previous bets
                draw_bet $gid 0
                draw_bet $gid 1
            }
        }
        flop {
            draw_flop $gid
            add_to_log $gid \
                    [::msgcat::mc "Flop is dealt: %s" \
                                  [join [lmap [namespace current]::num2card \
                                              $flags(flop)] ", "]]
            draw_best_hand $gid
            if {$flags(showdown)} {
                set_state $gid turn-deal
            } else {
                if {$flags(button)} {
                    set flags(bet) 0
                } else {
                    set flags(bet) 1
                }
                set flags(bets) 0
                start_betting $gid
            }
        }
        turn-deal {
            if {$flags(button)} {
                if {$flags(showdown)} {
                    set delay 4000
                } else {
                    set delay 0
                }
                after $delay [namespace code [list send_community_cards \
                                                   $gid {8}]]
            }

            if {!$flags(showdown)} {
                # Erasing the previous bets
                draw_bet $gid 0
                draw_bet $gid 1
            }
        }
        turn {
            draw_turn $gid
            add_to_log $gid [::msgcat::mc "Turn is dealt: %s" \
                                [join [lmap [namespace current]::num2card \
                                            $flags(turn)] ", "]]
            draw_best_hand $gid
            if {$flags(showdown)} {
                set_state $gid river-deal
            } else {
                if {$flags(button)} {
                    set flags(bet) 0
                } else {
                    set flags(bet) 1
                }
                set flags(bets) 0
                start_betting $gid
            }
        }
        river-deal {
            if {$flags(button)} {
                if {$flags(showdown)} {
                    set delay 4000
                } else {
                    set delay 0
                }
                after $delay [namespace code [list send_community_cards \
                                                   $gid {9}]]
            }

            if {!$flags(showdown)} {
                # Erasing the previous bets
                draw_bet $gid 0
                draw_bet $gid 1
            }
        }
        river {
            draw_river $gid
            add_to_log $gid [::msgcat::mc "River is dealt: %s" \
                                [join [lmap [namespace current]::num2card \
                                            $flags(river)] ", "]]
            draw_best_hand $gid
            if {$flags(showdown)} {
                set_state $gid finish
            } else {
                if {$flags(button)} {
                    set flags(bet) 0
                } else {
                    set flags(bet) 1
                }
                set flags(bets) 0
                start_betting $gid
            }
        }
        finish {
            disable_controls $gid
            $flags(bbox) itemconfigure 3 -state normal
            if {[llength $flags(opp_hole_cards)] != 2} {
                # Waiting for opponent's cards
                after 1000 [list [namespace current]::on_state_change $gid]
            } else {
                set my_hand [select_best_hand [concat $flags(hole_cards) \
                                                      $flags(flop) \
                                                      $flags(turn) \
                                                      $flags(river)]]
                set opp_hand [select_best_hand [concat $flags(opp_hole_cards) \
                                                       $flags(flop) \
                                                       $flags(turn) \
                                                       $flags(river)]]
                set my_score [score $my_hand]
                set opp_score [score $opp_hand]
                add_to_log $gid \
                        [::msgcat::mc "Your best hand is %s (%s)" \
                                    [join [lmap [namespace current]::num2card \
                                                $my_hand] ", "] \
                                    [score2msg $my_hand]]
                add_to_log $gid \
                        [::msgcat::mc "Opponent's best hand is %s (%s)" \
                                    [join [lmap [namespace current]::num2card \
                                                $opp_hand] ", "] \
                                    [score2msg $opp_hand]]
                if {$my_score > $opp_score} {
                    draw_bet $gid 0 ""
                    draw_bet $gid 1 [::msgcat::mc "Winner"]
                    if {$flags(my_bet) >= $flags(opp_bet)} {
                        add_to_log $gid \
                                [::msgcat::mc "You won pot %s" \
                                    [expr {$flags(my_bet) + $flags(opp_bet)}]]
                        set flags(my_stack) \
                            [expr {$flags(my_stack) + $flags(my_bet) +
                                   $flags(opp_bet)}]
                    } else {
                        add_to_log $gid [::msgcat::mc "You won pot %s" \
                                                [expr {2*$flags(my_bet)}]]
                        add_to_log $gid \
                                [::msgcat::mc "Opponent won side pot %s" \
                                    [expr {$flags(opp_bet) - $flags(my_bet)}]]
                        set flags(my_stack) \
                            [expr {$flags(my_stack) + 2*$flags(my_bet)}]
                        set flags(opp_stack) \
                            [expr {$flags(opp_stack) + $flags(opp_bet) -
                                   $flags(my_bet)}]
                    }
                } elseif {$my_score < $opp_score} {
                    draw_bet $gid 1 ""
                    draw_bet $gid 0 [::msgcat::mc "Winner"]
                    if {$flags(opp_bet) >= $flags(my_bet)} {
                        add_to_log $gid [::msgcat::mc "Opponent won pot %s" \
                                    [expr {$flags(my_bet) + $flags(opp_bet)}]]
                        set flags(opp_stack) \
                            [expr {$flags(opp_stack) + $flags(my_bet) +
                                   $flags(opp_bet)}]
                    } else {
                        add_to_log $gid [::msgcat::mc "Opponent won pot %s" \
                                                [expr {2*$flags(opp_bet)}]]
                        add_to_log $gid [::msgcat::mc "You won side pot %s" \
                                    [expr {$flags(my_bet) - $flags(opp_bet)}]]
                        set flags(opp_stack) \
                            [expr {$flags(opp_stack) + 2*$flags(opp_bet)}]
                        set flags(my_stack) \
                            [expr {$flags(my_stack) + $flags(my_bet) -
                                   $flags(opp_bet)}]
                    }
                } else {
                    draw_bet $gid 0 [::msgcat::mc "Split"]
                    draw_bet $gid 1 [::msgcat::mc "Split"]
                    add_to_log $gid \
                            [::msgcat::mc "You and opponent split pot %s" \
                                    [expr {$flags(my_bet) + $flags(opp_bet)}]]
                    set flags(my_stack) \
                        [expr {$flags(my_stack) + $flags(my_bet)}]
                    set flags(opp_stack) \
                        [expr {$flags(opp_stack) + $flags(opp_bet)}]
                }

                set flags(my_bet) 0
                set flags(opp_bet) 0

                set_state $gid check
            }
        }
        check {
            disable_controls $gid
            $flags(bbox) itemconfigure 3 -state normal
            add_to_log $gid [::msgcat::mc "Checking decks"]
            after 4000 [namespace code [list check_deck $gid]]
        }
    }
}

proc poker::check_deck {gid} {
    variable $gid
    upvar 0 $gid flags

    # This proc is called from after command, so checking the game existence
    if {![exists $gid]} return

    set subels {}
    set seq 1
    foreach card $flags(deck) {
        if {[lsearch -exact $flags(ovisible_cards) $seq] < 0} {
            if {$flags(button)} {
                set dkey [dkey [lindex $flags(keys) [expr {$seq - 1}]]]
                set msg [dec2hex [decipher $dkey $card]]
            } else {
                set msg [dec2hex $card]
            }
            lappend subels [::xmpp::xml::create card \
                                -attrs [list seq $seq \
                                             msg $msg]]
            update

            # During update many things may happen
            if {![exists $gid] || $flags(stop)} return
        }

        incr seq
    }

    add_to_log $gid [::msgcat::mc "Sending unencrypted deck for checking"]

    ::xmpp::sendIQ $flags(xlib) set \
            -query [::xmpp::xml::create check \
                            -xmlns games:cards \
                            -attrs [list type poker:th:1 \
                                         id $flags(id)] \
                            -subelements $subels] \
            -to $flags(opponent) \
            -command [namespace code [list check_deck_result $gid]]

    add_to_log $gid [::msgcat::mc "Waiting for checked deck"]
}

proc poker::check_deck_result {gid status xml} {
    variable $gid
    upvar 0 $gid flags

    if {![string equal $status ok]} {
        # TODO
        add_to_log $gid [::msgcat::mc "Opponent thinks that you cheat"]
        return
    }

    set flags(my_deck_checked) 1

    if {$flags(opp_deck_checked)} {
        set flags(state) new
    }
}

proc poker::gen_rnd {bytes} {
    variable prime1

    # TODO: Support for other MODP groups
    set num 0
    for {set i 0} {$i < $bytes} {incr i 8} {
        set num [expr {$num * (16**8) + int((16**8) * rand())}]
    }
    return [expr {$num % $prime1}]
}

proc poker::dec2hex {num} {
    return [format %llx $num]
}

proc poker::hex2dec {num} {
    return [expr 0x$num]
}

proc poker::shuffle {deck} {
    set deck1 {}
    foreach card $deck {
        lappend deck1 [list $card [expr {rand()}]]
    }
    set deck2 {}
    foreach card [lsort -real -index 1 $deck1] {
        lappend deck2 [lindex $card 0]
    }
    return $deck2
}

proc poker::egcd {a b} {
    set r [expr {$a % $b}]
    if {$r == 0} {
        return {0 1}
    } else {
        lassign [egcd $b $r] x y
        return [list $y [expr {$x - $y * ($a / $b)}]]
    }
}

proc poker::exp {a n p} {
    # a**n (mod p)

    set b 1
    while {$n > 0} {
        if {$n % 2 == 0} {
            set n [expr {$n / 2}]
            set a [expr {($a * $a) % $p}]
        } else {
            incr n -1
            set b [expr {($b * $a) % $p}]
        }
    }
    return $b
}

proc poker::ekey {key} {
    variable prime1
    variable generator1

    exp $generator1 $key $prime1
}

proc poker::encipher {ekey message} {
    variable prime1

    expr {($message * $ekey) % $prime1}
}

proc poker::dkey {key} {
    variable prime1
    variable generator1
    variable generatorm1

    if {![info exists generatorm1]} {
        lassign [egcd $prime1 $generator1] x y
        set generatorm1 [expr {$y % $prime1}]
    }
    exp $generatorm1 $key $prime1
}

proc poker::decipher {dkey message} {
    variable prime1

    expr {($message * $dkey) % $prime1}
}

proc poker::select_best_hand {cards} {
    switch -- [llength $cards] {
        5 {
            return $cards
        }
        6 {
            set score 0
            set hand {}
            for {set i 0} {$i < 6} {incr i} {
                set h [lreplace $cards $i $i]
                set s [score $h]
                if {$s > $score} {
                    set score $s
                    set hand $h
                }
            }
            return $hand
        }
        7 {
            set score 0
            set hand {}
            for {set i 0} {$i < 7} {incr i} {
                for {set j [expr {$i + 1}]} {$j < 7} {incr j} {
                    set h [lreplace [lreplace $cards $j $j] $i $i]
                    set s [score $h]
                    if {$s > $score} {
                        set score $s
                        set hand $h
                    }
                }
            }
            return $hand
        }
        default {
            return -code error
        }
    }
}

proc poker::score2msg {hand} {
    set score [score $hand]

    if {$score >= 9*16**7} {
        return [::msgcat::mc "Royal flush"]
    }
    if {$score >= 8*16**7} {
        return [::msgcat::mc "Straight flush"]
    }
    if {$score >= 7*16**7} {
        return [::msgcat::mc "Four of a kind"]
    }
    if {$score >= 6*16**7} {
        return [::msgcat::mc "Full house"]
    }
    if {$score >= 5*16**7} {
        return [::msgcat::mc "Flush"]
    }
    if {$score >= 4*16**7} {
        return [::msgcat::mc "Straight"]
    }
    if {$score >= 3*16**7} {
        return [::msgcat::mc "Three of a kind"]
    }
    if {$score >= 2*16**7} {
        return [::msgcat::mc "Two pairs"]
    }
    if {$score >= 1*16**7} {
        return [::msgcat::mc "Pair"]
    }
    if {$score >= 14*16**4} {
        return [::msgcat::mc "Ace"]
    }
    if {$score >= 13*16**4} {
        return [::msgcat::mc "King"]
    }
    if {$score >= 12*16**4} {
        return [::msgcat::mc "Queen"]
    }
    if {$score >= 11*16**4} {
        return [::msgcat::mc "Jack"]
    }
    if {$score >= 10*16**4} {
        return [::msgcat::mc "Ten"]
    }
    if {$score >= 9*16**4} {
        return [::msgcat::mc "Nine"]
    }
    if {$score >= 8*16**4} {
        return [::msgcat::mc "Eight"]
    }
    if {$score >= 7*16**4} {
        return [::msgcat::mc "Seven"]
    }
    # Couldn't reach here
    return ""
}

proc poker::score {hand} {
    # hand is a list of numbers 0 <= num < 52
    set pips {}
    set suits {}
    foreach num $hand {
        lappend pips [expr {$num / 4 + 2}]
        lappend suits [expr {$num % 4}]
    }

    set pips [lsort -integer $pips]
    lassign $pips c0 c1 c2 c3 c4

    set straight \
        [expr {($c0==$c1-1 && $c1==$c2-1 && $c2==$c3-1 && $c3==$c4-1) ||
               ($c4==14 && $c0==2 && $c1==3 && $c2==4 && $c3==5)}]

    # score could be 0xeeeed max (4 Aces and King)
    set score [expr {(((($c4*16) + $c3)*16 + $c2)*16 + $c1)*16 + $c0}]
    if {$straight && $c4==14 && $c3==5} {
        set score [expr {(((($c3*16) + $c2)*16 + $c1)*16 + $c0)*16 + $c4}]
    }

    lassign [lsort $suits] s0 s1 s2 s3 s4
    set flush [expr {$s0 eq $s4}]

    if {$straight == 1 && $flush && $c0 == 10} {
        # Royal flush
        return [expr {9*16**7}]
    }
    if {$straight == 1 && $flush} {
        # Straight flush
        return [expr {8*16**7 + $score}]
    }
    if {$c0 == $c3 || $c1 == $c4} {
        # Four of a kind
        return [expr {7*16**7 + $c3*16**6 + $score}]
    }
    if {$c0 == $c1 && $c2 == $c4} {
        # Full house
        return [expr {6*16**7 + $c4*16**6 + $score}]
    }
    if {$c0 == $c2 && $c3 == $c4} {
        # Full house
        return [expr {6*16**7 + $c2*16**6 + $score}]
    }
    if {$flush} {
        # Flush
        return [expr {5*16**7 + $score}]
    }
    if {$straight} {
        # Straight
        return [expr {4*16**7 + $score}]
    }
    if {$c0 == $c2 || $c1 == $c3 || $c2 == $c4} {
        # Three of a kind
        return [expr {3*16**7 + $c2*16**6 + $score}]
    }
    if {$c0 == $c1 && $c2 == $c3} {
        # Two pairs
        return [expr {2*16**7 + $c3*16**6 + $c1*16**5 + $score}]
    }
    if {$c0 == $c1 && $c3 == $c4} {
        # Two pairs
        return [expr {2*16**7 + $c4*16**6 + $c1*16**5 + $score}]
    }
    if {$c1 == $c2 && $c3 == $c4} {
        # Two pairs
        return [expr {2*16**7 + $c4*16**6 + $c1*16**5 + $score}]
    }
    if {$c0 == $c1} {
        # Pair
        return [expr {1*16**7 + $c1*16**6 + $score}]
    }
    if {$c1 == $c2} {
        # Pair
        return [expr {1*16**7 + $c2*16**6 + $score}]
    }
    if {$c2 == $c3} {
        # Pair
        return [expr {1*16**7 + $c3*16**6 + $score}]
    }
    if {$c3 == $c4} {
        # Pair
        return [expr {1*16**7 + $c4*16**6 + $score}]
    }
    return $score
}

proc poker::num2card {num} {
    # 0 <= num < 52

    set pip [string map {10 T 11 J 12 Q 13 K 14 A} [expr {$num / 4 + 2}]]
    set suit [string map {0 C 1 D 2 H 3 S} [expr {$num % 4}]]
    return $pip$suit
}

proc poker::card2num {card} {
    lassign [split $card ""] pip suit
    set pip [string map {T 10 J 11 Q 12 K 13 A 14} $pip]
    set suit [string map {C 0 D 1 H 2 S 3} $suit]
    return [expr {($pip - 2) * 4 + $suit}]
}

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

proc poker::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] eq "poker:th:1"} {
        set modps {}
        foreach subel $subels {
            ::xmpp::xml::split $subel stag sxmlns sattrs scdata ssubels

            if {$sxmlns eq "http://jabber.org/protocol/feature-neg"} {
                lassign [::xmpp::data::findForm $ssubels] type form
                set fields [::xmpp::data::parseForm $form]

                foreach {tag field} $fields {
                    switch -- $tag {
                        field {
                            lassign $field var type label desc required \
                                           options values media
                            if {[string equal $var modp]} {
                                foreach {olabel ovalue} $options {
                                    lappend modps $ovalue
                                }
                            }
                        }
                    }
                }
            }
        }

        # TODO: Support of other MODP groups
        if {[lsearch -exact $modps 1] < 0} {
            set var [list error cancel not-acceptable]
            return
        }

        if {[::xmpp::xml::isAttr $attrs deal]} {
            set deal [::xmpp::xml::getAttr $attrs deal]
            switch -- $deal {
                true -
                false { }
                1 {
                    set deal true
                }
                0 {
                    set deal false
                }
                default {
                    set var [list error modify bad-request]
                }
            }
        } else {
            set deal true
        }
        # TODO: Support of other MODP groups
        set var [invited_dialog $xlib $from $iqid \
                                [::xmpp::xml::getAttr $attrs id] \
                                $deal 1]
    }
    return
}

proc poker::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] == "poker:th:1"} {
        set gid [make_gid $from [::xmpp::xml::getAttr $attrs id]]
        if {[exists $gid]} {
            set var [turn_recv $gid $tag $subels]
        } else {
            set var [list error cancel item-not-found]
        }
    }
    return
}


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

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

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