ftp.nice.ch/pub/next/developer/languages/lisp/gcl.2.2-LISP.I.bs.tar.gz#/gcl-2.2/gcl-tk/demos/mkPuzzle.tcl

This is mkPuzzle.tcl in view mode; [Download] [Up]

# mkPuzzle w
#
# Create a top-level window containing a 15-puzzle game.
#
# Arguments:
#    w -	Name to use for new top-level window.

proc mkPuzzle {{w .p1}} {
    global xpos ypos
    catch {destroy $w}
    toplevel $w
    dpos $w
    wm title $w "15-Puzzle Demonstration"
    wm iconname $w "15-Puzzle"

    message $w.msg -font -Adobe-times-medium-r-normal--*-180* -aspect 300 \
	    -text "A 15-puzzle appears below as a collection of buttons.  Click on any of the pieces next to the space, and that piece will slide over the space.  Continue this until the pieces are arranged in numerical order from upper-left to lower-right.  Click the \"OK\" button when you've finished playing."
    frame $w.frame -geometry 120x120 -borderwidth 2 -relief sunken \
	-bg Bisque3
    button $w.ok -text OK -command "destroy $w"
    pack $w.msg -side top
    pack $w.frame -side top -padx 5 -pady 5
    pack $w.ok -side bottom -fill x

    set order {3 1 6 2 5 7 15 13 4 11 8 9 14 10 12}
    for {set i 0} {$i < 15} {set i [expr $i+1]} {
	set num [lindex $order $i]
	set xpos($num) [expr ($i%4)*.25]
	set ypos($num) [expr ($i/4)*.25]
	button $w.frame.$num -relief raised -text $num \
		-command "puzzle.switch $w $num"
	place $w.frame.$num -relx $xpos($num) -rely $ypos($num) \
	    -relwidth .25 -relheight .25
    }
    set xpos(space) .75
    set ypos(space) .75
}

# Procedure invoked by buttons in the puzzle to resize the puzzle entries:

proc puzzle.switch {w num} {
    global xpos ypos
    if {(($ypos($num) >= ($ypos(space) - .01))
	    && ($ypos($num) <= ($ypos(space) + .01))
	    && ($xpos($num) >= ($xpos(space) - .26))
	    && ($xpos($num) <= ($xpos(space) + .26)))
	    || (($xpos($num) >= ($xpos(space) - .01))
	    && ($xpos($num) <= ($xpos(space) + .01))
	    && ($ypos($num) >= ($ypos(space) - .26))
	    && ($ypos($num) <= ($ypos(space) + .26)))} {
	set tmp $xpos(space)
	set xpos(space) $xpos($num)
	set xpos($num) $tmp
	set tmp $ypos(space)
	set ypos(space) $ypos($num)
	set ypos($num) $tmp
	place $w.frame.$num -relx $xpos($num) -rely $ypos($num)
    }
}

These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.