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 [L1 ].
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]