Collapse (iPaq)
if 0 {Richard Suchenwirth 2005-01-22 - After seeing KPV's Collapse in the Tk Game Pack, I wanted to have it on the iPaq too. This just needed some tweaking of geometry and font sizes, reducing the number of defined levels etc.; and here it is:
}
##################
#
# 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
# suchenwi Jan 22, 2003 - adapted for iPaq
# TODO:
# bombs
package require Tk 8.4
array set S {title "Collapse" version 1.0 cols 7 rows 10 cell 25
delay 10 mute 0 numSteps 4 level 1 ticks 13}
set S(rowsX) [expr {$S(rows) - 1}]
array set LEVEL {
1 {srows 3 tiles 3 newRow 4000 lines 25}
2 {srows 4 tiles 3 newRow 3000 lines 30}
3 {srows 5 tiles 3 newRow 2500 lines 30}
4 {srows 6 tiles 3 newRow 2000 lines 30}
5 {srows 7 tiles 3 newRow 2000 lines 35}
6 {srows 7 tiles 3 newRow 1500 lines 40}
}
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 1 -relief raised
canvas .cc -relief ridge -bg black -height [expr {5 + $S(cell)}] -width $w \
-highlightthickness 0 -bd 1 -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" -command NewGame
set levels {}
foreach a [lsort -integer [array names ::LEVEL]] {
lappend levels "L. $a"
}
eval tk_optionMenu .optlvl S(strlvl) $levels
.optlvl config -highlightthickness 0
trace add variable ::S(strlvl) write Tracer
checkbutton .pause -text Pause -variable S(pause) \
-command {Pause 0} -relief raised -anchor w
button .about -text About -command About
button .x -text X -command exit
pack .ctrl -side right -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 .pause -in .ctrl -sticky ew -pady 1
grid rowconfigure .ctrl 50 -weight 1
grid .about -in .ctrl -row 100 -sticky ew -pady 5
grid .x -in .ctrl -sticky ew
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) "L. %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}
if ![info exi LEVEL($lvl)] {set lvl [expr 1+$lvl%7]}
array set S $LEVEL($lvl)
set S(tiles) 4 ;# Always use 4 tiles
} else {
array set S $LEVEL($S(level))
set S(strlvl) "L. $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
# 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 500 [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 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, Oct. 2003 - "
append msg "Based on a program by GameHouse\n"
append msg " Collapse the rising blocks "
append msg "to get as many points as possible.\n"
append msg "Score points by clicking on a block that has "
append msg "two or more neighbors of same color. Blocks above "
append msg "the explosion will collapse on blocks "
append msg "below. The more blocks exploded the higher your score.\n"
append msg "As you play, new lines of blocks will appear. When "
append msg "\"Lines Left\" reaches 0, the next level will start."
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 3] -text $txt -font {Helvetica 18 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 -fill black -outline gold -stipple gray50
.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 3] -font {Helvetica 14 bold} \
-fill white -tag pause -text "PAUSED" -justify center
.c create text [GetXY 6 3] -font {Helvetica 10 bold} \
-fill white -tag pause -text "Press p to continue" -justify center
} else { ;# Pause off
.c delete pause
after $::S(newRowX) ticker
}
}
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
NewGame
wm geometry . 240x305+0+0
bind . <Up> {exec wish $argv0 &; exit} ;# rapid dev helper