#!/usr/local/bin/wish
#MOLS a puzzle whose aim is to construct a pair of
#mutually orthogonal latin squares of size n. That is,
#no two equal numbers or colors on a given line or column. Click on a
#card on the right and click where you want it to go to move it to the left
#Clicking on a card on the left returns it to the right. The space
#bar resets the game. Pressing a number key from 3-0 followed by the
#space bar will reset with that number for n (0 stands for 10).


set n 4

set mols {}


proc Check {a b c d} {
global n mols
set r 1
foreach entry $mols {
if {[lrange $entry 0 1] == "$a $b"} {
set r -1
break
}
if {[lrange $entry 2 3] == "$c $d"} {
set r 0
}
if {[lindex $entry 0] == $a && [lindex $entry 2] == $c} {
set r 0
}
if {[lindex $entry 0] == $a && [lindex $entry 3] == $d} {
set r 0
}
if {[lindex $entry 1] == $b && [lindex $entry 3] == $d} {
set r 0
}
if {[lindex $entry 1] == $b && [lindex $entry 2] == $c} {
set r 0
}
}
return $r
}
 
set colors {white yellow pink orange "sky blue" green purple grey red brown}
set card "0 0"

proc Reset {} {
global mols n colors
set mols {}
if {[winfo exists .f1]} {
destroy .f1
destroy .f2
destroy .fm
}
frame .f1 
frame .f2
frame .fm -width 20 -relief sunken
pack .f1 .fm .f2 -side left
for {set i 0} {$i < [expr {$n*$n}]} {incr i} {
button .f1.b$i -height 2 -width 2 -command "Do $i"
grid .f1.b$i -row [expr {$i/$n}] -column [expr {$i%$n}]
button .f2.c$i -height 2 -width 2 -command "Card $i"
.f2.c$i configure -text [expr $i/$n] -background [lindex $colors [expr $i%$n]]
grid .f2.c$i -row [expr {$i/$n}] -column [expr {$i%$n}]
}
}

proc Card {x} {
global card n
set card "[expr $x/$n] [expr $x%$n]"
}

proc Do {x} {
global card n colors mols
set ch [Check [expr $x/$n] [expr $x%$n] [lindex $card 0] [lindex $card 1]]
if {[.f1.b$x cget -text] == ""} {
if {$ch == 1} {
.f1.b$x configure -text [lindex $card 0] -background [lindex $colors [lindex $card 1]]
lappend mols "[expr $x/$n] [expr $x%$n] [lindex $card 0] [lindex $card 1]"
.f2.c[expr $n*[lindex $card 0] + [lindex $card 1]] configure -text "" -background grey
}
} else {
set ca "[.f1.b$x cget -text] [lsearch -exact $colors [.f1.b$x cget -background]]"  
.f2.c[expr $n*[lindex $ca 0] + [lindex $ca 1]] configure -text [lindex $ca 0] -background [lindex $colors [lindex $ca 1]]
.f1.b$x configure -text "" -background grey
set pos [lsearch -exact $mols "[expr $x/$n] [expr $x%$n] [lindex $ca 0] [lindex $ca 1]"]
set mols [lreplace $mols $pos $pos]
}
}

bind . <space> Reset
bind . <Key-0> "set n 10"
bind . <Key-6> "set n 6"
bind . <Key-7> "set n 7"
bind . <Key-8> "set n 8"
bind . <Key-9> "set n 9"
bind . <Key-3> "set n 3"
bind . <Key-4> "set n 4"
bind . <Key-5> "set n 5"

Reset