Mine

wdb Presumably the 994,378th 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.

Usage:

 mine.tcl
 mine.tcl child
 mine.tcl teenie
 mine.tcl custom (cols) (rows) (mines)

Have fun!

Screenshot edit

Code edit

#!/usr/bin/wish

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

# debug
proc -- args #
proc echo args {puts $args}
proc aloud args {
  puts $args
  uplevel $args
}
namespace path "::tcl::mathop ::tcl::mathfunc"


# mine, 30 cols 16 rows 99 mines

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

switch [lindex $argv 0] {
  child {lassign {8 8 10} cols rows mines}
  teenie {lassign {16 16 40} cols rows mines}
  custom {
    lassign $argv - cols rows mines
    if {$cols eq ""} then {
      set cols 16
    }
    if {$rows eq ""} then {
      set rows $cols
    }
    if {$mines eq ""} then {
      set mines [int [sqrt [* $cols $rows 4]]]
    }
  }
  default {lassign {30 16 99} cols rows mines}
}

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
}

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 {canvas .c}} {
  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
    $canvas 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 {[$canvas itemcget $tags -text] ne $bombChar} then {
        set count 0
        foreach di {-1 0 1} {
          foreach dj {-1 0 1} {
            if {[$canvas itemcget col[+ $i $di]&&row[+ $j $dj]&&text -text] eq
                $bombChar} then {
              incr count
            }
          }
        }
        if {$count > 0} then {
          $canvas itemconfigure col$i&&row$j&&text\
            -text $count\
            -fill [lindex {black
                           blue4
                           green4
                           red4
                           grey25
                           blue4
                           green4
                           red4
                           grey25} $count]
        }
      }
    }
  }
  after idle [list 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]
    if {$freeTiles > 0} then {
      wm title [winfo toplevel $canvas] "Minesweeper - $freeTiles tiles left"
    } else {
      wm title [winfo toplevel $canvas] Success!
    }
    update
  }
}

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
      }
    }
  }
}

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

Discussion edit

Survived dead, because of an error in source:

wdb strange behaviour, couldnʼt reproduce it – bumm should be visible ... nonetheless, changed the sequence. Try again!

(Later) problem appearently solved

Category Games