#!/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