Screenshot  edit

Code  edit

##+###############################################################
#
# 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

Discussion  edit

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References