Minesweeper

Die x-te Nachprogrammierung des einen Programms, das Windows groß gemacht hat: Minesweeper. Minimalistisches Script in Tcl/Tk. Wenn das Spiel zu Ende ist, ist es zu Ende: neuer Anlauf? Neuer Programmstart. Kein Timer, keine Bestenliste, kein garnichts.

Bildschirmfoto Minesweeper

Aufruf von Kommandozeile:

Quelltext:


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

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}} {
  #
  # draw a tile
  # make tile responsive
  #
  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
      }
      setTitle
    }
    release $col $row
  "
}

proc flag {col row {canvas .c}} {
  #
  # toggle flag
  #
  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
  }
  setTitle
}

proc unflaggedMines {{canvas .c}} {
  #
  # $mines minus number of flags
  #
  global rows cols mines
  set result $mines
  for {set i 0} {$i < $cols} {incr i} {
    for {set j 0} {$j < $rows} {incr j} {
      if {[$canvas itemcget col$i&&row$j&&flag -text] ne ""} then {
        incr result -1
      }
    }
  }
  set result
}

proc setTitle {{canvas .c}} {
  #
  # game status on window title
  #
  global flagChar cols rows
  if {[wm title .] ne "Bumm!"} then {
    global mines
    set top [winfo toplevel $canvas]
    set freeTiles [- [llength [$canvas find withtag surface]] $mines]
    if {$freeTiles == 0} then {
      wm title $top Success!
      $canvas itemconfigure flag -text $flagChar
      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> ""
        }
      }
    } else {
      wm title $top "$freeTiles tiles, [unflaggedMines] mines"
    }
  }
}

proc press {col row {canvas .c}} {
  #
  # visual response: pressed tile "sunken"
  #
  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}} {
  #
  # visual response: pressed tile "raised"
  #
  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} {
  #
  # take n different elements from list (none twice!)
  #
  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}} {
  #
  # On first pressed tile,
  # init game such that this tile has no mine!
  # (Some kind of humanity ...)
  #
  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]
        }
      }
    }
  }
  check $col $row
}

proc check {col row {canvas .c}} {
  #
  # Check pressed tile on mine
  #
  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 {
      #
      # hit a mine, finish game:
      #
      bumm $col $row $canvas
    } elseif {[$canvas find withtag row$row&&col$col&&surface] ne ""} then {
      #
      # remove mine, unhide number of neighboured mines
      #
      $canvas delete row$row&&col$col&&!text
      if {[$canvas itemcget col$col&&row$row&&text -text] eq ""} then {
        #
        # if zero neighboured mines, check neighboured tiles too
        #
        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
      }
    }
  }
}

proc bumm {col row {canvas .c}} {
  #
  # mine hit, game over
  #
  global rows cols flagCharHollow bombChar
  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

Vergnügen!

(Ursprung – 26.06.2017)

<< Home | Sitemap | A-Z | Impressum | Suche >>