[wdb] Presumably the 994,378st clone of Bill Gatesʼ ingenious game “Mine Sweeper” which was '''that one reason''' why Windows became '''that famous.''' (Is it true that he has invented this game? Himself? '''Whoa.''')

Ok. As minimalist I prefer the core of games, not the bell and whistles. Call me a purist. My personal version of “mine”. No timer, no hall of fame. Just number of tiles left to be seen in window title. Licence [OLL].
======
#!/usr/bin/wish

package require Tk
bind [winfo class .] <Destroy> exit

proc -- args #
proc echo args {puts $args}
proc aloud args {
  puts $args
  uplevel $args
}

# mine, 30 cols 16 rows 99 mines

# here to customize
lassign "30 16 99" cols rows mines
# lassign "8 8 8" cols rows mines

namespace path "::tcl::mathop ::tcl::mathfunc"

pack [canvas .c\
        -width [- [* 25 $cols] 2]\
        -height [- [* 25 $rows] 2]\
        -background grey70] -expand yes -fill both
wm title . Minesweeper
wm resizable . 0 0

#
# game states
#

variable pressed false
variable init true

set bombChar \u2688
set flagChar \u2691
set flagCharHollow \u2690


proc tile {col row {canvas .c}} {
  global bombChar flagChar
  set w 25
  set h 3
  set x [* $col $w]
  set y [* $row $w]
  set tags "col$col row$row"
  $canvas create text [+ $x 12] [+ $y 12]\
    -text ""\
    -anchor center\
    -font "Helvetica 16 bold"\
    -tags "$tags text"
  $canvas create polygon\
    [+ $x 1] [+ $y 1] [+ $x $w -1] [+ $y 1] [+ $x 1] [+ $y $w -1]\
    -fill grey85 -tags "$tags topleft"
  $canvas create polygon\
    [+ $x 1] [+ $y $w -1] [+ $x $w -1] [+ $y $w -1] [+ $x $w -1] [+ $y 1]\
    -fill grey15 -tags "$tags bottomright"
  $canvas create rectangle [+ $x $h] [+ $y $h] [+ $x $w -$h] [+ $y $w -$h]\
    -fill grey70 -tags "$tags surface" -outline ""
  $canvas create text [+ $x 11] [+ $y 11]\
    -text ""\
    -anchor center\
    -font "Helvetica 16 bold"\
    -fill white\
    -tags "$tags flag"
  #
  $canvas bind col$col&&row$row&&surface <1> "press $col $row"
  $canvas bind col$col&&row$row&&surface <3> "flag $col $row"
  $canvas bind col$col&&row$row&&flag <3> "flag $col $row"
  $canvas bind col$col&&row$row&&surface\
    <Leave> "release $col $row"
  $canvas bind col$col&&row$row&&surface\
    <ButtonRelease> "
    if {\$pressed} then {
      if {\$init} then {
        init $col $row
      } else {
        check $col $row
      }
    }
    release $col $row
  "
}

proc flag {col row {canvas .c}} {
  global flagChar
  if {[$canvas itemcget col$col&&row$row&&flag -text] eq $flagChar} then {
    $canvas itemconfigure col$col&&row$row&&flag -text ""
  } else {
    $canvas itemconfigure col$col&&row$row&&flag -text $flagChar
  }
}

proc press {col row {canvas .c}} {
  if {[$canvas itemcget row$row&&col$col&&flag -text] eq ""} then {
    variable pressed true
    $canvas itemconfigure col$col&&row$row&&topleft -fill grey15
    $canvas itemconfigure col$col&&row$row&&bottomright -fill grey85
    $canvas itemconfigure col$col&&row$row&&surface -fill grey65
  }
}

proc release {col row {canvas .c}} {
  variable pressed false
  $canvas itemconfigure col$col&&row$row&&topleft -fill grey85
  $canvas itemconfigure col$col&&row$row&&bottomright -fill grey15
  $canvas itemconfigure col$col&&row$row&&surface -fill grey70
}

apply {
  {cols rows} {
    .c del all
    for {set i 0} {$i < $cols} {incr i} {
      for {set j 0} {$j < $rows} {incr j} {
        tile $i $j
      }
    }
  }
} $cols $rows

proc takeNfromList {n liste} {
  if {$n > 0} then {
    set i [expr {int(rand()*[llength $liste])}]
    list [lindex $liste $i] {*}[takeNfromList [- $n 1] [lreplace $liste $i $i]]
  }
}

proc init {col row} {
  global rows cols mines
  global bombChar
  variable init
  if {!$init} then return
  set init false
  # hide 99 mines everywhere, but not at $col $row
  # first, collect fields
  for {set i 0} {$i < $cols} {incr i} {
    for {set j 0} {$j < $rows} {incr j} {
      if {$col != $i && $row != $j} then {
        lappend fields "$i $j"
      }
    }
  }
  # hide $mines mines
  set mineIndices [takeNfromList $mines $fields]
  foreach idx $mineIndices {
    lassign $idx x y
    .c itemconfigure col$x&&row$y&&text -text $bombChar
  }
  # write num of neighboured mines
  for {set i 0} {$i < $cols} {incr i} {
    for {set j 0} {$j < $rows} {incr j} {
      set tags col$i&&row$j&&text
      if {[.c itemcget $tags -text] ne $bombChar} then {
        set count 0
        foreach di {-1 0 1} {
          foreach dj {-1 0 1} {
            if {[.c itemcget col[+ $i $di]&&row[+ $j $dj]&&text -text] eq
                $bombChar} then {
              incr count
            }
          }
        }
        if {$count > 0} then {
          .c itemconfigure col$i&&row$j&&text\
            -text $count\
            -fill [lindex {black
                           blue4
                           green4
                           red4
                           grey25
                           blue4
                           green4
                           red4
                           grey25} $count]
        }
      }
    }
  }
  check $col $row
}

proc check {col row {canvas .c}} {
  global bombChar rows cols mines
  if {[$canvas itemcget col$col&&row$row&&flag -text] eq ""} then {
    if {[$canvas itemcget col$col&&row$row&&text -text] eq $bombChar} then {
      bumm $col $row $canvas
    } elseif {[$canvas find withtag row$row&&col$col&&surface] ne ""} then {
      $canvas delete row$row&&col$col&&!text
      if {[$canvas itemcget col$col&&row$row&&text -text] eq ""} then {
        check [- $col 1] [- $row 1] $canvas
        check [- $col 1]    $row    $canvas
        check [- $col 1] [+ $row 1] $canvas
        #
        check    $col    [- $row 1] $canvas
        check    $col    [+ $row 1] $canvas
        #
        check [+ $col 1] [- $row 1] $canvas
        check [+ $col 1]    $row    $canvas
        check [+ $col 1] [+ $row 1] $canvas
      }
    }
    set freeTiles [- [llength [$canvas find withtag surface]] $mines]
    wm title [winfo toplevel $canvas] "Minesweeper - $freeTiles tiles left"
  }
}

proc bumm {col row {canvas .c}} {
  global rows cols flagCharHollow bombChar
  after idle "wm title [winfo toplevel $canvas] Bumm!"
  for {set i 0} {$i < $cols} {incr i} {
    for {set j 0} {$j < $rows} {incr j} {
      $canvas bind col$i&&row$j&&surface <1> ""
      $canvas bind col$i&&row$j&&surface <3> ""
      $canvas bind col$i&&row$j&&flag <3> ""
      $canvas bind col$i&&row$j&&surface <Leave> ""
      $canvas bind col$i&&row$j&&surface <ButtonRelease> ""
      if {$i == $col && $j == $row} then {
        # hit the mine, sorry ...
        $canvas delete col$i&&row$j&&!text
        $canvas itemconfigure col$i&&row$j&&text -fill red
      } elseif {[$canvas itemcget col$i&&row$j&&flag -text] ne ""} then {
        # flag set
        if {[$canvas itemcget col$i&&row$j&&text -text] ne $bombChar} then {
          # but no mine under it
          $canvas itemconfigure col$i&&row$j&&flag\
            -text $flagCharHollow\
            -font "Helvetica 16 bold overstrike"\
            -fill black
        }
      } elseif {[$canvas itemcget col$i&&row$j&&text -text] eq $bombChar} then {
        $canvas delete col$i&&row$j&&!text
      }
    }
  }
}
======

------
Survived dead, because of an error in source:


[http://i.imgur.com/jKdmAxD.png]


<<categories>>Enter Category Here