#!/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)&#124;&#124;($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
}
</div><div class="naked_ctrl">
<form action="/index.cgi/speech" method="get" name="gate">
<p><a href="http://altstyle.alfasado.net">AltStyle</a> によって変換されたページ <a href="http://www.inference.org.uk/mackay/itprnn/code/tcl/mine.tcl">(-&gt;オリジナル)</a>
/ <label>アドレス: <input type="text" name="naked_post_url" value="http://www.inference.org.uk/mackay/itprnn/code/tcl/mine.tcl" size="22" /></label> <label>モード: <select name="naked_post_mode">
<option value="default">デフォルト</option>
<option value="speech" selected="selected">音声ブラウザ</option>
<option value="ruby">ルビ付き</option>
<option value="contrast">配色反転</option>
<option value="larger-text">文字拡大</option>
<option value="mobile">モバイル</option>
</select>
<input type="submit" value="表示" />
</p>
</form>
</div>