Here's another silly game (with a slight twist on the original) - Bruce Hartweg
#########################################################################
##
## TkBomb - Hexagonal Variant of Bomb Finding game
##
#########################################################################
## Change Log: (please add entry and update the TkBombVersion)
##
## Date Name Notes
## --------- ------------- --------------------------------------------
## 25Nov2001 B. Hartweg Initial Release
##
#########################################################################
namespace eval tkbomb {
variable TkBombVersion 0.1
variable Bombs
variable Color
variable Cos
variable Sin
variable Vals
variable Marks
variable Scores
variable Settings
array set Bombs {}
array set Marks {}
array set Scores {}
array set Settings {
HexSize 12
BoardSize 7
BombPercent 15
Colors {black blue orange green yellow purple cyan}
}
set Deg2Rad [expr {acos(-1) / 180.0}]
foreach a {0 60 120 180 240 300 360} {
set ang [expr {$a * $Deg2Rad}]
set Cos($a) [expr {cos($ang)}]
set Sin($a) [expr {sin($ang)}]
}
set Color(main) [. cget -background]
set Color(dark) [tkDarken $Color(main) 50]
set Color(light) [tkDarken $Color(main) 125]
font create FNT -family helvetica -weight bold -size -16
}
proc ::tkbomb::GUI {} {
variable Settings
variable BombsLeft
wm title . "TkBomb"
menu .mbar -type menubar
. config -menu .mbar
# File Menu
.mbar add cascade -label File -menu [set m [menu .mbar.f -tearoff 0]]
$m add command -label "New Game" -command \
[namespace code newGame]
$m add command -label Quit -command exit
# Options Menu
.mbar add cascade -label Options -menu [set m [menu .mbar.o -tearoff 0]]
foreach {s n} {small 12 medium 16 large 20} {
$m add radiobutton -label "$s hexes" -value $n \
-variable "[namespace which -variable Settings](HexSize)"
}
$m add separator
foreach {s n} {small 5 medium 10 large 15 huge 20} {
$m add radiobutton -label "$s board" -value $n \
-variable "[namespace which -variable Settings](BoardSize)"
}
$m add separator
foreach {s n} {easy 10 medium 15 hard 20 difficult 30} {
$m add radiobutton -label "$s" -value $n \
-variable "[namespace which -variable Settings](BombPercent)"
}
# Help Menu
.mbar add cascade -label Help -menu [set m [menu .mbar.h -tearoff 0]]
$m add command -label "About..." -command \
[namespace code about]
# widgets
pack [label .bomb -textvar [namespace which -variable BombsLeft]]
pack [canvas .c]
wm resizable . 0 0
}
proc ::tkbomb::hexPoints {x y r} {
variable Cos
variable Sin
foreach a {120 180 240 300 0 60} {
lappend points [expr {$x+$r*$Cos($a)}] [expr {$y+$r*$Sin($a)}]
}
return $points
}
proc ::tkbomb::makeHex {x y r tag} {
variable Color
set spts [hexPoints $x $y [expr {$r-2}]]
set lpts [hexPoints $x $y $r]
# make shadows for 3-D effect
.c create polygon $lpts -fill $Color(dark) -tag "Shadow$tag"
.c create polygon [lrange $lpts 0 7] -fill $Color(light) -tag "Shadow$tag"
.c create polygon $spts -fill $Color(main) -tag "Top$tag"
.c create text $x $y -anchor center -text "" -font FNT -tag "Text$tag"
foreach tg "Top$tag Text$tag" {
.c bind $tg <Enter> ".c itemconfig Top$tag -fill $Color(light)"
.c bind $tg <Leave> ".c itemconfig Top$tag -fill $Color(main)"
.c bind $tg <1> [namespace code "openHex $tag"]
.c bind $tg <Shift-1> [namespace code "markHex $tag"]
.c bind $tg <2> [namespace code "markHex $tag"]
.c bind $tg <3> [namespace code "markHex $tag"]
}
}
proc ::tkbomb::unsetBindings {} {
.c bind all <Enter> { break }
.c bind all <Leave> { break }
.c bind all <1> { break }
.c bind all <Shift-1> { break }
.c bind all <2> { break }
.c bind all <3> { break }
}
proc ::tkbomb::clearBindings {} {
.c bind all <Enter> {}
.c bind all <Leave> {}
.c bind all <1> {}
.c bind all <Shift-1> {}
.c bind all <2> {}
.c bind all <3> {}
}
proc ::tkbomb::openHex {tag} {
variable Bombs
variable Vals
variable Marks
variable Settings
if {[info exists Marks($tag)]} {
# can't open this
} elseif {[info exists Bombs($tag)]} {
.c delete Shadow$tag
foreach t [array names Marks] {
if {![info exists Bombs($t)]} {
.c itemconfig Text$t -text "X" -fill red
}
}
foreach t [array names Bombs] {
if {![info exists Marks($t)]} {
.c itemconfig Text$t -text "\u263c" -fill red
}
}
.c itemconfig Top$tag -fill red
.c itemconfig Text$tag -text "\u263c" -fill black
unsetBindings
tk_messageBox -message "You LOSE!"
} elseif {[info exists Vals($tag)]} {
.c delete Shadow$tag
.c delete Top$tag
set v $Vals($tag)
unset Vals($tag)
if {$v>0} {
.c itemconfig Text$tag -text $v -fill [lindex $Settings(Colors) $v]
} else {
.c itemconfig text$tag -text ""
foreach t [neighbors $tag] {
openHex $t
}
}
checkWin
}
}
proc ::tkbomb::markHex {tag} {
variable Marks
variable BombsLeft
if {[info exists Marks($tag)]} {
unset Marks($tag)
.c itemconfig Text$tag -text ""
incr BombsLeft 1
} else {
set Marks($tag) 1
.c itemconfig Text$tag -text "\u263c"
incr BombsLeft -1
checkWin
}
}
proc ::tkbomb::checkWin {} {
variable Bombs
variable Marks
variable Vals
if {[array size Bombs] == [array size Marks] &&
[array size Bombs] == [array size Vals] } {
unsetBindings
tk_messageBox -message "You WIN!"
}
}
#
# Given a hex tag - return list of 6 touching hexes
# NOTE: some of these may NOT be valid (i.e. outside of game boundaries)
#
proc ::tkbomb::neighbors {tag} {
foreach {c r} [split $tag :] break
set rm [expr $r-1]
set rp [expr $r+1]
set cm [expr $c-1]
set cp [expr $c+1]
set res {}
foreach {v1 v2} {c rm c rp cm rm cm r cp r cp rp} {
lappend res "[set $v1]:[set $v2]"
}
set res
}
proc ::tkbomb::newGame {} {
variable Bombs
variable Color
variable Cos
variable Sin
variable Vals
variable Marks
variable Settings
variable NumHexes
variable Settings
variable BombsLeft
set xm [expr {$Settings(HexSize)*1.5}]
set ym [expr {$Settings(HexSize)*$Sin(60)}]
set sz [expr {round($ym*1.5)}]
font configure FNT -size -$sz
# reset data
.c delete all
clearBindings
foreach v {Bombs Vals Marks} {
catch {unset $v}
array set $v {}
}
# build hexes
for {set c 0} {$c < $Settings(BoardSize)} {incr c} {
set x [expr $c*$xm]
set R [expr {2*$Settings(BoardSize) - 1 - $c}]
set Y [expr {$c*$ym}]
for {set r 0} {$r < $R} {incr r} {
set y [expr {$Y+$r*$ym*2}]
set tag "$c:[expr {$r+$c}]"
makeHex $x $y $Settings(HexSize) $tag
set Vals($tag) 0
if {$c==0} continue
set tag "-$c:$r"
makeHex -$x $y $Settings(HexSize) $tag
set Vals($tag) 0
}
}
# center data & size canvas
foreach {x1 y1 x2 y2} [.c bbox all] break
.c move all [expr {-1*$x1 + 10}] [expr {-1*$y1 + 10}]
.c config -width [expr {$x2 - $x1 + 20}] -height [expr {$y2 - $y1 + 20}]
# get # of bombs
set NumHexes [array size Vals]
set BombsLeft [expr {round($Settings(BombPercent)*$NumHexes/100.0)}]
# randomly place bombs
set l [array names Vals]
set N 0
while {$N<$BombsLeft} {
set i [expr {int(rand()*[llength $l])}]
set tag [lindex $l $i]
if {![info exists Bombs($tag)]} {
set Bombs($tag) 1
incr N
}
}
# calc numbers around bombs
foreach tag [array names Vals] {
if {![info exists Bombs($tag)]} {
foreach tt [neighbors $tag] {
catch {incr Vals($tag) $Bombs($tt)}
}
}
}
}
proc ::tkbomb::about {} {
variable TkBombVersion
if {[winfo exists .about]} {
wm deiconify .about
} else {
set w [toplevel .about -class dialog]
wm withdraw $w
wm transient $w .
wm title $w "About TkBomb $TkBombVersion"
button $w.b -text Dismiss -command [list wm withdraw $w]
text $w.text -height 9 -bd 1 -width 70
pack $w.b -fill x -side bottom
pack $w.text -fill both -side left -expand 1
$w.text tag config center -justify center
$w.text tag config title -justify center -font {Courier -18 bold}
$w.text insert 1.0 "About TkBomb $TkBombVersion" title \
"\n\nCopyright (C) 2001 Bruce B Hartweg <[email protected]>\n" \
center {
Find all the hidden Bombs!
Button 1 click will open a hex & show number of adjacent bombs
Button 2 or 3 click (or Shift 1) will mark/unmark a hex
} left
$w.text config -state disabled
wm deiconify $w
}
}
####################################################################################
::tkbomb::GUI
::tkbomb::newGame