#########################################################################
##
## TkBomb - Hexagonal Variant of Bomb Finding game 
##
#########################################################################
## Change Log: (please add entry and update the TkBombVersion)
##
##  Date       Name           Notes
##  ---------  -------------  --------------------------------------------
##  25Nov2001  B. Hartweg     Initial Release
##  09May2004  MG             (0) Small change to allow it to work as-is with 8.4+
##  28Aug2004  MG             (1) Already "opened" hex's could previously be marked
##
#########################################################################
package require Tk
if { [package vsatisfies [package present Tk] 8.4] } {
     interp alias {} doDarken {} ::tk::Darken
   } else {
     interp alias {} doDarken {} tkDarken
   };# (0)
namespace eval tkbomb {
   variable TkBombVersion 0.3
   variable Bombs
   variable Open ;# (1)
   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) [doDarken $Color(main) 50]
   set Color(light) [doDarken $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
   variable Open

   if {[info exists Open($tag)]} {
   return; # (1)
      }
   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)
      set Open($tag) 1 ;# (1)
      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
   variable Open
   
   if {[info exists Open($tag)]} {
   return; # (1)
      }

   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 Open ;# (1)
   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 Open} {
      unset -nocomplain $v
      array set $v {}
   } ;# (1) Open added to foreach

   # 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