Updated 2016-02-23 19:55:12 by HJG ▲

if 0 {
Page contents
 Introduction
 Code
 Data
 Comments

Introduction edit

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, and I wanted
to fill in an entry for tcl, with a fairly short and simple version of this 15-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.
There is one builtin puzzle, and more puzzles can be loaded from an external file.

}

Code edit

 # 15puzzle_35.tcl - HaJo Gurt -  2016-02-21
 # http://wiki.tcl.tk/14403

 #: 15-Puzzle - with grid, buttons and colors,
 #  and more puzzle-data from source.

  package require Tk

  set progVersion "15-Puzzle v0.35";        # 2016-02-21

  global Msg Moves PuzzNr GoalNr
  set Msg    $progVersion
  set Moves   0
  set PuzzNr  0
  set GoalNr  0

  set Keys   { 11 12 13 14  21 22 23 24  31 32 33 34  41 42 43 44 }

  set Puzz(T) "TheFifteenPuzzle"; # Title
  set Goal(T) "...Fifteen......"; # Title-highlight

  set Goal(0) "ABCDEFGHIKLMNOP_"; # Rows LTR   / 1:E : 108
  set Goal(1) "AEINBFKOCGLPDHM_"; # Cols forw. / 1:M : 114

  set Puzz(0) "CAFBEGPNDLHIOKM_"; # E  / 156 from Tk-demo
 #set Puzz(1) "EGPNCAFBDLHIOKM_"; # moved to 4x4_puzz.tcl

  if { [catch { source 4x4_puzz.tcl } ] } { 
    bell
    set Msg "No puzzle-file"
  }

  set Puzzle $Puzz(T)
  set Goal_  $Goal(T)

#---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+---

  proc Move {k} {
  # find the key with the empty tile:
    set e -1
    foreach p $::Keys  {
      set t [.key$p cget -text]
      if { $t eq "_" } { set e $p }
    }
    if {$e  <  0} {return 0};   # no key with empty tile found
    if {$k == $e} {return 0};   # click was on the empty tile

    set t [.key$k cget -text]
    .key$e config -text $t
    .key$k config -text "_";  
    return 1
  }

  proc Check {} {
    set ok 0
    set i  0
    foreach k $::Keys {
      set t [.key$k cget -text]
      set g [string index $::Goal_ $i]
      incr i

      .key$k config -background white
      if { $t eq $g  } { .key$k config -background lightgreen; incr ok }
      if { $t eq "_" } { .key$k config -background gray }
    }

    # Solved:
    update
    if { $ok > 15 && $::Moves > 0} {
      foreach k $::Keys  {
        .key$k flash; bell;
      }
    }
  }

  proc Click {k} {
    set ::Msg ""
    set val [.key$k cget -text]
    set ok [Move $k]

    incr ::Moves $ok
    wm title . "$::Moves moves"
    Check
  }

  proc ShowKeys {} {
    set i 0
    foreach k $::Keys  {
      set t [string index $::Puzzle $i]
      incr i
      .key$k config -text $t -background white;  
    }
    Check
  }

  proc NewGame {N} {
    global Msg Moves PuzzNr GoalNr

                         set ::Goal_ $::Goal(0);
    if { $GoalNr == 1} { set ::Goal_ $::Goal(1); }
                 
    incr  PuzzNr $N
    if { [catch { set ::Puzzle $::Puzz($PuzzNr)} ] } { 
      wm title . "No puzzle $PuzzNr !"
      bell; after 333
      set PuzzNr 0;
      set ::Puzzle $::Puzz($PuzzNr)
    }

    if { $N==0 } {
      set Msg "Try again"
    } else { 
      set Msg "New game" 
    }

    set Moves 0
    ShowKeys
    wm title . "$Msg #$PuzzNr"
  }

#---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+---

  button .reset   -text "Restart"  -fg blue -command {NewGame  0}; # same puzzle
  button .newGame -text "New Game" -fg red  -command {NewGame +1}; # next puzzle

  bind   .newGame <3>              {NewGame -1};   # Rightclick : previous puzzle
  bind   .newGame <Shift-Button-1> {set PuzzNr 0}; # Shift-click: select puzzle #1

  foreach k $::Keys {
    button .key$k -text "$k" -width 4 -command "Click $k"
  }

  grid .newGame x .reset x -sticky nsew -pady 4

  grid .key11 .key12 .key13 .key14  -sticky nsew  -padx 1 -pady 1
  grid .key21 .key22 .key23 .key24  -sticky nsew  -padx 1 -pady 1
  grid .key31 .key32 .key33 .key34  -sticky nsew  -padx 1 -pady 1
  grid .key41 .key42 .key43 .key44  -sticky nsew  -padx 1 -pady 1

  grid configure .newGame .reset  -columnspan 2 -padx 15

  ShowKeys
  wm title . $Msg
  focus -force .
  wm resizable . 0 0

Data edit

This optional file provides additional puzzles, and gets included in the above program via source.

If this file is missing, the main program runs with just the one builtin puzzle.
 # 4x4_puzz.tcl - 2016-02-20
 # http://wiki.tcl.tk/14403

  if {![info exists Puzz]} {
    error "This script only provides data for the program '15puzzle.tcl'.\n\n"
  }

 ### Puzzle-data for 15puzzle_35.tcl :

 #set Puzz(0) "CAFBEGPNDLHIOKM_"; # E  / builtin, from Tk-demo

  set Puzz(1) "EGPNCAFBDLHIOKM_"; # -  / 116
  set Puzz(2) "EONKMI_GBHLPCFAD"; # L  / 133
  set Puzz(3) "PGM_ELNDOKHIBCFA"; # EK / 146
  set Puzz(4) "ABIKCDLMEFNOGHP_"; # ABP / 98
  set Puzz(5) "IKAB_PCDLMEFNOGH"; # NO  / 61
#...more puzzles...

Comments edit

HJG The game is working fine, but there is no check if the clicked button is next to the empty tile.

I wanted to take care of that with '-state disabled' / '-state normal', but doing that resulted in some strange effects...

As-is, you have the choice to play it by 'sliding' or 'swapping'.
I think this a valid variant to play - find the perfect swapping-sequence (akin to Tower-of-Hanoi).

The button "New game" selects the next game, "Restart" starts the same puzzle again.
Rightclick on "New game" selects the previous puzzle, and a shift-click goes back to puzzle #1.

I changed from lists to strings, and there is an include-file now, with more puzzles.
A puzzle-generator (to-be-written) could just append lines to that file.

See also:

Category ApplicationCategory GamesCategory GUI