#!/usr/lib/scadalisp/bin/phlisp

(require "filesel")
(require "widgets")
(require "readwgt")
(require "imageproc")
(require "usage")

(setq __USAGE "
#ifdef __USAGE
#%C	[-r reduction] [filename]
#    -r reduction  Reduce by reduction ratio (e.g., .5=half)
#
#    Plays the 16-puzzle game with the named image, or queries the user
#    for an image if none is given.
#endif
")

;;;
;;; Some configuration options
;;;

(setq Reduction 1)
(setq BaseDir ".")
(setq WidgetFiles nil)

;;;
;;; Parse the argument list.
;;;

(setq imagename nil)

(do ((arg (cdr argv) (cdr arg))
     (i (car arg) (car arg)))
    ((not arg))
    (cond
     ((equal i "-r") (setq Reduction (number (cadr arg)))
      (if (= Reduction 0) (setq Reduction 0.5))
      (setq arg (cdr arg)))
     ((equal (substr i 0 1) "-") (exit-program (Usage)))
     (t (setq imagename i))
     )
    )

;;;
;;; Initialize Photon
;;;

(PtInit nil)

;;;
;;; Create an image label with the current parent.  Do not display it.
;;;

(defun image-label (image)
  (let (lab)
    (if image
	(progn
	  (setq lab (new PtLabel))
	  (lab SetArea 0 0 0 0)
	  (-> lab label_type Pt_IMAGE)
	  (-> lab border_width 0)
	  (-> lab margin_width 0)
	  (-> lab margin_height 0)
	  (-> lab label_data image)
	  )
      )
    lab
    )
  )

;;;
;;; Add a row and col instance variable to PtLabel
;;;

(class-add-ivar PtLabel 'row)
(class-add-ivar PtLabel 'col)

;;;
;;; Load an image and cut it into a 4x4 mess.  Create a window big enough for
;;; the whole thing and display all the pieces except one.
;;;

(defun get-image-grid (filename)
  (let (image subims win lab w h pieces)
    (if (not (equal (substr filename 0 1) "/"))
	(setq filename (string BaseDir "/" filename)))
    (setq image (PxLoadImage filename))
    (if (< Reduction 1)
	(progn
	  (setq image (PxReduceImage image Reduction Reduction))
	  (gc)))		; explicitly reclaim large image buffer
    (setq subims (ImageSubDivide image 4 4))
    (setq subims (reverse (cdr (reverse subims))))
    (setq win (new PtWindow))
    (-> win title (string filename))
    (win SetArea 10 10 (@ (@ image size) w) (@ (@ image size) h))
    (setq w (@ (@ (car subims) size) w))
    (setq h (@ (@ (car subims) size) h))

    (setq pieces (make-array 4))
    (do ((row 0 (++ row)))
	((>= row 4))
	(aset pieces row (make-array 4))
	(do ((col 0 (++ col)))
	    ((>= col 4))
	    (if subims
		(progn
		  (setq lab (image-label (car subims)))
		  (lab SetPos (* col w) (* row h))
		  (lab SetDim (@ (@ (car subims) size) w)
		       (@ (@ (car subims) size) h))
		  (-> lab flags Pt_SELECTABLE)
		  (-> lab row row)
		  (-> lab col col)
		  (-> lab label_flags (cons Pt_LABEL_SELECT_SHIFT nil))
		  (PtAttachCallback lab Pt_CB_ACTIVATE
				    `(MovePieceToEmpty ,lab))
		  (aset (aref pieces row) col lab)
		  (setq subims (cdr subims))
		  )
	      )
	    )
	)
    (Jumble pieces)
    (PtRealizeWidget win)
    pieces
    )
  )

;;;
;;; Slide a piece from its current row and column by incrementing the
;;; row and column appropriately.
;;;

(defun MovePiece (piece row col rowinc colinc)
  (let ((steps 25) (x (@ (@ piece pos) x)) (y (@ (@ piece pos) y))
	rowmove colmove goalx goaly (newpos {PhPoint}))
    (setq rowmove (* rowinc (/ (@ (@ piece dim) h) steps)))
    (setq colmove (* colinc (/ (@ (@ piece dim) w) steps)))
    (setq goalx (+ (@ (@ piece pos) x) (* colinc (@ (@ piece dim) w))))
    (setq goaly (+ (@ (@ piece pos) y) (* rowinc (@ (@ piece dim) h))))
    (do ((i 0 (++ i)))
	((>= i steps))
	(setq x (+ x colmove))
	(setq y (+ y rowmove))
	(-> newpos x x)
	(-> newpos y y)
	(-> piece pos (cons newpos Pt_BLIT_FORCE))
	(PtUpdate)
	)
    (-> newpos x goalx)
    (-> newpos y goaly)
    (-> piece pos (cons newpos Pt_BLIT_FORCE))
    (PtUpdate)
    (-> piece row (+ row rowinc))
    (-> piece col (+ col colinc))
    )
  )

;;;
;;; Move a piece to a new row, possibly pushing others ahead
;;;

(defun RowMove (pieces row col)
  (let (index compare piece)
    (setq index (if (> row RowEmpty) 1 -1))
    (setq compare (if (> row RowEmpty) > <))
    (do ((i (+ RowEmpty index) (+ i index)))
	((compare i row))
	(setq piece (aref (aref pieces i) col))
	(MovePiece piece i col (neg index) 0)
	(aset (aref pieces i) col nil)
	(aset (aref pieces RowEmpty) ColEmpty piece)
	(setq RowEmpty i)
	(setq ColEmpty col)
	)
    )
  )

;;;
;;; Move a piece to a new col, possibly pushing others ahead
;;;

(defun ColMove (pieces row col)
  (let (index compare piece)
    (setq index (if (> col ColEmpty) 1 -1))
    (setq compare (if (> col ColEmpty) > <))
    (do ((i (+ ColEmpty index) (+ i index)))
	((compare i col))
	(setq piece (aref (aref pieces row) i) )
	(MovePiece piece row i 0 (neg index))
	(aset (aref pieces row) i nil)
	(aset (aref pieces RowEmpty) ColEmpty piece)
	(setq RowEmpty row)
	(setq ColEmpty i)
	)
    )
  )

;;;
;;; Move a piece to the empty square if possible.
;;;

(defun MovePieceToEmpty (piece)
  (let (row col)
    (setq row (@ piece row))
    (setq col (@ piece col))
    (if (= row RowEmpty)
	(ColMove Pieces row col)
      (if (= col ColEmpty)
	  (RowMove Pieces row col)))
    )
  )

;;;
;;; Randomly move the empty square around, modifying the positions of the
;;; square being replaced.
;;;

(defun MoveEmptyRandomly (pieces)
  (let (x y piece (xdif 0) (ydif 0) oldcol oldrow)
    (if (= 0 (floor (* (random) 2)))
	(progn
	  (setq xdif (- (* (floor (* (random) 2)) 2) 1))
	  (setq x (+ ColEmpty xdif))
	  (setq y RowEmpty)
	  (if (or (> x 3) (< x 0))
	      (setq x (- ColEmpty xdif)))
	  )
      (progn
	(setq ydif (- (* (floor (* (random) 2)) 2) 1))
	(setq y (+ RowEmpty ydif))
	(setq x ColEmpty)
	(if (or (> y 3) (< y 0))
	    (setq y (- RowEmpty ydif)))
	)
      )
    (setq piece (aref (aref pieces y) x))
    (if piece
	(progn
	  (setq oldcol (@ piece col))
	  (setq oldrow (@ piece row))
	  (-> piece row RowEmpty)
	  (-> piece col ColEmpty)
	  (aset (aref pieces RowEmpty) ColEmpty piece)
	  (setq RowEmpty oldrow)
	  (setq ColEmpty oldcol)
	  (aset (aref pieces RowEmpty) ColEmpty nil)
	  )
      )
    )
  )

;;;
;;; Jumble all the pieces by moving the empty square around for a while.
;;; When it's all over, re-position the parts of the image.
;;;

(defun Jumble (pieces)
  (let (x y piece)
    (do ((i 0 (++ i)))
	((> i 500))
	(MoveEmptyRandomly pieces)
	)
    (do ((i 0 (++ i)))
	((> i 3))
	(do ((j 0 (++ j)))
	    ((> j 3))
	    (setq piece (aref (aref pieces i) j))
	    (if piece
		(piece SetPos (* j (@ (@ piece dim) w))
		       (* i (@ (@ piece dim) h)))
	      )
	    )
	)
    )
  )

;;;
;;; The mainline.
;;;

(if (not imagename)
    (setq imagename (ModalFileSelector BaseDir "*.{gif,jpg,bmp}")))

(if imagename
    (progn
      (setq RowEmpty 3)
      (setq ColEmpty 3)
      (set-random (clock))
      (setq Pieces (get-image-grid imagename))
      (PtMainLoop)
      )
  )
