if 0 {
HJG 2016-02-16: There is a 15-puzzle in the Tk-demo. It uses buttons for the tiles and place to move the buttons around.
Other variants here on the wiki are The Classic 15 Puzzle and N-puzzle, but they are quite lengthy.
Both programs use numbers - it would be nice to have a variant that can use other symbols and/or a sliced-up picture.
Currently, there is a draft-task for the 15-puzzle at rosettacode , so to fill in an entry for tcl, I wanted a fairly short and simple version of that puzzle.
Starting with the layout from A small calculator, I'm using a grid of buttons here, and moving around the text on the buttons.
Also, there is only a limited number of canned puzzles (as in "1" :).
}
# 15puzzle_02.tcl - HaJo Gurt - 2016-02-16
# http://wiki.tcl.tk/14403
#: 15-Puzzle - with grid, buttons and colors
package require Tk
set progVersion "15-Puzzle v0.12"; # 2016-02-16
global msg
set msg " "
set Moves 0
set Keys { 11 12 13 14 21 22 23 24 31 32 33 34 41 42 43 44 }
set Goal { A B C D E F G H I K L M N O P _ }; # Rows LTR / 1:E : 183
#set Goal { A E I N B F K O C G L P D H M _ }; # Cols forw. / 1:M : 114
#set Goal { A M L K B N _ I C O P H D E F G }; # Spiral CCW / 0 : 121
#set Goal { A B C D M N O E L _ P F K I H G }; # Spiral CW1 / 0 : 154
set Puzz { C A F B E G P N D L H I O K M _ }; # from Tk-demo
proc Move {k} {
# find key with the empty space:
foreach p0 $::Keys {
set t [.key$p0 cget -text]
if { $t eq "_" } { break }
}
# found at pos p0
set t [.key$k cget -text]
.key$p0 config -text $t
#-state active
#-relief raised
.key$k config -text "_"; # -background gray
}
proc Check {} {
set ok 0
set i 0
foreach k $::Keys {
set t [.key$k cget -text]
set g [lindex $::Goal $i]
incr i
.key$k config -background white
if { $t eq $g } { .key$k config -background lightgreen; incr ok }
#lime : only in Tcl/Tk 8.6
if { $t eq "_" } { .key$k config -background gray }
#-relief sunken -state disabled
}
update
#if { $ok > 15} { bell; after 250; bell }
if { $ok > 15} {
foreach k $::Keys {
.key$k flash; bell;
}
}
}
proc Click {k} {
set ::msg ""
incr ::Moves
set val [.key$k cget -text]
wm title . "$::Moves moves"
Move $k
Check
}
proc New15 {} {
set ::Moves 0
set i 0
foreach k $::Keys {
set t [lindex $::Puzz $i]
incr i
.key$k config -text $t -background white; # white
}
set ::msg "New game"
wm title . "$::msg / $::Moves"
Check
}
button .quit -text "Off" -fg red -command exit
button .newA -text "New A" -fg red -command {New15}
button .newB -text "Clear" -fg blue -command {set ::msg ""}
foreach k $::Keys {
button .key$k -text "$k" -width 4 -command "Click $k"
}
grid .quit .newB .newA -sticky nsew
grid .key11 .key12 .key13 .key14 -sticky nsew
grid .key21 .key22 .key23 .key24 -sticky nsew
grid .key31 .key32 .key33 .key34 -sticky nsew
grid .key41 .key42 .key43 .key44 -sticky nsew
grid configure .newA -columnspan 2 -padx 4
New15
wm title . $progVersion
focus -force .The game is working, but there is no check yet if the clicked button is next to the empty tile.
I wanted to take care of that with '-state disabled' / '-state active', but doing that resulted in some strange effects...
Also, the buttons for new game etc. are not final.
See also: