##+##########################################################################
 #
 # Chinese Checkers
 # by Keith Vetter, September 6, 2006
 #
 package require Tk
 
 image create photo ::img::b(1) -data {
    R0lGODlhJwAnALMAANnZ2QeEBxeMFy+XL0ekR1msWWm0aXm8eYnFiZjMmKnTqbjcuMfjx9fr1+j0
    6Pr7+iH5BAEAAAAALAAAAAAnACcAAAT/EMhJaQghCAGDlBDISaulIQghxIBjQCFlCAECOWmtIQgB
    h5xUChFCgEBOWmUQYwxI5KRjjCFECBDISWkQYgxCCCxyFkIIGWMMIWCAQE4qgxCDkFKgkVOWUggh
    YwwBRQgQyDmDGIOQYuCRcxpTCiFkjAGFCBDIOYUYpBRzEIIoJYTQOceYUggkYwwhAgRygiAGKeYc
    lGBSSqmUEDrHmAILIWMMEQIEUgYxCCkHJaXgklKplNA5xhQCCRlDiBAAACAMOEgxJym1GGNswaVU
    SugcYwohA44hQgAABDFIMfAgpRhrrTXGloIqIXSMKYWQMQQUIQAQxCDloKTgYs451xpb/0upBBE6
    xhRCxhgiBAiAGISYg9JizcH3nGuMraUSQgcaUwghYwgRQBBwkGIOUos1956DrjW2lkoInWMKLISM
    MUQIQQxSoDlJLdacc641BtlaKiV0jimFEDikCCGIQYo5ScHFWnOutcbYWgqmhM4xphAyxhAwyDFI
    MQeptRhsUjK21lIJoXOgMYWQMYYIQYwBSTEHJbUYY40xyNhaSiWEzjGlQELGGEIEMQYpBh6UlFqL
    McbWWlCplBA6xpRCyIBjCBGCGKSYgxBMSsEl51JKJYTQMQaWQsgYQ4QQxCCQFHNQSkrBJaVSKiWE
    zjEGFkLIGEOEEMQgkBRzDkoJKjlVSv8JoXOMKbAQQsYYIoQgxoCkFHMOQjDJKRFC5xxjSoGEjDGE
    CCGIMSQsxpyDEEIpQSTlOceYUgghA44hRAggiDEIKdCYcw5EcqJzzjGmFEIgGWMMEQIAQYwBCSnF
    GAOPnNQYU0ohhAw4hhAhABCCGINAUooxxsAjJTRSllIIIWOMIWCQAIAgxhiEkAILNHLSUgohhIwx
    4BAiBAAACEGMAQchBBYpjZmTEELGGHAIEUKAQMogxBgDEilhkbNAIucYYwghQoBAThCEGGMMSOSk
    FA4phRAhQCDnDELAISUkclI45BRChACBnDQEIQQcctI6hRAhBAjkpDIEIQQcclIqhAg2IUAgJ60h
    BCEEHHJOIYQIIQQI5KRVhhACFHJSCYOUEMhJa4VBziAEpRDISaulMMhJAwRyUhoBADs=}
 set S(sz) [image width ::img::b(1)]
 
 array set S {title "Chinese Checkers" pad 10 padx 2}
 array set G {turn 1 okay 0 ended 0 n,players 6 players {1 2 3 4 5 6}}
 array set COLORS {bg \#006600 ctrl,bg black ctrl,fg white oval gray50 txt deepskyblue}
 array set C {1 green 2 yellow 3 blue 4 purple 5 red 6 cyan}
 
 proc DoDisplay {} {
    global S COLORS P
 
    wm title . $S(title)
 
    GetCorners
    set w [expr {40 + 2*[lindex $P(2) 0]}]      ;# Size based off of board/piece
    set h [expr {40 + 2*[lindex $P(6) 1]}]
 
    frame .ctrl -bd 0 -padx 5 -pady 5 -bg $COLORS(ctrl,bg)
    pack .ctrl -side right -fill both -ipady 5
    MakeCtrlArea
    DoMenus
 
    canvas .c -width $w -height $h -bd 0 -highlightthickness 0 -bg $COLORS(bg)
    bind .c <Configure> {ReCenter %W %h %w}
    pack .c -side top -fill both -expand 1
 
    bind all <Alt-F4> exit
    bind all <F4> [list console show]
 }
 proc DoMenus {} {
    option add *Menu.tearOff 0
    menu .menu
    . config -menu .menu
 
    menu .menu.game
    .menu      add cascade -label "Game" -menu .menu.game -underline 0
    .menu.game add command -label "New Game" -command NewGame
 
    set m .menu.game.players
    menu $m
    .menu.game add cascade -label "Players" -menu $m -underline 0
    foreach n {2 3 4 6} {
        $m add radio -label "$n Players" \
            -variable G(n,players) \
            -value $n \
            -underline 0 \
            -command NewGame
    }
    .menu.game add separator
    .menu.game add command -label "Exit" -command exit
 
    menu .menu.help
    .menu add cascade -label "Help" -menu .menu.help -underline 0
    .menu.help add command -label "Help" -command Help -state disabled
    .menu.help add command -label "About" -command About
 }
 proc MakeCtrlArea {} {
    global S G C COLORS
 
    eval destroy [winfo child .ctrl]
 
    label .ctrl.title -text Turn -font {Times 42 bold underline} \
        -bg $COLORS(ctrl,bg) -fg $COLORS(ctrl,fg)
    canvas .ctrl.c -bg black -bd 0 -highlightthickness 0 -width 180
    grid .ctrl.title -sticky ew -row 1 -pady {0 10}
    grid .ctrl.c -sticky news -row 2
    grid rowconfigure .ctrl 2 -weight 1
 
    .ctrl.c delete all
    set y [expr {20 + $::S(sz)/2}]
    foreach who $G(players) {
        .ctrl.c create image 130 $y -image ::img::b($who) -anchor c
        .ctrl.c create line 20 $y 100 $y -width 10 -tag [list arrow arrow$who] \
            -fill $COLORS(ctrl,bg) -arrow last -arrowshape {16 24 11} \
            -capstyle round
        incr y [expr {20 + $::S(sz)}]
    }
 }
 proc GetCorners {} {
    global P
    set P(outer) {}
    foreach {who cells} {
        0 {-9 -1 -9 1}
        1 {-5 3 -4 6}
        2 {-5 13 -4 14}
        3 {-1 9 1 9}
        4 {4 14 5 13}
        5 {4 6 5 3}
        6 {9 1 9 -1}
        7 {5 -3 4 -6}
        8 {4 -14 5 -13}
        9 {1 -9 -1 -9}
        10 {-5 -13 -4 -14}
        11 {-4 -6 -5 -3}
    } {
        lassign [eval Midpoint $cells] x y
        set x1 [expr {$x * 1.02}]               ;# Looks better a bit bigger
        set y1 [expr {$y * 1.02}]
 
        set P($who) [list $x $y]
        lappend P(outer) $x1 $y1
    }
    set P(-1) $P(11)
 }
 proc ShadedText {w xy fg bg args} {
    lassign $xy x y
    set cbg [ $w cget -bg ]
    eval [list $w create text $x $y -fill $bg] $args
    eval [list $w create text [expr {$x-2}] [expr {$y-2}] -fill $cbg] $args
    eval [list $w create text [expr {$x-3}] [expr {$y-3}] -fill  $fg] $args
 }
 proc About {} {
    set msg "$::S(title)\n\nby Keith Vetter\nSeptember 2006\n"
    tk_messageBox -title "About $::S(title)" -message $msg
 }
 proc NewGame {} {
    global G
 
    if {$G(n,players) == 2} {set a {{1 4} {2 5} {6 3}}}
    if {$G(n,players) == 3} {set a { {1 3 5} {2 4 6} }}
    if {$G(n,players) == 4} {set a { {1 2 4 5} {2 3 5 6} {3 4 6 1} }}
    if {$G(n,players) == 6} {set a {{1 2 3 4 5 6}}}
    set G(players) [lindex $a [expr {int(rand()*[llength $a])}]]
 
    InitBoard $G(players)
    Redraw
 
    set G(turn) 0
    set G(ended) 0
    MakeCtrlArea
    NextTurn
 }
 proc NextTurn {} {
    global G
 
    if {[Victory]} {
        set G(ended) 1
        return
    }
    set n [lsearch $G(players) $G(turn)]
    if {[incr n] >= [llength $G(players)]} {set n 0}
    set G(turn) [lindex $G(players) $n]
 
    .ctrl.c itemconfig arrow         -fill $::COLORS(ctrl,bg)
    .ctrl.c itemconfig arrow$G(turn) -fill $::COLORS(ctrl,fg)
 }
 proc Victory {} {
    global B V G S
 
    if {$G(turn) == 0} {return 0}
    foreach cell $V($G(turn)) {
        lassign $cell row col
        set team [lindex $B($row,$col) 0]
        if {$team != $G(turn)} { return 0 }
    }
 
    .c create text 0 -40 -anchor s -text " Wins! " -font {Times 42 bold} \
        -tag victory -fill red
    lassign [.c bbox victory] x0 y0 x1 y1
    .c create image 0 $y0 -tag victory -image ::img::b($G(turn)) -anchor s
    .c create rect $x0 [expr {$y0 - $S(sz) - 2*$S(pad)}] $x1 $y1 \
        -fill black -outline red -width 5
    .c raise victory
    return 1
 }
 ##+##########################################################################
 #
 # Recenter -- keeps 0,0 at the center of the canvas during resizing
 #
 proc ReCenter {W h w} {                   ;# Called by configure event
    set h2 [expr {$h / 2}]
    set w2 [expr {$w / 2}]
    $W config -scrollregion [list -$w2 -$h2 $w2 $h2]
 }
 proc InitBoard {whom} {
    global B V
 
    unset -nocomplain B
    unset -nocomplain V
 
    array set cnts {0 -1 1 -1 2 -1 3 -1 4 -1 5 -1 6 -1}
    array set opposites {0 0  1 4  2 5  3 6  4 1  5 2  6 3}
 
    for {set row -8} {$row < 5} {incr row} {    ;# Up triangle
        set width [expr {(8 + $row)}]
        for {set col [expr {-$width}]} {$col <= $width} {incr col 2} {
            set who 0
            if {$row <= -5} {set who 1}
            if {$row > 0 && $row + $col >= 10} { set who 3}
            if {$row > 0 && $row - $col >= 10} { set who 5}
            lappend V($opposites($who)) [list $row $col]
            if {[lsearch $whom $who] == -1} { set who 0}
            set B($row,$col) [list $who [incr cnts($who)]]
        }
    }
    for {set row 8} {$row > -5} {incr row -1} { ;# Down triangle
        set width [expr {(8 - $row)}]
        for {set col [expr {-$width}]} {$col <= $width} {incr col 2} {
            set who 0
            if {$row >= 5} {set who 4}
            if {$row < 0 && -$row + $col >= 10} { set who 2}
            if {$row < 0 && -$row - $col >= 10} { set who 6}
            lappend V($opposites($who)) [list $row $col]
            if {[lsearch $whom $who] == -1} { set who 0}
            set B($row,$col) [list $who [incr cnts($who)]]
        }
    }
 }
 proc Redraw {} {
    global S B P COLORS
    .c delete all
    .c create poly $P(outer) -fill white -outline black -width 9
    ShadedText .c [Cell2XY -9.25 -2.5] $COLORS(txt) black -text "Chinese" \
        -font {Times 42 bold} -anchor ne
    ShadedText .c [Cell2XY -9.25 2] $COLORS(txt) black -text "Checkers" \
        -font {Times 42 bold} -anchor nw
    AllHomes
 
    foreach arr [lsort -dictionary [array names B]] {
        lassign [split $arr ","] row col
        Redraw1 $row $col
    }
    .c raise c
    .c raise txt
 }
 proc Redraw1 {row col} {
    global C B S COLORS
 
    set xy [Cell2XY $row $col]
    set xy2 [eval MakeBox $xy [expr {$S(sz)+2}]]
    .c create oval $xy2 -tag [list o o$row,$col] -fill {} -outline $COLORS(oval) -width 2
 
    lassign $B($row,$col) team id
    if {$team > 0} {
        .c create image $xy -image ::img::b($team) -tag [list c c$team,$id]
        .c bind c$team,$id <Button-1>        [list BDown $team $id %x %y]
        .c bind c$team,$id <B1-Motion>       [list BMove $team $id %x %y]
        .c bind c$team,$id <ButtonRelease-1> [list BUp   $team $id %x %y]
    }
    #.c create text $xy -text "$row,$col" -tag txt
 }
 proc Cell2XY {row col} {
    global S
    set x [expr {($S(pad) + $S(sz)) * $col/2}]
    set y [expr {($S(padx) + $S(sz)) * $row}]
    return [list $x $y]
 }
 proc XY2Cell {x y} {
    global S
    set sign [expr {$x < 0 ? -1 : 1}]
 
    set row [expr {round($y / double($S(padx) + $S(sz)))}]
    set col [expr {($x / ($S(pad) + $S(sz)))}]
    if {$row & 1} {                             ;# Odd row
        set col [expr {int($col)*2 + $sign}]
    } else {                                    ;# Even row
        set col [expr {2*int((2*$col+$sign)/2)}]
    }
    return [list $row $col]
 }
 proc Midpoint {r1 c1 r2 c2} {
    lassign [Cell2XY $r1 $c1] x1 y1
    lassign [Cell2XY $r2 $c2] x2 y2
    return [list [expr {($x1+$x2)/2}] [expr {($y1+$y2)/2}]]
 }
 proc MakeBox {x y diam} {
    set r [expr {$diam/2}]
    return [list [expr {$x-$r}] [expr {$y-$r}] [expr {$x+$r}] [expr {$y+$r}]]
 }
 proc AllHomes {} {
    for {set who 1} {$who <= 6} {incr who} {
        set n [expr {($who-1)*2 - 1}]           ;# Starting corner
        set xy [concat $::P($n) $::P([incr n]) $::P([incr n])]
        .c create poly $xy -tag home -fill $::C($who)
    }
 }
 proc BDown {team id x y} {                      ;# Button down
    global S G B
 
    set G(okay) 0                               ;# Assume bad
    if {$G(ended)} return
    if {$team != $G(turn)} return
    set G(okay) 1
    set xx [.c canvasx $x]
    set yy [.c canvasy $y]
    lassign [XY2Cell $xx $yy] row col
    set G(from) "$row,$col"
    set G(moves) [LegalMoves $row $col]
    HighlightMany $G(moves) - -
    .c raise c$team,$id
 }
 proc BMove {team id x y} {
    if {! $::G(okay)} return
    set xx [.c canvasx $x]
    set yy [.c canvasy $y]
    .c coords c$team,$id $xx $yy
 
    lassign [XY2Cell $xx $yy] row col
    HighlightMany $::G(moves) $row $col
 }
 proc BUp {team id x y} {
    global G B
 
    if {! $G(okay)} return
 
    Unhighlight
    lassign [XY2Cell [.c canvasx $x] [.c canvasy $y]] row col
 
    if {[lsearch $G(moves) [list $row $col]] != -1} { ;# Legal move
        set done 1
        set B($row,$col) $B($G(from))           ;# Move into new spot
        set B($G(from)) [list 0 x]              ;# Mark old spot empty
        .c coords c$team,$id [Cell2XY $row $col]
        NextTurn
    } else {
        lassign [split $G(from) ","] row col
        .c coords c$team,$id [Cell2XY $row $col]
    }
 }
 ##+##########################################################################
 #
 # LegalMoves -- returns a list of all positions piece can move to.
 # recursive calling to handle multiple jumps
 #
 proc LegalMoves {row col {onlyJumps 0} {moves {}}} {
    foreach dir {0 1 2 3 4 5} {
        lassign [DoMove $row $col $dir 1] r c
        set team [GetTeam $r $c]
        if {$team == 0} {                       ;# Immediate neighbor empty
            if {! $onlyJumps} {
                lappend moves [list $r $c]
            }
        } elseif {$team != -1} {                ;# See if we can jump neighbor
            lassign [DoMove $row $col $dir 2] r c
            if {[lsearch $moves [list $r $c]] != -1} continue ;# Already visited
            if {[GetTeam $r $c] == 0} {         ;# Yes, we can jump
                lappend moves [list $r $c]
                set moves [LegalMoves $r $c 1 $moves] ;# See about more jumps
            }
        }
    }
 
    return $moves
 }
 ##+##########################################################################
 #
 # DoMove -- return position moved FAR places in direction DIR
 #
 proc DoMove {row col dir far} {
    array set DIRS {0 {0 2} 1 {1 1} 2 {1 -1} 3 {0 -2} 4 {-1 -1} 5 {-1 1}}
    lassign $DIRS($dir) dr dc
    set row [expr {$row + $far * $dr}]
    set col [expr {$col + $far * $dc}]
    return [list $row $col]
 }
 ##+##########################################################################
 #
 # GetCell -- returns who's in a given cell, handling off board positions
 #
 proc GetCell {row col} {
    if {! [info exists ::B($row,$col)]} { return -1}
    return $::B($row,$col)
 }
 proc GetTeam {row col} {
    return [lindex [GetCell $row $col] 0]
 }
 proc HighlightMany {who row col} {
    Unhighlight
    foreach item $who {
        lassign $item r c
        Highlight $r $c [expr {($r == $row && $c == $col) ? 2 : 1}]
    }
 }
 proc Highlight {row col how} {
    .c itemconfig o$row,$col -width [expr {$how == 1 ? 3 : 6}] -outline red
 }
 proc Unhighlight {} {
    .c itemconfig o -width 2 -outline $::COLORS(oval)
 }
 
 image create photo ::img::b(2) -data {
    R0lGODlhJwAnALMAANnZ2YSEB4yMF5iXL6SkR6ysWbS0aby8ecTFiczMmNPTqdzcuOTjx+zr1/T0
    6Pz7+iH5BAEAAAAALAAAAAAnACcAAAT/EMhJaQghCAGDlBDISaulIQghxIBjQCFlCAECOWmtIQgB
    h5xUChFCgEBOWmUQYwxI5KRjjCFECBDISWkQYgxCCCxyFkIIGWMMIWCAQE4qgxCDkFKgkVOWUggh
    YwwBRQgQyDmDGIOQYuCRcxpTCiFkjAGFCBDIOYUYpBRzEIIoJYTQOceYUggkYwwhAgRygiAGKeYc
    lGBSSqmUEDrHmAILIWMMEQIEUgYxCCkHJaXgklKplNA5xhQCCRlDiBAAACAMOEgxJym1GGNswaVU
    SugcYwohA44hQgAABDFIMfAgpRhrrTXGloIqIXSMKYWQMQQUIQAQxCDloKTgYs451xpb/0upBBE6
    xhRCxhgiBAiAGISYg9JizcH3nGuMraUSQgcaUwghYwgRQBBwkGIOUos1956DrjW2lkoInWMKLISM
    MUQIQQxSoDlJLdacc641BtlaKiV0jimFEDikCCGIQYo5ScHFWnOutcbYWgqmhM4xphAyxhAwyDFI
    MQeptRhsUjK21lIJoXOgMYWQMYYIQYwBSTEHJbUYY40xyNhaSiWEzjGlQELGGEIEMQYpBh6UlFqL
    McbWWlCplBA6xpRCyIBjCBGCGKSYgxBMSsEl51JKJYTQMQaWQsgYQ4QQxCCQFHNQSkrBJaVSKiWE
    zjEGFkLIGEOEEMQgkBRzDkoJKjlVSv8JoXOMKbAQQsYYIoQgxoCkFHMOQjDJKRFC5xxjSoGEjDGE
    CCGIMSQsxpyDEEIpQSTlOceYUgghA44hRAggiDEIKdCYcw5EcqJzzjGmFEIgGWMMEQIAQYwBCSnF
    GAOPnNQYU0ohhAw4hhAhABCCGINAUooxxsAjJTRSllIIIWOMIWCQAIAgxhiEkAILNHLSUgohhIwx
    4BAiBAAACEGMAQchBBYpjZmTEELGGHAIEUKAQMogxBgDEilhkbNAIucYYwghQoBAThCEGGMMSOSk
    FA4phRAhQCDnDELAISUkclI45BRChACBnDQEIQQcctI6hRAhBAjkpDIEIQQcclIqhAg2IUAgJ60h
    BCEEHHJOIYQIIQQI5KRVhhACFHJSCYOUEMhJa4VBziAEpRDISaulMMhJAwRyUhoBADs=}
 image create photo ::img::b(3) -data {
    R0lGODlhJwAnALMAANnZ2QcHhBcXjCcnlDc3nEdIpFlZrGlotHl5vImJxJiYzKam0re22s7O5+jo
    9Pr6/CH5BAEAAAAALAAAAAAnACcAAAT/EMhJaQghCAGDlBDISaulIQghxIBjQCFlCAECOWmtIQgx
    BiRykjGGECEECOSkVQYxBiEEFjkJIWQMIUKAQE5KgxCDkFKgkdOUUgghYwgBAwRyUhmEGKQYA4+c
    0hhTCiFjCChCgEDOGcQgpJgDkZzzHGNKIWQMKESAQM4pBCnGHJQSTEqllBBC5xhTICFjCBEgkBME
    MYg5CCUF1VprKZUSQucYaAohY4gQIJAyiEGKQUmtBZmUaymVEDrHFFgIGUKEAAAAYUBSzEFqLdZa
    awyytZRKCJ1jSiFwDBECACCIQcyBKK3VWnOttcYWXColdI4xhZAhoAgBgCBIMSipBVlz/8651hpj
    aymYEjrHlELGECFAAMQg5aCkWGsOvudca42xpVJC8BxTCiFDiACCgIOYg9Jizbn3HHStNcaWSgmh
    Y6AphIwhQgiCFAMPUou1Bp2UrTXGllIJIXiMKYWMIUIIgsBiDlKLtdaccw221hhbSiWEzjGwFDKG
    CCEMUsyBKC3GYJNTMsaWSgmhA48phYwhQhCDFGgOSmox2OSUjK2lUkLoQGNKIWMIEcQgBZqDklqL
    sdZaY5CxtZRKCZ1jTIGFjCFECIIUcxBMSa0FmZxsraVSSugcaEwpZAwRQhCEwGIOSkqtBZmUay2l
    UkLoHGhKIWQMEUIQg8BiDkJJKbjkXP9KqZQQOsdAUwohY4gQghgEFmMOQilBJadMKSGEzjEGlkLG
    ECKEIAYhsJhzEEopJaVgkhIhdI4xpRACxxAiBBDEIKUYeA5CCCY5E0IInWNMKbAQMoYIAYAgBoGk
    GHPOgUhOes4xxpRCCBxDiBAACEEMQmAx5pxzIJISHimNMaUQMsYQMEgAQBBjEFKKgQYeOakxppRC
    CBlwCBECAACEIMaAhJQCjZTnzFlKIYQMOIQIIUAgZRBiDEJKKQUaOQ0sUhJCxhBChACBnCAIMQYh
    BBY5qSSEjDGEEDAECOScQYgxBiGEwCInJFKOMYQQIUAgJw1BCDHGgEROCoeUQogQAgRBclIZghAC
    DjkpFUKEECCQk9YQghACDjmnEEKEEAIEctIqQwgBCjmphEFKCOSktcIgZxCCUgjkpNVSGOSkAQI5
    KY0AOw==}
 image create photo ::img::b(4) -data {
    R0lGODlhJwAnALMAANnZ2YQHhIwXjJQnlJw3nKRIpKxZrLRotLx5vMSJxMyYzNKm0tq22ufO5/To
    9Pz6/CH5BAEAAAAALAAAAAAnACcAAAT/EMhJaQghCAGDlBDISaulIQghxIBjQCFlCAECOWmtIQgx
    BiRykjGGECEECOSkVQYxBiEEFjkJIWQMIUKAQE5KgxCDkFKgkdOUUgghYwgBAwRyUhmEGKQYA4+c
    0hhTCiFjCChCgEDOGcQgpJgDkZzzHGNKIWQMKESAQM4pBCnGHJQSTEqllBBC5xhTICFjCBEgkBME
    MYg5CCUF1VprKZUSQucYaAohY4gQIJAyiEGKQUmtBZmUaymVEDrHFFgIGUKEAAAAYUBSzEFqLdZa
    awyytZRKCJ1jSiFwDBECACCIQcyBKK3VWnOttcYWXColdI4xhZAhoAgBgCBIMSipBVlz/8651hpj
    aymYEjrHlELGECFAAMQg5aCkWGsOvudca42xpVJC8BxTCiFDiACCgIOYg9Jizbn3HHStNcaWSgmh
    Y6AphIwhQgiCFAMPUou1Bp2UrTXGllIJIXiMKYWMIUIIgsBiDlKLtdaccw221hhbSiWEzjGwFDKG
    CCEMUsyBKC3GYJNTMsaWSgmhA48phYwhQhCDFGgOSmox2OSUjK2lUkLoQGNKIWMIEcQgBZqDklqL
    sdZaY5CxtZRKCZ1jTIGFjCFECIIUcxBMSa0FmZxsraVSSugcaEwpZAwRQhCEwGIOSkqtBZmUay2l
    UkLoHGhKIWQMEUIQg8BiDkJJKbjkXP9KqZQQOsdAUwohY4gQghgEFmMOQilBJadMKSGEzjEGlkLG
    ECKEIAYhsJhzEEopJaVgkhIhdI4xpRACxxAiBBDEIKUYeA5CCCY5E0IInWNMKbAQMoYIAYAgBoGk
    GHPOgUhOes4xxpRCCBxDiBAACEEMQmAx5pxzIJISHimNMaUQMsYQMEgAQBBjEFKKgQYeOakxppRC
    CBlwCBECAACEIMaAhJQCjZTnzFlKIYQMOIQIIUAgZRBiDEJKKQUaOQ0sUhJCxhBChACBnCAIMQYh
    BBY5qSSEjDGEEDAECOScQYgxBiGEwCInJFKOMYQQIUAgJw1BCDHGgEROCoeUQogQAgRBclIZghAC
    DjkpFUKEECCQk9YQghACDjmnEEKEEAIEctIqQwgBCjmphEFKCOSktcIgZxCCUgjkpNVSGOSkAQI5
    KY0AOw==}
 image create photo ::img::b(5) -data {
    R0lGODlhJwAnALMAANnZ2YQHB4wXF5QnJ5w3N6RIR6xZWbRoabx5ecSJicyYmNKmptq2t+TIx/To
    6Pz6+iH5BAEAAAAALAAAAAAnACcAAAT/EMhJaQghCAGDlBDISaulIQghxIBjQCFlCAECOWmtIQgx
    BiRykjGGECEECOSkVQYxBiEEFjkJIWQMIUKAQE5KgxCDkFKgkdOUUgghYwgBAwRyUhmEGKQYA4+c
    0hhTCiFjCChCgEDOGcQgpJgDkZzzHGNKIWQMKESAQM4pBCnGHJQSTEqllBBC5xhTICFjCBEgkBME
    MYg5CCUF1VprKZUSQucYaAohY4gQIJAyiEGKQUmtBZmUaymVEDrHFFgIGUKEAAAAYUBSzEFqLdZa
    awyytZRKCJ1jSiFwDBECACCIQcyBKK3VWnOttcYWXColdI4xhZAhoAgBgCBIMSipBVmD/07K1hhb
    S6WEDjymFDKGCAEAMSApByXFWnPvOQebZGyplNA5phRIyBAigCAGMQfBtFhz7j3nXGsMsqVSQugY
    UwgZcIgQgiDFHKQWg61BJ2VrjbGlVEIIHmNKIWOIEIIgsJiD1GKtQSdla42xpVRCCJ5jSiFjiBDC
    ILCYg9JirLXmWoOtMcaWSgmhcwwshYwhQhCDFHMgSmox2OSUjK2lUkLoQGNKIWMIEcQgBZqDklqL
    sdZaY5CxtZRKCZ1jTIGFjCFECIIUcxBMSa0FmZxsraVSSugcaEwpZAwRQhCEwGIOSkqtBZmUay2l
    UkLoHGhKIWQMEUIQg8BiDkJJKbjkXP9KqZQQOsdAUwohY4gQghgEFmMOQilBJadMKSGEzjEGlkLG
    ECKEIAYhsJhzEEopJaVgkhIhdI4xpRACxxAiBBDEIKUYeA5CCCY5E0IInWNMKbAQMoYIAYAgBoGk
    GHPOgUhOes4xxpRCCBxDiBAACEEMQmAx5pxzIJISHimNMaUQMsYQMEgAQBBjEFKKgQYeOakxppRC
    CBlwCBECAACEIMaAhJQCjZTnzFlKIYQMOIQIIUAgZRBiDEJKKQUaOQ0sUhJCxhBChACBnCAIMQYh
    BBY5qSSEjDGEEDAECOScQYgxBiGEwCInJFKOMYQQIUAgJw1BCDHGgEROCoeUQogQAgRBclIZghAC
    DjkpFUKEECCQk9YQghACDjmnEEKEEAIEctIqQwgBCjmphEFKCOSktcIgZxCCUgjkpNVSGOSkAQI5
    KY0AOw==}
 image create photo ::img::b(6) -data {
    R0lGODlhJwAnALMAANnZ2QeEhBeMjC+XmEekpFmsrGm0tHm8vInFxJrMzKrU1Ljc3Mfj5Nfr7Oj0
    9Pr7/CH5BAEAAAAALAAAAAAnACcAAAT/EMhJaQghCAGDlBDISaulIQghxIBjQCFlCAECOWmtIQgB
    h5xUChFCgEBOWmUQcEgJiZxwyClECBDISWkQYoxBCCxyFkIIHFIKESCQk8ogxBikFGjklKUUQsYY
    Q0ARAgRyziDGGKQYeOScxpRCyBhjQCECBHJOIQYpxRyEIEoJIXTOMaYUAoccQgQI5ARBjFHMOSjB
    pJRKKSF0jjEFFjLGGCIECKQMYgxSDkpJwSWXUikldI4xBRIyxhAiBAAACHAMUsxJSi3GGINrKZUS
    OseYQggcUoQAAAhCFnMgSoqx1lpjbCkFE0LHmFLIGEMIGAIAQQxSDkpqQeacc62xtVRK/wiiY0wh
    ZIwhQgAQiDGIOSgt1tyDz7nG2FIqIXQMNIWQMYYQAQQx4CjmILVYc+85B1tjS6mE0DmmFEjGGEOE
    EMQgxcCT1GLNOedaYwwupVJC55hSCBlwDBFCEIMUc5KCi7XmXGuNsaUUTAmdY0whZIwhYJBjkGIO
    Smox2KRkbC2lEkLnQGMKIWMMEYIYA5JiDkpqMcYaY5CxpZRKCJ1jSoGEjDGECGIMUgw8KCW1FmOM
    rbWgUikhdIwphZABxxAiBDFIMQchmJSCS06lVEoIoWMMLIWQMYYIIYgxICnmoJSgknOmlBA6x5gC
    CRljDBFCEGMQWMw5KKUElZwpJYTOMf+mFEjIGGOIEIIYg8BSzDkIwSSnRAidc4wpBRIyxhAihCDG
    GJAUY85BCKGUIJLynGNMKYSMAccQIgQQxBiEFGjMOQciOdE55xhTCiGQjDGGCAGAIMaAg5RijIFH
    TmqMKaUQMgYcQ4gQAAhBjDEgKcUYY+CREhopSymEwCGlCCEAAIKYAxJSCjRy0lIKIQQOKYUIAQAA
    QhBwyEEILFIaMychBA4phQghQCBlEGKMMQghBBY5CyRSwiGlECIECOQEQQg4pIRETirhkFMIEQIE
    cs4gBBxyDkjkhENOKYQIAQI5aQhCCDjkpHUKIUIIEMhJZQhCCDjkpFQIEUKAQE5aQwgvQgg45JxC
    CBFCCBDISasMIQQo5KQSBikhkJPWCoOcQQhKIZCTVkthkJMGCOSkNAIAOw==}
 
 ################################################################
 
 InitBoard $G(players)
 DoDisplay
 NewGame
 return