#!/bin/sh # # sudoku.tcl von Jochen Meyer-Hilberg 05.03.2007 # # Die nächste Zeile startet wish \ exec wish "$0" "$@" wm title . "SUDOKU" label .titel -font -*-helvetica-bold-r-normal--34-*- -text "SUDOKU" frame .feld frame .knopf pack .titel .feld .knopf -side top -padx 2m -pady 2m -fill x button .knopf.new -text "New" -command HoleErsteWerte -state disabled button .knopf.undo -text "Undo" -command HoleAlteWerte -state disabled button .knopf.quit -text "Quit" -command exit pack .knopf.new .knopf.undo .knopf.quit -side left -expand yes bind . q exit set indizes(0) { 1 2 3 4 5 6 7 8 9 } set indizes(1) { 1 2 3 } set indizes(2) { 4 5 6 } set indizes(3) { 7 8 9 } set indizes(4) { 1 2 3 7 8 9 } foreach x $indizes(0) { foreach y $indizes(0) { set feld("$x$y") $indizes(0) button .feld."$x$y" -font -*-helvetica-bold-r-normal--24-*- \ -width 3 -height 1 -bg SkyBlue1 -activebackground SkyBlue1 \ -command "WaehleZiffer $x $y" grid .feld."$x$y" -row "$x" -column "$y" -sticky nsew set moeglichkeiten("$x$y") 9 } } foreach x $indizes(2) { foreach y $indizes(4) { .feld."$x$y" configure -bg yellow -activebackground yellow .feld."$y$x" configure -bg yellow -activebackground yellow } } set nummer 0 proc HoleErsteWerte { } { global nummer set nummer 1 HoleAlteWerte } proc HoleAlteWerte { } { global nummer indizes feld altes_feld moeglichkeiten alte_moeglichkeiten if { $nummer < 2 } { .knopf.new configure -state disabled .knopf.undo configure -state disabled } .titel configure -fg black foreach i $indizes(0) { foreach j $indizes(0) { set feld("$i$j") $altes_feld("$nummer$i$j") set moeglichkeiten("$i$j") $alte_moeglichkeiten("$nummer$i$j") if { $moeglichkeiten("$i$j") > 0 } { .feld."$i$j" configure -bg SkyBlue1 -activebackground SkyBlue1 } if { $moeglichkeiten("$i$j") > 1 } { .feld."$i$j" configure -text "" -fg black -activeforeground black } } } foreach i $indizes(2) { foreach j $indizes(4) { if { $moeglichkeiten("$i$j") > 0 } { .feld."$i$j" configure -bg yellow -activebackground yellow } if { $moeglichkeiten("$j$i") > 0 } { .feld."$j$i" configure -bg yellow -activebackground yellow } } } incr nummer -1 } proc WaehleZiffer { x y } { global feld moeglichkeiten if { $moeglichkeiten("$x$y") > 1 } { .feld."$x$y" configure -text "?" catch { destroy .ziffer } toplevel .ziffer grab .ziffer wm title .ziffer "Wähle Ziffer" wm transient .ziffer . wm protocol .ziffer WM_DELETE_WINDOW \ "SetzeFeldZurueck $x $y ; destroy .ziffer" label .ziffer.titel -font -*-helvetica-bold-r-normal--24-*- \ -text "Bitte Ziffer wählen:" frame .ziffer.knopf button .ziffer.quit -text "Quit" \ -command "SetzeFeldZurueck $x $y ; destroy .ziffer" pack .ziffer.titel .ziffer.knopf .ziffer.quit -side top -padx 2m -pady 2m bind .ziffer q "SetzeFeldZurueck $x $y ; destroy .ziffer" foreach z $feld("$x$y") { button .ziffer.knopf."$z" -font -*-helvetica-bold-r-normal--24-*- \ -text "$z" -command "SpeichereAktuelleWerte ; \ AktualisiereFeld $x $y $z ; SucheLoesung ; destroy .ziffer" pack .ziffer.knopf."$z" -side left bind .ziffer "" "SpeichereAktuelleWerte ; \ AktualisiereFeld $x $y $z ; SucheLoesung ; destroy .ziffer" bind .ziffer "" "SpeichereAktuelleWerte ; \ AktualisiereFeld $x $y $z ; SucheLoesung ; destroy .ziffer" } } } proc SetzeFeldZurueck { x y } { .feld."$x$y" configure -text "" } proc SpeichereAktuelleWerte { } { global nummer indizes feld altes_feld moeglichkeiten alte_moeglichkeiten incr nummer foreach i $indizes(0) { foreach j $indizes(0) { set altes_feld("$nummer$i$j") $feld("$i$j") set alte_moeglichkeiten("$nummer$i$j") $moeglichkeiten("$i$j") } } .knopf.new configure -state normal .knopf.undo configure -state normal } proc AktualisiereFeld { x y z } { global indizes feld moeglichkeiten set feld("$x$y") "$z" .feld."$x$y" configure -text $feld("$x$y") set moeglichkeiten("$x$y") 0 foreach u $indizes(0) { if { "$u" != "$x" } { ZaehleMoeglichkeiten "$u" "$y" "$z" } if { "$u" != "$y" } { ZaehleMoeglichkeiten "$x" "$u" "$z" } } set i [ expr int (("$x" + 2) / 3) ] set j [ expr int (("$y" + 2) / 3) ] foreach u $indizes($i) { foreach v $indizes($j) { if { "$u$v" != "$x$y" } { ZaehleMoeglichkeiten "$u" "$v" "$z" } } } foreach u $indizes(0) { foreach w $indizes(0) { set anzahl("$w") 0 } foreach v $indizes(0) { foreach w $feld("$u$v") { set index("$w") "$u$v" incr anzahl("$w") } } foreach w $indizes(0) { if { $anzahl("$w") == 1 } { set xy $index("$w") if { $moeglichkeiten("$xy") > 1 } { set feld("$xy") "$w" set moeglichkeiten("$xy") 1 } } } foreach w $indizes(0) { set anzahl("$w") 0 } foreach v $indizes(0) { foreach w $feld("$v$u") { set index("$w") "$v$u" incr anzahl("$w") } } foreach w $indizes(0) { if { $anzahl("$w") == 1 } { set xy $index("$w") if { $moeglichkeiten("$xy") > 1 } { set feld("$xy") "$w" set moeglichkeiten("$xy") 1 } } } } foreach i $indizes(1) { foreach j $indizes(1) { foreach w $indizes(0) { set anzahl("$w") 0 } foreach u $indizes($i) { foreach v $indizes($j) { foreach w $feld("$u$v") { set index("$w") "$u$v" incr anzahl("$w") } } } foreach w $indizes(0) { if { $anzahl("$w") == 1 } { set xy $index("$w") if { $moeglichkeiten("$xy") > 1 } { set feld("$xy") "$w" set moeglichkeiten("$xy") 1 } } } } } } proc ZaehleMoeglichkeiten { x y z } { global feld moeglichkeiten if { $moeglichkeiten("$x$y") > 0 } { set ziffern { } set moeglichkeiten("$x$y") 0 foreach w $feld("$x$y") { if { "$w" != "$z" } { set ziffern "$ziffern$w " incr moeglichkeiten("$x$y") } } set feld("$x$y") $ziffern if { $moeglichkeiten("$x$y") == 0 } { .feld."$x$y" configure -bg red -activebackground red } } } proc SucheLoesung { } { global indizes feld moeglichkeiten set suchen 1 while { $suchen > 0 } { set summe 0 set suchen 0 foreach x $indizes(0) { foreach y $indizes(0) { set summe [ expr $summe + $moeglichkeiten("$x$y") ] if { $moeglichkeiten("$x$y") == 1 } { .feld."$x$y" configure -fg red -activeforeground red AktualisiereFeld "$x" "$y" $feld("$x$y") set suchen 1 } } } if { $summe == 0 } { .titel configure -fg red } } }