Attachment "gemgame.tcl" to
ticket [749353ffff]
added by
mistachkin
2003-06-05 13:29:14.
#############################################################################
#
# GemGame -- based on a game by Derek Ramey
# by Keith Vetter -- May 2003
#
# slightly modified by Joe Mistachkin
#
# 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 GetPiece {} {
# return [expr {1 + int(rand() * 7)}]
# force the ability to "cascade" easier...
return [expr {1 + int(rand() * 2)}]
}
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) [GetPiece]
.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) [GetPiece]
}
}
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???
if {$::S(score) < 10} {
snd_bad play ;# Nope, undo the move
SwapCells $row1 $col1 $row $col
} else {
incr ::S(score) -10
set S(score2) (-10)
}
}
if {! [Hint 1]} { ;# Is the game over???
if {$::S(score) < 10} {
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) [GetPiece]
}
.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]
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