if 0 { The game of 'bridg-it'
computer AI from Martin Gardener ref.
models board as electrical circuit. Max voltage across resistance is computer's best move.
Ver 0.2 - minor improvement to handling window close - could leave  the . window running in 0.1/
}

  proc help {{op stdout}} {
	append all " Your aim is to complete a continuous line from top to bottom of the board -\n"
	append all " joining the blue dots.\n\n"
	append all " While the opponent aims to complete a continuous line from side to side,\n"
	append all " joining the red dots.\n\n"
	append all " Click to place a link between 2 blue dots.\n\n"
	append all " Choose a smaller or larger board with the spinbox number and 'Restart'.\n\n"
	append all " Once either of the players has succeeded, the other player cannot finish\n"
	append all " The game can only end in victory for one or other player - draw is impossible.\n\n"
	append all " Ref: Martin Gardner, Mathematical Puzzles and Diversions.\n"
	tk_messageBox -message $all
	puts $op $all
  }

# the artificial intelligence solves a linear set of equations, so load:.
  package require math::linearalgebra 
#
# cells
#	1	n+1	2n+2
#	2	n+2....
#	3	n+3...
#	4...
#
#
# resistances - n2 = n*(n-1) number of vertical resistances
#	0	n+1	2n+2
#	     n2	    n2+n
#	1	n+1....
#	     n2+1	    n2+n+1
#	2	n+2...
#	     n2+2	    n2+n+2
#	3...
#
# each cell forms a closed loop of resistances and has a current flowing round it
# the actual voltage across a reistance is R.(adjacent current-this current)..

  proc calccurr {brd nx} { ;# make the computer's move
	set nloops [expr {$nx*($nx-1)+1}]
	#puts "Computer moves for $nx size board - $nloops "
	# this has nx*(nx-1)+1 loops to be solved for.
	# we create a matrix and solve it
	set mt [math::linearalgebra::mkMatrix $nloops $nloops 0.0]
	set vc [math::linearalgebra::mkVector $nloops 0.]
	math::linearalgebra::setelem vc 0 1 ;# the driving voltage
	set i 0
	set rloop 0
	while {$i<$nx} { ;# consider first loop. rshared to 'lower' side only
		set iup [expr {$i*$nx}] ;# the shared resistor
		set iadj [expr {$i*($nx-1)+1}] ;# adjacent current loop
		set rloc [$brd getres $iup]
		set rloop [expr {$rloop+$rloc}]
		math::linearalgebra::setelem mt 0  $iadj -$rloc
		math::linearalgebra::setelem mt $iadj 0  -$rloc
		math::linearalgebra::setelem mt $iadj $iadj [expr {[math::linearalgebra::getelem $mt $iadj $iadj]+$rloc}]
		incr i
	}
	math::linearalgebra::setelem mt 0 0 $rloop
	set j 0
	set iloop 0
	while {$j<$nx-1} { ;# consider each loop row. Up sides already handled
		set i 0
		while {$i<$nx} { ;# consider each loop in row. Up side already handled
			set iup [expr {$i*$nx+$j+1}] ;# the shared resistor
			set ithis [expr {$i*($nx-1)+$j+1}] ;# the local current
			set iadj [expr {$i*($nx-1)+$j+2}] ;# adjacent current loop
			set rloc [$brd getres $iup]
			math::linearalgebra::setelem mt $ithis $ithis [expr {[math::linearalgebra::getelem $mt $ithis $ithis]+$rloc}]
			if {$j<$nx-2} { ;# there is nothing beneath nx-2.
				math::linearalgebra::setelem mt $iadj $iadj [expr {[math::linearalgebra::getelem $mt $iadj $iadj]+$rloc}]
				math::linearalgebra::setelem mt $ithis $iadj -$rloc
				math::linearalgebra::setelem mt $iadj $ithis -$rloc
			}
			if {$i<$nx-1} {
				set iup [expr {$nx*$nx+$i*($nx-1)+$j }] ;# the shared resistor
				set iadj [expr {$ithis+($nx-1)}] ;# adjacent current loop
				set rloc [$brd getres $iup]
	# then cover right except at end of row
				math::linearalgebra::setelem mt $ithis $ithis [expr {[math::linearalgebra::getelem $mt $ithis $ithis]+$rloc}]
				math::linearalgebra::setelem mt $iadj $iadj [expr {[math::linearalgebra::getelem $mt $iadj $iadj]+$rloc}]
				math::linearalgebra::setelem mt $ithis $iadj -$rloc
				math::linearalgebra::setelem mt $iadj $ithis -$rloc
			}
			incr i
			incr iloop
		}
		incr j
	}
	set currs [ math::linearalgebra::solveGauss $mt $vc ]
	#now find voltage across each resistor - the biggest is the BEST computer move.	
	set imax -1
	set vmax 0
	for {set i 0} {$i<$nx*$nx+($nx-1)*($nx-1)} { incr i} {
		if {[$brd getres $i]==1} { ;# not yet cut or shorted.
	# find shared currents. Difference is the voltage
			if {$i<$nx*$nx} { ;# a horizontal resistor
				set ix [expr {$i/$nx}]
				set jx [expr {$i%$nx}]
				set iup [expr {$jx==0?0:($i-$ix)}]
				set idn [expr {$jx>$nx-2?-1:$i-$ix+1}]
				set v [expr {$idn>0?[lindex $currs $iup]-[lindex $currs $idn]:[lindex $currs $iup]}]
			} else { ;# vert resist.
				set iii [expr {$i-$nx*$nx}] ;# which ij
				set ix [expr {$iii/($nx-1)}]
				set jx [expr {$iii%($nx-1)}]
				set iup [expr {$ix*($nx-1)+$jx+1}]
				set idn [expr {$iup+$nx-1}]
				set v [expr {[lindex $currs $iup]-[lindex $currs $idn]}]
			}
			if {abs($v)>abs($vmax)} {
				set vmax $v
				set imax $i
			} 
		}
	}
	return [list $imax [lindex $currs 0]]
  }

  proc bridgit {w args} { ;# a game of bridgit, toplevel for the board
	# and allows new smooth shaped buttons.
	global $w.props ;# an array of options specific to the bridgit game 'class' 
	global $w.res ;# an array of resistors for the computer move 
		# set by .this -<option> <value>
	array set $w.props {-size 7 -spacing 50} ;	# define the option list and each default value
	array set options {}
	set bridArgs {} ;# list of arguments not specific to the class
	foreach {opt val} $args {
		if {[array names $w.props $opt]!=""} {set options($opt) $val
		} else { lappend bridArgs $opt $val }
	}

	# make the base canvas.
	eval toplevel $w $bridArgs ;# create the "procedure" w

	bind $w <Destroy> "$w destroy %W"
	interp hide {} $w
	# Install the alias:
	interp alias {} $w {} bridgitCmd $w ;# bridgitsCmd are sub-commands for this class
	foreach opt [array names options] {
		$w configure $opt $options($opt)
	}
	$w makeboard
	wm withdraw .
 	return $w ;# the original object
  }
  proc bridgitCmd {self cmd args} {
#	puts "$self bridgitCmd $cmd args $args"
 	switch -- $cmd {
		configure {eval bridgitConfigure $self $cmd $args}
		cget {eval bridgitCget $self $args}

		{about} {return [help]  ;# return unit value
		}
		{size} {return [$self cget -size]  ;# return unit value
		}
		{destroy} { ;# all destroy events come here - check that we are destroying the lowest level window.
			if {$self==[lindex $args 0]} {
				#tk_messageBox -message "$self is being destroyed $args<<\n[info level ]"
				exit
			}
		}
 		{getid} {	set x [lindex $args 0]
			set y [lindex $args 1]
			set nx [lindex $args 2] ;# which move has been made
			# returns 0,nx-1 for first column of player moves; nx-2nx-1 for second
			#>nx*nx for a horizontal move
			# -1 for an invalid move.
			set spacing [$self cget -spacing]
			set ix [expr {($x-$spacing/2)/$spacing}]
			set iy [expr { $y/$spacing }]
			set nc [expr {$nx*$nx}] ;# numbero fo vertical moves available to the player.
			# identify side (top, bottom, L, R)
			set ixrel [expr {($x-$spacing*$ix-$spacing/2)}]
			set iyrel [expr {($y-($spacing*$iy))}]
			if {$ix>=-1 && $ix<$nx} {
				if {$iy>=0 && $iy<$nx} {
					if {abs($ixrel-$spacing/2)>abs($iyrel-$spacing/2)} {
						if {$ixrel<$spacing/2} { set sid "L" } else { set sid "R" }
					} else {
						if {$iyrel<$spacing/2} { set sid "T" } else { set sid "B" }
					}
					switch $sid {
					"L" {
						if {$ix>$nx} {return -1} ;# invalid cell
						if {$ix<0} {return -2} ;# invalid cell
 						return [expr {$ix*$nx+$iy}] 
					}
					"R" {
						if {$ix<-1} {return -1} ;# invalid cell
						if {$ix>$nx-1} {return -2} ;# invalid cell
						return [expr {($ix+1)*$nx+$iy}]
					}
					"T" {
						if {$ix>=($nx-1)} {return -1} ;# invalid cell
						if { $ix<0 } {return -2} ;# invalid cell
						if {$iy<1} {return -3} ;# invalid cell
						return [expr {$nx*$nx+$ix*($nx-1)+$iy-1}] 
					}
					"B" {
						if {$ix>=($nx-1)} {return -1} ;# invalid cell
						if { $ix<0} {return -2} ;# invalid cell
						if {$iy>($nx-2)} {return -2} ;# invalid cell
						return [expr {$nx*$nx+$ix*($nx-1)+$iy}] 
					}
					}
				}
			}
			return -1
  		}

		{getcut} { return [eval $self getid $args] }
		{makemove} {
			set ishort [lindex $args 0] ;# the resistor being cut.
			set nx [$self cget -size]
			set spac [$self cget -spacing]
			if {$ishort<$nx*$nx} { ;# H- move
				set ix [expr {int($ishort/$nx)}]
				set iy [expr {int($ishort%$nx)}]
		 		$self.froth.board create line [expr {$ix*$spac}] [expr {($iy+.5)*$spac}] \
					[expr {($ix+1)*$spac}] [expr {($iy+.5)*$spac}] -fill red -width 3

			} else {
				set nrel [expr {$ishort-$nx*$nx}] ;# id relative to start of horizontal res.
				set ix [expr {int($nrel/($nx-1))}]
				set iy [expr {int($nrel%($nx-1))}]
		 		$self.froth.board create line [expr {($ix+1)*$spac}] [expr {($iy+.5)*$spac}] \
			[expr {($ix+1)*$spac}] [expr {($iy+1.5)*$spac}] -fill red -width 3
			}
		}
		{setres} { 
			global $self.props
			set $self.props(res[lindex $args 0]) [lindex $args 1]
		 }
		{getres} { 
			return [$self cget res[lindex $args 0] ]
		 }

		{makeresists} {
			set n [$self cget -size]
	# the algorithm depends on shorting out or cutting a set of resistors.
	# each resistor represents a possible computer's move. 
	# A player's move cuts the resistor; the computer move at same place shorts out the resistor.
			for {set i 0} {$i<$n*$n+($n-1)*($n-1)} { incr i} {
				$self setres $i 1
			}
		}
		{makeboard} { ;# puts "$self makeboard -- $cmd $args"; 
			set n [$self cget -size]
			# insert symbols into a canvas.
			set spacing [$self cget -spacing]
			catch {destroy $self.froth}
			set frm [frame $self.froth] 
			pack [canvas $frm.board -height [expr {$spacing*$n+10}] -width [expr {$spacing*$n+10}]] -padx 10 -pady 10
			bind $frm.board <ButtonPress-1> "$self click %x %y $n"
			bind $frm.board <Motion> "$self setcursor %x %y"
			set i 0
			while {$i<=$n} {
				set x [expr {$spacing*$i}]
				set j 0
				while {$j<$n} {
					set y [expr {$spacing*($j+.5)}]
					$frm.board create oval $x $y [expr {$x+5}] [expr {$y+5}] -fill red
					incr j
				}
				incr i
			}
			set i 0
			while {$i<$n} {
				set x [expr {$spacing*($i+0.5)}]
				set j 0
				while {$j<=$n} {
					set y [expr {$spacing*$j}]
					$frm.board create oval $x $y [expr {$x+5}] [expr {$y+5}] -fill blue
					incr j
				}
				incr i
			}
			set ::ival "Your move."
			pack [label $frm.mesg -textvariable ::ival] -padx 10 -pady 4 
			pack [frame $frm.butts] -padx 2 -pady 4
			pack [ button $frm.rest -text "Restart" -command "$self makeboard "] -padx 10 -pady 1 -side left
			pack [ spinbox $frm.setsiz -from 3 -to 18 -command "$self configure -size %s"] -padx 10 -pady 1 -side left
			$frm.setsiz set [$self cget -size]
			pack [ button $frm.aboutt -text "About..." -command "$self about"] -padx 10 -pady 4 -side left
			pack [ button $frm.exit -text "Exit" -command "exit 1"] -padx 10 -pady 4 -side right
			pack $frm 
  
			$self makeresists [$self cget -size]
			return 
		}
		{setwin} {
			set ::ival "[lindex $args 0] Wins"
			switch [lindex $args 0] {
				{Boris} {	$self.froth.board configure -background green }
				default {	$self.froth.board configure -background cyan }
			}
		}
		{setcursor} {
			set nx [$self cget -size]
			set icut [$self getcut [lindex $args 0] [lindex $args 1] $nx]
			if {$icut<$nx*$nx} { $self.froth.board configure -cursor sb_v_double_arrow
			} else { $self.froth.board configure -cursor sb_h_double_arrow }
		}
		{click} {
			set x [lindex $args 0]
			set y [lindex $args 1]
			set nx [lindex $args 2] ;# xy are relative to the board (not window).
			# identify nearest dot pair
			# $self.froth.board the game frame x,y are relative to $self.froth.board.
			set i1 [$self getid $x $y $nx]
			set icut [$self getcut $x $y $nx ]
			if {$icut<$nx*$nx} { set horv "v"} else { set horv "h"}
			if {$icut>=0} {
				if {[$self getres $icut]==1} {
					$self playerscut $horv $icut $nx
					$self setres $icut 1.e8 ;# my move - cuts out resistor
					# computer move shorts the resistor
					set ::ival "OK.."; update idletasks
					$self computermove $nx ;# calculate response
				} else { set ::ival "Already used" }
			} else {
				set ::ival "Invalid Move $icut"; update idletasks
			}
		}
		{computermove} {
			set nx [lindex $args 0] ;# make the computer's move
			set res [ calccurr $self $nx]
			set imax [lindex $res 0]
			$self setres $imax 1.e-8
			$self makemove $imax
			set res [ calccurr $self $nx] ;# recalculate the current to check if computer has won.
			set curmax [expr {abs([lindex $res 1])}]
			if {$curmax<1.e-3} {
				$self setwin "You"
			} elseif {$curmax>1.e3} { 
				$self setwin "Boris"
			} else {
				set ::ival "Your move"
		#puts "Best current is $curmax"
			}
		}
		{playerscut} {
			set horv [lindex $args 0]
			set nres [lindex $args 1]; set nx [lindex $args 2]
			set spac [$self cget -spacing]
			set ix [expr {int($nres/$nx)}]
			set iy [expr {int($nres%$nx)}]
			if {$horv=="v"} {
				set ix [expr {int($nres/$nx)}]
				set iy [expr {int($nres%$nx)}]
				$self.froth.board create line [expr {($ix+.5)*$spac}] [expr {$iy*$spac}] \
					[expr {($ix+.5)*$spac}] [expr {($iy+1)*$spac}] -fill blue -width 3
			} else { ;# a horizontal move 
				set nrel [expr {$nres-$nx*$nx}] ;# id relative to start of horizontal res.
				set ix [expr {int($nrel/($nx-1))}]
				set iy [expr {int($nrel%($nx-1)+1)}]
		 		$self.froth.board create line [expr {($ix+0.5)*$spac}] [expr {$iy*$spac}] \
					[expr {($ix+1.5)*$spac}] [expr {$iy*$spac}] -fill blue -width 3
			}
		}

		{default} { ;# use $cmd to canvas widget 
		#	puts "Action $cmd $args"
			eval interp invokehidden {{}} $self $cmd $args
		}
	}
  }
  proc bridgitConfigure {self cmd args} {
	# 3 scenarios:
	#
	# $args is empty       -> return all options with their values
	# $args is one element -> return current values
	# $args is 2+ elements -> configure the options
	global $self.props
	switch [llength $args] {
		0 { ;# return all options 
			set result [array names $self.props]

			return $result
		}
		1 { ;# return argument values
			if {[array names $w.props $opt]!=""} { lappend opts [$self cget $args] 
			} else { puts "No option $opt" }
			return $opts
		}
		default { ;# >1 arg - an option and its value
				# go through each option:
			foreach {option value} [lrange $args 0 end] {
				if {[array names $self.props $option]!=""} {
					# set global array element for each option. 
					set $self.props($option) $value
				} else {
					$self configure $option $value
				}
			}
			return {}
		}
	}
  }
   proc bridgitCget {self args} {
	# cget defaults done by the interp cget command
	upvar #0 $self.props props ;# get local address for global array
	#puts "$self get $args [array names props]"
	if {[array names props $args ]!=""} {
		#puts "CGoth $self $args; $props($args)"
		return $props($args)
	}
	return [uplevel 1 [list interp invokehidden {} $self cget $args]]
  }
  #console show
  update idletasks
  catch { destroy .game}
  set bif [bridgit .game -size 9 -spacing 45]

----
[Category Games]