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

# sub.tcl
# Plays the boring battleship game 'submarine'
# and tells you the information content of the answers you get.
# motivation: to show that log(1/p) is a reasonable measure of info gained.
# see also subs.tcl

# search HERE for size adjustment 

frame .sub
wm geometry . +10+10
pack  .sub
set w .sub
set top .
wm title . "Submarine"
wm iconname . "tsp"
wm geometry . +10+10

bind . <Control-C> {destroy .}
bind . <Control-c> {destroy .}
set colone [frame .sub.colone]
set rightcol [frame .sub.rightcol]
pack $rightcol -in $colone -side right -padx 2 -pady 2
set rightcolmid [frame .sub.rightcolmid]
set control [frame .sub.control]
set toprow [frame .sub.toprow]
set tworow [frame .sub.rightcol.tworow]
set threerow [frame .sub.fourrow]
set fourrow [frame .sub.threerow]
set fiverow [frame .sub.fiverow]
pack $control  $threerow $toprow -side top  -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 Dismiss -command "destroy $top"
pack $w.buttons.dismiss  -side left -expand 1

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

# 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
set state(2) "red"
set state(1) "lightgreen"
set state(0) "blue3"

# adjustableInteger $control $control "si" size size
global size ; set size 8
# size = size of ocean , in squares
global I  ; set I [expr $size*$size] ;# number of locations
# adjustableInteger $control $control "su" totsubs totsubs
global totsubs ; set totsubs 1
# initial number of subs
global subsleft 
global squaresleft 
global subii

proc randomize {c} {
    global subsleft squaresleft
    global totsubs I
    global subx suby
    global subii result
    global xn Info megatext megatext2 megatext3
    set result ""
    set subsleft $totsubs
    set squaresleft $I
    set subii [expr (int(rand()*$I)+1  )] 
    for { set ii 1 } { $ii <= $I } { incr ii } {
	set xn($ii) 0 
	$c  itemconfig  nd$ii -outline green1
	$c  itemconfig  nd$ii -fill Blue3
	
    }
    set Info 0.0
    $megatext insert end "\n\n"
    $megatext2 insert end "\n\n"
    $megatext3 insert end "\n\n"
}

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
}


set command "pack "
# set font "Helvetica 14 bold"
set scrolllist ""
# widths of text panels
# HERE for size adjustment . was 32,20,20. jan 2000: was 25,16,16, with font size 12 below
set mwidth(megatext)  32
set mwidth(megatext2) 22
set mwidth(megatext3) 22
foreach i {megatext megatext2 megatext3 } { 
    frame $w.$i
    set s $w.$i
    text $s.text -width $mwidth($i) -height 16 -yscrollcommand "\$scroll set" -wrap none -background white -insertofftime 0
    pack $s.text -side left
    append scrolllist "set com \"$s.text yview \$args\";  eval \$com ; "
    append command " \$w.$i"
# HERE for size adjustment . was 8,12,14,24 (14 for large)
#    $s.text tag configure small -font {Courier 8}
#    $s.text tag configure bold -font {Courier 12 bold italic}
    $s.text tag configure large -font {Courier 18 bold}
#    $s.text tag configure verybig -font {Helvetica 24 bold}
    $s.text tag configure colory -foreground red
    $s.text tag configure color2 -foreground red
    $s.text tag configure color3 -foreground blue3
    $s.text tag configure colorn -foreground green4
    eval "set $i $s.text"
 }
set scroll [    scrollbar $w.scroll -command "slideme" ]
#puts $scroll
#puts $scrolllist
#puts "proc slideme {arg1 arg2} {$scrolllist}"
eval "proc slideme {args} {$scrolllist}"

# finish off the pack
append command " $scroll -in $rightcolmid  -side left -fill y"
eval $command

# probability widths
set pwidth 8
# entropy label width
set ewidth 8 
global Info ; set Info 0.0
global result ; set result ""
global Infos ; set Infos ""
label $w.subl -width 12 -justify left -text "Unhit subs:" -background pink1 -anchor nw  -font $font
label $w.spacer -width 2 -text ""
label $w.subiil -width 17 -justify left -text "Sub's secret:" -background red1 -anchor nw  -font $fonttiny
frame $w.entropyf
label $w.entropyl -width $ewidth -justify left -text "Entropy:" -background yellow1 -anchor nw  -font $font
label $w.pl -width 14 -justify left -text "Probabilities:" -background yellow1 -anchor nw  -font $font
label $w.infol -width 20 -justify left -text "Information learnt:" -background skyblue1 -anchor nw  -font $font
label $w.info -width $ewidth -justify left -text "" -textvariable Info -background white -anchor nw  -font $font  -foreground blue3
label $w.resultl -width 15 -justify left -text "Latest outcome:" -background yellow -anchor nw  -font $font
label $w.result -width 2 -text "" -textvariable result -background white -anchor nw  -font $font
label $w.title -width 24 -text "Submarine" -background Blue4 -foreground lightblue1 -font "Helvetica 32"
pack [button $w.control.restart -text "Restart" -command "randomize \$c"] -side left
pack $w.title -in $control -side left  -padx 2 -pady 2

global Entropy ; set Entropy ""
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 green1 -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 green1 -anchor nw  -font $font
label $w.pyt -width $pwidth -justify left -text "P(y):" -background pink1 -anchor nw  -font $font  
label $w.pnt -width $pwidth -justify left -text "P(n):" -background green1 -anchor nw  -font $font  
pack $w.pyt $w.pyr $w.py -in $w.pyf -side top
pack $w.pnt $w.pnr $w.pn -in $w.pnf -side top
label $w.subsleft -width 2 -justify left -text "" -textvariable subsleft -background pink1 -anchor nw  -font $font
label $w.subii -width 5 -justify left -text "" -textvariable subii -background pink1 -anchor nw  -font $fonttiny
label $w.sql -width 14 -justify left -text "Unhit squares:" -background skyblue1 -anchor nw  -font $font
label $w.squaresleft -width 3 -justify left -text "" -textvariable squaresleft -background skyblue1 -anchor nw  -font $font
label $w.entropy -width $ewidth -justify left -text "" -textvariable Entropy -background yellow1 -anchor nw  -font $font
pack  $w.infol $w.info -in $tworow -side left
pack  $w.resultl $w.result -in $fourrow -side left
pack  $w.subii $w.subiil -in $fiverow -side right
# info learnt:
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.subl $w.subsleft $w.spacer $w.sql $w.squaresleft  -in $threerow -side left -fill both
# probability and entropy frames: 
pack $w.pl $w.pyf $w.pnf $w.entropyf -in $toprow -side left  -padx 2 -pady 2
# pack entropy frame contents: 
pack $w.entropyl $w.entropy -in $w.entropyf -side top



###################################
#
#   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
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 topy 0
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 Blue3 -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
	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"
$c bind node <Any-Enter> "enterNode $c"
$c bind node <B1-Enter> "enterNode $c; hitNode $c"
$c bind node <Shift-Enter> "enterNode $c; hitNode $c"
$c bind node <Control-Enter> "enterNode $c; hitNode $c"
$c bind node <Any-Leave> "itemLeave"

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


# on entering a node, compute the probability 
# which is (0,1) if asked(ii)
# and is (subsleft/squaresleft) otherwise
proc enterNode {c} {
    global restoreCmd 
    global subii xn subsleft squaresleft
    global Entropy py pn
    $c  itemconfig current -outline yellow2
#    $c  itemconfig current -fill skyblue2
# find weights that use this distance
    set nowthen [$c gettags current]
#    puts $nowthen
    set myn [lindex $nowthen [lsearch -regexp $nowthen nd]]
    regsub  "nd" $myn "" ii
#    puts $ii
    setpypn $ii
    set restoreCmd "global Entropy; set Entropy {}; global py; set py {}; global pn; set pn {}; global pry; set pry {}; global prn; set prn {}; $c itemconfig current -outline green;  "
}

proc setpypn {ii} {
    global xn Entropy py pn subsleft squaresleft pry prn
    if {[set xn($ii)]} {
	if { $xn($ii)==2 } {
	    set py  1.0 
	    set pry " 1/1 "
	} else {
	    set py 0.0
	    set prn " 1/1 "
	    set pry " 0/1 "
	}
    } else {
	set py [expr ($subsleft*1.0/$squaresleft)] 
	set pry "$subsleft/$squaresleft"
	set emptyleft [expr ($squaresleft-$subsleft)]
	set prn "$emptyleft/$squaresleft"
    }
    set pn [expr (1.0 - $py)] 
    set Entropy [entropy $py]
#     puts  $Entropy
}

proc hitNode {c} {
    global restoreCmd 
    global state xn py pn pry prn
    global megatext3 megatext2 megatext subii subsleft squaresleft
    global Info result
    set nowthen [$c gettags current]
    set myn [lindex $nowthen [lsearch -regexp $nowthen nd]]
    regsub  "nd" $myn "" ii
    puts "$ii"
    setpypn $ii
    if {[set xn($ii)]} {
#	puts "already been here" 
    } else {
	incr squaresleft -1
	if { $subii==$ii } {
	    incr subsleft -1
	    set xn($ii) 2
	} else {
	    set xn($ii) 1
	}
    }
    if { $subii==$ii } {
	set result  y 
    } else {
	set result  n
    }
    $c  itemconfig current -fill $state($xn($ii))
    $megatext insert end "\n"
    $megatext2 insert end "\n"
    $megatext3 insert end "\n"
    set thisp [set p$result]
# the float number ^^
    set thispr [set pr$result]
# the ratio ^^^^^^
    if {$thisp>=1.0} {
	set thish "0"
    } else {
	set thish [expr (-log($thisp)/log(2.0))]
    }
    set thisps [string range $thisp 0 5]
    set thishs [string range $thish 0 5]
    set Info [expr ($Info+$thish)]
    set Infos  [string range $Info 0 6]
    set junk "P($result): $thispr = $thisps"
    $megatext insert end $junk "large color$result"
    $megatext yview end
    set junk "h($result): $thishs"
    $megatext2 insert end $junk "large color$result"
    $megatext2 yview end
    set junk "hTOT: $Infos" 
    $megatext3 insert end $junk {large color3}
    $megatext3 yview end

# need to do this in order to get py and pn reset.
    enterNode $c
}

proc find_energy { ii } {
# this assumes the energy is right and just works out the change
    if {1} {
	set Happy "stable"
    } else {
	set Happy "unstable"
    }
}


proc itemLeave { } {
    global restoreCmd

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