[Keith Vetter] 2003-06-04 : here's an addictive little puzzle 
game copied from an applet at [http://javaboutique.internet.com/GemGame/]. 

The object of the game is to swap neighboring gems to create 
rows or columns of three or more similar gems. When you do
so, those gems explode and all the gems above slide down and
new gems fill in the top. The more gems you explode in a turn
the more points you get.

----
[TV] Looks nice, when does the game end ?
[KPV] When you can't move anymore. It may take a while--my
max score is around 9000.

----
[MC] Added [catch] around ''snd_ok'' and ''snd_bad''.  (I have [Snack] installed but don't have permissions to write to /dev/dsp & /dev/mixer.)

----
 ##+##########################################################################
 #
 # GemGame -- based on a game by Derek Ramey
 # by Keith Vetter -- May 2003
 #
 # see http://javaboutique.internet.com/GemGame/
 # 
 
 package require Tk
 
 array set S {title "Gem Game" cols 10 rows 10 cell 30}
 set S(w) [expr {$S(cell) * $S(cols) + 10}]
 set S(h) [expr {$S(cell) * $S(rows) + 10}]
 
 proc DoDisplay {} {
    wm title . $::S(title)
    CompressImages
    frame .ctrl -relief ridge -bd 2 -padx 5 -pady 5 -bg black
    canvas .c -relief ridge -bg black -height $::S(h) -width $::S(w) \
        -highlightthickness 0 -bd 2 -relief raised 
    label .score -text Score: -bg black -fg white
    .score configure  -font "[font actual [.score cget -font]] -weight bold"
    option add *font [.score cget -font]
 
    label .vscore -textvariable S(score) -bg black -fg yellow
    label .vscore2 -textvariable S(score2) -bg black -fg yellow
    button .new -text "New Game" -command NewGame
    button .hint -text "Hint" -command Hint
    button .about -text About -command About
 
    pack .ctrl -side left -fill y -ipady 5
    pack .c -side top -fill both -expand 1
    grid .score -in .ctrl -sticky ew -row 1
    grid .vscore -in .ctrl -sticky ew
    grid .vscore2 -in .ctrl -sticky ew
    grid rowconfigure .ctrl 10 -minsize 50
    grid .new -in .ctrl -sticky ew -row 11 
    grid .hint -in .ctrl -sticky ew -pady 10
    grid rowconfigure .ctrl 50 -weight 1
    grid .about   -in .ctrl -row 100 -sticky ew
    
    bind all <Alt-c> {console show}
 }
 proc CompressImages {} {
    image create photo ::img::img(0)            ;# Blank image
    foreach id {1 2 3 4 5 6 7} {
        foreach a {2 3 4} {                     ;# We need narrower images
            image create photo ::img::img($id,$a)
            if {$a == 4} continue
            ::img::img($id,$a) copy ::img::img($id) -subsample $a $a
        }
    }
 }
 proc NewGame {} {
    array set ::S {score 0 score2 "" busy 0 click {}}
    
    .hint config -state normal
    .c delete all
    for {set row -2} {$row < $::S(rows)+2} {incr row} { ;# Initialize the board
        for {set col -2} {$col < $::S(cols)+2} {incr col} {
            set ::B($row,$col) -1
            if {$row < 0 || $row >= $::S(rows)} continue
            if {$col < 0 || $col >= $::S(cols)} continue
            set ::B($row,$col) [expr {1 + int(rand() * 7)}]
            .c create image [GetXY $row $col] -tag "c$row,$col"
            .c bind "c$row,$col" <Button-1> [list DoClick $row $col]
        }
    }
    # Change all cells on initial board that would explode
    while {1} {
        set cells [FindExploders]
        if {$cells == {}} break
        foreach cell $cells {
            set ::B($cell) [expr {1 + int(rand() * 7)}]
        }
    }
    DrawBoard
 }
 proc DrawBoard {} {
    for {set row 0} {$row < $::S(rows)} {incr row} {
        for {set col 0} {$col < $::S(cols)} {incr col} {
            .c itemconfig "c$row,$col" -image ::img::img($::B($row,$col))
        }
    }
 }
 proc GetXY {r c} {
    global S
    set x [expr {5 + $c * $S(cell) + $S(cell)/2}]
    set y [expr {5 + $r * $S(cell) + $S(cell)/2}]
    return [list $x $y]
 }
 proc DoClick {row col} {                        ;# Handles mouse clicks
    global S
 
    if {$S(busy)} return
    set S(busy) 1
    .c delete box
    
    if {$S(click) == {}} {                      ;# 1st click, draw the box
        set xy [.c bbox "c$row,$col"]
        .c create rect $xy -tag box -outline white -width 2
        set S(click) [list $row $col]
        set S(busy) 0
        return
    }
 
    foreach {row1 col1} $S(click) break         ;# 2nd click, swap and explode
    set S(click) {}
 
    set dx [expr {abs($col - $col1)}]
    set dy [expr {abs($row - $row1)}]
    if {$dx <= 1 && $dy <= 1 && $dx != $dy} {   ;# Valid neighbors
        SwapCells $row $col $row1 $col1
        set n [Explode]
        if {! $n} {                             ;# Did something explode???
            catch { snd_bad play }              ;# Nope, undo the move
            SwapCells $row1 $col1 $row $col
        }
        if {! [Hint 1]} {                       ;# Is the game over???
            GameOver
        }
    }
    set S(busy) 0
    
 }
 proc SlideCells {cells} {                       ;# Slides some cells down
    foreach {r c} $cells {
        .c itemconfig c$r,$c -image {}
        if {[info exists ::B($r,$c)] && $::B($r,$c) != -1} {
            set M($r,$c) $::B($r,$c)
        } else {
            set M($r,$c) [expr {1 + int(rand() * 7)}]
        }
        .c create image [GetXY $r $c] -image ::img::img($M($r,$c)) -tag slider
    }
    set numSteps 8
    set dy [expr {double($::S(cell)) / $numSteps}]
    for {set step 0} {$step < $numSteps} {incr step} {
        .c move slider 0 $dy
        update
        after 10
    }
    foreach {r c} $cells {                      ;# Update board data 
        set ::B([expr {$r+1}],$c) $M($r,$c)
    }
    DrawBoard
    .c delete slider
 }
 proc SwapCells {r1 c1 r2 c2} {
    global B
    
    .c itemconfig c$r1,$c1 -image {}
    .c itemconfig c$r2,$c2 -image {}
    foreach {x1 y1} [GetXY $r1 $c1] break
    foreach {x2 y2} [GetXY $r2 $c2] break
    .c create image $x1 $y1 -image ::img::img($B($r1,$c1)) -tag {slide1 slide}
    .c create image $x2 $y2 -image ::img::img($B($r2,$c2)) -tag {slide2 slide}
 
    set numSteps 8
    set dx [expr {$x2 - $x1}]
    set dy [expr {$y2 - $y1}]
    set dx1 [expr {double($dx) / $numSteps}]
    set dy1 [expr {double($dy) / $numSteps}]
    set dx2 [expr {-1 * $dx1}]
    set dy2 [expr {-1 * $dy1}]
    for {set step 0} {$step < $numSteps} {incr step} {
        .c move slide1 $dx1 $dy1
        .c move slide2 $dx2 $dy2
        update
        after 10
    }
    .c delete slide
    foreach [list B($r1,$c1) B($r2,$c2)] [list $B($r2,$c2) $B($r1,$c1)] break
    DrawBoard
 }
 proc Explode {} {
    set cnt 0
    while {1} {
        set cells [FindExploders]               ;# Find who should explode
        if {$cells == {}} break                 ;# Nobody, we're done
        incr cnt [llength $cells]
        catch { snd_ok play }
        ExplodeCells $cells                     ;# Do the explosion affect
        CollapseCells                           ;# Move cells down
    }
    incr ::S(score) [expr {$cnt*$cnt}]
    set ::S(score2) ""                          ;# Show special scores
    if {$cnt > 3} {set ::S(score2) "([expr {$cnt*$cnt}])"}
    return [expr {$cnt > 0 ? 1 : 0}]
 }
 proc CollapseCells {} {
    while {1} {                                 ;# Stop nothing slides down
        set sliders {}
        for {set col 0} {$col < $::S(cols)} {incr col} {
            set collapse 0
            for {set row [expr {$::S(rows)-1}]} {$row >= 0} {incr row -1} {
                if {$collapse || $::B($row,$col) == 0} {
                    lappend sliders [expr {$row-1}] $col
                    set collapse 1
                }
            }
        }
        if {$sliders == {}} break
        SlideCells $sliders
    }
 }
 proc ExplodeCells {cells} {
    foreach stage {2 3 4} {
        foreach who $cells {
            .c itemconfig c$who -image ::img::img($::B($who),$stage)
            if {$stage == 4} {set ::B($who) 0}
        }
        update
        after 100
    }
 }
 proc FindExploders {} {                         ;# Find all triplets and up
    global S B
 
    array set explode {}
    for {set row 0} {$row < $S(rows)} {incr row} {
        for {set col 0} {$col < $S(cols)} {incr col} {
            set me $B($row,$col)
            if {$me == 0} continue
            foreach {dr dc} {-1 0 1 0 0 -1 0 1} {
                set who [list $row $col]
                for {set len 1} {1} {incr len} {
                    set r [expr {$row + $len * $dr}]
                    set c [expr {$col + $len * $dc}]
                    if {$B($r,$c) != $me} break
                    lappend who $r $c
                }
                if {$len < 3} continue
                foreach {r c} $who {
                    set explode($r,$c) [list $r $c]
                }
            }
        }
    }
    return [array names explode]
 }
 
 proc Hint {{how 0}} {
    global S B
 
    if {$how == 0} {
        incr S(score) -50
        set S(score2) (-50)
    }
    set h { 0 1 -1 2  0 2       0 1  1  2  0  2       0 2 -1  1 0  1
            0 2  1 1  0 1       0 1 -1 -1  0 -1       0 1  1 -1 0 -1
            1 0  2 1  2 0       1 0  2 -1  2  0       2 0  1 -1  1 0
            2 0  1 1  1 0       1 0 -1 -1 -1  0       1 0 -1  1 -1 0
            0 1  0 3  0 2       0 1  0 -2  0 -1       1 0  3 0   2 0  
            1 0 -2 0 -1 0
    }
 
    .c delete box
    set S(click) {}
    set hints {}
    for {set row 0} {$row < $::S(rows)} {incr row} { ;# Test each cell
        for {set col 0} {$col < $::S(cols)} {incr col} {
            set me $B($row,$col)
            foreach {dr1 dc1 dr2 dc2 dr3 dc3} $h { ;# Check certain neighbors
                set r [expr {$row+$dr1}]; set c [expr {$col+$dc1}]
                if {$B($r,$c) != $me} continue
                set r [expr {$row+$dr2}]; set c [expr {$col+$dc2}]
                if {$B($r,$c) != $me} continue
                if {$how == 1} {return 1}
                lappend hints [list $r $c [expr {$row+$dr3}] [expr {$col+$dc3}]]
            }
        }
    }
    if {$how == 2} {return $hints}
    if {$hints == {}} {return 0}
    set n [expr {int(rand() * [llength $hints])}]
    set hint [lindex $hints $n]
 
    .c dtag hint
    foreach {r c} $hint { .c addtag hint withtag c$r,$c }
    .c create rect [.c bbox hint] -tag box -outline white -width 3
    .c dtag hint
 }
 proc About {} {
    set msg "$::S(title)\nby Keith Vetter, June 2003\n"
    append msg "Based on a program by Derek Ramey\n\n"
    append msg "Click on adjacent gems to swap them. If you get three or\n"
    append msg "more gems in a row or column, they will explode and those\n"
    append msg "above will drop down and new gems will fill in the top."
    tk_messageBox -message $msg
 }
 proc GameOver {} {
    .c create rect 0 0 [winfo width .c] [winfo height .c] \
        -fill white -stipple gray25
    .c create text [GetXY 4 5] -text "Game Over" -font {Helvetica 28 bold} \
        -fill white -tag over
    .hint config -state disabled
 }
 proc DoSounds {} {
    proc snd_ok {play} {}                       ;# Stub
    proc snd_bad {play} {}                      ;# Stub
    if {[catch {package require base64}]} return
    if {[catch {package require snack}]} return
    
    set s(ok) {UklGRkACAABXQVZFZm10IBAAAAABAAEAESsAABErAAABAAgAZGF0YRwCAACAgId0Z
        HZbU5aMj7/MsIZ6UX6nWIiITWiIRUGUlZesvrGCiKiKTl96Fit3YF5emrGHqcqhlJuAdWxgW
        01EbWSHubW1uJ2MkqGPYFVSamtvgHmEh5ybraWLkHp5Xm5oWGRvb3WSlYqMi4+JhY6Ac25xd
        Xp5jYR/hoODdIN8e356goCHgoqGgIV/g35/d3N2eHZ6gIOIgouHioaNioGAfHpycHp2dH2Hi
        ouNiYiKhIF9enZzd3l+dX2BgYKIjoaJhIJ/fX6AfHl8fICAgICEgISFhYF/gH+AfIJ/gH6Af
        X6AfICAfYB+gn2DfoGAgIOAgYB8e3x9gIKChYCDgIN/g32Afn+BgIF+gH+BgIOAgX2CfYGAg
        IB/gH9/fIB/gICBgH+Df4KAgIB9gHuBfYKAgoCAhICDgIN+gH+Af4CAgIGAg4CFgIOAgICAg
        H9/f32AfoF/gn+BgICAf4B/gICAgICAgIKAgYCAgH+AfYB8f4CAgoGBgIKBgHt0cnqEi4yIh
        oKHioOBeoF+gHRvbW10eYSHhoyMmI+PhIF5dm9tbW92fICJjpKRkY6JhHx5b2xlbnWAhYeOj
        pSQkIiAe3R1cnNzdnx/gomLj4yJhICAfHp3d3d6fYKDhoKGgIeAhX1/eXt9foCAg4GCg4CDf
        YF6gHmAfYCBgIR/h4CEf4B9fn98gHuEfYV/g4CAgn6Fe4R6gn1/gHuDe4V+g4CAgn8=}
    set s(bad) {UklGRrEHAABXQVZFZm10IBAAAAABAAEAESsAABErAAABAAgAZGF0YY0HAAB/f39/
        gICAgICAgICAf39/fn9/f4CAgICAf3+AgICBgYGBf359fX5/gIGChISEgX14dXZ6f4OFiIuM
        iYB2bm52foSHio+Sk4x+bWBXY3mHjY2NlZqSg3NtcXp6eHd5goqLiY6Nf2tqeIKLnLGrhmJC
        OWF8h4+xvJJ3WTJTeX6Eja+/mH1qUE5lfoKIlsK6h3tbL2l/go28xIR9Qz15gIq9w31+Qjp2
        f4a0y4yBbkM9b3mDls6zgnY3Q3d5goWSp8yxjoF4VRlVc3iHvdGGhVYlWnt6o9irf4NAKmh2
        fpnYuYOLRytleX2w2KKGg0cpYnZ9sdaiiXc7Qmx0jsbAknUvT32Dw7uhhXo+NGF1g7LPpoqE
        Wj9GYXV+jK3gq4+FVihab3uJv9OWjXdEMmJxjqGsr4xqXm96iH1zflphcoqyv4xvaVNpiZSA
        f4qCgIiloJh+TFRja259nbiphnxnbGJfdpKXmaKPbl1fX26JnKOYe3BiaXqMinyHgn18fYeA
        e29xiot2fYiIi4h7dn+Fl6eMamNmcYGFg5Gbjn56cHVzdYWXnpB+bmhgdIibqqWHbFpUYnGH
        m6igjXlrX1hohJWkjnd2e397en1/b2NufYKSoqqUe2hbVVtte5KjpKKhgmFaZ3B3f5GclYp/
        gnxyamdwgIyapaGOgXFdaHeBhYN9h5eMjImBfm1pfIJ/g46WiXx1cm92gYeKkZeNf3h7fGhb
        aHmAkamqnIt1X09Vb3+PoqSQhXFcYXGAhI+moYp2alZRbIKLm62tmHtkTk9hc4KVpKmehHBl
        Xmh4hI6TlpOMdmpnaHOBi5OUjoRwcG5tfIWLj5GPgXl8fXyChICDeWptd3qCiYyLjI2BfYJ9
        d3d3fIB/h4h+enh+g4OHhoKAeXV5gIOCgoOAfHd7gYeNj4+LgXNsam12foOMjYqLhoB+eXqD
        hYeMhHVtam55h4yNjYd/fH18fH6AgYGCgoWJhnxxbnR8g4uQjIN7eXt5e36AgYGEh4N8eXp+
        goSEg358e3l7gIGEh4WDgHl3eHqAhYeIhoJ7dnV3fYKEhoWDgHt8gYSGhX95dXV3fYSJiYWD
        fXl6e31+gYSEg4SCfXp4d3Z5gYmNjIh+c3F0e4OHiYuKhX56eHh5fYGDg4F/fn1/hYaDgX16
        eHl9gIOFh4mGgHx6d3Z6gYaJiIWCfXl4eXyBhIOBfn+Cg4SFg396dHJ0eoOLjouFgH57e36A
        gH58enp7fYCFioiFgX17ent9fH+Cg4F/fn+Af3+AgYODg4OBfnt4d3l8foGFiYmGg4F/e3h2
        d3uAhIaHhYJ+e3t+gIGChIOAfXp5eXt+gIOFhoOCg4F+fX19fXx8fX6AgYKDgX9/goOCgH58
        e3l5fICDhYaFg4B9fn9+fXx8fH6AgoSFhYKAfnp6e35/gYKDgoB/f3+AgIGCgICAgIGBfnp4
        eHyAhouNi4V8c29xeYGIjY2Gfnh1eHyBg4ODg4F+fX5+fXt7fYCEiImGgXx2dHd9g4eIh4WB
        fXp5e36ChoaDf3p4eXx+gYWGhYKAfXp7fH6Ag4SDf318fH1+gYSEgoB9fH1/goODgYB9e3t8
        gISIiIaAenZ2eX2Ch4qIhYB6d3h6foGFh4aDgH17ent9f4GCg4OCgX9+fX19fXx9gIKEhYSB
        fnt6enx/g4SDgYB/fn59fX1+gIGBgoOCf3x7fH1/gYODgH9/f39/gYGAf318e31/goOEhIJ/
        fHp6fYCDhYWDf3x6e32Ag4WFhIF+fHt8fX+AgYOEhIF/fHp6fYGEhYWDf3t6e32Ag4aGg397
        enp7foCCg4OCgH9+fn5+f4CBgYGAf359fX5+foGDhIWFgn57eHh6foKFhoSAfHp6fICEh4eD
        fnp4eHt/goSFhIF+fHx9gIKDgoF/fXx8fn+BgoKCgYCAf359foCAgYB/fn9/f4CBgYB+fn+A
        gYKCgX99fX1+gIGCgoGAfn18fX5/gYOEg4F+fHt7fX+Cg4OCgH58fHx+gIOEhIOBfnx7e31/
        gYOEhIKAfXx8fn+AgYGAf35+f3+BgoKBgH99fX5/gIGBgYB/fn1+f4GDg4OAfnx8fH6AgoOD
        gX59fX5/gYGBgIB/f3+AgYGBgH9+fn5/f4CAgICAgH9+fX5+gIGCgoF/fn19fX+AgoKCgYB/
        fn19foCBgoKAf359fn5/gIGBgIB/f39+fn5+f4CBgoKBgH9+fX1+gIGBgYGAgH9/fn9/f39/
        f3+AgICAgICAgIB/f39/f4CAgICAgICAgYCAf35+f39/gIGAgH9+fn5/gIGCgoB/fn1+fn+A
        gYGAf39/f3+AgICAgIB/f39/f3+AgICAgICAgH9/fn5/f4CAgIB/f39/gICAgIB/f35+fn9/
        gIGBgIB/f39/f39/f39/f39/f4CBgYGBgH9+fX1+gIGCgoGAfn5+fn+AgYGAf35+fn5/gIGB
        gYB/f35+f3+AgICAf39/f3+AgICAgH9/f39/gICAf39/f3+AgICAgICAf39/f3+AgICAgICA
        f39/f39/gICAgIB/f4CAgH9/f39/f3+AgICAgICAf39/f4CAgICA}
    foreach snd {ok bad} {
        regsub -all {\s} $s($snd) {} sdata            ;# Bug in base64 package
        sound snd_$snd
        snd_$snd data [::base64::decode $sdata]
    }
 }
 image create photo ::img::img(1) -data {
    R0lGODdhHgAeALMAAAAAAAAAyAAAKAAA6EhI2FBQ/xAQSBgQSDAw////////////////////////
    /////ywAAAAAHgAeAAAE/xDISau9OOvN+4RBhBDCCCEIQggshRAiAgRyyhCCCWGMEWAQhJRSCBEh
    BAjkBMLAI+cxUkAjpxBCQCBnCOHAImchIEAkpxSEQCBlGOHAIqc0EMk5DSEQSBlGOAQWOYuBSM5p
    SIFAyjDCgUXOQg5Eck5TCgRShhEOLHIWciCScxpSIJAyjHBgkVMeiOSchhQIpAwjHFjklAYiOach
    BAIpwwgHFjkLORDJOQ0hEEgZQjiwyEkIgEhOGQQhEEhpjDnHnHOMgUIaKaUUEMhJCDEBIjmDgEHO
    KSQEUpJCDERyShHgkHMEEQIEUpJCDERyShHgkHMEEwIEUpJCBERyShHgkIJzBBECBFKSQgxEckoR
    4JBzBBECBFKSQgxEckoT4JBzBBECBFKSQgxEckoR4JBzBBMCBFISQkSASM4gYJBzCgmBnMYIIYwR
    xggohDFCGCOEEBDICUIIYowxQoBBEEJKIUSMQSCQE5wAQhhjhAADKISUQgg55EAgpzwQyEmrvTjr
    zW8EADs=}
 image create photo ::img::img(2) -data {
    R0lGODdhHgAeAJEAAAAAABDgAGj/WP///ywAAAAAHgAeAAACzISPqcvtDyMi8YHkA8Un+EjxgeQD
    xSf4R/EDSD5Q/CD4QPEDSL4BxQ+CT/EDSL4BxQ+Cj6nLQPGB5BtQ/CD4QPGB5BtQ/CD4RvGB5APF
    D4J/FB9IPlD8IPhIsYHkA8Un+GgREQTKB4pN8PEoNpBsoNgEHzEigiCJAMUm+JgQEQRJBCKCQviY
    FhEESQQigkL4mBcRBEkgIgg+JkYEQRKICIKPmRFAMiIIPqZCAEmIIPiYahEEIYLgY+oFkBCCj6kq
    u7sAEeFj6nL7wxhJAQA7}
 image create photo ::img::img(3) -data {
    R0lGODdhHgAeAJEAAAAAAP//QOjwAODgACwAAAAAHgAeAAACxISPqctLgQg+pmYEQSL4mHoRFEiE
    4GMqRFACERGCj5kUG0g2wcc8ig8kn+BjAsUPIPlC8BEpvgHJN4KPRvEPSP4RfKT4CCQfCb5RfAwg
    +SgEn+KjAclHAwCg+HhA8vEIPqZuknw8oPl4AAAkHw1oPhrBJ/koQPNxCL6RfASajwQfSf4BzT+C
    j0byDWi+EXxEki9A84fgYwLJB5pP8DGPZAPNJviYKSIkbGYIPqaCCAmbIfiYeiKEjeBjagrQCB9T
    l9ufkQIAOw==}
 image create photo ::img::img(4) -data {
    R0lGODdhHgAeAJEAAAAAANAAAP8AAP84OCwAAAAAHgAeAAAC/4SPqcvtD0h8zAAh+CgCFB8TRAi+
    iQhQfEQQEYIPJBsoPh6ICInwSTZQfDQg2QQ7TESEwPgYICIEyCwijCRQfAQRAJIBABQbQODuCKZs
    AACKHwQfjeQLAADFN6D5BiTfAAAovgHNNyD5BgBA8Q1ovgHJNwAAim9A8w1IvgEAUHwDmm9A8g0A
    gOIb0HwDkm8AABTfgOYbkHwDAKD4BjTfgOQbAADFD4KPRvIFAIBiAwiQfAMBQCEYEWEiBMpHmAEg
    SAAAAQRJBEg+As0m+ECy4e4OaD7BJtlwdwc0n2CLiADJR4SZoRE+iAiQfESYGYJ/AiQfU2CG4J8A
    yccUGIKPqQK7BQA7}
 image create photo ::img::img(5) -data {
    R0lGODlhHgAeALMAAAAAAFyI/5zO/xtX/3qn/zx1/16T/zF5/2+V/wAwzT9w/6b5/wAduAA75SBg
    /424/yH5BAEAAAAALAAAAAAeAB4AAwT/EMhJq704601ZcyBYOAzDWYNYHGx7NKfUDEqxujjJJU5d
    BECD0HAgtkwZnmIJDAwJUILwiGHQFIFfAGFAEB4PgeAhZTkwg6sW4SWIF/CFoPyyfJbYLfsriMfn
    RkgTDXhMbF5vfnAPgR2FQAh6YYpxZEaOhVh7bn2UgAdnEwyPkGxglHCfB5h4pV5hnX+MRAWsTKVQ
    sLJQl6KZeYe5YmJgUrS2t3qvX8zGZhVXpMptUVwGAXUUhL+uwdZABwWCEqPcwIfo4AMX5ZkBCpGQ
    W00jVdGPeU1ANgowGff4gGCp0Y8DwF94HCSIkQBhIQcDxnHwALBHA38xKpTYWCKjx48gAytEAAA7}
 image create photo ::img::img(6) -data {
    R0lGODdhHgAeAJEAAAAAAIDw/xjo/1jo/ywAAAAAHgAeAAACv4SPqcvtD6OcjMTHI/iYIEDxMWAI
    PqKIAMU/mBmCj0ayCf7RbIKPJBto/gEOwTeSDTQfB5Lgk2yg+XiQAARQNtB8TEgAAiQCNB/T4IAA
    BAjQfEyEARoAEUDzMRUMCEgAzcdUMCAgIEDzMRECaACAiADNxzSIoAAAJBtoPiZQbAAAkg00Hw8o
    NsEn2UDzcYBiE3wj2UDzDyg2wUeSTfCPYhN8NBEBkn8QEQQfUYDko0AQfEwg+XgEH1OX2x9GORsp
    ADs=}
 image create photo ::img::img(7) -data {
    R0lGODlhHgAeALMAAAAAANtNyeId0/8A/wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAACH5BAAAAAAALAAAAAAeAB4AAwSWEMhJq703AMG7/8KGAUG5gegZWmWroty7Tm0tf/dc72Me
    SzvTYEgs5iYhXnFJlJEkMRdzOlCRNFYNlSpyvQDb7dX0DXNtZTNzjPWA1Us2tPOGN9FuuxFP19+9
    eX5VfDGCg4B9gnJZdXBdZFFCjnSQbFpmTliWklwpQEFkGDA6QZs2njQ2oDw4LCarpXQYGrCgIj24
    uQARADs=}
 
 DoDisplay
 DoSounds
 NewGame

----
[Category Games] | [Tcl/Tk Games] | [Category Application]