Return to mkPuzzle.tcl CVS log

Up to [Micropolis - Activity] / micropolis / src / tk / library / demos

Annotation of micropolis/src/tk/library/demos/mkPuzzle.tcl, revision 1.1.1.1

1.1       root        1: # mkPuzzle w
                      2: #
                      3: # Create a top-level window containing a 15-puzzle game.
                      4: #
                      5: # Arguments:
                      6: #    w -       Name to use for new top-level window.
                      7: 
                      8: proc mkPuzzle {{w .p1}} {
                      9:     catch {destroy $w}
                     10:     toplevel $w
                     11:     dpos $w
                     12:     wm title $w "15-Puzzle Demonstration"
                     13:     wm iconname $w "15-Puzzle"
                     14:     message $w.msg -font -Adobe-times-medium-r-normal--*-180* -aspect 300 \
                     15:            -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."
                     16:     set order {3 1 6 2 5 7 15 13 4 11 8 9 14 10 12}
                     17:     global xpos ypos
                     18:     frame $w.frame -geometry 120x120 -borderwidth 2 -relief sunken \
                     19:        -bg Bisque3
                     20: 
                     21:     for {set i 0} {$i < 15} {set i [expr $i+1]} {
                     22:        set num [lindex $order $i]
                     23:        set xpos($num) [expr ($i%4)*.25]
                     24:        set ypos($num) [expr ($i/4)*.25]
                     25:        button $w.frame.$num -relief raised -text $num \
                     26:                -command "puzzle.switch $w $num"
                     27:        place $w.frame.$num -relx $xpos($num) -rely $ypos($num) \
                     28:            -relwidth .25 -relheight .25
                     29:     }
                     30:     set xpos(space) .75
                     31:     set ypos(space) .75
                     32: 
                     33:     button $w.ok -text OK -command "destroy $w"
                     34: 
                     35:     pack append $w $w.msg {top fill} $w.frame {top expand padx 10 pady 10} \
                     36:            $w.ok {bottom fill}
                     37: }
                     38: 
                     39: 
                     40: # Procedure invoked by buttons in the puzzle to resize the puzzle entries:
                     41: 
                     42: proc puzzle.switch {w num} {
                     43:     global xpos ypos
                     44:     if {(($ypos($num) >= ($ypos(space) - .01))
                     45:            && ($ypos($num) <= ($ypos(space) + .01))
                     46:            && ($xpos($num) >= ($xpos(space) - .26))
                     47:            && ($xpos($num) <= ($xpos(space) + .26)))
                     48:            || (($xpos($num) >= ($xpos(space) - .01))
                     49:            && ($xpos($num) <= ($xpos(space) + .01))
                     50:            && ($ypos($num) >= ($ypos(space) - .26))
                     51:            && ($ypos($num) <= ($ypos(space) + .26)))} {
                     52:        set tmp $xpos(space)
                     53:        set xpos(space) $xpos($num)
                     54:        set xpos($num) $tmp
                     55:        set tmp $ypos(space)
                     56:        set ypos(space) $ypos($num)
                     57:        set ypos($num) $tmp
                     58:        place $w.frame.$num -relx $xpos($num) -rely $ypos($num)
                     59:     }
                     60: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.