#!/usr/local/bin/wish
#Arcs, a puzzle based on a Sam Loyd puzzle, by Felipe Voloch
#The objective is to place as many pieces as you can on a chess
#board with at most two pieces on any row, column or diagonal.
#You may start with an empty board or with some randomly placed pieces
#(by pressing random) or with some preassigned pieces (by placing them
#and pressing lock). By pressing anneal, the computer will try to find
#the maximum by simulated annealing (and usually succeeds). By pressing
#reveal, the computer reveals its solution.

button .reset -text "reset" -command Reset
button .random -text "random" -command Rand
button .bye -text "bye" -command "destroy ."
button .ann -text "anneal" -command Anneal
button .rev -text "reveal" -command Reveal
button .lo -text "lock" -command Lock
label .l -text "score:" 
entry .he -width 2 -textvariable "score"
entry .e -width 2 -textvariable "max"
set score 0
set max 0
grid .reset -row 9 -column 0 -columnspan 2
grid .random -row 9 -column 2 -columnspan 2
grid .l -row 8 -column 5 -columnspan 2
grid .he -row 8 -column 7
grid .lo -row 9 -column 4 -columnspan 2 
grid .bye -row 9 -column 6 -columnspan 2 
grid .ann -row 8 -column 0 -columnspan 2
grid .e -row 8 -column 2
grid .rev -row 8 -column 3 -columnspan 2

for {set i 0} {$i < 8} {incr i} {
for {set j 0} {$j < 8} {incr j} {
if {[expr ($i+$j)%2]} {
button .b$i$j -textvariable "b($i,$j)" -command "Do $i $j" -background yellow
} else {
button .b$i$j -textvariable "b($i,$j)" -command "Do $i $j" -background white
}
set b($i,$j) 0
set lo($i,$j) 0
grid .b$i$j -row $i -column $j
}}


proc Reset {} {
global b score lo max
for {set i 0} {$i < 8} {incr i} {
for {set j 0} {$j < 8} {incr j} {
set b($i,$j) 0
set lo($i,$j) 0
}}
set score 0
set max 0
}

proc Lock {} {
global b score lo
for {set i 0} {$i < 8} {incr i} {
for {set j 0} {$j < 8} {incr j} {
set lo($i,$j) $b($i,$j)
}}
} 
 
proc Rand {} {
global b score lo
set score 0
for {set i 0} {$i < 8} {incr i} {
for {set j 0} {$j < 8} {incr j} {
if {[expr rand()] < 0.05} {
Do $i $j
set lo($i,$j) 1
}}}}

proc Do {x y} {
global b score lo
if {$b($x,$y)==1 && $lo($x,$y)==0} {
set b($x,$y) 0
incr score -1
} else {
set hor 0
set ver 0
set dia 0
set ant 0
for {set i 0} {$i < 8} {incr i} {
set hor [expr {$hor + $b($i,$y)}]
set ver [expr {$ver + $b($x,$i)}]
}
set k [expr {$x + $y}]
if {$k < 8} {
for {set i 0} {$i <= $k} {incr i} {
set dia [expr {$dia + $b($i,[expr {$k-$i}])}]
}
} else {
for {set i [expr {$k-7}]} {$i <= [expr {15-$k}]} {incr i} {
set dia [expr {$dia + $b($i,[expr {$k-$i}])}]
}
}
set s [expr {$y-$x}]
if {$s > 0} {
for {set i 0} {$i <= [expr {7-$s}]} {incr i} {
set ant [expr {$ant + $b($i,[expr {$i+$s}])}]
}
} else {
for {set i 0} {$i <= [expr {7+$s}]} {incr i} {
set ant [expr {$ant + $b([expr {$i-$s}],$i)}]
}
}
if {$hor < 2 && $ver <2 && $dia <2 && $ant < 2} {
set b($x,$y) 1
incr score
}
}
}

proc Doc {x y} {
global c score2 lo max
if {$c($x,$y)==1 && $lo($x,$y)==0} {
set c($x,$y) 0
incr score2 -1
} else {
set hor 0
set ver 0
set dia 0
set ant 0
for {set i 0} {$i < 8} {incr i} {
set hor [expr {$hor + $c($i,$y)}]
set ver [expr {$ver + $c($x,$i)}]
}
set k [expr {$x + $y}]
if {$k < 8} {
for {set i 0} {$i <= $k} {incr i} {
set dia [expr {$dia + $c($i,[expr {$k-$i}])}]
}
} else {
for {set i [expr {$k-7}]} {$i <= [expr {15-$k}]} {incr i} {
set dia [expr {$dia + $c($i,[expr {$k-$i}])}]
}
}
set s [expr {$y-$x}]
if {$s > 0} {
for {set i 0} {$i <= [expr {7-$s}]} {incr i} {
set ant [expr {$ant + $c($i,[expr {$i+$s}])}]
}
} else {
for {set i 0} {$i <= [expr {7+$s}]} {incr i} {
set ant [expr {$ant + $c([expr {$i-$s}],$i)}]
}
}
if {$hor < 2 && $ver <2 && $dia <2 && $ant < 2} {
set c($x,$y) 1
incr score2
}
}
}

proc Anneal {} {
global c b score score2 max lo cmax
for {set i 0} {$i < 8} {incr i} {
for {set j 0} {$j < 8} {incr j} {
set c($i,$j) $b($i,$j) 
set cmax($i,$j) $b($i,$j) 
}}
set score2 $score
set max $score
for {set r 0} {$r < 10000} {incr r} {
set i [expr {int(8*rand())}]
set j [expr {int(8*rand())}]
if {$c($i,$j)==0 || [expr {rand()}] < 0.2} {
Doc $i $j
}
if {$score2 > $max} {
set max $score2
for {set i 0} {$i < 8} {incr i} {
for {set j 0} {$j < 8} {incr j} {
set cmax($i,$j) $c($i,$j) 
}}
}
}
}

proc Reveal {} {
global b cmax score max
for {set i 0} {$i < 8} {incr i} {
for {set j 0} {$j < 8} {incr j} {
set b($i,$j) $cmax($i,$j)
}}
set score $max
}