Version 10 of Minesweeper on Tktable
Updated 2004-05-31 12:54:38 by SMHif 0 { This is a first attempt at doing something with Tktable by Steve Howarth (SMH).
How do I add a small gif image here? RS: If you have it somewhere on the Web, just add the URL in brackets to have it shown. If not, mail it to me, see what we can do...
It's yet another version of the old minesweeper game played on a 16 x 16 grid (reduced to 8 x 8 for above image). I haven't implemented a timer yet. I won't add highscores as that might get into territories blocked by safe environments.
Oh yeah, and it probably requires at least TCL 8.x due to a) Tktable and b) string comparisons using 'eq'
See also tkmines.
}
package require Tk
package require Tktable
package require math
# Widget names/Commands
set rstBtn .f.b
set cntLbl .f.c
set timLbl .f.tm
set tbl .f.t
set initMines 40
set nMines 0
set gameOn 0
variable tab; # tab($r,$c) contains revealed mine counts
variable map; # map($r,$c) contains "M" or number of mines in adj. cells
variable cntVar; # Number of flags to place
variable timer; # Elapsed time. Not used yet.
# table info
array set table {
name .f.t cmd .f.t
rows 16 cols 16 cellSize 18
xp -1 yp -1 x -1 y -1
offsets {-1 -1 -1 0 -1 1
0 -1 0 1
1 -1 1 0 1 1 }
valid 0
}
frame .f
pack .f -side top
set tbl $table(name)
table $tbl -rows $table(rows) -cols $table(cols) \
-roworigin 0 -colorigin 0 -selectmode none \
-colwidth -$table(cellSize) -rowheight -$table(cellSize) \
-width 0 -height 0 \
-variable tab \
-flashmode off \
-cursor top_left_arrow \
-borderwidth 2 \
-state disabled \
-resizeborders none
set f [font create -family "arial black" -size 15 ]
label $cntLbl -font $f -textvariable cntVar
label $timLbl -font $f -textvariable timer
button $rstBtn
grid $cntLbl $rstBtn $timLbl
grid $tbl -columnspan 3
# set up tags for the various cell states:
# NC Not clicked yet
# C0 Empty no neighbours
# C1..C8 Empty n neighbours
# FLAG Flag Symbol
# MINE Mine
# NOMINE bad flag
# BANG exploded mine
set f [font create -family "arial black" -size 9 ]
$tbl tag configure NC -bg gray75 -relief raised -showtext 1
$tbl tag configure C0 -bg gray -relief flat
foreach {n c} {1 blue 2 "dark green" 3 red 4 "dark blue" 5 "dark red" 6 brown 7 black 8 navy } {
$tbl tag configure C$n -bg gray -fg $c -relief flat -font $f
}
# $tbl tag configure FLAG / MINE / NOMINE / BOOM (tags with images, see later)
# Win. All mines flagged. All other squares clicked at least once
proc checkWin {} {
if { ! $::cntVar } {
if { ! [llength [$::tbl tag cell NC]]} {
tk_messageBox -message "Woo hoo!" -type ok
set ::gameOn 0
}
}
}
# When placing a flag: if mine decrease remainder count.
proc flag rc {
$::tbl tag celltag FLAG $rc
incr ::cntVar -1
}
proc isFlagged rc { $::tbl tag includes FLAG $rc }
# Remove a flag. If was correctly place, have one more to find again
proc deflag rc {
incr ::cntVar
}
proc getCell {x y} {
global table
set c [expr ($x - 2) /$table(cellSize) ]
set r [expr ($y - 2) /$table(cellSize) ]
set table(col) $c; set table(row) $r
set table(rc) $r,$c
puts "$x,$y"
}
proc showMines {} {
global map tbl table
for {set r 0} {$r < $table(rows)} {incr r} {
for {set c 0} {$c < $table(cols)} {incr c} {
set rc $r,$c
if { [$tbl tag includes FLAG $rc] } {
if { $map($rc) ne "M" } {
$tbl tag celltag NOMINE $rc
}
} elseif { $map($rc) eq "M"} {
$tbl tag celltag MINE $rc
}
}
}
}
proc showZero {r c} {
global tbl table map offsets tab
lappend toDo $r $c
set inList($r,$c) 1
while {[llength $toDo] } {
set r [lindex $toDo 0]
set c [lindex $toDo 1]
set rc $r,$c
$tbl tag celltag C0 $rc
set toDo [lreplace $toDo 0 1]
foreach {dr dc} $table(offsets) {
set nr [expr $r + $dr]
if {$nr < 0 || $nr >= $table(rows) } continue
set nc [expr $c + $dc]
if {$nc < 0 || $nc >= $table(cols) } continue
set rc $nr,$nc
if {[isFlagged $rc]} {deflag $rc }
if { [catch {set inList($rc)} err ] } {
if { $map($rc) eq "0" } {
lappend toDo $nr $nc
set inList($rc) 1
} else {
set tab($rc) $map($rc)
$tbl tag celltag "C$map($rc)" $rc
}
}
}
}
}
# Pressing down left button makes us worry
bind $tbl <ButtonPress-1> {
if { $::gameOn } { $::rstBtn configure -image $::images(worry) }
break
}
# Releasing left button reveals our fate
bind $tbl <ButtonRelease-1> {
global tbl table map images
getCell %x %y
set rc $table(rc)
if {$::gameOn && ! [isFlagged $rc]} {
if { $map($rc) eq "M" } {
showMines
$::rstBtn configure -image $images(dead)
$tbl tag celltag BOOM $rc
set ::gameOn 0
} elseif { $map($rc) > 0 } {
set tab($rc) $map($rc)
$tbl tag celltag "C$tab($rc)" $rc
$::rstBtn configure -image $images(smiley)
} else {
showZero $table(row) $table(col)
$::rstBtn configure -image $images(smiley)
}
checkWin
}
break
}
# Pressing right button, toggles NC<->FLAG
bind $tbl <3> {
global tbl table tab
if $::gameOn {
getCell %x %y
set rc $table(rc)
if {[isFlagged $rc ]} {
deflag $rc
$tbl tag celltag NC $rc
} elseif { [$tbl tag includes NC $rc ] } {
flag $rc
}
}
checkWin
break ;# Avoid hiliting cell
}
proc getImage {tag imageData} {
if {[catch {image create photo [list gif $tag] -data $imageData} image]} return
return $image
}
set im [getImage FLAG {
R0lGODlhEAAQAPcAAAAAAIAAAACAAICAAAAAgIAAgACAgMDAwMDcwKbK8EAgAGAgAIAgAKAgAMAg
AOAgAABAACBAAEBAAGBAAIBAAKBAAMBAAOBAAABgACBgAEBgAGBgAIBgAKBgAMBgAOBgAACAACCA
AECAAGCAAICAAKCAAMCAAOCAAACgACCgAECgAGCgAICgAKCgAMCgAOCgAADAACDAAEDAAGDAAIDA
AKDAAMDAAODAAADgACDgAEDgAGDgAIDgAKDgAMDgAODgAAAAQCAAQEAAQGAAQIAAQKAAQMAAQOAA
QAAgQCAgQEAgQGAgQIAgQKAgQMAgQOAgQABAQCBAQEBAQGBAQIBAQKBAQMBAQOBAQABgQCBgQEBg
QGBgQIBgQKBgQMBgQOBgQACAQCCAQECAQGCAQICAQKCAQMCAQOCAQACgQCCgQECgQGCgQICgQKCg
QMCgQOCgQADAQCDAQEDAQGDAQIDAQKDAQMDAQODAQADgQCDgQEDgQGDgQIDgQKDgQMDgQODgQAAA
gCAAgEAAgGAAgIAAgKAAgMAAgOAAgAAggCAggEAggGAggIAggKAggMAggOAggABAgCBAgEBAgGBA
gIBAgKBAgMBAgOBAgABggCBggEBggGBggIBggKBggMBggOBggACAgCCAgECAgGCAgICAgKCAgMCA
gOCAgACggCCggECggGCggICggKCggMCggOCggADAgCDAgEDAgGDAgIDAgKDAgMDAgODAgADggCDg
gEDggGDggIDggKDggMDggODggAAAwCAAwEAAwGAAwIAAwKAAwMAAwOAAwAAgwCAgwEAgwGAgwIAg
wKAgwMAgwOAgwABAwCBAwEBAwGBAwIBAwKBAwMBAwOBAwABgwCBgwEBgwGBgwIBgwKBgwMBgwOBg
wACAwCCAwECAwGCAwICAwKCAwMCAwOCAwACgwCCgwECgwGCgwICgwKCgwMCgwOCgwADAwCDAwEDA
wGDAwIDAwKDAwP/78KCgpICAgP8AAAD/AP//AAAA//8A/wD//////yH5BAEAAPkALAAAAAAQABAA
AAhBAAEIHEiwoMF/CBEaJJiw4UKB/yBKfBgRQMWKCxsmfGhR4UaKGjFmHCgyo0OOKBmWhLiyo0aO
Gz8WVHiwZUoAAQEAOw==}]
$tbl tag configure FLAG -image $im
set im [ getImage MINE {
R0lGODlhEAAQAPcAAAAAAIAAAACAAICAAAAAgIAAgACAgMDAwMDcwKbK8EAgAGAgAIAgAKAgAMAg
AOAgAABAACBAAEBAAGBAAIBAAKBAAMBAAOBAAABgACBgAEBgAGBgAIBgAKBgAMBgAOBgAACAACCA
AECAAGCAAICAAKCAAMCAAOCAAACgACCgAECgAGCgAICgAKCgAMCgAOCgAADAACDAAEDAAGDAAIDA
AKDAAMDAAODAAADgACDgAEDgAGDgAIDgAKDgAMDgAODgAAAAQCAAQEAAQGAAQIAAQKAAQMAAQOAA
QAAgQCAgQEAgQGAgQIAgQKAgQMAgQOAgQABAQCBAQEBAQGBAQIBAQKBAQMBAQOBAQABgQCBgQEBg
QGBgQIBgQKBgQMBgQOBgQACAQCCAQECAQGCAQICAQKCAQMCAQOCAQACgQCCgQECgQGCgQICgQKCg
QMCgQOCgQADAQCDAQEDAQGDAQIDAQKDAQMDAQODAQADgQCDgQEDgQGDgQIDgQKDgQMDgQODgQAAA
gCAAgEAAgGAAgIAAgKAAgMAAgOAAgAAggCAggEAggGAggIAggKAggMAggOAggABAgCBAgEBAgGBA
gIBAgKBAgMBAgOBAgABggCBggEBggGBggIBggKBggMBggOBggACAgCCAgECAgGCAgICAgKCAgMCA
gOCAgACggCCggECggGCggICggKCggMCggOCggADAgCDAgEDAgGDAgIDAgKDAgMDAgODAgADggCDg
gEDggGDggIDggKDggMDggODggAAAwCAAwEAAwGAAwIAAwKAAwMAAwOAAwAAgwCAgwEAgwGAgwIAg
wKAgwMAgwOAgwABAwCBAwEBAwGBAwIBAwKBAwMBAwOBAwABgwCBgwEBgwGBgwIBgwKBgwMBgwOBg
wACAwCCAwECAwGCAwICAwKCAwMCAwOCAwACgwCCgwECgwGCgwICgwKCgwMCgwOCgwADAwCDAwEDA
wGDAwIDAwKDAwP/78KCgpICAgP8AAAD/AP//AAAA//8A/wD//////yH5BAEAAPkALAAAAAAQABAA
AAg9APMJHEiwoMGDCBMqXGgQgEKHAyEKlBgxH4CLFy0iBPAPY8aNHj8WDEnyIEmKI0uatOhR40iC
FFG+ZKgwIAA7}]
$tbl tag configure MINE -image $im
$tbl tag configure BOOM -image $im -bg red
set im [ getImage NOMINE {
R0lGODdhEAAQAPcAAAAAAIAAAACAAICAAAAAgIAAgACAgICAgMDAwP8AAAD/AP//AAAA//8A/wD/
/////4iIiIiIiIiIiIiIiIgIiICICICAiAgIAACIiIgAAACIiIgAAACAiAgAAACAiAgAAACAiAgA
AACAiAgAAA+IiIgAAACIiIgAAICAiAgIAIgIiICICIiIiIiIiIiIiIiIiP8AAAAAAB8ACwgBALXI
MCPzMAAAAAEEfgAAAAUEvoUADwAAAAAAAAAAAAAAAAAAEAAAEAAAAQAAEAAAAP///wAAAAAAEAAA
DwsBZv8QALXcACMBeAAAAAAA//8AAAAAAAAAAAAA//8AAAAAAAAAAP///////wAAAAAAAP//AAD/
/wAAAAAAAAAAAAAAAAAAAAAAAAAAAKcBWQAQALXcALUm2AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAAAAAAALAAAAAAQABAA
AAhOABEIHEiwoMGDBgEQBKBwYMOBCRIwnKgwosGIDyhGTJAw4kSLCRl69PjQ4UeSJQVqRBkSwEiJ
KVWiBHkR5smaFBkioImgpE6HCIMKPRgQADs=}]
$tbl tag configure NOMINE -image $im
set images(smiley) [getImage SMILEY {
R0lGODlhIAAgAPcAAAAAAIAAAACAAICAAAAAgIAAgACAgMDAwMDcwKbK8EAgAGAgAIAgAKAgAMAg
AOAgAABAACBAAEBAAGBAAIBAAKBAAMBAAOBAAABgACBgAEBgAGBgAIBgAKBgAMBgAOBgAACAACCA
AECAAGCAAICAAKCAAMCAAOCAAACgACCgAECgAGCgAICgAKCgAMCgAOCgAADAACDAAEDAAGDAAIDA
AKDAAMDAAODAAADgACDgAEDgAGDgAIDgAKDgAMDgAODgAAAAQCAAQEAAQGAAQIAAQKAAQMAAQOAA
QAAgQCAgQEAgQGAgQIAgQKAgQMAgQOAgQABAQCBAQEBAQGBAQIBAQKBAQMBAQOBAQABgQCBgQEBg
QGBgQIBgQKBgQMBgQOBgQACAQCCAQECAQGCAQICAQKCAQMCAQOCAQACgQCCgQECgQGCgQICgQKCg
QMCgQOCgQADAQCDAQEDAQGDAQIDAQKDAQMDAQODAQADgQCDgQEDgQGDgQIDgQKDgQMDgQODgQAAA
gCAAgEAAgGAAgIAAgKAAgMAAgOAAgAAggCAggEAggGAggIAggKAggMAggOAggABAgCBAgEBAgGBA
gIBAgKBAgMBAgOBAgABggCBggEBggGBggIBggKBggMBggOBggACAgCCAgECAgGCAgICAgKCAgMCA
gOCAgACggCCggECggGCggICggKCggMCggOCggADAgCDAgEDAgGDAgIDAgKDAgMDAgODAgADggCDg
gEDggGDggIDggKDggMDggODggAAAwCAAwEAAwGAAwIAAwKAAwMAAwOAAwAAgwCAgwEAgwGAgwIAg
wKAgwMAgwOAgwABAwCBAwEBAwGBAwIBAwKBAwMBAwOBAwABgwCBgwEBgwGBgwIBgwKBgwMBgwOBg
wACAwCCAwECAwGCAwICAwKCAwMCAwOCAwACgwCCgwECgwGCgwICgwKCgwMCgwOCgwADAwCDAwEDA
wGDAwIDAwKDAwP/78KCgpICAgP8AAAD/AP//AAAA//8A/wD//////yH5BAEAAPkALAAAAAAgACAA
AAiSAPMJHEiwoMGDCBMqXMiwocOHEAkCmEgxokGK+zJqrGgRgMaPIAFE9AiyZEaRDkmaNIlyocqV
LF3CnLmv5cGXNV9OjJkQ586NOE/2pEnTpkSiM40ODIp0I0KmTWsO3QjTp0KdVUNeDcmypNKCPlX+
/Pj1otexZFNCPQtxrdOOaE9OtAiW4ly6ePPq3cu3r9++AQEAOw==}]
set images(worry) [getImage WORRY {
R0lGODlhIAAgAPcAAAAAAIAAAACAAICAAAAAgIAAgACAgMDAwMDcwKbK8EAgAGAgAIAgAKAgAMAg
AOAgAABAACBAAEBAAGBAAIBAAKBAAMBAAOBAAABgACBgAEBgAGBgAIBgAKBgAMBgAOBgAACAACCA
AECAAGCAAICAAKCAAMCAAOCAAACgACCgAECgAGCgAICgAKCgAMCgAOCgAADAACDAAEDAAGDAAIDA
AKDAAMDAAODAAADgACDgAEDgAGDgAIDgAKDgAMDgAODgAAAAQCAAQEAAQGAAQIAAQKAAQMAAQOAA
QAAgQCAgQEAgQGAgQIAgQKAgQMAgQOAgQABAQCBAQEBAQGBAQIBAQKBAQMBAQOBAQABgQCBgQEBg
QGBgQIBgQKBgQMBgQOBgQACAQCCAQECAQGCAQICAQKCAQMCAQOCAQACgQCCgQECgQGCgQICgQKCg
QMCgQOCgQADAQCDAQEDAQGDAQIDAQKDAQMDAQODAQADgQCDgQEDgQGDgQIDgQKDgQMDgQODgQAAA
gCAAgEAAgGAAgIAAgKAAgMAAgOAAgAAggCAggEAggGAggIAggKAggMAggOAggABAgCBAgEBAgGBA
gIBAgKBAgMBAgOBAgABggCBggEBggGBggIBggKBggMBggOBggACAgCCAgECAgGCAgICAgKCAgMCA
gOCAgACggCCggECggGCggICggKCggMCggOCggADAgCDAgEDAgGDAgIDAgKDAgMDAgODAgADggCDg
gEDggGDggIDggKDggMDggODggAAAwCAAwEAAwGAAwIAAwKAAwMAAwOAAwAAgwCAgwEAgwGAgwIAg
wKAgwMAgwOAgwABAwCBAwEBAwGBAwIBAwKBAwMBAwOBAwABgwCBgwEBgwGBgwIBgwKBgwMBgwOBg
wACAwCCAwECAwGCAwICAwKCAwMCAwOCAwACgwCCgwECgwGCgwICgwKCgwMCgwOCgwADAwCDAwEDA
wGDAwIDAwKDAwP/78KCgpICAgP8AAAD/AP//AAAA//8A/wD//////yH5BAEAAPkALAAAAAAgACAA
AAiPAPMJHEiwoMGDCBMqXMiwocOHEAkCmEgxokGK+zJqrGgRgMaPIAFE9AiyZEaRDkmaNIlyocp9
L0+WbInwZcyNMxWq9DjxY8+YNC+GtHkTZsKiK1nWTMp049KmTIMORAr15NGqSq9iDalzJsWvObtu
tcqQatayZn1KFRvVYj6MQ9dC/DrRrd27ePPq3cuXb0AAOw==
}]
set images(dead) [getImage DEAD {
R0lGODlhIAAgAPcAAAAAAIAAAACAAICAAAAAgIAAgACAgMDAwMDcwKbK8EAgAGAgAIAgAKAgAMAg
AOAgAABAACBAAEBAAGBAAIBAAKBAAMBAAOBAAABgACBgAEBgAGBgAIBgAKBgAMBgAOBgAACAACCA
AECAAGCAAICAAKCAAMCAAOCAAACgACCgAECgAGCgAICgAKCgAMCgAOCgAADAACDAAEDAAGDAAIDA
AKDAAMDAAODAAADgACDgAEDgAGDgAIDgAKDgAMDgAODgAAAAQCAAQEAAQGAAQIAAQKAAQMAAQOAA
QAAgQCAgQEAgQGAgQIAgQKAgQMAgQOAgQABAQCBAQEBAQGBAQIBAQKBAQMBAQOBAQABgQCBgQEBg
QGBgQIBgQKBgQMBgQOBgQACAQCCAQECAQGCAQICAQKCAQMCAQOCAQACgQCCgQECgQGCgQICgQKCg
QMCgQOCgQADAQCDAQEDAQGDAQIDAQKDAQMDAQODAQADgQCDgQEDgQGDgQIDgQKDgQMDgQODgQAAA
gCAAgEAAgGAAgIAAgKAAgMAAgOAAgAAggCAggEAggGAggIAggKAggMAggOAggABAgCBAgEBAgGBA
gIBAgKBAgMBAgOBAgABggCBggEBggGBggIBggKBggMBggOBggACAgCCAgECAgGCAgICAgKCAgMCA
gOCAgACggCCggECggGCggICggKCggMCggOCggADAgCDAgEDAgGDAgIDAgKDAgMDAgODAgADggCDg
gEDggGDggIDggKDggMDggODggAAAwCAAwEAAwGAAwIAAwKAAwMAAwOAAwAAgwCAgwEAgwGAgwIAg
wKAgwMAgwOAgwABAwCBAwEBAwGBAwIBAwKBAwMBAwOBAwABgwCBgwEBgwGBgwIBgwKBgwMBgwOBg
wACAwCCAwECAwGCAwICAwKCAwMCAwOCAwACgwCCgwECgwGCgwICgwKCgwMCgwOCgwADAwCDAwEDA
wGDAwIDAwKDAwP/78KCgpICAgP8AAAD/AP//AAAA//8A/wD//////yH5BAEAAPkALAAAAAAgACAA
AAiVAPMJHEiwoMGDCBMqXMiwocOHEAkCmEgxokGK+zJqrGgRgMaPIAFE9AiyZEaRDkmaNIlyocqV
LF2G3KfS48uTCm/SnFmy5cGbNjfuDJlQJ8yYP48qpYnQ6NKNTZ/C9FnQKcaVVKv2rGk0q0SeYKHm
FIr1o9eLUnE2nCh1IkSnZi3mu2rWrdyBFDne3cu3r9+/gANDDAgAOw==
}]
proc initGame {} {
global tbl images table map tab
array set map {}
set t $tbl
# initialise mine array with extra 'guard' cells around entire area.
for { set r -1 } { $r <= $table(rows) } { incr r } {
for { set c -1 } { $c <= $table(cols) } { incr c } {
set map($r,$c) "0"
set tab($r,$c) ""
}
}
set mxr [expr $table(rows) - 1]
set mxc [expr $table(cols) - 1]
set ::cntVar 0
while { $::cntVar < $::initMines } {
set r [::math::random 0 $mxr ]
set c [::math::random 0 $mxc ]
if { $map($r,$c) ne "M"} {
incr ::cntVar
set map($r,$c) "M"
# increase adj. mine count for all neighboring cells which don't contain mines
foreach {dr dc} $table(offsets) {
set nr [expr $r + $dr]
set nc [expr $c + $dc]
if { $map($nr,$nc) ne "M" } { incr map($nr,$nc)}
}
}
}
# inititialize the array, titles, and celltags
for {set r 0} {$r < $table(rows)} {incr r} {
for {set c 0} {$c < $table(cols)} {incr c} {
$tbl tag celltag NC $r,$c
# set tab($r,$c) $map($r,$c); # Uncomment for cheat mode
}
}
set ::gameOn 1
set ::timer 0
$::rstBtn configure -image $images(smiley) -command initGame
}
initGame# 31May2004 SMH Fixed bad image link # Category Games