;******************************************************************************
;
; File name     : mkPuzzle.stk
; Creation date : Aug-9-1993
; Last update   : Aug-10-1993
;
;******************************************************************************
;
; STk adaptation of the Tk widget demo.
;
; mkPuzzle:
; Create a top-level window containing a 15-puzzle game.
;
;******************************************************************************

(provide "mkPuzzle")

(define xpos (make-vector 16))
(define ypos (make-vector 16))
(define space 0)


(define (mkPuzzle)
  (catch (destroy .top-puzzle))
  (toplevel ".top-puzzle")
  (dpos .top-puzzle)
  (wm 'title .top-puzzle "15-Puzzle Demonstration")
  (wm 'iconname .top-puzzle "15-Puzzle")

  (message ".top-puzzle.m"
	   :font "-Adobe-times-medium-r-normal--*-180*" :aspect 300
	   :text "A 15-puzzle appears below as a collection of buttons.\n\nClick 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.\n\nClick the \"OK\" button when you've finished playing.")
  (frame ".top-puzzle.f" :geometry "120x120" :borderwidth 2 :relief "sunken"
	 :bg "Bisque3")
  (button ".top-puzzle.ok" :text "OK" :command '(destroy .top-puzzle))
  (pack .top-puzzle.m :side "top")
  (pack .top-puzzle.f :side "top" :padx 5 :pady 5)
  (pack .top-puzzle.ok :side "bottom" :fill "x")

  (for ((order '(3 1 6 2 5 7 15 13 4 11 8 9 14 10 12))
	(i 0 (+ i 1))
	(num ()))
       (< i 15)
       (set! num (list-ref order i))
       (vector-set! xpos num (* (modulo i 4) 0.25))
       (vector-set! ypos num (* (floor (/ i 4)) 0.25))
       (button (& ".top-puzzle.f." num)
	       :relief "raised" :text num
	       :command `(puzzle-switch .top-puzzle ,num))
       (place (& ".top-puzzle.f." num)
	      :relx (vector-ref xpos num) :rely (vector-ref ypos num)
	      :relwidth 0.25 :relheight 0.25))

  (vector-set! xpos space 0.75)
  (vector-set! ypos space 0.75))


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

(define (puzzle-switch w num)
  (let ((x (vector-ref xpos num)) (y (vector-ref ypos num))
        (x_spc (vector-ref xpos space)) (y_spc (vector-ref ypos space)))
    (if (or (and (>= y (- y_spc 0.01)) (<= y (+ y_spc 0.01))
		 (>= x (- x_spc 0.26)) (<= x (+ x_spc 0.26)))
	    (and (>= x (- x_spc 0.01)) (<= x (+ x_spc 0.01))
		 (>= y (- y_spc 0.26)) (<= y (+ y_spc 0.26))))
	(begin
	  (vector-set! xpos space x)
	  (vector-set! xpos num x_spc)
	  (vector-set! ypos space y)
	  (vector-set! ypos num y_spc)
	  (place (& w ".f." num) :relx x_spc :rely y_spc)))))