#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

# mine.tcl - plays minehunt
# Source code (c) David MacKay  Sept 10 2002
#
# Unlike the Visor version, this one lets you carry on after 
# losing lives.
#
global helptext 
set helptext { MINEHUNT                          David MacKay 2002

 Left-click to test a square; if it's a mine, you lose a life.
    Test result is the number of neighbouring mines.
    (When the answer is zero, you can trivially propagate
     and test all neighbours too. This is done for you automatically.)

 Right-click to mark a square pink ("suspected mine")

 'Declare' announces that you think you've finished. All
   unmarked squares are tested. Squares marked pink are not
   tested.

 'Reveal' causes all mines to be revealed. The ones you did not
   step on remain "." (The Reveal function is only useful for
   explaining the game.)

 Challenge: think about how to make an automated minehunt-player that
   loses as few lives as possible.  The mines are laid at random
   (subject to at most one mine per square).

 Shortcuts: R/r restart 
}

# search HERE for size adjustment 

frame .mine
wm geometry . +10+10
pack  .mine
set w .mine
set top .
wm title . "Minehunt"
wm iconname . "mine"
wm geometry . +10+10

bind . <Control-C> {destroy .}
bind . <Control-c> {destroy .}
set colone [frame .mine.colone]
set rightcol [frame .mine.rightcol]
pack $rightcol -in $colone -side right -padx 2 -pady 2
set rightcolmid [frame .mine.rightcolmid]
set header [frame .mine.header]
set control [frame .mine.control]
set toprow [frame .mine.toprow]
set tworow [frame .mine.rightcol.tworow]
set threerow [frame .mine.fourrow]
set fourrow [frame .mine.threerow]
global messages
set messages [text $w.messages -background white -height 8 -wrap word -pady 2 -padx 3 -width 30]
pack $w.messages -padx 6 -in $fourrow
set fiverow [frame .mine.fiverow]
pack $header $control  $threerow  -side top  -padx 2 -pady 2
pack  $toprow -side bottom  -padx 2 -pady 2
pack  $tworow -side top  -padx 2 -pady 2
pack $colone -side left  -padx 2 -pady 2
global xn pry prn
frame $w.buttons
pack $w.buttons -side right -fill x -pady 2m -in $control
button $w.buttons.dismiss -text Quit -command "destroy $top"
button $w.buttons.help    -text Help -command "help"
pack $w.buttons.dismiss  -side left -expand 1 -padx 4
pack $w.buttons.help     -side left -expand 1 -padx 4

# make a frame called l within frame controls, and associate these buttons 
# with an integer called L
proc adjustableInteger { w controls l Lname Lstring } {
    frame $w.$l 
    pack $w.$l -in $controls -side left  -pady 2  -padx 6 -anchor w
    button $w.$l.l -text "$Lstring:" -padx 0 -pady 0 -borderwidth 1 -command {}
    button $w.$l.up -text ">" -padx 0 -pady 0 -borderwidth 1 -command "incr $Lname"
    button $w.$l.dn -text "<" -padx 0 -pady 0 -borderwidth 1 -command "incr $Lname -1"
    bind  $w.$l.up  <3> "$w.$l.dn invoke"
    bind  $w.$l.dn  <3> "$w.$l.up invoke"
    entry $w.$l.n -textvariable $Lname -width 3 -borderwidth 1
    pack $w.$l.l $w.$l.dn $w.$l.up $w.$l.n -in $w.$l -side left
}

# whether to propagate matters when a zero is encountered
global autozero ;  set autozero 1

# HERE for size adjustment 
# $font used in all the little headings and displays. was 20. 12 too small
global font ; set font "Courier 18"
global font ; set font "Courier 20"
global fonttiny ; set fonttiny "Courier 8"
global state
# 0 = uninvestigated, 1 = done, empty, red = 2 = hit and destroyed a soldier
set state(3) "pink"
set state(2) "red"
set state(1) "lightgreen"
set state(0) "skyblue3"

# adjustableInteger $control $control "si" size size
global size ; set size 11
# size = size of ocean , in squares
global I  ; set I [expr $size*$size] ;# number of locations
adjustableInteger $control $control "su" totmines mines
global totmines ; set totmines 20
# initial number of mines
global minesleft 
global squaresleft 
# the array of where mines are or not:
global ismine 
# neighbours of square ii
global listof
global liveslost

proc setpypn {} {
    global xn py pn minesleft squaresleft pry prn
    if {[expr ($squaresleft>0)]} {
	set py [expr ($minesleft*1.0/$squaresleft)] 
	set pry "$minesleft/$squaresleft"
	set emptyleft [expr ($squaresleft-$minesleft)]
	set prn "$emptyleft/$squaresleft"
	set pn [expr (1.0 - $py)] 
    }
}

proc randomize {c} {
    global liveslost
    global minesleft squaresleft
    global totmines I
    global minex miney
    global ismine 
    global xn 
    set liveslost 0
    set minesleft $totmines
    set squaresleft $I
    setpypn

    for { set ii 1; set Ileft $I } { $ii <= $I } { incr ii } {
	set xn($ii) 0 
	$c  itemconfig  n$ii -outline green1
	$c  itemconfig  n$ii -fill SkyBlue3
	$c  itemconfig  txt$ii -text "." -fill Black
	set ismine($ii) [expr (rand()< $minesleft*1.0/$Ileft)]
#	puts [set ismine($ii)]
	if {[set ismine($ii)]} {
	    incr minesleft -1
	}
	incr Ileft -1
    }
# reset minesleft  
    set minesleft $totmines
    global thistotmines
    global messages
    $messages insert end "\n$totmines mines laid\n"
    $messages yview end

    set thistotmines $totmines
#    revealmines $c
# find who the neighbours are:
    neighbours $c
# count your neighbours:
    countmines $c
}
global thistotmines

proc revealmines {c} {
    global totmines I
    global ismine 
    for { set ii 1 } { $ii <= $I } { incr ii } {
	if {[set ismine($ii)]} {
	    $c  itemconfig  n$ii -fill Red3
	}
    }
}

# hit all squares that have not been touched.
proc finishblanks {c} {
    global thistotmines I
    global xn
# this counts red and pink:
    set pinkies 0
# this counts pink:
    set creditpinkies 0
    for { set ii 1 } { $ii <= $I } { incr ii } {
	if {[expr ($xn($ii)==0)]} {
	    hitNode $c hit $ii
	}
	if {[expr ($xn($ii)==3)||($xn($ii)==2)]} {
	    incr pinkies
	}
	if {[expr ($xn($ii)==3)]} {
	    incr creditpinkies
	}
    }
    global messages
    if {[expr ($pinkies>$thistotmines)]} {
#	puts "You have marked too many nodes pink"
	$messages insert end "Too many nodes pink\n"
    }
    if {[expr ($pinkies==$thistotmines)]} {
	$messages insert end "You have finished (score $creditpinkies)\n"
    }
    $messages yview end
}

# create list of neighbours of each sqaure
proc neighbours {c} {
    global I xc yc size iixy
    global ismine listof
    for { set ii 1 } { $ii <= $I } { incr ii } {
	set x $xc($ii) ; set y $yc($ii)
	set xmin [expr ($x-1)]
	if {[expr ($xmin<1)]} { set xmin 1 }
	set xmax [expr ($x+1)]
	if {[expr ($xmax>$size)]} { set xmax $size }
	set ymin [expr ($y-1)]
	if {[expr ($ymin<1)]} { set ymin 1 }
	set ymax [expr ($y+1)]
	if {[expr ($ymax>$size)]} { set ymax $size }
	set thislist ""
	for { set dx $xmin } { $dx <= $xmax } { incr dx } {
	    for { set dy $ymin } { $dy <= $ymax } { incr dy } {
		if { ($dx == $x) && ($dy == $y) } {
		    # do nothing
		} else {
		    set iii $iixy($dx,$dy)
		    set thislist [concat $thislist $iii]
		}
	    }
	}
#	puts "the list for $ii is $thislist"
	set listof($ii) $thislist
    }
}


global secret
# find how many mines neighbour each square
proc countmines {c} {
    global I iixy secret
    global ismine  listof
    for { set ii 1 } { $ii <= $I } { incr ii } {
	set thecount 0 
	foreach iii $listof($ii) {
	    if {[set ismine($iii)]} {
		incr thecount 
	    }
	}
#	$c  itemconfig  txt$ii -text $thecount
	set secret($ii) $thecount
	if {[set ismine($ii)]} {
#	    $c  itemconfig  txt$ii -text M
	    set secret($ii) "M"
	}
    }
}

proc revealcount {c ii} {
    global secret
    $c  itemconfig  txt$ii -text $secret($ii)
}

proc entropy { f } {
    if {($f>0.0)&&($f<1.0)} {
	set h [expr -($f*log($f)+(1.0-$f)*log(1.0-$f))/log(2.0)]
    } else {
	set h 0
    }
    return $h
}


# probability widths
set pwidth 8

label $w.liveslostl -width 12 -justify left -text "Lives lost:" -background yellow -anchor nw  -font $font
label $w.minel -width 8 -justify left -text "Mines:" -background pink1 -anchor nw  -font $font
label $w.spacer -width 2 -text ""
label $w.spacer2 -width 2 -text ""
label $w.pl -width 20 -justify left -text "Naive Probabilities:" -background yellow1 -anchor nw  -font $font
label $w.title -width 26 -text "Mine Hunt" -background Blue4 -foreground lightblue1 -font "Helvetica 32"
pack [button $w.control.restart -text "Restart" -command "randomize \$c"] -side left -padx 4
pack [button $w.control.declare -text "Declare" -command "finishblanks \$c"] -side left -padx 4
pack [button $w.control.reveal -text "Reveal" -command "revealmines \$c"] -side left -padx 4
pack $w.title -in $header -side left  -padx 2 -pady 2

global py ; set py ""
global pn ; set pn ""
frame $w.pyf ; frame $w.pnf 
label $w.py -width $pwidth -justify left -text "" -textvariable py -background pink1 -anchor nw  -font $font
label $w.pn -width $pwidth -justify left -text "" -textvariable pn -background lightgreen -anchor nw  -font $font
label $w.pyr -width $pwidth -justify left -text "" -textvariable pry -background pink1 -anchor nw  -font $font
label $w.pnr -width $pwidth -justify left -text "" -textvariable prn -background lightgreen -anchor nw  -font $font
pack  $w.pyr $w.py -in $w.pyf -side top
pack  $w.pnr $w.pn -in $w.pnf -side top
label $w.liveslost -width 2 -justify left -text "" -textvariable liveslost -background yellow -anchor nw  -font $font
label $w.minesleft -width 2 -justify left -text "" -textvariable minesleft -background pink1 -anchor nw  -font $font
label $w.sql -width 8 -justify left -text "Squares:" -background skyblue1 -anchor nw  -font $font
label $w.squaresleft -width 3 -justify left -text "" -textvariable squaresleft -background skyblue1 -anchor nw  -font $font

pack $fourrow  -in $rightcol -side top
pack $rightcolmid -in $rightcol -side top  -padx 2 -pady 2
# secret:
pack  $fiverow -in $rightcol -side top
pack  $w.liveslostl $w.liveslost  $w.spacer2 $w.minel $w.minesleft $w.spacer $w.sql $w.squaresleft  -in $threerow -side left -fill both
# probability frames: 
pack $w.pl $w.pyf $w.pnf  -in $toprow -side left  -padx 2 -pady 2

###################################
#
#   Canvas
#
###################################
# size of squares
global recwidth ; set recwidth 25 
# spacing of squares
global recdx ; set recdx 30
global recdy ; set recdy $recdx
global recheight ; set recheight $recwidth
set width [expr ($size+1.5)*$recdy]

set c $w.c
# c is the canvas for playing on, c2 is where we do some calculations
canvas $c -relief sunken -borderwidth 2 -width $width -height $width -background black
pack $c  -side top -in $colone
bind . <Control-R> {randomize $c}
bind . <Control-r> {randomize $c}
bind . <R> {randomize $c}
bind . <r> {randomize $c}

set bg [lindex [$c config -bg] 4]
set name(1) "A" ;
set name(2) "B" ;
set name(3) "C" ;
set name(4) "D" ;
set name(5) "E" ;
set name(6) "F" ;
set name(7) "G" ;
set name(8) "H" ;
set name(9) "I" ;
set name(10) "J" ;
set name(11) "K" ;
set topy 0
global iixy xc yc
set ii 1
for {set i 1 } {$i <= $size} {incr i} {
    set y [expr {$recdy * $i}]
    for {set j 1} {$j <= $size} {incr j} {
	set x [expr {$recdx*$j}]
	set item [$c create rect ${x} ${y} [expr $x+$recwidth] [expr $y+$recheight] \
		-width 2 -outline green -fill SkyBlue3 -tags [list node$i$j nd$ii n$ii]]
	set xn($ii) 0
	$c addtag node withtag $item
	set xc($ii) $i
	set yc($ii) $j
	set iixy($i,$j) $ii
	set x [expr {$recdx*($j+0.25)}]
	set item [$c create text ${x} ${y}  -anchor nw -text "." \
		-font $font -tags [list nd$ii txt$ii]]
	$c addtag text withtag $item
	$c bind nd$ii <1> "hitNode $c hit $ii"
	$c bind nd$ii <3> "hitNode $c mark $ii"
	$c bind nd$ii <Any-Enter> "enterNode $c $ii"
	$c bind nd$ii <Any-Leave> "itemLeave"
	incr ii
    }
    set x [expr {$recdx*0.5}]
# top edges labels
    set item [$c create text ${y} ${x} -anchor w \
	    -text "$i" -font $font -tags label -fill yellow]
# side edges labels
    set item [$c create text ${x} ${y} -anchor nw \
	    -text $name($i) -font $font -tags label -fill yellow1]
}

#$c bind node <1> "hitNode $c hit"
#$c bind node <3> "hitNode $c mark"
#$c bind node <Any-Enter> "enterNode $c"
#$c bind node <B1-Enter> "enterNode $c; hitNode $c hit"

################ let's go!
randomize  $c


# on entering a node, compute the probability 
# which is (0,1) if asked(ii)
# and is (minesleft/squaresleft) otherwise
proc enterNode {c {ii 0}} {
    global restoreCmd 
    global  xn minesleft squaresleft
    global  py pn
    if {$ii == 0 } {

	set nowthen [$c gettags current]
	#    puts $nowthen
	set myn [lindex $nowthen [lsearch -regexp $nowthen nd]]
	regsub  "nd" $myn "" ii
	#    puts $ii
    }
    $c  itemconfig n$ii -outline yellow2
    set restoreCmd "$c itemconfig n$ii -outline green; "
}


# two sorts of hit: hit and mark
# hitNode c hit guesses that there is no mine there
#           mark guesses there is, and nothing is revealed. (or unguesses)
proc hitNode {c type {iii 0}} {
    global restoreCmd listof autozero secret liveslost
    global state xn py pn pry prn
    global  ismine minesleft squaresleft
    if {$iii == 0} {
	set nowthen [$c gettags current]
	set myn [lindex $nowthen [lsearch -regexp $nowthen nd]]
	regsub  "nd" $myn "" ii
	puts "$ii"
    } else {
	set ii $iii
    }
    if {$type == "mark"} {
	if {[expr ($xn($ii)==0)]} {
#mark
	    set xn($ii) 3
	    incr squaresleft -1
	    incr minesleft -1
	} elseif {[expr ($xn($ii)==3)]} {
#unmark
	    set xn($ii) 0
	    incr squaresleft 1
	    incr minesleft 1
	}
    } else {
# type == hit
	if {[set xn($ii)] && [expr ($xn($ii)<3)]} {
	    #	puts "already been here" 
	    # the x<3 clause means that you can change your mind
# about a pink spot and hit it if you want.
	} else {
# show the text
	    revealcount $c $ii
	    if { $xn($ii)==3 } {
		# user is hitting a square currently labelled as mine!
		# quick, undo that labelling.
		incr squaresleft 1
		incr minesleft 1
	    }
	    incr squaresleft -1
	    if { $ismine($ii) } {
		incr liveslost
		incr minesleft -1
		set xn($ii) 2
	    } else {
		set xn($ii) 1
		if {($autozero && ($secret($ii)==0))} { 
# propagate the hits to all neighbours (and rely on hitnode to 
# be sensible and ignore hits already made.
		    $c  itemconfig txt$ii -fill yellow
		    foreach  iii $listof($ii) {
			hitNode $c hit $iii
		    }
		}
	    }
	}
    }
    setpypn
    $c  itemconfig n$ii -fill $state($xn($ii))
}



proc itemLeave { } {
    global restoreCmd

    eval $restoreCmd
}
#####################################################################




proc help { } {
    set w .help
    catch {destroy $w}
    toplevel $w
    wm geometry $w +10+10
    bind $w <Control-c> "destroy $w"
    frame $w.buttons
    pack $w.buttons -side bottom -fill x -pady 2 -expand 1 -padx 4
    button $w.buttons.dismiss -text Dismiss -command "destroy $w"
    pack $w.buttons.dismiss  -side left -fill x -expand 1 -padx 4

  text $w.t -background white -height 27 -wrap word\
            -xscrollcommand "$w.xscroll set" \
            -yscrollcommand "$w.yscroll set" \
            -setgrid 1 -highlightthickness 0 -pady 2 -padx 3
        scrollbar $w.xscroll -command "$w.t xview" \
            -highlightthickness 0 -orient horizontal
        scrollbar $w.yscroll -command "$w.t yview" \
            -highlightthickness 0 -orient vertical

pack $w.yscroll -side right -fill y
pack $w.xscroll -side bottom -fill x
pack $w.t -expand yes -fill both
global helptext
    $w.t insert 0.0 $helptext
}