#!/usr/bin/wish
##
## SCRIPT: sudoku.tk
##
## Sudoku 0.7.1 by David Easton, 2005
## with user interaction changes by Aldo Buratti
##
## This Buratti-version was downloaded in 2013 August from
## https://irrational-numbers.googlecode.com/files/sudoku-0.7.1.zip
## which is the link that Buratti placed on the wiki page
## http://wiki.tcl.tk/13272 - 'Sudoku'.
##
## Four '.tcl' files were merged into one script by B. Montandon 2013aug02.
## The 10 GIF files that are referenced below can be found on the
## wiki.tcl.tk/13272 page. Download them into an 'images' subdirectory
## of the directory where this script was downloaded.

namespace eval sudoku {
    
    variable S
    set S(preDone) 0
    set S(afterIds) [list]

     # some constants
    set S(fixedNumberColor)  black
    set S(userNumberColor)   darkgrey
    set S(smallNumberColor)  grey

    set S(wheelFgColor)      darkblue
    set S(wheelBgColor)      white

    set S(normalCellBg)   white
    set S(errorCellBg)    red
    set S(selectedCellBg) grey90

    set S(gridLinesColor) black
}

# Generating an image of the puzzle

proc sudoku::generatePuzzleImage {} {

    variable S

    set puzImg [image create photo]

    # Copy the blank grid
    $puzImg copy $S(img,grid) -shrink

    # Add numbers as appropriate
    foreach col [list 1 2 3 4 5 6 7 8 9] {
        foreach row [list 1 2 3 4 5 6 7 8 9] {
            set val [getVal $col $row]
            if {$val >= 1 && $val <= 9} {
            
                set x [expr {$col * 25 - 18}]
                set y [expr {$row * 25 - 19}]

                $puzImg copy $S(img,$val) -to $x $y
            }
        }
    }

    return $puzImg
}

proc sudoku::saveImage {} {

    variable S

    set types {{"Image Files" {.gif}}}
    
    set filename [tk_getSaveFile -filetypes $types \
            -initialfile sudoku.gif \
            -defaultextension .gif \
            -parent $S(w:top)]
    
    if { $filename != {} } {    
        set image [generatePuzzleImage]
        $image write -format gif $filename
        image delete $image
    }
}

# Pencil marks

proc sudoku::clearPen {row col} {
    
    variable S
    $S(w:c) itemconfigure $S(idp1:$row,$col) -text ""
    $S(w:c) itemconfigure $S(idp2:$row,$col) -text ""
}

proc sudoku::getPen {row col} {
    
    variable S
    set p1 [$S(w:c) itemcget $S(idp1:$row,$col) -text]
    set p2 [$S(w:c) itemcget $S(idp2:$row,$col) -text]
    
    return [split "$p1$p2" ""]
}

proc sudoku::setPen {row col penList} {
    
    variable S
    set penList [lsort $penList]
    $S(w:c) itemconfigure $S(idp1:$row,$col) -text [join [lrange $penList 0 2] ""]
    $S(w:c) itemconfigure $S(idp2:$row,$col) -text [join [lrange $penList 3 5] ""]
}

proc sudoku::togPen {row col num} {
    
    variable S
    
    if { $num < 1 || $num > 9 } {
        return
    }
    
    set penList [getPen $row $col]
    
    if {[set i [lsearch $penList $num]] == -1} {
        lappend penList $num
    } else {
        set penList [lreplace $penList $i $i]
    }
    setPen $row $col $penList
}

# Sudoku Generation

proc sudoku::choose {list} {
    return [lindex $list [expr {int(rand() * [llength $list])}]]
}

# Merge puzzle and mask
proc sudoku::merge {p m} {

    set l [list]
    foreach yp $p ym $m {
        set yl [list]
        foreach ep $yp em $ym {
            if {$em} {
                lappend yl $ep
            } else {
                lappend yl " "
            }
        }
        lappend l $yl
    }
    return $l
}

# Used to generate a puzzle in advance for faster
# response when generate button is clicked
proc sudoku::bgGen {args} {
    variable S
    
    foreach afterId $S(afterIds) {
        catch {after cancel $afterId}
    }
    set S(afterIds) [list]
   
    if {$S(preDone) == 0} {

        # First make a finished puzzle
        set p [sudoku-create::start]
        
        # Now make a mask (use value of 30 for hard, 36 for easy)
        
        switch $S(level) {
            "Easy" {
                set min 34
                set max 36
            }
            "Medium" {
                set min 30
                set max 34
            }
            "Hard" {
                set min 26
                set max 32
            }
            default {
                set min 24
                set max 36
            }
        }
        
        set m [sudoku-mask::generate $p $min]
        set solvable 0
        
        while {$solvable == 0} {
            # Apply the mask
            set l [merge $p $m]
            
            # See if it is solveable
            foreach {res solveList} [sudoku-solve::solve $l] {break}
            
            if { $res } {
                set solvable 1
            } else {
                
                set maxlen 1
                set sqList [list]
                foreach row $solveList x [list 1 2 3 4 5 6 7 8 9] {
                    foreach entry $row y [list 1 2 3 4 5 6 7 8 9] {
                        set len [llength $entry]
                        if {$len > $maxlen} {
                            set maxlen $len
                            set sqList [list $y,$x]
                        } elseif {$len == $maxlen} {
                            lappend sqList $y,$x
                        }
                    }
                }
                #puts $sqList
                set sq [choose $sqList]
                
                #puts "Chose $sq from $sqList"
                
                set m [sudoku-mask::easier $sq]
                
                if { [sudoku-mask::numvis] > $max } {
                    break
                }
            }
        }
        
        if {$solvable == 1} {
            set S(preDone) 1
            set S(prePuz) $l
        } else {
            lappend S(afterIds) [after 200 sudoku::bgGen]
            update
        }
    }
}

proc sudoku::generate {} {

    variable S

    set count 1    
    clear
    
    $S(w:top) configure -cursor watch
    update
    
    # Use prebuilt puzzle if one is ready
    if {$S(preDone) == 1} {
        
        set l $S(prePuz)
        
    } else {
    
        # First make a finished puzzle
        set p [sudoku-create::start]
        
        # Now make a mask (use value of 30 for hard, 36 for easy)
        
        switch $S(level) {
            "Easy" {
                set min 34
                set max 36
            }
            "Medium" {
                set min 30
                set max 34
            }
            "Hard" {
                set min 26
                set max 32
            }
            default {
                set min 24
                set max 36
            }
        }
    
        set m [sudoku-mask::generate $p $min]
        set solvable 0
        
        while {$solvable == 0} {
            # Apply the mask
            set l [merge $p $m]
            #fromList $l
     
            # See if it is solveable
            foreach {res solveList} [sudoku-solve::solve $l] {break}
    
            if { $res } {
                set solvable 1
            } else {

                set maxlen 1
                set sqList [list]
                foreach row $solveList x [list 1 2 3 4 5 6 7 8 9] {
                    foreach entry $row y [list 1 2 3 4 5 6 7 8 9] {
                        set len [llength $entry]
                        if {$len > $maxlen} {
                            set maxlen $len
                            set sqList [list $y,$x]
                        } elseif {$len == $maxlen} {
                            lappend sqList $y,$x
                        }
                    }
                }
                #puts $sqList
                set sq [choose $sqList]
                
                #puts "Chose $sq from $sqList"
                
                set m [sudoku-mask::easier $sq]
                
                if { [sudoku-mask::numvis] > $max } {
                    set p [sudoku-create::start]
                    set m [sudoku-mask::generate $p $min]
                }
                
                #puts "NUMBER VISIBLE = [sudoku-mask::numvis]"
                
                incr count
            }
            #update
        }
    }
    fromList $l
    #puts "$count attempts"
    #puts "NUMBER VISIBLE = [sudoku-mask::numvis]"
            
    colour
    
    # Now make a new one in the background
    set S(preDone) 0
    $S(w:top) configure -cursor arrow
    
    lappend S(afterIds) [after 500 sudoku::bgGen]
}

proc sudoku::colour {} {
    
    variable S
    
    set S(fixedList) [list]
    foreach col [list 1 2 3 4 5 6 7 8 9] {
        foreach row [list 1 2 3 4 5 6 7 8 9] {
            set val [getVal $col $row]
            if {$val == " "} {
                $S(w:c) itemconfigure $S(idt:$col,$row) -fill $S(userNumberColor)
            } else {
                lappend S(fixedList) "$col,$row"
            }
        }
    }
}

proc sudoku::solve {} {
    
    variable S
    
    set l [toList]
    colour
    foreach {res solution} [sudoku-solve::solve $l] {break}
    fromList $solution
}

# Clearing

proc sudoku::clear {} {
    
    variable S

    set S(fixedList) [list]
    foreach col [list 1 2 3 4 5 6 7 8 9] {
        foreach row [list 1 2 3 4 5 6 7 8 9] {
            setVal $col $row " "
            $S(w:c) itemconfigure $S(idt:$col,$row) -fill $S(fixedNumberColor)
            clearPen $col $row
        }
    }
    check
}

proc sudoku::checkSquare {col row} {
    
    variable S
    set val [getVal $col $row]
    
    set ok true
    
    if { $val >= 1 && $val <= 9 } {
        
        # Check row
        foreach nc [list 1 2 3 4 5 6 7 8 9] {
            if {$nc == $col} {continue}
            if {$val == [getVal $nc $row]} {
                set ok false
            }
        }
        
        # Check column
        foreach nr [list 1 2 3 4 5 6 7 8 9] {
            if {$nr == $row} {continue}
            if {$val == [getVal $col $nr]} {
                set ok false
            }
        }
        
        # Check box
        foreach rowList {{1 2 3} {4 5 6} {7 8 9}} {
            if {[lsearch $rowList $row] != -1} {break}
        }
        foreach colList {{1 2 3} {4 5 6} {7 8 9}} {
            if {[lsearch $colList $col] != -1} {break}
        }
        
        foreach nc $colList {
            foreach nr $rowList {
                if {$nc == $col && $nr == $row} {continue}
                if {$val == [getVal $nc $nr]} {
                    set ok false
                }
            }
        }
    }
    
    if {$ok} {
        $S(w:c) itemconfigure $S(idr:$col,$row) -fill $S(normalCellBg)
    } else {
        $S(w:c) itemconfigure $S(idr:$col,$row) -fill $S(errorCellBg)
    }
    return $ok
}

proc sudoku::check {} {
    
    variable S
    
    # Check each row
    foreach row [list 1 2 3 4 5 6 7 8 9] {
        foreach col [list 1 2 3 4 5 6 7 8 9] {
            checkSquare $col $row       
        }      
    }
     #after checking, the current cell is cleared
    set S(currR) -1
    set S(currC) -1

}

# Clicking etc.

proc sudoku::getVal {col row} {
    variable S
    return $S(v:$col,$row)
}

proc sudoku::setVal {col row val} {
    variable S
    set S(v:$col,$row) $val
    $S(w:c) itemconfigure $S(idt:$col,$row) -text $S(v:$col,$row)
}

proc sudoku::clickLeft {col row} {
    
    variable S
     ## if it is not a fixed cell
    if {[lsearch $S(fixedList) "$col,$row"] == -1} {
        if { $S(currR) != -1 } {
           $S(w:c) itemconfigure $S(idr:$S(currC),$S(currR)) -fill $S(normalCellBg)
           checkSquare $S(currC) $S(currR)        
        }


        set S(currR) $row
        set S(currC) $col
           
        wheel-moveto $col $row         
        wheel-open 5 38
        after 1
        $S(w:c) itemconfigure $S(idr:$S(currC),$S(currR)) -fill $S(selectedCellBg)
    }
}


# Utility functions

proc sudoku::toList {} {
    
    set l [list]
    foreach col [list 1 2 3 4 5 6 7 8 9] {
        set lc [list]
        foreach row [list 1 2 3 4 5 6 7 8 9] {
            lappend lc [getVal $col $row]
        }
        lappend l $lc
    }
    return $l
}

proc sudoku::fromList {l} {
 
    set col 0
    foreach column $l {
        incr col
        set row 0
        foreach entry $column {
            incr row
            if {[llength $entry] == 1} {
                setVal $col $row $entry
            } else {
                setVal $col $row " "
            }
        }
    }
}

proc sudoku::closeDown { win } {
    destroy $win
    exit   
}

# Draw the board

proc sudoku::drawBoard {c cellsize} {
    
    variable S
    set w $cellsize
    set h $cellsize
    set hw [expr {$w / 2}]
    set hh [expr {$h / 2}]
 
     # offset (border) should be enough to display the numeric-input wheel;
     # Set offset equal to a cellsize (or greater than)
    set offx $cellsize
    set offy $cellsize
    
    # Each square
    foreach col [list 1 2 3 4 5 6 7 8 9] {
        foreach row [list 1 2 3 4 5 6 7 8 9] {
            
            set x2 [expr {$col * $w + $offx}]
            set x1 [expr {$x2 - $w}]
            set y2 [expr {$row * $h + $offy}]
            set y1 [expr {$y2 - $h}]
            set xm [expr {$x1 + $hw}]
            set ym [expr {$y1 + $hh}]
            
            set idr [$c create rectangle $x1 $y1 $x2 $y2 -outline $S(gridLinesColor) -fill $S(normalCellBg) -width 1]
            set idp1 [$c create text [expr {$x1+3}] $y1 -anchor nw -text "" -font penfont -fill $S(smallNumberColor)]
            set idp2 [$c create text [expr {$x1+3}] $y2 -anchor sw -text "" -font penfont -fill $S(smallNumberColor)]
            set idt [$c create text $xm $ym -anchor c -text " " -font numfont]
            
            set S(idr:$col,$row) $idr
            set S(idt:$col,$row) $idt
            set S(idp1:$col,$row) $idp1
            set S(idp2:$col,$row) $idp2
            
            foreach id [list $idr $idt $idp1 $idp2] {
                $c bind $id <Button-1> [list sudoku::clickLeft $col $row]
                # ??? $c bind $id <Control-Button-1> [list sudoku::clickRight $col $row]
            }
        }
    }
    
    set maxx [expr {$x2 + $offx}]
    set maxy [expr {$y2 + $offy}]
    
    # Each box
    foreach bx [list 0 1 2] {
        foreach by [list 0 1 2] {
            set x1 [expr {$bx * 3 * $w + $offx}]
            set x2 [expr {$x1 + 3 * $w}]
            set y1 [expr {$by * 3 * $h + $offy}]
            set y2 [expr {$y1 + 3 * $h}]
            
            $c create rectangle $x1 $y1 $x2 $y2 -outline $S(gridLinesColor) -width 3
        }
    }
    
    return [list $maxx $maxy]
}

# Building the UI

proc sudoku::buildWindow {win} {
    
    variable S
    
    font create penfont -family {Comic Sans MS} -size 8
    font create numfont -family {Comic Sans MS} -size 16 -weight bold
    
    set S(num) 1

    set c [canvas $win.c]
    set cellsize 40
    foreach {x y} [drawBoard $c $cellsize] {break}    
    $c configure -width $x -height $y
    grid $c -sticky {} -padx 5 -pady 5
    
    set S(level) "Easy"
    set S(w:top) $win
    set S(w:c) $c
    
    clear   
    wm resizable $win 0 0

    focus $c
    bind $c <KeyPress> [list sudoku::checkKeyPress %K]

    bind $c <Control-KeyPress> [list sudoku::checkControlKeyPress %K]
     
     # expr is the radius of the circle surroundind the cell

    sudoku::wheel-create $c [expr $cellsize/2*sqrt(2)]
    
}

# aboutBox
#
# Display an about box
proc sudoku::aboutBox { w } {
    
    set message "Sudoku v0.7.1\n"
    append message "(c) David Easton, 2005\n\n"
    append message "User Interaction redesigned by Aldo Buratti\n\n"

    append message "Written in Tcl/Tk"
    
    tk_messageBox -icon info \
            -title "About" \
            -type ok \
            -parent $w \
            -message $message
}

# Function:    help
#
# Description: Shows help text for sudoku
proc sudoku::help {} {
    
    catch {destroy .help}
    toplevel .help
    wm title .help "Sudoku Help"
    
    set t [text .help.t -relief raised -wrap word -width 70 -height 28 \
            -padx 10 -pady 10 -cursor {} -yscrollcommand {.help.sb set}]
    set sb [scrollbar .help.sb -orient vertical -command [list $t yview]]
    set btnOK [button .help.btnOK -text OK -width 8 -command {destroy .help}]
    pack $btnOK -side bottom -pady 10
    pack $sb -side right -fill y
    pack $t -side top -expand 1 -fill both
    
    set bold "[font actual [$t cget -font]] -weight bold"
    set italic "[font actual [$t cget -font]] -slant italic"
    $t tag config title -justify center -foregr red -font "Arial 20 bold"
    $t tag configure title2 -justify center -font "Arial 12 bold"
    $t tag configure bullet -font $bold
    $t tag configure n -lmargin1 15 -lmargin2 15
    $t tag configure nc -justify center
    $t tag configure ital -font $italic
    
    $t insert end "Sudoku\n" title
    $t insert end "by David Easton\n\n" title2
    
    set m "To solve a Sudoku puzzle, every digit from 1 to 9 must appear in:\n
            * Each of the nine vertical columns\n
            * Each of the nine horizontal rows\n
            * Each of the nine boxes\n\n"
    $t insert end "Rules\n" bullet $m n
    
    set m "Start a new game using Game->Generate\n\n"
    $t insert end "Starting a new game\n" bullet $m n
    
    set m "The level can be changed under the Options menu.\n\n"
    $t insert end "Changing the level\n" bullet $m n
    
    $t insert end "Inserting a number\n" bullet \
"Select a cell and then enter a digit (or space to delete).\n
 You can use the numeric wheel or the keyboard.\n
 If <Control> key is pressed, the selected number will be drawn as an annotation" \
    n
    
    $t config -state disabled
}
    
# buildMenus
#
# Build menus for toplevel w
proc sudoku::buildMenus { w } {
    
    variable S
     
    menu $w.menu -tearoff 0
    set Menu(main) $w.menu
    
    set m $w.menu.game
    set Menu(game) $m
    menu $m -tearoff 0
    $w.menu add cascade -label "Game" -menu $m -underline 0
    $m add command -label "Generate" -command [list sudoku::generate]
    $m add command -label "Solve" -command [list sudoku::solve]
    $m add command -label "Check" -command [list sudoku::check]
    $m add separator
    $m add command -label "Save Image" -command [list sudoku::saveImage]
    $m add command -label "Clear" -command [list sudoku::clear]
    $m add separator
    $m add command -label "Exit" -command [list sudoku::closeDown $w]
    
    set m $w.menu.opts
    set Menu(opts) $m
    $w.menu add cascade -label "Options" -menu $m
    menu $m -tearoff 0
    
    set m $w.menu.opts.level
    $w.menu.opts add cascade -label "Level" -menu $m
    menu $m -tearoff 0
    set levList [list "Easy" "Medium" "Hard"]
    foreach lev $levList {
        $m add radio -label "$lev" \
                -variable sudoku::S(level) \
                -value $lev \
                -command "set sudoku::S(preDone) 0;sudoku::bgGen"
    }
    
    set m $w.menu.help
    set Menu(help) $m
    $w.menu add cascade -label "Help" -menu $m
    menu $m -tearoff 0
    $m add command -label "Help" -command [list sudoku::help]
    $m add command -label "About" -command [list sudoku::aboutBox $w]
    #$m add separator
    #$m add command -label "Show Console" -command "console show"
    
    $w configure -menu $w.menu
}

# readImages
#
# Read the images
proc sudoku::readImages { } {

    variable S

    set S(img,grid) [image create photo -file ./images/sudoku_grid.gif]

    foreach num [list 1 2 3 4 5 6 7 8 9] {
        set S(img,$num) [image create photo -file ./images/sudoku_$num.gif]
    }


    set S(img,blank) [image create photo -width 15 -height 17]
}


 #--- Numeric Wheel for input ------------------------ 

proc sudoku::checkKeyPress {val} {
 
 variable S

 if { $S(currC) == -1 } return
 
 if { $val == "space" } { set val " " }
 if { [string first $val "123456789 "] != -1 } {
   wheel-close
   setVal $S(currC) $S(currR) $val
   clearPen $S(currC) $S(currR)
   checkSquare $S(currC) $S(currR)
 }
}


proc sudoku::checkControlKeyPress {val} {
 
 variable S

  if { $S(currC) == -1 } return

  if { $val == "space" } { set val " " }
  if { [string first $val "123456789 "] != -1 } {
        togPen $S(currC) $S(currR) $val
    }
}

 # R is the 'inner' radius of the wheel
proc sudoku::wheel-create {cvs R} {

  variable S
  set S(wheelXc) 0
  set S(wheelYc) 0

  set pi [expr acos(0)*2]
   # degree-to-radiant conversion factor
  set d2r [expr $pi/180.0]

  set halfAlfa [expr (360/10)/2*$d2r]
  set r [expr $R*sin($halfAlfa)/(1-sin($halfAlfa))]

  set keys [list space 1 2 3 4 5 6 7 8 9]
  for { set alfa -90; set idx 0 } { $idx <= 9 } { incr alfa 36; incr idx } {
      set x [expr ($R+$r) * cos($alfa*$d2r)]
      set y [expr ($R+$r) * sin($alfa*$d2r)]
      
      set key [lindex $keys $idx]

        # pseudo-shadow
      $cvs create oval [expr $x-$r] [expr $y-$r] [expr $x+$r] [expr $y+$r] \
           -fill grey80 -outline {}  -tag [list numctrl shadow]

      $cvs create oval [expr $x-$r] [expr $y-$r] [expr $x+$r] [expr $y+$r] \
           -fill $S(wheelBgColor) -outline $S(wheelFgColor) \
           -tag [list numctrl oval val_$key]
       # NOTE: set disabled state, so that state "numbers" cannot be selected. 
      $cvs create text $x $y -text $key -tag [list numctrl text val_$key] \
           -state disabled -fill $S(wheelFgColor)
       
      $cvs bind val_$key <1> \
           [list event generate $cvs <KeyPress> -keysym $key]
      $cvs bind val_$key <Control-1> \
           [list event generate $cvs <Control-KeyPress> -keysym $key]
  }
   # shift shadow and put them under the ovals
  $cvs move numctrl&&shadow 2 2
  $cvs lower shadow&&numctrl numctrl&&oval

   # touch 0th oval display
  $cvs itemconfigure numctrl&&text&&val_space -text "X"

  $cvs bind oval <Enter> [list $cvs itemconfigure current -fill $S(selectedCellBg)]
  $cvs bind oval <Leave> [list $cvs itemconfigure current -fill $S(normalCellBg)]

   # hide it
  $cvs itemconfigure numctrl -state hidden

  set S(outerRadius) [expr $R+2*$r]
}

proc sudoku::wheel-destroy {} {
    variable S

    $S(w:c) delete numctrl
}

proc sudoku::wheel-movetoXY {x y} {
   variable S

   $S(w:c) move numctrl [expr $x - $S(wheelXc)] [expr $y - $S(wheelYc)]
   set S(wheelXc) $x
   set S(wheelYc) $y
}

proc sudoku::wheel-moveto { col row } {
   variable S
   
    # the xy should be the center of the cell ($row $col)
   foreach {x0 y0 x1 y1} [$S(w:c) bbox $S(idr:$col,$row)] { break }

   set xc [expr ($x0+$x1)/2]
   set yc [expr ($y0+$y1)/2]
   wheel-movetoXY  $xc $yc
}


 # r0 is the initial radius
 # r1 is the final radius (close to the wheel  radius)
 # (r1/r0 = 6 --> smooth
 #        <5  --> too fast
 #        > 8 --> slow
proc sudoku::wheel-open {r0 r1} {
    variable S

    set cvs $S(w:c)
    set circleID [$cvs create oval [expr $S(wheelXc)-$r0] [expr $S(wheelYc)-$r0] \
                        [expr $S(wheelXc)+$r0] [expr $S(wheelYc)+$r0] \
                  -outline $S(userNumberColor)
                 ]
    for {set i 2} { $i <$r1/$r0 } {incr i} {
        set sFactor [expr $i.0/($i-1)] 
        $cvs scale $circleID $S(wheelXc) $S(wheelYc) $sFactor $sFactor
        update idletasks
        after 30
    }
    $cvs delete $circleID
     # show wheel
    $cvs itemconfigure numctrl -state normal
    $cvs itemconfigure numctrl&&text -state disabled

    bind $cvs <Motion> [list sudoku::checkOutOfWheel %x %y]
}


proc sudoku::checkOutOfWheel {x y}  {
   
   variable S
   set dist [expr sqrt( ($x-$S(wheelXc))*($x-$S(wheelXc)) + \
                     ($y-$S(wheelYc))*($y-$S(wheelYc)) )]
   if { $dist > $S(outerRadius) } {
       wheel-close
   }
}


proc sudoku::wheel-close {} {
    variable S
    
    bind $S(w:c) <Motion> {}
    $S(w:c) itemconfigure numctrl -state hidden
}




# MAIN 

package require Tk

## source sudoku-create.tcl
# sudoku-create.tcl
# 
# Package to create sudoku puzzles
# 
# Author: David Easton

package provide sudoku-create 1.0

namespace eval sudoku-create {
    variable v
}

proc sudoku-create::shuffle { list } {
    set n 1
    set slist {}
    foreach item $list {
        set index [expr {int(rand()*$n)}]
        set slist [linsert $slist $index $item]
        incr n
    }
    return $slist
}

proc sudoku-create::toList {} {
    
    variable v
    
    set l [list]
    foreach y [list 0 1 2 3 4 5 6 7 8 ] {
        set lx [list]
        foreach x [list 0 1 2 3 4 5 6 7 8] {
            set n [expr {9*$y + $x}]
            lappend lx $v($n)
        }
        lappend l $lx
    }
    return $l
}

proc sudoku-create::start {} {
    
    variable v
    
    set v(stop) 0
    
    makeRowLists
    makeColLists
    makeBoxLists
    
    nextSquare 0 [shuffle [list 1 2 3 4 5 6 7 8 9]]
    
    return $v(list)
}

proc sudoku-create::printStatus {{max 81}} {
    
    variable v
    
    foreach y [list 0 1 2 3 4 5 6 7 8] {
        foreach x [list 0 1 2 3 4 5 6 7 8] {
            set n [expr {9*$y + $x}]
            if {$n >= $max} {puts "";return}
            puts -nonewline $v($n)
        }
        puts ""
    }
}

# Note: The last column of each row does not
# need to be in this list, as this is the
# square itself.
proc sudoku-create::makeRowLists {} {
    foreach r [list 0 1 2 3 4 5 6 7 8] {
        set v(rowList,$r) [list]
        foreach c [list 0 1 2 3 4 5 6 7] {
            lappend v(rowList,$r) [expr {9 * $r + $c}]
        }
    }
}

# Note: The last row of each column does not
# need to be in this list, as this is the
# square itself.
proc sudoku-create::makeColLists {} {
    variable v
    foreach c [list 0 1 2 3 4 5 6 7 8] {
        set v(colList,$c) [list]
        foreach r [list 0 1 2 3 4 5 6 7] {
            lappend v(colList,$c) [expr {9 * $r + $c}]
        }
    }
}

# Note: The last row of each box does not
# need to be in this list, as the row checking
# will always cover those squares.
proc sudoku-create::makeBoxLists {} {
    variable v
    foreach bc [list 0 1 2] {
        foreach br [list 0 1 2] {
            set offset [expr {27 * $br + 3 * $bc}]
            set i "$br$bc"
            set v(boxList,$i) [list]
            foreach y [list 0 1] {
                foreach x [list 0 1 2] {
                    lappend v(boxList,$i) [expr {$offset + (9 * $y) + $x}]
                }
            }
        }
    }
}

proc sudoku-create::nextSquare {n possList} {
    
    variable v
    
    if { $v(stop) } {return}
    
    if {$n == 81} {
        #printStatus $n
        set v(list) [toList]
        set v(stop) 1
        return
    }
    
    set r [expr {$n / 9}]
    set c [expr {$n % 9}]
    set b [expr {$r/3}][expr {$c/3}]
    
    if {$c == 0} {set possList [shuffle [list 1 2 3 4 5 6 7 8 9]]}
    
    set clist [list]
    foreach e [lrange $v(colList,$c) 0 [expr {$r -1}]] {
        lappend clist $v($e)
    }
    
    set blist [list]
    if {$r % 3} {
        foreach e $v(boxList,$b) {
            if { $e >= $n } {break}
            lappend blist $v($e)
        }
    }
    
    foreach i $possList {
        
        # Test for uniqueness in col, box
        
        if {[lsearch $clist $i] != -1} {
            continue
        }
        if {[lsearch $blist $i] != -1} {
            continue
        }
        
        set v($n) $i
        set ind [lsearch $possList $i]
        nextSquare [expr {$n+1}] [lreplace $possList $ind $ind]
    }
}



## source sudoku-mask.tcl

# sudoku-mask.tcl
#
# Package to create masks for sudoku puzzles
#
# Author: David Easton

package provide sudoku-mask 1.0

namespace eval sudoku-mask {
    variable M
}

proc sudoku-mask::choose {list} {
    return [lindex $list [expr {int(rand() * [llength $list])}]] 
}

proc sudoku-mask::addSquare {sq} {
    
    variable M
    
    if {[lsearch $M(vis) $sq] == -1} {
        lappend M(vis) $sq
        set M($sq) 1
    }
}

proc sudoku-mask::removeSquare {sq} {
    
    variable M
    
    if {[set i [lsearch $M(vis) $sq]] != -1} {
        set M(vis) [lreplace $M(vis) $i $i] 
        set M($sq) 0
    }
}

proc sudoku-mask::init {} {
    
    variable M
    
    set M(vis) [list]
    
    foreach x [list 1 2 3 4 5 6 7 8 9] {
        foreach y [list 1 2 3 4 5 6 7 8 9] {
            set M($x,$y) 1
            lappend M(vis) "$x,$y"
        }
    }
}

proc sudoku-mask::chooseSym {} {
    # Full list is miry mirx mirxy miryx mirb rot180 rot90
    return [choose [list mirb rot180 rot90]]
}

proc sudoku-mask::symmetry {type sq} {
    set res [list $sq]
    foreach {x y} [split $sq ,] {break}
    
    set xi [expr {10-$x}]
    set yi [expr {10-$y}]
    
    switch $type {
        miry {
            if {$x != 5} {
                lappend res "$xi,$y"
            }  
        }
        mirx {
            if {$y != 5} {
                lappend res "$x,$yi"
            }
        }
        mirxy {
            if {$x != $y} {
                lappend res "$y,$x"
            }           
        }
        miryx {
            if {$x != $yi} {
                lappend res "$yi,$xi"
            }
        }
        mirb {
            if {$x != 5 || $y != 5} {
                lappend res "$x,$yi"
                lappend res "$xi,$yi"
                lappend res "$xi,$y"               
            }
        }
        rot180 {
            if {$x != 5 || $y != 5} {
                lappend res "$xi,$yi"
            } 
        }
        rot90 {
            if {$x != 5 || $y != 5} {
                lappend res "$yi,$x"   
                lappend res "$xi,$yi"
                lappend res "$y,$xi"
            }
        }
    }
    return $res
}

proc sudoku-mask::show {} {
    
    variable M
    foreach y [list 1 2 3 4 5 6 7 8 9] {
        foreach x [list 1 2 3 4 5 6 7 8 9] {
            puts -nonewline $M($x,$y)
        }
        puts ""
    }
    puts ""
}

proc sudoku-mask::toList {} {
    
    variable M
    
    set l [list]
    foreach x [list 1 2 3 4 5 6 7 8 9] {
        set lx [list]
        foreach y [list 1 2 3 4 5 6 7 8 9] {
            lappend lx $M($x,$y)
        }
        lappend l $lx
    }
    return $l
}

# Searches for instances of 4 squares containing 2 different values
# where the values are interchangeable.  These must always be specified
# at start of the puzzle if the puzzle is to have a unique solution
proc sudoku-mask::analysePuzzle {p} {
    
    set matchedList [list]
    
    set col 0
    foreach column $p {
        incr col
        set row 0
        foreach val $column {
            incr row
            set block [expr {(($row -1)/3)*3 + (($col -1)/3)} + 1]
            
            set colRowFromBlockVal($block,$val) $col,$row
            set valFromColRow($col,$row) $val
        }
    }
    
    set blockAssociations(1) [list 2 3 4 7]
    set blockAssociations(2) [list 3 5 8]
    set blockAssociations(3) [list 6 9]
    set blockAssociations(4) [list 5 6 7]
    set blockAssociations(5) [list 6 8]
    set blockAssociations(6) [list 9]
    set blockAssociations(7) [list 8 9]
    set blockAssociations(8) [list 9]
    set blockAssociations(9) [list]
    
    foreach block [list 1 2 3 4 5 6 7 8 9] {
        foreach num [list 1 2 3 4 5 6 7 8 9] {
            set sq1 $colRowFromBlockVal($block,$num)
            foreach assocBlock $blockAssociations($block) {
                set sq2 $colRowFromBlockVal($assocBlock,$num)
                foreach {c1 r1} [split $sq1 ,] {break}
                foreach {c2 r2} [split $sq2 ,] {break}
                if { $valFromColRow($c1,$r2) == $valFromColRow($c2,$r1) } {
                    set matched [lsort [list $sq1 $c1,$r2 $c2,$r1 $sq2]]
                    if {[lsearch $matchedList $matched] == -1} {
                        lappend matchedList $matched
                    }
                }
            }
        }
    }
    return $matchedList
}

proc sudoku-mask::generate {p num} {
    
    variable M
    
    init
    set M(sym) [chooseSym]

    set matchedList [analysePuzzle $p]

    # Only show $num visible entries
    while {[llength $M(vis)] > $num} {
        if {[llength $matchedList]} {
            set useMatchedList true
            set sq [choose [choose $matchedList]]
        } else {
            set useMatchedList false
            set sq [choose $M(vis)]
        }
        set sqList [symmetry $M(sym) $sq]
        foreach sq $sqList {
            if {$useMatchedList} {
                # Remove any matching entries from matchedList
                foreach index [lsort -integer -decreasing [lsearch -all -glob $matchedList *${sq}*]] {
                    set matchedList [lreplace $matchedList $index $index]
                }
            }
            removeSquare $sq
        }
    }
    
    #show
    return [toList]
}

# Change
proc sudoku-mask::change {} {
    sudoku-mask::less
    sudoku-mask::more   
}

# Number visible
proc sudoku-mask::numvis {} {
    variable M
    return [llength $M(vis)]   
}

# Harder
proc sudoku-mask::harder { {sq 0} } {
    variable M
    if { $sq == 0 || [lsearch $M(vis) $sq] == -1} {
        set sq [choose $M(vis)]
    }
    set sqList [symmetry $M(sym) $sq]
    foreach sq $sqList {
        removeSquare $sq
    }
    #show    
    return [toList]
}

# Easier
proc sudoku-mask::easier { {sq 0} } {
    variable M
    
    # Protect against infinite loop
    if { [llength $M(vis)] == 81} {return}
    
    if { $sq == 0 } {
        set x [choose [list 1 2 3 4 5 6 7 8 9]]
        set y [choose [list 1 2 3 4 5 6 7 8 9]]
    } else {
        foreach {x y} [split $sq ,] {break}
    }
    
    while {[lsearch $M(vis) $x,$y] != -1} {
        set x [choose [list 1 2 3 4 5 6 7 8 9]]
        set y [choose [list 1 2 3 4 5 6 7 8 9]]
    }
    set sq $x,$y
    set sqList [symmetry $M(sym) $sq]

    foreach sq $sqList {
        addSquare $sq
    }
    #show
    return [toList]
}

## source sudoku-solve.tcl
# sudoku-solve.tcl
# 
# Package to solve sudoku puzzles
# 
# Author: David Easton

package provide sudoku-solve 1.0

namespace eval sudoku-solve {
    variable S
    variable V
}

proc sudoku-solve::toList {} {
    variable V
    
    set l [list]
    foreach col [list 1 2 3 4 5 6 7 8 9] {
        set lc [list]
        foreach row [list 1 2 3 4 5 6 7 8 9] {
            set box [getBoxFromRowCol $col $row]
            lappend lc $V($col,$row,$box)
        }
        lappend l $lc
    }
    return $l
}

proc sudoku-solve::getBoxFromRowCol {col row} {
    set box [expr {3 * (($row - 1)/3) + ($col - 1)/3 + 1}]
}

proc sudoku-solve::solve {l} {
    
    variable S
    
    init
    set S(numDone) 0
    set S(progress) 0
    # 0 for unsolvable, 1 for single answer
    set S(answer) 0
    set S(known) [list]
    
    foreach num [list 1 2 3 4 5 6 7 8 9] {
        set S(rem,col,$num) [list 1 2 3 4 5 6 7 8 9]
        set S(rem,row,$num) [list 1 2 3 4 5 6 7 8 9]
        set S(rem,box,$num) [list 1 2 3 4 5 6 7 8 9]
    }
    
    set col 0
    foreach column $l {
        incr col
        set row 0
        foreach entry $column {
            incr row
            if {[regexp {[0-9]} $entry]} {
                setKnown $col $row $entry
            }
        }
    }

    # Ensure that we always use the easiest method when possible
    while {$S(progress)} {
        while {$S(progress)} {       
            while {$S(progress)} {
                set S(progress) 0
                if {$S(numDone) == 81} {
                    break
                }  
                rule2
            }
            rule3
        }
        rule4
    }
    
    if {$S(numDone) == 81} {
        set S(answer) 1
    }
   
    showAll
    
    return [list $S(answer) [sudoku-solve::toList]]
}

proc sudoku-solve::listSquares {type num} {
    variable V
    switch $type {
        "col" { set eList [array names V "$num,*,*"]}
        "row" { set eList [array names V "*,$num,*"]}
        "box" { set eList [array names V "*,*,$num"]}
        default {set elList [list]}
    }
    return [lsort $eList]
}

proc sudoku-solve::rule2 {} {
    # For each row, column and box
    # see if only 1 square can be any particular number
    variable S
    variable V
    foreach i [list 1 2 3 4 5 6 7 8 9] {
        foreach type [list col row box] {
            foreach num $S(rem,$type,$i) {
                set matchList [list]
                foreach entry [listSquares $type $i] {
                    if {[lsearch $V($entry) $num] != -1} {
                        lappend matchList $entry
                    }
                }
                if {[llength $matchList] == 1} {
                    set entry [lindex $matchList 0]
                    #puts "Solved $entry = $num *rule 2*"
                    foreach {co ro bo} [split $entry ,] {break}
                    setKnown $co $ro $num
                }
            }
        }
    }
}

proc sudoku-solve::rule3 {} {
    # For each col/row/box.  If a number can only exist in
    # 1 col/row/box, then can remove the number from others
    # This is an extension of the testing performed in rule2
    
    variable S
    variable V
    foreach i [list 1 2 3 4 5 6 7 8 9] {
        foreach type [list col row box] {
            foreach num $S(rem,$type,$i) {
                set matchList [list]
                foreach entry [listSquares $type $i] {
                    if {[lsearch $V($entry) $num] != -1} {
                        lappend matchList $entry
                    }
                }
                # Test whether matchList has another col/row/box in common
                if {[llength $matchList] == 1} {
                    set entry [lindex $matchList 0]
                    #puts "Solved $entry = $num *rule 2*"
                    foreach {co ro bo} [split $entry ,] {break}
                    setKnown $co $ro $num
                } elseif {[llength $matchList] < 4} {
                    set coList [list]
                    set roList [list]
                    set boList [list]
                    foreach entry $matchList {
                        foreach {co ro bo} [split $entry ,] {break}
                        if {[lsearch $coList $co] == -1} {lappend coList $co}
                        if {[lsearch $roList $ro] == -1} {lappend roList $ro}
                        if {[lsearch $boList $bo] == -1} {lappend boList $bo}
                    }
                    switch $type {
                        col -
                        row {
                            # For col/row, check if in same box
                            if {[llength $boList] == 1} {
                                # Remove $num from other cols/rows in this box
                                set bo [lindex $boList 0]
                                foreach ent [listSquares box $bo] {
                                    if {[lsearch $matchList $ent] != -1} {continue}
                                    if {[set ind [lsearch $V($ent) $num]] != -1} {
                                        set V($ent) [lreplace $V($ent) $ind $ind]
                                        set S(progress) 1
                                        #puts "Removed $num from $ent *rule 3* (type $type)"
                                        if {[llength $V($ent)] == 1} {
                                            foreach {co ro bo} [split $ent ,] {break}
                                            #puts "Solved $ent = $V($ent) *rule 3*"
                                            setKnown $co $ro $V($ent)
                                        }
                                    }
                                }
                            }
                        }
                        box {
                            # For box, check if in same row or col
                            if {[llength $coList] == 1} {
                                # Remove $num from other boxes in this col
                                set co [lindex $coList 0]
                                foreach ent [listSquares col $co] {
                                    if {[lsearch $matchList $ent] != -1} {continue}
                                    if {[set ind [lsearch $V($ent) $num]] != -1} {
                                        set V($ent) [lreplace $V($ent) $ind $ind]
                                        set S(progress) 1
                                        #puts "Removed $num from $ent *rule 3* (type $type)"
                                        if {[llength $V($ent)] == 1} {
                                            foreach {co ro bo} [split $ent ,] {break}
                                            #puts "Solved $ent = $V($ent) *rule 3*"
                                            setKnown $co $ro $V($ent)
                                        }
                                    }
                                }
                            }
                            if {[llength $roList] == 1} {
                                # Remove $num from other boxes in this row
                                set ro [lindex $roList 0]
                                foreach ent [listSquares row $ro] {
                                    if {[lsearch $matchList $ent] != -1} {continue}
                                    if {[set ind [lsearch $V($ent) $num]] != -1} {
                                        set V($ent) [lreplace $V($ent) $ind $ind]
                                        set S(progress) 1
                                        #puts "Removed $num from $ent *rule 3* (type $type)"
                                        if {[llength $V($ent)] == 1} {
                                            foreach {co ro bo} [split $ent ,] {break}
                                            #puts "Solved $ent = $V($ent) *rule 3*"
                                            setKnown $co $ro $V($ent)
                                        }
                                    }
                                }
                            }
                        }
                    }
                }
            }
        }
    }
}

proc sudoku-solve::rule4 {} {
    # For each row, column and box
    # if 2 squares can only be 1,3 for example, remove 1,3 from other
    # squares in the row/col/box.
    # Also this needs to cover 3 squares with 1,2 2,3 1,3 etc.
    
    variable S
    variable V
    
    foreach type [list col row box] {
        foreach i [list 1 2 3 4 5 6 7 8 9] {
            catch {array unset match}
            foreach num $S(rem,$type,$i) {
                set match($num) [list]
                foreach entry [listSquares $type $i] {
                    if {[lsearch $V($entry) $num] != -1} {
                        lappend match($num) $entry
                    }
                }
            }
            # Search for pairs
            if {[set retCode [testMatch match 2]]} {return $retCode}
            if {[set retCode [testMatch match 3]]} {return $retCode}
            if {[set retCode [testMatch match 4]]} {return $retCode}
            if {[set retCode [testMatch match 5]]} {return $retCode}
        }
    }
}

# Returns 1 if it did something useful, 0 otherwise
proc sudoku-solve::solveRule4 {squares numbers} {
    
    variable V
    
    set retCode 0
    
    # For each square, remove entries which are not
    # the numbers provided.
    foreach entry $squares {
        foreach num $V($entry) {
            if {[lsearch $numbers $num] == -1} {
                set S(progress) 1
                #puts "Removed $num from $entry *rule 4a*"
                set V($entry) [lremove $V($entry) $num]
                set retCode 1
            }
        }
    }
    
    # For each row/col/box in common, remove the numbers
    # provided.
    # See what they have in common
    set coList [list]
    set roList [list]
    set boList [list]
    foreach entry $squares {
        foreach {co ro bo} [split $entry ,] {break}
        if {[lsearch $coList $co] == -1} {lappend coList $co}
        if {[lsearch $roList $ro] == -1} {lappend roList $ro}
        if {[lsearch $boList $bo] == -1} {lappend boList $bo}
    }
    
    if {[llength $coList] == 1} {
        foreach entry [listSquares col $coList] {
            if {[lsearch $squares $entry] != -1} {
                continue
            }
            foreach num $numbers {
                if {[set ind [lsearch $V($entry) $num]] != -1} {
                    set S(progress) 1
                    #puts "Removed $num from $entry *rule 4b*"
                    set retCode 1
                    set V($entry) [lreplace $V($entry) $ind $ind]
                    if {[llength $V($entry)] == 1} {
                        foreach {co ro bo} [split $entry ,] {break}
                        #puts "Solved $entry = $V($entry) *rule 4*"
                        setKnown $co $ro $V($entry)
                    }
                }
            }
        }
    }
    if {[llength $roList] == 1} {
        foreach entry [listSquares row $roList] {
            if {[lsearch $squares $entry] != -1} {
                continue
            }
            foreach num $numbers {
                if {[set ind [lsearch $V($entry) $num]] != -1} {
                    set S(progress) 1
                    #puts "Removed $num from $entry *rule 4b*"
                    set retCode 1
                    set V($entry) [lreplace $V($entry) $ind $ind]
                    if {[llength $V($entry)] == 1} {
                        foreach {co ro bo} [split $entry ,] {break}
                        #puts "Solved $entry = $V($entry) *rule 4*"
                        setKnown $co $ro $V($entry)
                    }
                }
            }
        }
    }
    if {[llength $boList] == 1} {
        foreach entry [listSquares box $boList] {
            if {[lsearch $squares $entry] != -1} {
                continue
            }
            foreach num $numbers {
                if {[set ind [lsearch $V($entry) $num]] != -1} {
                    set S(progress) 1
                    #puts "Removed $num from $entry *rule 4b*"
                    set retCode 1
                    set V($entry) [lreplace $V($entry) $ind $ind]
                    if {[llength $V($entry)] == 1} {
                        foreach {co ro bo} [split $entry ,] {break}
                        #puts "Solved $entry = $V($entry) *rule 4*"
                        setKnown $co $ro $V($entry)
                    }
                }
            }
        }
    }
    return $retCode
}

proc sudoku-solve::testMatch {matchName num} {
    upvar $matchName match
    
    set unknown [array names match]
    
    # No point in doing all this if we cannot rule
    # anything out anyway
    if {[llength $unknown] <= $num} {return 0}
    
    set numList [list]
    foreach entry [array names match] {
        if {[llength $match($entry)] <= $num} {
            lappend numList $entry
        }
    }
    # If at least $num numbers have only $num squares represented, continue
    if {[llength $numList] >= $num} {
        set cmd comb$num
        foreach combo [$cmd $numList] {
            set sqs [list]
            foreach c $combo {
                foreach entry $match($c) {
                    if {[lsearch $sqs $entry] == -1} {
                        lappend sqs $entry
                    }
                }
            }
            if {[llength $sqs] == $num} {
                set retCode [solveRule4 $sqs $combo]
                return $retCode
            }
        }
    }
    return 0
}

proc sudoku-solve::showAll {} {
    variable V
    foreach row [list 1 2 3 4 5 6 7 8 9] {
        foreach col [list 1 2 3 4 5 6 7 8 9] {
            set box [getBoxFromRowCol $col $row]
            if {[llength $V($col,$row,$box)] > 1} {
                #puts -nonewline "."
            } else {
                #puts -nonewline $V($col,$row,$box)
            }
        }
        #puts ""
    }
    #puts ""
}

proc sudoku-solve::show {} {
    variable V
    parray V
}


# Make unsolved grid
proc sudoku-solve::init {} {
    variable V
    foreach row [list 1 2 3 4 5 6 7 8 9] {
        foreach col [list 1 2 3 4 5 6 7 8 9] {
            set box [getBoxFromRowCol $col $row]
            set V($col,$row,$box) [list 1 2 3 4 5 6 7 8 9]
        }
    }
}

proc sudoku-solve::lremove {list entry} {
    if {[set i [lsearch $list $entry]] != -1} {
        return [lreplace $list $i $i]
    } else {
        return $list
    }
}

# Known values
proc sudoku-solve::setKnown {col row to} {
    
    variable S
    variable V
    
    # Check if this has already been set
    if {[lsearch $S(known) $col,$row] != -1} {
        return
    }
    
    set box [getBoxFromRowCol $col $row]
    
    # Check that it is possible
    if {[lsearch $V($col,$row,$box) $to] != -1} {
        
        set S(progress) 1
        set V($col,$row,$box) $to
        
        set S(rem,col,$col) [lremove $S(rem,col,$col) $to]
        set S(rem,row,$row) [lremove $S(rem,row,$row) $to]
        set S(rem,box,$box) [lremove $S(rem,box,$box) $to]

        lappend S(known) $col,$row
        incr S(numDone)
        
        # Clear this value from all others in this row, col & box
        set colList [listSquares col $col]
        set rowList [listSquares row $row]
        set boxList [listSquares box $box]
        
        set remList [list]
        foreach entry [concat $colList $rowList $boxList] {
            if {[lsearch $remList $entry] == -1 && $entry != "$col,$row,$box"} {
                lappend remList $entry
            }
        }
        
        foreach entry $remList {
            if {[set i [lsearch $V($entry) $to]] != -1} {
                set V($entry) [lreplace $V($entry) $i $i]
                if {[llength $V($entry)] == 1} {
                    foreach {co ro bo} [split $entry ,] {break}
                    #puts "Solved $entry = $V($entry) *rule 1*"
                    setKnown $co $ro $V($entry)
                }
            }
        }
        
        return $to
    } else {
        return 0
    }
}

# Pre-built comb functions designed for speed
proc sudoku-solve::comb5 {list} {
    set rl [list]
    set i1 0
    foreach e1 $list {
        incr i1
        set i2 0
        foreach e2 [lrange $list $i1 end] {
            incr i2
            set i3 0
            foreach e3 [lrange $list [expr {$i1+$i2}] end] {
                incr i3
                set i4 0
                foreach e4 [lrange $list [expr {$i1+$i2+$i3}] end] {
                    incr i4
                    foreach e5 [lrange $list [expr {$i1+$i2+$i3+$i4}] end] {
                        lappend rl [list $e1 $e2 $e3 $e4 $e5]
                    }
                }
            }
        }
    }
    return $rl
}

proc sudoku-solve::comb4 {list} {
    set rl [list]
    set i1 0
    foreach e1 $list {
        incr i1
        set i2 0
        foreach e2 [lrange $list $i1 end] {
            incr i2
            set i3 0
            foreach e3 [lrange $list [expr {$i1+$i2}] end] {
                incr i3
                foreach e4 [lrange $list [expr {$i1+$i2+$i3}] end] {
                    lappend rl [list $e1 $e2 $e3 $e4]
                }
            }
        }
    }
    return $rl
}

proc sudoku-solve::comb3 {list} {
    set rl [list]
    set i1 0
    foreach e1 $list {
        incr i1
        set i2 0
        foreach e2 [lrange $list $i1 end] {
            incr i2
            foreach e3 [lrange $list [expr {$i1 + $i2}] end] {
                lappend rl [list $e1 $e2 $e3]
            }
        }
    }
    return $rl
}

proc sudoku-solve::comb2 {list} {
    set rl [list]
    set i 0
    foreach e1 $list {
        incr i
        foreach e2 [lrange $list $i end] {
            lappend rl [list $e1 $e2]
        }
    }
    return $rl
}




wm withdraw .

set win .sudoku

toplevel $win
wm title $win "Sudoku"

wm protocol $win WM_DELETE_WINDOW [list sudoku::closeDown $win]


sudoku::readImages
sudoku::buildWindow $win
sudoku::buildMenus $win
update
#sudoku::bgGen