[Keith Vetter] 2003-10-31 : here's an addictive little arcade
type game similar to [Gem Game] (in fact I reused most of
its code) based on a applet at [http://www.gamehouse.com/affiliates/template.jsp?AID=1406].

The object of the games is to collapse the rising blocks to
get as many points as possible. You click on a colored block
and if it has three or more neighbors of the same color, they
explode and the blocks above collapse down. But as your exploding
blocks, new lines of blocks are being added. 

I'm not quite done with the code, a few final touches are needed
and perhaps people here might have some suggestions. Two things
in particular come to mind: 1) a better visual indicator of how
much time before a new row appears, and 2) some sort of end
of level bonus probably based either on height or number of 
blocks, along with some cute visual display.

It's a fun little game, enjoy.

----
[KPV] 2003-11-04 : puts some finishing touches on this game: end
of round bonuses, new levels, and better visual for the new line.
----

[male] 2003-11-21:

First, when the game is over, and I want to restart, to start a new game, then the "game over" in the screen won't disappear and every click inside the screen won't cause collapse/slide actions.

Second, toggling the pause button won't everytime cause a pause.

The First problem is change inside the source.
----
[HJG] when pause is activated during LevelOverAnimation, it gets reset when the next level starts
----
The "pocket edition" is at [Collapse (iPaq)] :-)
----
 ##+###############################################################
 #
 # Collapse
 # http://www.gamehouse.com/affiliates/template.jsp?AID=1406
 # by Keith Vetter -- October 2003
 #
 # KPV  Oct 30, 2003 - Initial revision starting with gemgame code
 # KPV  Nov 04, 2003 - EOR bonus, new row count down display, new levels
 # male Nov 21, 2003 - Game Over canvas items with tags, delete
 #                     in NewGame
 #
 # TODO:
 #   bombs
 
 package require Tk 8.4
 
 array set S {title "Collapse" version 1.0 cols 12 rows 15 cell 27
    delay 10 mute 0 numSteps 4 level 1 ticks 13}
 set S(rowsX) [expr {$S(rows) - 1}]
 
 array set LEVEL {
    1 {srows  4 tiles 3 newRow 5000 lines 25}
    2 {srows  5 tiles 3 newRow 4000 lines 30}
    3 {srows  7 tiles 3 newRow 2000 lines 30}
    4 {srows  7 tiles 3 newRow 1000 lines 30}
    5 {srows  8 tiles 3 newRow 1000 lines 35}
    6 {srows  9 tiles 3 newRow 1000 lines 40}
    7 {srows 10 tiles 3 newRow 1000 lines 45}
    8 {srows  3 tiles 3 newRow  700 lines 20}
    9 {srows  4 tiles 3 newRow  700 lines 25}
   10 {srows  5 tiles 3 newRow  700 lines 25}
   11 {srows  4 tiles 4 newRow 4000 lines 25}
 }
 
 proc DoDisplay {} {
    global S
    wm title . $S(title)
    set w [expr {$S(cell) * $S(cols) + 5}]
    set h [expr {$S(cell) * $S(rows) + 5}]
 
    CompressImages
 
    option add *Label.background black
    frame .ctrl -relief ridge -bd 2 -bg black
    canvas .c -relief ridge -bg black -height $h -width $w \
        -highlightthickness 0 -bd 2 -relief raised
    canvas .cc -relief ridge -bg black -height [expr {5 + $S(cell)}] -width $w \
        -highlightthickness 0 -bd 2 -relief raised
 
    label .score -text Score: -fg white
    .score configure  -font "[font actual [.score cget -font]] -weight bold"
    option add *font [.score cget -font]
 
    label  .vscore  -textvariable S(score) -fg yellow
    label  .vscore2 -textvariable S(score2) -fg yellow
    label  .level   -text Level: -fg white
    label  .vlevel  -textvariable S(level) -fg yellow
    label  .lines   -text "Lines Left:" -fg white
    label  .vlines  -textvariable S(lines) -fg yellow
    button .new     -text "New Game" -command NewGame
 
    set levels {}
    foreach a [lsort -integer [array names ::LEVEL]] {
        lappend levels "Level $a"
    }
    eval tk_optionMenu .optlvl S(strlvl) $levels
    .optlvl config -highlightthickness 0
    trace variable ::S(strlvl) w Tracer
 
    checkbutton .mute  -text Mute -variable S(mute) -relief raised -anchor w
    checkbutton .pause -text Pause -variable S(pause) \
        -command {Pause 0} -relief raised -anchor w
    button .about -text About -command About
 
    pack .ctrl -side left -fill y -ipady 5 -ipadx 5
    pack .c -side top -fill both -expand 1
    pack .cc -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 .level -in .ctrl -sticky ew
    grid .vlevel -in .ctrl -sticky ew
    grid .lines -in .ctrl -sticky ew
    grid .vlines -in .ctrl -sticky ew
    grid rowconfigure .ctrl 20 -minsize 10
    grid .new -in .ctrl -sticky ew -row 25 -pady 1
    grid .optlvl -in .ctrl -sticky ew -pady 1
    grid .mute -in .ctrl -sticky ew -pady 1
    grid .pause -in .ctrl -sticky ew -pady 1
    grid rowconfigure .ctrl 50 -weight 1
    grid .about -in .ctrl -row 100 -sticky ew -pady 5
 
    bind all <F2> {console show}
    bind .c <p> {Pause 1}
    bind .c <P> {Pause 1}
    bind .c <s> [list StartStop 0]
    bind .c <Button-3> {set S(tcnt) 0}
 
    focus .c
 
    for {set row 0} {$row < $S(rows)} {incr row} {
        for {set col 0} {$col < $S(cols)} {incr col} {
            .c create image [GetXY $row $col] -tag [list c$row,$col cell]
            .c bind "c$row,$col" <Button-1> [list DoClick $row $col]
        }
    }
    for {set col 0} {$col < $S(cols)} {incr col} {
        .cc create image [GetXY 0 $col] -tag [list c$col cell]
    }
 }
 proc CompressImages {} {
    image create photo ::img::img(0)            ;# Blank image
    foreach id {1 2 3 4} {                      ;# Each image we have
        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 Tracer {var1 var2 op} {                    ;# Handles level optionMenu
    if {$var2 == "strlvl"} {
        scan $::S(strlvl) "Level %d" level
        if {$level == $::S(level)} return
        set ::S(level) $level
        NewGame
    }
 }
 proc NewGame {} {
    array set ::S {score 0 state 0 score2 "" best 0}
    catch {eval .c delete gameOver;}
    StartLevel
    Banner "CLICK TO START"
    WaitClick
 }
 proc StartLevel {} {
    global S B BB LEVEL
 
    StartStop 0
    array set S {busy 0 needRow 0 pause 0}
    if {! [info exists LEVEL($S(level))]} {     ;# Above set levels
        set lvl [expr {$S(level) % 10}]
        if {$lvl == 0} {set lvl 10}
        array set S $LEVEL($lvl)
        set S(tiles) 4                          ;# Always use 4 tiles
    } else {
        array set S $LEVEL($S(level))
        set S(strlvl) "Level $S(level)"
    }
    set S(newRowX) [expr {$S(newRow) / $S(ticks)}] ;# Tick mark interval
 
    .c delete banner
    .c itemconfig cell -image {}
    array unset B
    set row1 [expr {$S(rowsX) - 4}]
 
    for {set row -1} {$row < $S(rows)} {incr row} {
        for {set col -1} {$col <= $S(cols)} {incr col} {
            if {$row < 0 || $row == $S(rows) || $col < 0 || $col == $S(cols)} {
                set B($row,$col) -1
            } else {
                set B($row,$col) 0
            }
        }
    }
    for {set col 0} {$col < $S(cols)} {incr col} {
        set BB($col) 0
    }
 
    DrawBoard
    for {set i 0} {$i < $S(srows)} {incr i} {
        UpRow
    }
 }
 proc DrawBoard {} {
    global S B
 
    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 DrawBoard2 {} {                            ;# The new row board
    global S BB
    for {set col 0} {$col < $S(cols)} {incr col} {
        .cc itemconfig c$col -image ::img::img($BB($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(state) == 0} {
        Banner ""
        StartStop 1
        set S(state) 1
        if {$row == -1} return
    }
 
    if {$S(state) != 1} return
    if {$S(busy)} return
    set S(busy) 1
    Explode $row $col
    set S(busy) 0
    if {$S(needRow)} NewRow
 }
 proc Explode {r c} {
    set cells [FindNeighbors $r $c]             ;# Find who should explode
    if {$cells == {}} return
    if {! $::S(mute)} {catch { snd_ok play }}
 
    # Update our score
    set cnt [llength $cells]
    set n [expr {$cnt * $cnt}]
    incr ::S(score) $n
    set ::S(score2) ""                          ;# Show special scores
    if {$cnt > 3} {set ::S(score2) "($n)"}
 
    ExplodeCells $cells                         ;# Do the explosion affect
    CollapseCells                               ;# Move cells down
    CompactCells                                ;# Move cells inward
 
    if {[IsEmpty]} {
        incr ::S(score) 1000
        Banner "1000 POINT BONUS"
        after 1000 [list Banner ""]
    }
 }
 proc FindNeighbors {row col} {                  ;# Find all triplets and up
    global S B
 
    # We'll do a flood fill (bfs) to find connected components
    set q [list $row $col]                      ;# Our BFS queue
    set qhead 0                                 ;# Head of the queue
 
    array unset neighbors                       ;# Whose in our neighborhood
    set neighbors($row,$col) 1                  ;# We're in our own neighborhood
    set type $B($row,$col)                      ;# Type of our neighborhood
    set cnt 1
 
    while {[llength $q] > $qhead} {             ;# While stuff in the queue
        foreach {r c} [lrange $q $qhead [incr qhead]] break
        incr qhead
 
        foreach {dr dc} {-1 0 1 0 0 -1 0 1} {   ;# Look n,s,e & w
            set r1 [expr {$r + $dr}]
            set c1 [expr {$c + $dc}]
            if {[info exists neighbors($r1,$c1)]} continue ;# Already seen
            if {$B($r1,$c1) != $type} continue  ;# Wrong type
 
            set neighbors($r1,$c1) 1            ;# Another neighbor
            lappend q $r1 $c1                   ;# Add to our BFS
            incr cnt
        }
    }
    if {$cnt < 3} {return {}}
    return [array names neighbors]
 }
 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 [expr {$::S(delay)}]
    }
 }
 proc CollapseCells {} {
    global B S
 
    while {1} {                                 ;# Stop when nothing slides
        set sliders {}
        for {set col 0} {$col < $S(cols)} {incr col} {
            set collapse 0
            for {set row $S(rowsX)} {$row >= 0} {incr row -1} {
                if {$B($row,$col) == -1} break
                if {$B($row,$col) == 0} {
                    set collapse 1
                } elseif {$collapse} {
                    lappend sliders $row $col y
                }
            }
        }
        if {$sliders == {}} break
        SlideCells $sliders
    }
 }
 proc CompactCells {} {
    global B S
 
    array set ::BB [array get B]
    set ROW $S(rowsX)
    set COL [expr {int($S(cols) / 2)}]
    while {1} {                                 ;# Stop when nothing slides
        set sliders {}
 
        # Check the slide to the right columns
        set cols {}
        for {set col 0} {$col < $COL} {incr col} {
            if {$B($ROW,$col) <= 0} {
                foreach c $cols {
                    for {set row $ROW} {$row >= 0} {incr row -1} {
                        if {$B($row,$c) <= 0} break
                        lappend sliders $row $c x
                    }
                }
                set cols {}
            } else {
                lappend cols $col
            }
        }
 
        # Check the slide to the left columns
        set cols {}
        for {set col [expr {$S(cols) - 1}]} {$col >= $COL} {incr col -1} {
            if {$B($ROW,$col) <= 0} {
                foreach c $cols {
                    for {set row $ROW} {$row >= 0} {incr row -1} {
                        if {$B($row,$c) <= 0} break
                        lappend sliders $row $c xx
                    }
                }
                set cols {}
            } else {
                lappend cols $col
            }
        }
 
        if {$sliders == {}} break
        SlideCells $sliders
    }
 }
 ##+##########################################################################
 #
 # SlideCells -- move a set of cells one unit in a specified direction.
 #
 # Tricky part is NOT losing the correct binding for cell X,Y. Thus we
 # first blank the real image and replace it with a temporary one which
 # we slide. DrawBoard will put the correct image back in place.
 #
 proc SlideCells {cells} {
    foreach {r c dir} $cells {
        .c itemconfig c$r,$c -image {}
        set M($r,$c) $::B($r,$c)
        set ::B($r,$c) 0
        .c create image [GetXY $r $c] -image ::img::img($M($r,$c)) \
            -tag slider$dir
    }
    .c raise banner
    set dx [expr {double($::S(cell)) / $::S(numSteps)}]
    set dy [expr {double($::S(cell)) / $::S(numSteps)}]
    for {set step 0} {$step < $::S(numSteps)} {incr step} {
        .c move slidery 0 $dy
        .c move slideryy 0 -$dy
        .c move sliderx $dx 0
        .c move sliderxx -$dx 0
        update
        after $::S(delay)
    }
    foreach {r c dir} $cells {                  ;# Update board data
        if {$dir == "y"} {
            set ::B([expr {$r+1}],$c) $M($r,$c)
        } elseif {$dir == "yy"} {
            set ::B([expr {$r-1}],$c) $M($r,$c)
        } elseif {$dir == "x"} {
            set ::B($r,[expr {$c+1}]) $M($r,$c)
        } elseif {$dir == "xx"} {
            set ::B($r,[expr {$c-1}]) $M($r,$c)
        }
    }
    DrawBoard
    .c delete slidery slideryy sliderx sliderxx
 }
 proc NewRow {} {
    global S B
 
    StartStop 0
    if {$S(busy)} {                             ;# Busy handling mouse click
        set S(needRow) 1                        ;# ...so set flag and leave
        return
    }
    set S(busy) 1
 
    incr S(lines) -1
    if {$S(lines) == 0} {                       ;# Is the level over yet???
        return [LevelOver]
    }
 
    # Check for game over
    for {set col 0} {$col < $S(cols)} {incr col} {
        if {$B(0,$col) > 0} {
            return [GameOver]
        }
    }
    UpRow
    StartStop 1
 
    set S(needRow) 0
    set S(busy) 0
 }
 ##+##########################################################################
 #
 # UpRow -- Scrolls the screen up one row and adds in another row
 #
 proc UpRow {} {
    global B S BB
 
    for {set col 0} {$col < $S(cols)} {incr col} {
        if {$BB($col) == 0} {set BB($col) [expr {1 + int(rand() * $S(tiles))}]}
    }
 
    set sliders {}
    for {set row 1} {$row < $S(rows)} {incr row} {
        for {set col 0} {$col < $S(cols)} {incr col} {
            if {$B($row,$col) == -1} continue
            lappend sliders $row $col yy
        }
    }
    for {set col 0} {$col < $S(cols)} {incr col} {
        set n $BB($col)
        if {$n == 0} {set n [expr {1 + int(rand() * $S(tiles))}]}
        set B($S(rows),$col) $n
        set BB($col) 0
        lappend sliders $S(rows) $col yy
    }
    SlideCells $sliders
    for {set col 0} {$col < $S(cols)} {incr col} {
        set B($S(rows),$col) -1
    }
 }
 proc IsEmpty {} {
    for {set row $::S(rowsX)} {$row >= 0} {incr row -1} {
        for {set col 0} {$col < $::S(cols)} {incr col} {
            if {$::B($row,$col) > 0} {return 0}
        }
    }
    return 1
 }
 proc About {} {
    set msg "$::S(title) v$::S(version)\nby Keith Vetter, October 2003\n"
    append msg "Based on a program by GameHouse\n\n"
 
    append msg "The object of the game is to collapse the rising blocks\n"
    append msg "to get as many points as possible.\n\n"
 
    append msg "Score points by clicking on a colored block that has\n"
    append msg "three or more neighbors of the same color. Blocks above\n"
    append msg "the resulting explosion will collapse on the blocks\n"
    append msg "below. The more blocks exploded the higher your score.\n\n"
 
    append msg "As you play, new lines of blocks will appear. When \n"
    append msg "\"Lines Left\" reaches zero, the level is over and the\n"
    append msg "next level will start.\n"
 
    tk_messageBox -message $msg
 }
 proc GameOver {{txt "Game Over"}} {
    set ::S(state) 2
    StartStop 0
    .c create rect 0 0 [winfo width .c] [winfo height .c] \
        -fill white -stipple gray25 -tag gameOver
    .c create text [GetXY 4 5] -text $txt -font {Helvetica 28 bold} \
        -fill white -tag gameOver
 }
 proc StartStop {onoff} {
    foreach aid [after info] {after cancel $aid}
    .cc itemconfig cell -image {}
    if {! $onoff} return
 
    set ::S(tcnt) $::S(ticks)
    after $::S(newRowX) ticker
 }
 proc ticker {} {
    global S BB
 
    incr S(tcnt) -1
    set col [expr {$S(ticks) - 1 - $S(tcnt)}]
 
    set BB($col) [expr {1 + int(rand() * $S(tiles))}]
    DrawBoard2
 
    if {$S(tcnt) <= 0} {
        NewRow
    } else {
        after $S(newRowX) ticker
    }
 }
 proc LevelOver {} {
    global S B
 
    set S(state) 3                              ;# Level over state
    StartStop 0
    Banner "LEVEL COMPLETE"
    update
    after 3000
    LevelOverAnimation
    incr S(level)
    StartLevel
    set S(state) 1
    StartStop 1
 }
 proc LevelOverAnimation {} {
    global S B
 
    Banner ""
    for {set row 0} {$row < $S(rows)} {incr row} {
        set bonus [expr {100 + $row*10}]
        incr S(score) $bonus
        Banner "$bonus POINT BONUS"
 
        for {set col 0} {$col < $S(cols)} {incr col} {
            if {$B($row,$col) > 0} break
            set B($row,$col) 4
            DrawBoard
            update
            after [expr {$S(delay)}]
        }
        if {$B($row,$col) > 0} break
    }
    after 2000
 }
 ##+##########################################################################
 #
 # WaitClick -- waits for a click to begin
 #
 proc WaitClick {} {
    set w [winfo width .c]
    set h [winfo height .c]
    .c create rect -10 -10 $w $h -tag scrim -fill black
    .c lower scrim
    .c raise banner
    .c bind banner <Button-1> {DoClick -1 -1}
    .c bind scrim <Button-1> {DoClick -1 -1}
 }
 proc Banner {msg} {
    global S
 
    .c delete banner scrim
    if {$msg == ""} return
 
    set x [expr {[winfo width .c] / 2}]
    .c create rect [expr {$x - 100}] 100 [expr {$x + 100}] 200 \
        -tag banner -width 5 -fill black -outline gold
    .c create text $x 175 -tag banner -font {Helvetica 12 bold} \
        -text $msg -anchor c -fill white
 
    for {set i 0} {$i < 6} {incr i} {
        set xx [expr {$x - (2.5-$i)*$S(cell)}]
        set yy [expr {120 + rand()*$S(cell)}]
        set who [expr {1 + int(rand() * $S(tiles))}]
        .c create image $xx $yy -image ::img::img($who) -tag banner
    }
 }
 proc Pause {byBinding} {
    global S
 
    if {$byBinding} {                           ;# Button toggles for us
        set S(pause) [expr {! $S(pause)}]
    }
 
    if {$S(pause) == 1} {                       ;# Pause on
        if {$S(state) != 1} return              ;# Not in play mode
        foreach aid [after info] {after cancel $aid}
 
        .c create rect 0 0 [winfo width .c] [winfo height .c] \
            -fill black -tag pause
        .c create text [GetXY 4 5] -font {Helvetica 28 bold} \
            -fill white -tag pause -text "PAUSED" -justify center
        .c create text [GetXY 6 5] -font {Helvetica 12 bold} \
            -fill white -tag pause -text "Press p to continue" -justify center
    } else {                                    ;# Pause off
        .c delete pause
        after $::S(newRowX) ticker
    }
 }
 proc DoSounds {} {
    proc snd_ok {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=}
    regsub -all {\s} $s(ok) {} sdata            ;# Bug in base64 package
    sound snd_ok
    snd_ok data [::base64::decode $sdata]
 }
 image create photo ::img::img(-1)
 image create photo ::img::img(0)
 image create photo ::img::img(1) -data {
    R0lGODdhGwAcANUAABwaKSopKi4nGAocdQYdswUhzw0jjRcgTDBr+HCX+iGX+2aG+156+hx58E5s
    +CZQ+BQ68gQo7K3p+5bV+5rF+nCr/JKs+D2p/BMy2RkYFyRBsCVC2T1b8hdT0j5Y0Yme90JVr1Rs
    0qG5+BRPlh80bjI2TBc9kP//////////////////////////////////////////////////////
    /////////////////////////////////////////////ywAAAAAGwAcAAAG/0AAICAEBIQCgEAA
    EAACAkBAABAAAgJAIDAAEoRDYrFAKBAKhgNAACggEooFo+FAIB6PxwMIEQ6HkQPAgJBIJpSK5ZJY
    MBAIxOPxgDyIEIKAkJA0IMCIUIiJFIbDIQQCKQAIFUqkUCgQCIQCAVgQDoER4RBSEBAulUiBUCgQ
    gAXhsBApRAqRSAQCKQAIiUqEUCAQiUNgRDiEFDIERSJSKBQwwIJQiClEMBFMJBKBRCCYDGGRwAwL
    mAIGg4lgIphIJAKJQCCQAoCgSECEQIxQGMFAMECIcCh8PAoCzWIBxAiHGMgGCBEOiZDHAxMgLBQQ
    DAazEW6GD+ED8ng8HhwOJv+jWSwgGMxms9k8II8HBPgQDjkcB2Ij0CwYj81ms3lshkIgRzgUOhib
    jGbBeGw2m8fm8Xg8iA6Ow+FwMBYbgYaxeGw2nI3wQQQ6hEMHY7HoZDQMB4ez8Xg4HA6HyHAAGUJh
    IuEBaBwOjofj4XA4Do7DMRwOEx8PQONwcDwejofDcTgcjiFjwVgwFh+LJwPiODgejocTAjqEDAZj
    wVgwFozF4mPxCDRCB8cT4giFQIZQuGAsFoyFpRICgBwOB4fj4DgcjiFjwVgsFowFwyIKZTRAh3A4
    ZDAYwIVwOEyIRB7AyMFwOBgMhjCRSHw+H4vFYhGJKBQLKHPwOIAMoXCxWCQzEonEp/KpVCwV0cdB
    ygBKJqBHOCQWQ8QRKSPIZASATCYDyAAEGYAgA8gAMoAMQAAQZABBADs=}
 image create photo ::img::img(2) -data {
    R0lGODdhGwAcANUAABkYFyopKhwaKS4nGFYnEasSB8oLBWkoKvE0I/hmWPhXTPVTO/VFOuw5MOgj
    EtkZD6gZH+QpH/CnldnHtveXjfGYcfeFdfh4b/dsZmwHBVsXE+x3Wa0mD+AqLk8ZKaU2HvVMRJ8t
    LqA4M6JKR/x+hPaKh+mdnf//////////////////////////////////////////////////////
    /////////////////////////////////////////////ywAAAAAGwAcAAAG/0BAABAACAYCgGAg
    GAgCgkBAEBAEBIGBYDAIEAqGgqFgKBiABeGwYCgYDAbDYSAQFBCJREKhWDAYDQQCAXQIh47H4wEJ
    HCKSiYRSsVwwCcWC0UAgIhGi4/EAZBiTCyIScUSIjsfD8Xg4Ho/Hw/EAZBaSBtAgFBYMBUPhYXgY
    HoaH4fF4PACZBSUiLAgLhoKwIHwYgA/h8KHJNCoPg8FQKBQehUfhASESHQ9ApmFxGAwFYWEIIQ4d
    D4fDockgNg9DQQiJPCCPiNDheAAjDocjEokAMoiEw2B4QCIPTuQRiTgckYgjEnF0EBFNBpFwGCAP
    DjAiHAo7RCGCgfBkEAqHgf/z6HwiHUQH0UEgEB0EooNogBqDDELheDiEnUYH2BAOEQ1EA9FgJBqa
    TEMRcYQiIsRwKGQwGIwGA4RhADIIRSQS6TRGDUYDyBAOiQwFhuHJMECIiKjRIIIYQJBwyAAxFBfQ
    INNYNDoNEYMxHAoVQwZIQQJpNA1GoyNqMEbDIUgxBDEYCpLCkwE2hMIRAwQCKUAgkAKkAIFAIIai
    pBhoOsMRYwQECYcKkGLIYDASJYVHg2gwGg3GcDgcghiMhoKi0GgQjU6jwWCAgAzhkNhoNBAKkwKQ
    6SAQwIZQyGgAGcJhg9FoNBgXCsijiSAiiEYDBAIpFIpEIgHECIcXSqkxGDxCEB1Eo8EAgRSJRCIh
    vFwuFlLJoogAAJ4CxwGMCIfDRqSD6CAiCEQEEgAAAAMBQAAACAAAwUAAGAAEA8AAIAAMAIAgADs=}
 image create photo ::img::img(3) -data {
    R0lGODdhGwAcANUAACopKi4nGBwaKTZ4LhyoBSG4BSCcBzNqLyaIFVP8E337T4z8Olz3NT71FDXo
    DT9FMC3YCZb8aOX7kbz9birICSF0EFLrFsj8VyRDFUXYGRxtDh04DljoNkjHLFHYMGroSlfKMWrZ
    UWXKTDQyNEaYMk6LRxkYF0CHNUa4Lf//////////////////////////////////////////////
    /////////////////////////////////////////////ywAAAAAGwAcAAAG/0AAICAICAKCAEAA
    CAgCgoAgIAgIAoKAACAADAiFQqFAIBQIBgKBUCAQCoVCgXAABACIhEKxWCyADGBCKGw0HA2gQzh0
    IAQPSEQyiUQUigUjkUgkGg0ikQKoWCQLBwQCpAiHRCEEAoE4HJBAxTJxFAgGgsFgMAAJQmGhUKBQ
    IBAIJFCxRBxCg2E4JBQKhQKFQoFAHJBAxXGBDIcFArAgHBYoFAoE4oBgKg5FhkAgEoEU4ZACgTgc
    EIzGsoAUCIWCsEAcAiFCocPhwFQaCkehUChQKBAKhDIcQhwORwOCqVgWEEqhAKQIhUCIcAhxOByO
    RsOBqVgWGUqBQqFQMkNHBv/oEA4bjYYDU7EwLECKUJiBZCAZh8PRcAAbQmHCsqlwGBkKpUPJZDIZ
    jsPBcTQ4wwaD4cBUOAwPpUPpUDIeR8bBcTCEjAajkWBYMBUOI9MBUjoUTybDsXAsDU6D0WA0GAwG
    B1PxcDwdSqfTyXgyHAuDw+AAGcKhwoOpeDieTqfT8Xg8HA6HMxwOFRzMwcPxADtCocfD4XA4QIZw
    KFQoPpgKKOQBdToijyfE4Qw/Q4VQofhgDh6OBwQCgTweDofzYXyECqIi8sFUPB+gRzj0cDgMDoPB
    +DAYCgZDEflgBh4OhyPkcDgfDuPDUDAYCgaDwYhEPpgDCMgRCj8fBQOoEA5GIwpgRDj0jAQkDufD
    +HwYH8UHqBAOiREFpxQwAU5AlHAI7AiHoA5KiBKiTgCBKWASmEwBk8AkMJkEJoEpYBIEBCaBKWAK
    AgA7}
 image create photo ::img::img(4) -data {
    R0lGODdhGwAcAMQAACspKzQyNExISbi4t8q7x6qpq6qnlOnp6fv8+tnY1mVnZtTZ8srJyXmId/Lp
    1Ih6iLPEzHZ3dbbItLa6zDhRUYp8dHN6jZuZlB8bKCsoFf///////////////////////ywAAAAA
    GwAcAAAF/yAgjkAgBkBAjgEZiIIwEMNQDEMxFEVRgIM4DkURAIFxgIg4goc4IuOBHAiSJIGygIg4
    kiJ4iOOBHAjCBM2BIEeSJEzCMAyTMEmSLKCzHAeSAM+BHNAwFEMxFMMwDBDDMElygAfiANGBJMRQ
    DMVQDMMwSATBMEmyHMcCBtGBJMNQDMMgDQMxEBDDMEySHEgiRAeIJOAgisRAMBDIiGKSJMlxJEJ0
    IAkxTBIBMdAoJkySJOBxIIkQHUgiDRIBMqKYMGAiistxHEgiRAeSQATBMAw0juAhjgeSUJWYMAzE
    MGAiigt4iKOIIIcQHcjBMEzCJEmSkCJyIAiCJKAQHUeSMMkMkyTJcRwHciAHiIjjIUQHsiQMAyVJ
    Ah7iCCLiKB5CdBwOwzBJkhzHcZDkeAjRcSwJmDBMkhzHgRwgIo7kQUXHkTAMkyTLcSAHSY6HEB1H
    koBMwiTJcRwHiIgjiRxClBxJwjBJchxHWY6HUB3HkjBgIh7HcYCIOJLiQVnJcSRJkhzHUZbkIUTg
    IY4kiIgjSR5ClCDgIYogIo5kKSZCYBymaY7HBQCCUICDOIoEMzCQREASARVNAAAABmQAkAFABgJA
    JmZiJmaiGAIAOw==}
 
 
 DoDisplay
 DoSounds
 NewGame

----
 
 [http://tclerswiki.googlepages.com/TCL_wiki_Collapse_Game.PNG ]
----
[Category Games] | [Tcl/Tk Games] | [Category Application]