 
;(load "./proyecto/ltk-0.91/ltk")

;(in-package :ltk)  ;; Cambiar el paquete de trabajo actual a LTK

;(load "./proyecto/aco2.lsp")



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;                                 ;;;;
;;;;                                 ;;;;
;;;;   JUEGO EL RATON Y LOS GATOS    ;;;;
;;;;                                 ;;;;
;;;;                                 ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;                                 ;;;;
;;;;  DEFINICIONES DE VARIABLES Y    ;;;;
;;;;                                 ;;;;
;;;;      PARÁMETROS GLOBALES        ;;;;
;;;;                                 ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defvar *juego*)

(defvar *ventana*)

(defvar *casillas*)   ;; Matriz 8x8 donde se almacenan los botones que representan el tablero.

(defvar *tablero*)    ;; Matriz 8x8 donde se almacena el estado del tablero.

(defvar *modo*)       ;; Modo de juego: P1 Vs CPU, P1 Vs P2, CPU Vs CPU 

(defvar *jugador*)    ;; Indica el bando con el que juega el humano.

(defvar *turno*)      ;; Indica el turno de juego

(defvar *profundidad*)

(defvar *posiciones*)

(defvar *contador*)

(defvar *heuristica-MAX*)

(defvar *heuristica-MIN*)

(defparameter *movimientos* '((+1 . -1) (+1 . +1) (-1 . -1) (-1 . +1)))

(defparameter *movimientos-2* '((-1 . -1) (0 . -1) (+1 . -1) (+1 . 0) 
				(+1 . +1) (0 . +1) (-1 . +1) (-1 . 0)))

(defparameter *movimientos-3* '((+1 . -1) (+1 . 0) (+1 . +1) (0 . +1) 
				(-1 . +1) (-1 . 0) (-1 . -1) (0 . -1)))

						       
(defparameter *minimo-valor* -99999)

(defparameter *maximo-valor* 99999)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;                                 ;;;;
;;;;                                 ;;;;
;;;;       FUNCIONES COMUNES         ;;;;
;;;;                                 ;;;;
;;;;                                 ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun casilla-libre (tablero casilla)
  (if (= (aref tablero (first casilla) (rest casilla)) 0)
      t
    nil))


(defun escribe-jugadas (lista archivo)
  (with-open-file (output-stream archivo :direction :output :if-does-not-exist :create :if-exists :append)
                  (loop for linea in lista do
                        (format output-stream "~a~%~%~%" linea))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;                                 ;;;;
;;;;                                 ;;;;
;;;;    FUNCIONES PARA MINIMAX       ;;;;
;;;;                                 ;;;;
;;;;                                 ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun f1-estatica-1 (tablero posiciones turno)
  (let ((valor (1- *maximo-valor*)))
    (setf valor (- valor (* 100 (- 7 (first (first posiciones))))))
    (setf valor (- valor (no-gatos-sobrepasados posiciones)))
    (cond ((and (< (+ (first (nth 1 posiciones)) (first (nth 2 posiciones)))
		   (+ (first (nth 3 posiciones)) (first (nth 4 posiciones))))
		(<= (rest (first posiciones)) 3))
	   (setf valor (- valor  (* 100 (- 7 (rest (first posiciones)))))))
	  ((and (> (+ (first (nth 1 posiciones)) (first (nth 2 posiciones)))
		   (+ (first (nth 3 posiciones)) (first (nth 4 posiciones))))
		(>= (rest (first posiciones)) 4))
	   (setf valor (- valor  (* 100 (rest (first posiciones)))))))
    (cond ((> 12 (+ (rest (nth 1 posiciones)) (rest (nth 2 posiciones))
		    (rest (nth 3 posiciones)) (rest (nth 4 posiciones))))
	   (setf valor (- valor  (* 100 (- 7 (rest (first posiciones)))))))
	  ((< 16 (+ (rest (nth 1 posiciones)) (rest (nth 2 posiciones))
		    (rest (nth 3 posiciones)) (rest (nth 4 posiciones))))
	   (setf valor (- valor  (* 100 (rest (first posiciones)))))))
    valor))



(defun f1-estatica-2 (tablero posiciones turno)
  (let ((valor (1- *maximo-valor*)))
    (setf valor (- valor (* 1000 (- 7 (first (first posiciones))))))
    (setf valor (- valor (no-gatos-sobrepasados posiciones)))
    (cond ((and (< (+ (first (nth 1 posiciones)) (first (nth 2 posiciones)))
		   (+ (first (nth 3 posiciones)) (first (nth 4 posiciones))))
		(<= (rest (first posiciones)) 3))
	   (setf valor (- valor  (* 50 (- 7 (rest (first posiciones)))))))
	  ((and (> (+ (first (nth 1 posiciones)) (first (nth 2 posiciones)))
		   (+ (first (nth 3 posiciones)) (first (nth 4 posiciones))))
		(>= (rest (first posiciones)) 4))
	   (setf valor (- valor  (* 50 (rest (first posiciones)))))))
    (cond ((> 12 (+ (rest (nth 1 posiciones)) (rest (nth 2 posiciones))
		    (rest (nth 3 posiciones)) (rest (nth 4 posiciones))))
	   (setf valor (- valor  (* 50 (- 7 (rest (first posiciones)))))))
	  ((< 16 (+ (rest (nth 1 posiciones)) (rest (nth 2 posiciones))
		    (rest (nth 3 posiciones)) (rest (nth 4 posiciones))))
	   (setf valor (- valor  (* 50 (rest (first posiciones)))))))
    valor))


(defun f1-estatica-3 (tablero posiciones turno)
  (let ((valor (1- *maximo-valor*)))
    (setf valor (- valor (* 50 (- 7 (first (first posiciones))))))
    (setf valor (- valor (no-gatos-sobrepasados posiciones)))
    (cond ((and (< (+ (first (nth 1 posiciones)) (first (nth 2 posiciones)))
		   (+ (first (nth 3 posiciones)) (first (nth 4 posiciones))))
		(<= (rest (first posiciones)) 3))
	   (setf valor (- valor  (* 200 (- 7 (rest (first posiciones)))))))
	  ((and (> (+ (first (nth 1 posiciones)) (first (nth 2 posiciones)))
		   (+ (first (nth 3 posiciones)) (first (nth 4 posiciones))))
		(>= (rest (first posiciones)) 4))
	   (setf valor (- valor  (* 200 (rest (first posiciones)))))))
    (cond ((> 12 (+ (rest (nth 1 posiciones)) (rest (nth 2 posiciones))
		    (rest (nth 3 posiciones)) (rest (nth 4 posiciones))))
	   (setf valor (- valor  (* 200 (- 7 (rest (first posiciones)))))))
	  ((< 16 (+ (rest (nth 1 posiciones)) (rest (nth 2 posiciones))
		    (rest (nth 3 posiciones)) (rest (nth 4 posiciones))))
	   (setf valor (- valor  (* 200 (rest (first posiciones)))))))
    valor))





(defun no-gatos-sobrepasados (posiciones)
  (let ((contador 0))
    (loop for posicion in (subseq posiciones 1 5) do
	  (if (< (first (first posiciones)) (first posicion))
	      (setf contador (1+ contador))))
    (* 1000 contador)))

(defun f1-estatica-4 (tablero posiciones turno)
  (let ((valor (1+ *minimo-valor*)))
    (setf valor (+ valor (no-misma-linea-horizontal posiciones)))
    (setf valor (+ valor (gatos-sobrepasados posiciones)))
    (setf valor (+ valor (hay-huecos-vertical posiciones)))
  ; (setf valor (+ valor (hay-huecos-diagonal posiciones)))
    (setf valor (+ valor (hay-huecos-horizontal posiciones)))
    valor))




(defun f1-estatica-5 (tablero posiciones turno)
  (let ((valor (1+ *minimo-valor*)))
    (setf valor (+ valor (no-misma-linea-horizontal posiciones)))
    ;(setf valor (+ valor (gatos-sobrepasados posiciones)))
    (setf valor (+ valor (hay-huecos-vertical posiciones)))
    (setf valor (+ valor (hay-huecos-diagonal posiciones)))
    (setf valor (+ valor (hay-huecos-horizontal posiciones)))
    valor))

(defun f1-estatica-6 (tablero posiciones turno)
  (let ((valor (1+ *minimo-valor*)))
    (setf valor (+ valor (no-misma-linea-horizontal posiciones)))
    (setf valor (+ valor (gatos-sobrepasados posiciones)))
  ;  (setf valor (+ valor (hay-huecos-vertical posiciones)))
  ; (setf valor (+ valor (hay-huecos-diagonal posiciones)))
  ;  (setf valor (+ valor (hay-huecos-horizontal posiciones)))
    valor))


(defun no-misma-linea-horizontal (posiciones)
  (let ((pos-i (loop for posicion in (subseq posiciones 1 5) collect (first posicion))))
    (* 1000 (abs (- (apply #'max pos-i) (apply #'min pos-i))))))

(defun gatos-sobrepasados (posiciones)
  (let ((contador 0))
    (loop for posicion in (subseq posiciones 1 5) do
	  (if (>= (first (first posiciones)) (first posicion))
	      (setf contador (1+ contador))))
    (* 200 contador)))

(defun hay-huecos-vertical (posiciones)
  (let ((contador 0)
	(j-actual -1))
    (loop for posicion in (subseq posiciones 1 5) do
	  (if (> (abs (- (rest posicion) j-actual)) 2)
	      (setf contador (1+ contador)))
	  (setf j-actual (rest posicion)))
    (if (> (abs (- 8 j-actual)) 2)
	(setf contador (+ contador (- 8 j-actual))))
    (* 100 contador)))

(defun hay-huecos-diagonal (posiciones)
  (let ((contador 0)
	(i-actual (first (nth 1 posiciones)))
	(j-actual (rest (nth 1 posiciones))))
    (loop for posicion in (subseq posiciones 2 5) do
	  (if (= (abs (- (first posicion) i-actual)) (abs (- (rest posicion) j-actual)))
	      (setf contador (1+ contador)))
	  (setf i-actual (first posicion))
	  (setf j-actual (rest posicion)))
    (* 30 contador)))

(defun hay-huecos-horizontal (posiciones)
  (let ((contador 0)
	(i-actual (first (nth 1 posiciones))))
    (loop for posicion in (subseq posiciones 2 5) do
	  (if (> (abs (- (first posicion) i-actual)) 1)
	      (setf contador (+ contador (abs (- (first posicion) i-actual)))))
	  (setf i-actual (first posicion)))
    (* 80 contador))) 


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;                                 ;;;;
;;;;                                 ;;;;
;;;;  FIN      PRUEBAS               ;;;;
;;;;                                 ;;;;
;;;;                                 ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  
       
(defun movimientos-validos (tablero origen turno)
  (cond ((= turno 1)
	 (loop for posibilidad in *movimientos*
	       when (and (>= (+ (first origen) (first posibilidad)) 0)
			 (<= (+ (first origen) (first posibilidad)) 7)
			 (>= (+ (rest origen) (rest posibilidad)) 0)
			 (<= (+ (rest origen) (rest posibilidad)) 7)
			 (casilla-libre tablero (cons (+ (first origen) (first posibilidad))
						      (+ (rest origen) (rest posibilidad))))) collect
						      (cons (+ (first origen) (first posibilidad))
							    (+ (rest origen) (rest posibilidad)))))
	((= turno 2)
	 (loop for posibilidad in (subseq *movimientos* 2 4) 
	       when (and (>= (+ (first origen) (first posibilidad)) 0)
			 (<= (+ (first origen) (first posibilidad)) 7)
			 (>= (+ (rest origen) (rest posibilidad)) 0)
			 (<= (+ (rest origen) (rest posibilidad)) 7)
			 (casilla-libre tablero (cons (+ (first origen) (first posibilidad))
						      (+ (rest origen) (rest posibilidad))))) collect
						      (cons (+ (first origen) (first posibilidad))
							    (+ (rest origen) (rest posibilidad)))))))



(defun numero-movimientos-posibles (tablero posiciones turno)
  (let ((numero 0))
    (cond ((= turno 1)
	   (setf numero (length (movimientos-validos tablero (first posiciones) turno))))
	  ((= turno 2)
	   (loop for posicion in (subseq posiciones 1 5) do
		 (setf numero (+ numero (length (movimientos-validos tablero posicion turno)))))))
    numero))


(defun es-estado-ganador (tablero posiciones turno)  
  (or (= 0 (numero-movimientos-posibles tablero posiciones turno))
      (= 1 (loop for i from 0 to 7 when (= 1 (aref tablero 7 i)) count i))))



;Funcion auxiliar para el calculo de sucesores.


(defun crea-sucesor (tablero posiciones origen destino turno)
  (let ((sucesor (make-array '(8 8)))
	(posicion (loop for i in posiciones collect i)))
    (loop for i from 0 to 4 when (eq origen (nth i posiciones)) do
	  (setf (nth i posicion) destino))
    (loop for fila from 0 to 7 do
	  (loop for columna from 0 to 7 do
		(setf (aref sucesor fila columna) (aref tablero fila columna))))
    (setf (aref sucesor (first origen) (rest origen)) 0)
    (setf (aref sucesor (first destino) (rest destino)) turno)
    (cons sucesor posicion)))


;Funcion auxiliar para el algoritmo minimax. Dado un tablero y un
;turno pasados como parametro, calcula todos los sucesores de dicho
;tablero.

(defun calcula-sucesores (tablero posiciones turno)
  (let ((sucesores nil)
	(origen nil))
    (cond ((= turno 1)
	   (setf origen (first posiciones))
	   (loop for posibilidad in (movimientos-validos tablero origen turno) do
		 (setf sucesores (append sucesores 
					 (list (crea-sucesor tablero posiciones origen posibilidad turno))))))
	  ((= turno 2)
	   (setf origen (subseq posiciones 1 5))
	   (loop for orig in origen do
		 (loop for posibilidad in (movimientos-validos tablero orig turno) do
		       (setf sucesores (append sucesores 
					       (list (crea-sucesor tablero posiciones orig posibilidad turno))))))))
    sucesores))


;Funcion recursiva con poda para el calculo del valor minimax de un nodo
;MAX. Si ha llegado a la profundidad maxima o el nodo es un tablero
;final, calcula el valor del nodo llamando a la funcion de evaluacion
;estatica *heuristica*. Sino realiza recursion.

(defun maximizador-alpha-beta (tablero-sucesor posiciones profundidad alpha beta)
  (let ((valor-max *minimo-valor*))
    (cond ((es-estado-ganador tablero-sucesor posiciones 1)  
	  ; (setf valor-max *maximo-valor*))
	   (if (= profundidad *profundidad*)
	       (setf valor-max -10000)
	     (setf valor-max *minimo-valor*)))
	  ((= profundidad 0)
	   (setf valor-max (funcall *heuristica-MAX* tablero-sucesor posiciones 1)))
	  (t
	   (let ((sucesores (calcula-sucesores tablero-sucesor posiciones 1)) 
		 (poda nil))
	     (loop for sucesor-actual in sucesores while (not poda) do
		   (setf valor-max (max (minimizador-alpha-beta (first sucesor-actual) (rest sucesor-actual)
								(1- profundidad) alpha beta) 
					valor-max)) 
		   (if (>= valor-max beta)
		       (setf poda t)) 
		   (setf alpha (max alpha valor-max))))))
    valor-max))


;Funcion recursiva con poda para el calculo del valor minimax,
;equivalente a la anterior pero sobre un nodo MIN. Si ha llegado
;a la profundidad maxima o el nodo es un tablero final, calcula 
;el valor del nodo llamando a la funcion de evaluacion estatica 
;*heuristica*. Sino realiza recursion.

(defun minimizador-alpha-beta (tablero-sucesor posiciones profundidad alpha beta)
  (let ((valor-min *maximo-valor*))
    (cond ((es-estado-ganador tablero-sucesor posiciones 2)
	   ;(setf valor-min *minimo-valor*))
	   (if (= profundidad *profundidad*)
	       (setf valor-min 10000)
	     (setf valor-min *maximo-valor*)))
	  ((= profundidad 0)
	   (setf valor-min (funcall *heuristica-MIN* tablero-sucesor posiciones 2)))
	  (t
	   (let ((sucesores (calcula-sucesores tablero-sucesor posiciones 2))
		 (poda nil))
	     (loop for sucesor-actual in sucesores while (not poda) do
		   (setf valor-min (min (maximizador-alpha-beta (first sucesor-actual) (rest sucesor-actual)
								(1- profundidad) alpha beta)
					valor-min))
		   (if (<= valor-min alpha)
		       (setf poda t))
		   (setf beta (min beta valor-min))))))
    valor-min))


;Funcion principal para el calculo de minimax sobre un nodo MAX, a
;partir de esta funcion comenzara la recursion, la profundidad y la
;poda alpha-beta. Devuelve el mejor tablero sucesor.


(defun minimax-nodoMAX ()
  (let* ((valor-max *minimo-valor*) 
	 (sucesores (calcula-sucesores *tablero* *posiciones* 1)) 
	 (valor-actual 0)
	 (mejor-sucesor (first sucesores)))
    (loop for sucesor-actual in sucesores do
	  (setf valor-actual 
		(minimizador-alpha-beta (first sucesor-actual) (rest sucesor-actual)
					*profundidad* valor-max *maximo-valor*))
	  (cond ((= valor-actual 10000)
		 (setf mejor-sucesor sucesor-actual)
		 (return))
		((> valor-actual valor-max)
		 (setf mejor-sucesor sucesor-actual)
		 (setf valor-max valor-actual))
		(t nil)))
    mejor-sucesor))


(defun minimax-nodoMIN ()
  (let* ((valor-min *maximo-valor*)
	 (sucesores (calcula-sucesores *tablero* *posiciones* 2))
	 (valor-actual 0)
	 (mejor-sucesor (first sucesores)))
    (loop for sucesor-actual in sucesores do
	  (setf valor-actual 
		(maximizador-alpha-beta (first sucesor-actual) (rest sucesor-actual)
					*profundidad* *minimo-valor* valor-min))
	  (cond ((= valor-actual -10000)
		 (setf mejor-sucesor sucesor-actual)
		 (return))
		((< valor-actual valor-min)
		 (setf mejor-sucesor sucesor-actual)
		 (setf valor-min valor-actual))
		(t nil)))
    mejor-sucesor))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;                                 ;;;;
;;;;                                 ;;;;
;;;;      FUNCIONES PARA JUGAR       ;;;;
;;;;                                 ;;;;
;;;;                                 ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun finaliza-juego ()
  (cond ((= *turno* 1)
	 (do-msg "Han ganado los gatos"))
	((= *turno* 2)
	 (do-msg "Ha ganado el raton"))))


(defun comprueba-si-fin ()
  (if (= *turno* 1)
      (setf *turno* 2)
    (setf *turno* 1))
  (cond ((not (es-estado-ganador *tablero* *posiciones* *turno*))
	 (escribe-jugadas (list *tablero*) "./proyecto/save/raton-gatos.txt")
	 (bind *Boton-Ayuda* "<ButtonPress-1>" (lambda (evt)
						 (pide-ayuda)))
	 (selecciona-ficha))
	(t
	 (bind *Boton-Ayuda* "<ButtonPress-1>" ())
	 (finaliza-juego))))


(defun aplica-movimiento (origen boton-destino posibilidades)
  (let ((imgvacia (make-image))
	(imgblanca (make-image))
	(imgnegra (make-image))
	(destino (first (loop for posibilidad in posibilidades 
		       when (eq (aref *casillas* (first posibilidad) (rest posibilidad))
				boton-destino) collect posibilidad))))
    (loop for i from 0 to 4 when (eq (nth i *posiciones*) origen) do
	  (setf (nth i *posiciones*) destino))
    (setf (aref *tablero* (first origen) (rest origen)) 0)
    (configure (aref *casillas* (first origen) (rest origen)) :image imgvacia)
    (cond ((= *turno* 1)
	   (setf (aref *tablero* (first destino) (rest destino)) 1)
	   (image-load imgblanca "./proyecto/imagenes/raton.gif")
	   (configure boton-destino :image imgblanca))
	  ((= *turno* 2)
	   (setf (aref *tablero* (first destino) (rest destino)) 2)
	   (image-load imgnegra "./proyecto/imagenes/gato.gif")
	   (configure boton-destino :image imgnegra)))
    (comprueba-si-fin)))




(defun selecciona-destino-raton (origen)
  (let* ((posibilidades (movimientos-validos *tablero* origen *turno*))
	 (botones (loop for posibilidad in posibilidades collect
			(aref *casillas* (first posibilidad) (rest posibilidad)))))
    (mapcar #'(lambda (x) (configure x :background :green)) botones)
    (mapcar #'(lambda (boton-destino)
		(bind boton-destino "<ButtonPress-1>"
		      (lambda (evt)
			(configure (aref *casillas* (first origen) (rest origen)) :background :#bbbab8)
			(bind (aref *casillas* (first origen) (rest origen)) "<ButtonPress-1>" ())
			(mapcar #'(lambda (x) (configure x :background :#bbbab8)) botones)
			(mapcar #'(lambda (x) (bind x "<ButtonPress-1>" ())) botones)
			(aplica-movimiento origen boton-destino
					   posibilidades)))) botones)))



(defun selecciona-destino-gatos (boton-origen botones)
  (let* ((origen (first (loop for i from 1 to 4 
			      when (eq (nth i botones)
				       boton-origen) collect (nth i *posiciones*))))
	 (posibilidades (movimientos-validos *tablero* origen *turno*))
	 (botones-destinos (loop for posibilidad in posibilidades collect
				 (aref *casillas* (first posibilidad) (rest posibilidad)))))
    (mapcar #'(lambda (x) (configure x :background :green)) botones-destinos)
    (mapcar #'(lambda (cambio-origen) 
		(bind cambio-origen "<ButtonPress-1>"
		      (lambda (evt)
			(configure boton-origen :background :#bbbab8)
			(configure cambio-origen :background :green)
			(mapcar #'(lambda (x) (configure x :background :#bbbab8)) botones-destinos)
			(mapcar #'(lambda (x) (bind x "<ButtonPress-1>" ())) botones-destinos)
			(selecciona-destino-gatos cambio-origen botones)))) (subseq botones 1 5))
    (mapcar #'(lambda (boton-destino)
		(bind boton-destino "<ButtonPress-1>"
		      (lambda (evt)
			(configure boton-origen :background :#bbbab8)
			(mapcar #'(lambda (x) (configure x :background :#bbbab8)) botones-destinos)
			(mapcar #'(lambda (x) (bind x "<ButtonPress-1>" ())) botones)
			(mapcar #'(lambda (x) (bind x "<ButtonPress-1>" ())) botones-destinos)
			(aplica-movimiento origen boton-destino posibilidades)))) botones-destinos)))


(defun movimiento-minimax-raton ()
  (let ((tablero-posiciones nil)
	(imgvacia (make-image))
	(pos-anteriores *posiciones*))
    (setf tablero-posiciones (minimax-nodoMAX))
    (setf *tablero* (first tablero-posiciones))
    (setf *posiciones* (rest tablero-posiciones))
    (configure (aref *casillas* (first (first pos-anteriores)) (rest (first pos-anteriores))) :image imgvacia)
    (imprime-fichas)
    (comprueba-si-fin)))



(defun movimiento-minimax-gatos ()
   (let ((tablero-posiciones nil)
	 (imgvacia (make-image))
	 (pos-anteriores *posiciones*))
     (setf tablero-posiciones (minimax-nodoMIN))
     (setf *tablero* (first tablero-posiciones))
     (setf *posiciones* (rest tablero-posiciones))
     (loop for i from 1 to 4 when (not (eq (nth i pos-anteriores)
					   (nth i *posiciones*))) do
       (configure (aref *casillas* (first (nth i pos-anteriores)) (rest (nth i pos-anteriores)))
		  :image imgvacia))
     (imprime-fichas)
     (comprueba-si-fin)))


(defun pide-ayuda ()
  (let ((posiciones nil))
    (cond ((= *turno* 1)
	   (setf posiciones (rest (minimax-nodoMAX)))
	   (configure (aref *casillas* (first (first *posiciones*)) (rest (first *posiciones*)))
		      :background :blue)
	   (configure (aref *casillas* (first (first posiciones)) (rest (first posiciones)))
		      :background :blue)
	   (sleep 1)
	   (configure (aref *casillas* (first (first *posiciones*)) (rest (first *posiciones*)))
		      :background :#bbbab8)
	   (configure (aref *casillas* (first (first posiciones)) (rest (first posiciones)))
		      :background :#bbbab8))
	  ((= *turno* 2)
	   (setf posiciones (rest (minimax-nodoMIN)))
	   (loop for i from 1 to 4 when (not (eq (nth i *posiciones*)
						 (nth i posiciones))) do
	     (configure (aref *casillas* (first (nth i *posiciones*)) (rest (nth i *posiciones*)))
			:background :blue)
	     (configure (aref *casillas* (first (nth i posiciones)) (rest (nth i posiciones)))
			:background :blue)
	     (sleep 1)
	     (configure (aref *casillas* (first (nth i *posiciones*)) (rest (nth i *posiciones*)))
			:background :#bbbab8)
	     (configure (aref *casillas* (first (nth i posiciones)) (rest (nth i posiciones)))
			:background :#bbbab8))))))
	     	 

(defun selecciona-ficha ()
  (let ((botones (loop for posicion in *posiciones* collect
		       (aref *casillas* (first posicion) (rest posicion)))))
    (cond ((or (and (= *modo* 1)     
		    (= *turno* 1)
		    (= *jugador* 1))
	       (and (= *modo* 2)
		    (= *turno* 1)))
	   (bind (nth 0 botones) "<ButtonPress-1>" 
		 (lambda (evt)
		   (configure (nth 0 botones) :background :green)
		   (bind (nth 0 botones) "<ButtonPress-1>" ()) 
		   (bind *Boton-Ayuda* "<ButtonPress-1>" ())
		   (selecciona-destino-raton (nth 0 *posiciones*)))))
	  ((or (and (= *modo* 1)
		    (= *turno* 1)   
		    (= *jugador* 2))
	       (and (= *modo* 3)
		    (= *turno* 1)))
	   (movimiento-minimax-raton))
	  ((or (and (= *modo* 1)     
		    (= *turno* 2)
		    (= *jugador* 1))
	       (and (= *modo* 3)
		    (= *turno* 2)))
	   (movimiento-minimax-gatos))
	  ((or (and (= *modo* 1)     
		    (= *turno* 2)
		    (= *jugador* 2))
	       (and (= *modo* 2)
		    (= *turno* 2)))
	   (mapcar #' (lambda (boton-origen)
			(bind boton-origen "<ButtonPress-1>"
			      (lambda (evt)
				(configure boton-origen :background :green)
				(mapcar #'(lambda (x) (bind x "<ButtonPress-1>" ())) botones)
				(bind *Boton-Ayuda* "<ButtonPress-1>" ())
				(selecciona-destino-gatos boton-origen botones)))) (subseq botones 1 5))))))
	 


(defun imprime-fichas ()
  (let ((imgblanca (make-image))
	(imgnegra  (make-image)))
    (image-load imgblanca "./proyecto/imagenes/raton.gif")
    (image-load imgnegra  "./proyecto/imagenes/gato.gif")
    (configure (aref *casillas* (first (first *posiciones*)) (rest (first *posiciones*)))
	       :image imgblanca)
    (loop for i from 1 to 4 do
	  (configure (aref *casillas* (first (nth i *posiciones*)) (rest (nth i *posiciones*)))
		     :image imgnegra))))


(defun crea-estado-inicial ()
  (setf *tablero* (make-array '(8 8) :initial-element 0))
  (setf (aref *tablero* 7 1) 2) 
  (setf (aref *tablero* 7 3) 2)
  (setf (aref *tablero* 7 5) 2)
  (setf (aref *tablero* 7 7) 2)
  (setf (aref *tablero* 0 4) 1))




(defun elige-bando () 
  (setf *Boton-Ayuda* (make-instance 'button :master *ventana* :text "Ayuda" :activebackground :#feffc3))
  (let ((img1 (make-image))
	(img2 (make-image))
	(img3 (make-image))
	(img4 (make-image))
	(boton1 (make-instance 'button
			       :master *ventana* 
			       :text "Ratón"))
	(boton2 (make-instance 'button
			       :master *ventana* 
			       :text "Gatos"))
	(boton3 (make-instance 'button
			       :master *ventana*
			       :text "Menú")))
    (place boton1 595 100 :width 150 :height 150)
    (place boton2 595 350 :width 150 :height 150)
    (image-load img1 "./proyecto/imagenes/raton2.gif")
    (image-load img2 "./proyecto/imagenes/gato2.gif")
    (image-load img3 "./proyecto/imagenes/ayuda.gif")
    (image-load img4 "./proyecto/imagenes/menu.gif")
    (configure boton1 :image img1)
    (configure boton2 :image img2)
    (bind boton1 "<ButtonPress-1>" (lambda (evt)
				     (setf *jugador* 1)
				     (destroy boton1)
				     (destroy boton2)
				     (place *Boton-Ayuda* 620 50 :width 100 :height 150)
				     (configure *Boton-Ayuda* :image img3)
				     (place boton3 620 300 :width 100 :height 150)
				     (configure boton3 :image img4)
				     (bind *Boton-Ayuda* "<ButtonPress-1>" (lambda (evt)
									     (pide-ayuda)))
				     (bind boton3 "<ButtonPress-1>" (lambda (evt)
								     (loop for i from 0 to 7 do
									   (loop for j from 0 to 7 do
										 (destroy (aref *casillas* i j))))
								     (destroy *botonSalir*)
								     (destroy *Boton-Ayuda*)
								     (destroy boton3)
								     (elige-juego)))
				     (selecciona-ficha)))
    (bind boton2 "<ButtonPress-1>" (lambda (evt)
				     (setf *jugador* 2)
				     (destroy boton1)
				     (destroy boton2)
				     (place *Boton-Ayuda* 620 50 :width 100 :height 150)
				     (configure *Boton-Ayuda* :image img3)
				     (place boton3 620 300 :width 100 :height 150)
				     (configure boton3 :image img4)
				     (bind *Boton-Ayuda* "<ButtonPress-1>" (lambda (evt)
								      (pide-ayuda)))
				     (bind boton3 "<ButtonPress-1>" (lambda (evt)
								     (loop for i from 0 to 7 do
									   (loop for j from 0 to 7 do
										 (destroy (aref *casillas* i j))))
								     (destroy *botonSalir*)
								     (destroy *Boton-Ayuda*)
								     (destroy boton3)
								     (elige-juego)))
				     (selecciona-ficha)))))


(defun inicializa-juego1 ()
  (setf *turno* 1)
  (setf *posiciones* (list '(0 . 4) '(7 . 1) '(7 . 3) '(7 . 5) '(7 . 7)))
  (crea-estado-inicial)
  (setf *casillas* (make-array '(8 8)))
  (loop for i from 0 to 7 do
	(loop for j from 0 to 7 do
	      (if (or (and (oddp i)
			   (evenp j))
		      (and (evenp i)
			   (oddp j)))
		  (setf (aref *casillas* i j) (make-instance 'button
							 :master *ventana*
							 :background :white
							 :activebackground :white))
		(setf (aref *casillas* i j) (make-instance 'button
							   :master *ventana*)))
	      (place (aref *casillas* i j) (+ 20 (* 65 j)) (+ 20 (* 65 i))
		     :width 65 :height 65)))
  (imprime-fichas)
  (elige-bando))





;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;                                 ;;;;
;;;;                                 ;;;;
;;;;  JUEGO LA LIEBRE Y LOS PERROS   ;;;;
;;;;                                 ;;;;
;;;;                                 ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun f2-estatica-1 (tablero posiciones turno)
  (let ((valor (1- *maximo-valor*)))
    (setf valor (- valor (* 100 (rest (first posiciones)))))
    (setf valor (- valor (no-perros-sobrepasados posiciones)))
    valor))

(defun f2-estatica-2 (tablero posiciones turno)
  (let ((valor (1- *maximo-valor*)))
    (setf valor (- valor (* 100 (rest (first posiciones)))))
    valor))

(defun f2-estatica-3 (tablero posiciones turno)
  (let ((valor (1- *maximo-valor*)))
    (setf valor (- valor (no-perros-sobrepasados posiciones)))
    valor))


(defun no-perros-sobrepasados (posiciones)
  (let ((contador 0))
    (loop for posicion in (subseq posiciones 1 4) do
	  (if (> (rest (first posiciones)) (rest posicion))
	      (setf contador (1+ contador))))
    (* 1000 contador)))


(defun f2-estatica-4 (tablero posiciones turno)
  (let ((valor (1+ *minimo-valor*)))
    (setf valor (+ valor (perros-retrasados posiciones)))
;    (setf valor (+ valor (perros-sobrepasados posiciones)))
    (setf valor (+ valor (no-misma-linea-vertical posiciones)))
 ;   (setf valor (+ valor (perros-sobrepasados posiciones)))
;    (setf valor (+ valor (hay-huecos-vertical posiciones)))
  ; (setf valor (+ valor (hay-huecos-diagonal posiciones)))
;    (setf valor (+ valor (hay-huecos-horizontal posiciones)))
    valor))


(defun f2-estatica-5 (tablero posiciones turno)
  (let ((valor (1+ *minimo-valor*)))
    (setf valor (+ valor (perros-retrasados posiciones)))
    (setf valor (+ valor (perros-sobrepasados posiciones)))
;    (setf valor (+ valor (no-misma-linea-vertical posiciones)))
 ;   (setf valor (+ valor (perros-sobrepasados posiciones)))
;    (setf valor (+ valor (hay-huecos-vertical posiciones)))
  ; (setf valor (+ valor (hay-huecos-diagonal posiciones)))
;    (setf valor (+ valor (hay-huecos-horizontal posiciones)))
    valor))

(defun f2-estatica-6 (tablero posiciones turno)
  (let ((valor (1+ *minimo-valor*)))
    (setf valor (+ valor (perros-retrasados posiciones)))
    (setf valor (+ valor (perros-sobrepasados posiciones)))
    (setf valor (+ valor (no-misma-linea-vertical posiciones)))
 ;   (setf valor (+ valor (perros-sobrepasados posiciones)))
;    (setf valor (+ valor (hay-huecos-vertical posiciones)))
  ; (setf valor (+ valor (hay-huecos-diagonal posiciones)))
;    (setf valor (+ valor (hay-huecos-horizontal posiciones)))
    valor))

(defun no-misma-linea-vertical (posiciones)
  (let ((pos-i (loop for posicion in (subseq posiciones 1 4) collect (rest posicion))))
    (* 1000 (abs (- (apply #'max pos-i) (apply #'min pos-i))))))

(defun perros-retrasados (posiciones)
  (let ((contador 0))
    (loop for posicion in (subseq posiciones 1 4) do
	  (setf contador (+ contador (- 4 (rest posicion)))))
      (* 200 contador)))


(defun perros-sobrepasados (posiciones)
  (let ((contador 0))
    (loop for posicion in (subseq posiciones 1 4) do
	  (if (>= (rest (first posiciones)) (rest posicion))
	      (setf contador (1+ contador))))
    (if (= 2 contador)
	20000
      0)))

;(defun hay-huecos-vertical (posiciones)
;  (let ((contador 0)
;	(j-actual -1))
;    (loop for posicion in (subseq posiciones 1 5) do
;	  (if (> (abs (- (rest posicion) j-actual)) 2)
;	      (setf contador (1+ contador)))
;	  (setf j-actual (rest posicion)))
;    (if (> (abs (- 8 j-actual)) 2)
;	(setf contador (+ contador (- 8 j-actual))))
;    (* 100 contador)))

;(defun hay-huecos-diagonal (posiciones)
;  (let ((contador 0)
;	(i-actual (first (nth 1 posiciones)))
;	(j-actual (rest (nth 1 posiciones))))
;    (loop for posicion in (subseq posiciones 2 5) do
;	  (if (= (abs (- (first posicion) i-actual)) (abs (- (rest posicion) j-actual)))
;	      (setf contador (1+ contador)))
;	  (setf i-actual (first posicion))
;	  (setf j-actual (rest posicion)))
;    (* 30 contador)))

;(defun hay-huecos-horizontal (posiciones)
;  (let ((contador 0)
;	(i-actual (first (nth 1 posiciones))))
;    (loop for posicion in (subseq posiciones 2 5) do
;	  (if (> (abs (- (first posicion) i-actual)) 1)
;	      (setf contador (+ contador (abs (- (first posicion) i-actual)))))
;	  (setf i-actual (first posicion)))
;    (* 80 contador))) 


(defun restriccionDiagonal (origen posibilidad)
  (let ((restringido nil))
    (if (and (or (and (oddp (first origen))  ;; Si i,j son pares o i,j son impares 
		      (oddp (rest origen)))
		 (and (not (oddp (first origen)))
		      (not (oddp (rest origen)))))
	     (or (equal posibilidad '(-1 . -1))  ;; Si posibilidad es diagonal
		 (equal posibilidad '(-1 . +1))
		 (equal posibilidad '(+1 . -1))
		 (equal posibilidad '(+1 . +1))))
	(setf restringido t))))
	

(defun movimientos-validos2 (tablero origen turno)
  (cond ((= turno 1)
	 (loop for posibilidad in *movimientos-2*
	       when (and (>= (+ (first origen) (first posibilidad)) 0)
			 (<= (+ (first origen) (first posibilidad)) 2)
			 (>= (+ (rest origen) (rest posibilidad)) 0)
			 (<= (+ (rest origen) (rest posibilidad)) 4)
			 (not (restriccionDiagonal origen posibilidad))
			 (casilla-libre tablero (cons (+ (first origen) (first posibilidad))
						      (+ (rest origen) (rest posibilidad)))))
	       collect (cons (+ (first origen) (first posibilidad))
			     (+ (rest origen) (rest posibilidad)))))
	((= turno 2)
	 (loop for posibilidad in (subseq *movimientos-2* 3 8)
	       when (and (>= (+ (first origen) (first posibilidad)) 0)
			 (<= (+ (first origen) (first posibilidad)) 2)
			 (>= (+ (rest origen) (rest posibilidad)) 0)
			 (<= (+ (rest origen) (rest posibilidad)) 4)
			 (not (restriccionDiagonal origen posibilidad))
			 (casilla-libre tablero (cons (+ (first origen) (first posibilidad))
						      (+ (rest origen) (rest posibilidad)))))
	       collect (cons (+ (first origen) (first posibilidad))
			     (+ (rest origen) (rest posibilidad)))))))




(defun numero-movimientos-posibles2 (tablero posiciones turno)  
  (let ((numero 0))
    (cond ((= turno 1)
	   (setf numero (length (movimientos-validos2 tablero (first posiciones) turno))))
	  ((= turno 2)
	   (loop for posicion in (subseq posiciones 1 4) do
		 (setf numero (+ numero (length (movimientos-validos2 tablero posicion turno)))))))
    numero))



(defun es-estado-ganador2 (tablero posiciones turno)
  (or (= 0 (numero-movimientos-posibles2 tablero posiciones turno)) 
      (= 1 (aref tablero 1 0))     ;; Si la liebre ha llegado al principio.
      (= 10 *contador*)))



;;; Funcion auxiliar para el calculo de sucesores.


(defun crea-sucesor2 (tablero posiciones origen destino turno)
  (let ((sucesor (make-array '(3 5)))
	(posicion (loop for i in posiciones collect i)))
    (loop for i from 0 to 3 when (eq origen (nth i posiciones)) do
	  (setf (nth i posicion) destino))
    (loop for fila from 0 to 2 do
	  (loop for columna from 0 to 4 do
		(setf (aref sucesor fila columna) (aref tablero fila columna))))
    (setf (aref sucesor (first origen) (rest origen)) 0)
    (setf (aref sucesor (first destino) (rest destino)) turno)
      (cons sucesor posicion)))

;Funcion auxiliar para el algoritmo minimax. Dado un tablero y un
;turno pasados como parametro, calcula todos los sucesores de dicho
;tablero.



(defun calcula-sucesores2 (tablero posiciones turno)
  (let ((sucesores nil)
	(origen nil))
    (cond ((= turno 1)
	   (setf origen (first posiciones))
	   (loop for posibilidad in (movimientos-validos2 tablero origen turno) do
		 (setf sucesores (append sucesores 
					 (list (crea-sucesor2 tablero posiciones origen posibilidad turno))))))
	  ((= turno 2)
	   (setf origen (subseq posiciones 1 4))
	   (loop for orig in origen do
		 (loop for posibilidad in (movimientos-validos2 tablero orig turno) do
		       (setf sucesores (append sucesores 
					       (list (crea-sucesor2 tablero posiciones orig posibilidad turno))))))))
    sucesores))


;Funcion recursiva con poda para el calculo del valor minimax de un nodo
;MAX. Si ha llegado a la profundidad maxima o el nodo es un tablero
;final, calcula el valor del nodo llamando a la funcion de evaluacion
;estatica *heuristica*. Sino realiza recursion.

(defun maximizador2-alpha-beta (tablero-sucesor posiciones profundidad alpha beta)
  (let ((valor-max *minimo-valor*))
    (cond ((es-estado-ganador2 tablero-sucesor posiciones 1)  
	  ; (setf valor-max *maximo-valor*))
	   (if (= profundidad *profundidad*)
	       (setf valor-max -10000)
	     (setf valor-max *minimo-valor*)))
	  ((= profundidad 0)
	   (setf valor-max (funcall *heuristica2-MAX* tablero-sucesor posiciones 1)))
	  (t
	   (let ((sucesores (calcula-sucesores2 tablero-sucesor posiciones 1)) 
		 (poda nil))
	     (loop for sucesor-actual in sucesores while (not poda) do
		   (setf valor-max (max (minimizador2-alpha-beta (first sucesor-actual) (rest sucesor-actual)
								(1- profundidad) alpha beta) 
					valor-max)) 
		   (if (>= valor-max beta)
		       (setf poda t)) 
		   (setf alpha (max alpha valor-max))))))
    valor-max))


;Funcion recursiva con poda para el calculo del valor minimax,
;equivalente a la anterior pero sobre un nodo MIN. Si ha llegado
;a la profundidad maxima o el nodo es un tablero final, calcula 
;el valor del nodo llamando a la funcion de evaluacion estatica 
;*heuristica*. Sino realiza recursion.

(defun minimizador2-alpha-beta (tablero-sucesor posiciones profundidad alpha beta)
  (let ((valor-min *maximo-valor*))
    (cond ((es-estado-ganador2 tablero-sucesor posiciones 2)
	   ;(setf valor-min *minimo-valor*))
	   (if (= profundidad *profundidad*)
	       (setf valor-min 10000)
	     (setf valor-min *maximo-valor*)))
	  ((= profundidad 0)
	   (setf valor-min (funcall *heuristica2-MIN* tablero-sucesor posiciones 2)))
	  (t
	   (let ((sucesores (calcula-sucesores2 tablero-sucesor posiciones 2))
		 (poda nil))
	     (loop for sucesor-actual in sucesores while (not poda) do
		   (setf valor-min (min (maximizador2-alpha-beta (first sucesor-actual) (rest sucesor-actual)
								(1- profundidad) alpha beta)
					valor-min))
		   (if (<= valor-min alpha)
		       (setf poda t))
		   (setf beta (min beta valor-min))))))
    valor-min))


;Funcion principal para el calculo de minimax sobre un nodo MAX, a
;partir de esta funcion comenzara la recursion, la profundidad y la
;poda alpha-beta. Devuelve el mejor tablero sucesor.


(defun minimax2-nodoMAX ()
  (let* ((valor-max *minimo-valor*) 
	 (sucesores (calcula-sucesores2 *tablero* *posiciones* 1)) 
	 (valor-actual 0)
	 (mejor-sucesor (first sucesores)))
    (loop for sucesor-actual in sucesores do
	  (setf valor-actual 
		(minimizador2-alpha-beta (first sucesor-actual) (rest sucesor-actual)
					*profundidad* valor-max *maximo-valor*))
	  (cond ((= valor-actual 10000)
		 (setf mejor-sucesor sucesor-actual)
		 (return))
		((> valor-actual valor-max)
		 (setf mejor-sucesor sucesor-actual)
		 (setf valor-max valor-actual))
		(t nil)))
    mejor-sucesor))

(defun minimax2-nodoMIN ()
  (let* ((valor-min *maximo-valor*)
	 (sucesores (calcula-sucesores2 *tablero* *posiciones* 2))
	 (valor-actual 0)
	 (mejor-sucesor (first sucesores)))
    (loop for sucesor-actual in sucesores when (not (and (= 3 *contador*)
		   (= (loop for posicion in (subseq (rest sucesor-actual) 1 4) summing (rest posicion))
		      (loop for posicion in (subseq *posiciones* 1 4) summing (rest posicion))))) do
	  (setf valor-actual 
		(maximizador2-alpha-beta (first sucesor-actual) (rest sucesor-actual)
					*profundidad* *minimo-valor* valor-min))
	  (cond ((= valor-actual -10000)
		 (setf mejor-sucesor sucesor-actual)
		 (return))
		((< valor-actual valor-min)
		 (setf mejor-sucesor sucesor-actual)
		 (setf valor-min valor-actual))
		(t nil)))
    mejor-sucesor))

(defun finaliza-juego2 ()   
  (cond ((= *contador* 10)
	 (do-msg "Ha ganado la liebre"))
	((= *turno* 1)
	 (do-msg "Han ganado los perros"))
	((= *turno* 2)
	 (do-msg "Ha ganado la liebre"))))


(defun comprueba-si-fin2 ()
  (if (= *turno* 1)
      (setf *turno* 2)
    (setf *turno* 1))   
  (cond ((not (es-estado-ganador2 *tablero* *posiciones* *turno*))
	 (escribe-jugadas (list *tablero*) "./proyecto/save/liebre-perros.txt")
	 (bind *Boton-Ayuda* "<ButtonPress-1>" (lambda (evt)
						 (pide-ayuda2)))
	 (selecciona-ficha2))
	(t 
	 (bind *Boton-Ayuda* "<ButtonPress-1>" ())
	 (finaliza-juego2))))




(defun aplica-movimiento2 (origen boton-destino posibilidades)
  (let ((imgvacia (make-image))
	(imgblanca (make-image))
	(imgnegra (make-image))
	(destino (first (loop for posibilidad in posibilidades 
		       when (eq (aref *casillas* (first posibilidad) (rest posibilidad))
				boton-destino) collect posibilidad))))
    (loop for i from 0 to 3 when (eq (nth i *posiciones*) origen) do
	  (setf (nth i *posiciones*) destino))
    (setf (aref *tablero* (first origen) (rest origen)) 0)
    (if (or (and (= *modo* 1)
		 (= *jugador* 2))
	    (and (= *modo* 2)
		 (= *turno* 2)))
	(if (or (and (= (1- (first origen)) (first destino))
		     (= (rest origen) (rest destino)))
		(and (= (1+ (first origen)) (first destino))
		     (= (rest origen) (rest destino))))
	    (setf *contador* (1+ *contador*))
	  (setf *contador* 0)))
    (configure (aref *casillas* (first origen) (rest origen)) :image imgvacia)
    (cond ((= *turno* 1)
	   (setf (aref *tablero* (first destino) (rest destino)) 1)
	   (image-load imgblanca "./proyecto/imagenes/liebre.gif")
	   (configure boton-destino :image imgblanca))
	  ((= *turno* 2)
	   (setf (aref *tablero* (first destino) (rest destino)) 2)
	   (image-load imgnegra "./proyecto/imagenes/perro.gif")
	   (configure boton-destino :image imgnegra)))
    (comprueba-si-fin2)))





(defun selecciona-destino-perros (boton-origen botones)
  (let* ((origen (first (loop for i from 1 to 3 
			      when (eq (nth i botones)
				       boton-origen) collect (nth i *posiciones*))))
	 (posibilidades (movimientos-validos2 *tablero* origen *turno*))
	 (botones-destinos (loop for posibilidad in posibilidades collect
				 (aref *casillas* (first posibilidad) (rest posibilidad)))))
    (mapcar #'(lambda (x) (configure x :background :green)) botones-destinos)
    (mapcar #'(lambda (cambio-origen) 
		(bind cambio-origen "<ButtonPress-1>"
		      (lambda (evt)
			(configure boton-origen :background :#bbbab8)
			(configure cambio-origen :background :green)
			(mapcar #'(lambda (x) (configure x :background :#bbbab8)) botones-destinos)
			(mapcar #'(lambda (x) (bind x "<ButtonPress-1>" ())) botones-destinos)
			(selecciona-destino-perros cambio-origen botones)))) (subseq botones 1 4))
    (mapcar #'(lambda (boton-destino)
		(bind boton-destino "<ButtonPress-1>"
		      (lambda (evt)
			(configure boton-origen :background :#bbbab8)
			(mapcar #'(lambda (x) (configure x :background :#bbbab8)) botones-destinos)
			(mapcar #'(lambda (x) (bind x "<ButtonPress-1>" ())) botones)
			(mapcar #'(lambda (x) (bind x "<ButtonPress-1>" ())) botones-destinos)
			(aplica-movimiento2 origen boton-destino posibilidades)))) botones-destinos)))



(defun selecciona-destino-liebre (origen)
  (let* ((posibilidades (movimientos-validos2 *tablero* origen *turno*))
	 (botones (loop for posibilidad in posibilidades collect
			(aref *casillas* (first posibilidad) (rest posibilidad)))))
    (mapcar #'(lambda (x) (configure x :background :green)) botones)
    (mapcar #'(lambda (boton-destino)
		(bind boton-destino "<ButtonPress-1>"
		      (lambda (evt)
			(configure (aref *casillas* (first origen) (rest origen)) :background :#bbbab8)
			(bind (aref *casillas* (first origen) (rest origen)) "<ButtonPress-1>" ())
			(mapcar #'(lambda (x) (configure x :background :#bbbab8)) botones)
			(mapcar #'(lambda (x) (bind x "<ButtonPress-1>" ())) botones)
			(aplica-movimiento2 origen boton-destino
					    posibilidades)))) botones)))


(defun movimiento-minimax-liebre ()
  (let ((tablero-posiciones nil)
	(imgvacia (make-image))
	(pos-anteriores *posiciones*))
    (setf tablero-posiciones (minimax2-nodoMAX))
    (setf *tablero* (first tablero-posiciones))
    (setf *posiciones* (rest tablero-posiciones))
    (configure (aref *casillas* (first (first pos-anteriores)) (rest (first pos-anteriores))) :image imgvacia)
    (imprime-fichas2)
    (comprueba-si-fin2)))


(defun movimiento-minimax-perros ()
   (let ((tablero-posiciones nil)
	 (imgvacia (make-image))
	 (pos-anteriores *posiciones*))
     (setf tablero-posiciones (minimax2-nodoMIN))
     (setf *tablero* (first tablero-posiciones))
     (setf *posiciones* (rest tablero-posiciones))
     (loop for i from 1 to 3 when (not (eq (nth i pos-anteriores)
					   (nth i *posiciones*))) do
       (configure (aref *casillas* (first (nth i pos-anteriores)) (rest (nth i pos-anteriores)))
		  :image imgvacia)
       (if (or (and (= (1- (first (nth i pos-anteriores))) (first (nth i *posiciones*)))
		    (= (rest (nth i pos-anteriores)) (rest (nth i *posiciones*))))
	       (and (= (1+ (first (nth i pos-anteriores))) (first (nth i *posiciones*)))
		    (= (rest (nth i pos-anteriores)) (rest (nth i *posiciones*)))))
	   (setf *contador* (1+ *contador*))
	 (setf *contador* 0)))
     (imprime-fichas2)
     (comprueba-si-fin2)))


(defun pide-ayuda2 ()
  (let ((posiciones nil))
    (cond ((= *turno* 1)
	   (setf posiciones (rest (minimax2-nodoMAX)))
	   (configure (aref *casillas* (first (first *posiciones*)) (rest (first *posiciones*)))
		      :background :blue)
	   (configure (aref *casillas* (first (first posiciones)) (rest (first posiciones)))
		      :background :blue)
	   (sleep 1)
	   (configure (aref *casillas* (first (first *posiciones*)) (rest (first *posiciones*)))
		      :background :#bbbab8)
	   (configure (aref *casillas* (first (first posiciones)) (rest (first posiciones)))
		      :background :#bbbab8))
	  ((= *turno* 2)
	   (setf posiciones (rest (minimax2-nodoMIN)))
	   (loop for i from 1 to 3 when (not (eq (nth i *posiciones*)
						 (nth i posiciones))) do
	     (configure (aref *casillas* (first (nth i *posiciones*)) (rest (nth i *posiciones*)))
			:background :blue)
	     (configure (aref *casillas* (first (nth i posiciones)) (rest (nth i posiciones)))
			:background :blue)
	     (sleep 1)
	     (configure (aref *casillas* (first (nth i *posiciones*)) (rest (nth i *posiciones*)))
			:background :#bbbab8)
	     (configure (aref *casillas* (first (nth i posiciones)) (rest (nth i posiciones)))
			:background :#bbbab8))))))


(defun selecciona-ficha2 ()
  (let ((botones (loop for posicion in *posiciones* collect
		       (aref *casillas* (first posicion) (rest posicion)))))
    (cond ((or (and (= *modo* 1)     
		    (= *turno* 1)
		    (= *jugador* 1))
	       (and (= *modo* 2)
		    (= *turno* 1)))
	   (bind (nth 0 botones) "<ButtonPress-1>" 
		 (lambda (evt)
		   (configure (nth 0 botones) :background :green)
		   (bind (nth 0 botones) "<ButtonPress-1>" ()) 
		   (bind *Boton-Ayuda* "<ButtonPress-1>" ())
		   ;;Se llama a selecciona-destino con el par punteado donde está la liebre
		   (selecciona-destino-liebre (nth 0 *posiciones*))))) 	  
	  ((or (and (= *modo* 1)
		    (= *turno* 1)   
		    (= *jugador* 2))
	       (and (= *modo* 3)
		    (= *turno* 1)))
	   (movimiento-minimax-liebre))
	  ((or (and (= *modo* 1)     
		    (= *turno* 2)
		    (= *jugador* 1))
	       (and (= *modo* 3)
		    (= *turno* 2)))
	   (movimiento-minimax-perros))
	  ((or (and (= *modo* 1)     
		    (= *turno* 2)
		    (= *jugador* 2))
	       (and (= *modo* 2)
		    (= *turno* 2))) 
	   (mapcar #'(lambda (boton-origen)
		       (bind boton-origen "<ButtonPress-1>"
			     (lambda (evt)
			       (configure boton-origen :background :green)
			       (mapcar #'(lambda (x) (bind x "<ButtonPress-1>" ())) botones)
			       (bind *Boton-Ayuda* "<ButtonPress-1>" ())
			       (selecciona-destino-perros boton-origen botones)))) (subseq botones 1 4))))))


(defun elige-bando2 () 
  (setf *Boton-Ayuda* (make-instance 'button :master *ventana* :text "Ayuda" :activebackground :#feffc3))
  (let ((img1 (make-image))
	(img2 (make-image))
	(img3 (make-image))
	(img4 (make-image))
	(boton1 (make-instance 'button
			       :master *ventana* 
			       :text "Liebre"))
	(boton2 (make-instance 'button
			       :master *ventana* 
			       :text "Perros"))
	(boton3 (make-instance 'button
			       :master *ventana*
			       :text "Menú")))
    (place boton1 595 100 :width 150 :height 150)
    (place boton2 595 350 :width 150 :height 150)
    (image-load img1 "./proyecto/imagenes/liebre2.gif")
    (image-load img2 "./proyecto/imagenes/perro2.gif")
    (image-load img3 "./proyecto/imagenes/ayuda.gif")
    (image-load img4 "./proyecto/imagenes/menu.gif")
    (configure boton1 :image img1)
    (configure boton2 :image img2)
    (bind boton1 "<ButtonPress-1>" (lambda (evt)
				     (setf *jugador* 1)
				     (destroy boton1)
				     (destroy boton2)
				     (place *Boton-Ayuda* 620 50 :width 100 :height 150)
				     (configure *Boton-Ayuda* :image img3)
				     (place boton3 620 300 :width 100 :height 150)
				     (configure boton3 :image img4)
				     (bind *Boton-Ayuda* "<ButtonPress-1>" (lambda (evt)
									     (pide-ayuda2)))
				     (bind boton3 "<ButtonPress-1>" (lambda (evt)
				     (loop for i from 0 to 2 do
					   (loop for j from 0 to 4 
						 when (not (= -1 (aref *tablero* i j))) do
						 (destroy (aref *casillas* i j))))
				     (destroy *botonSalir*)
				     (destroy *boton-Ayuda*)
				     (destroy boton3)
				     (elige-juego)))
				     (selecciona-ficha2)))
    (bind boton2 "<ButtonPress-1>" (lambda (evt)
				     (setf *jugador* 2)
				     (destroy boton1)
				     (destroy boton2)
				     (place *Boton-Ayuda* 620 50 :width 100 :height 150)
				     (configure *Boton-Ayuda* :image img3)
				     (place boton3 620 300 :width 100 :height 150)
				     (configure boton3 :image img4)
				     (bind *Boton-Ayuda* "<ButtonPress-1>" (lambda (evt)
								      (pide-ayuda2)))
				     (bind boton3 "<ButtonPress-1>" (lambda (evt)
				     (loop for i from 0 to 2 do
					   (loop for j from 0 to 4 
						 when (not (= -1 (aref *tablero* i j))) do
						 (destroy (aref *casillas* i j))))
				     (destroy *botonSalir*)
				     (destroy *Boton-Ayuda*)
				     (destroy boton3)
				     (elige-juego)))
				     (selecciona-ficha2)))))



(defun imprime-fichas2 ()
  (let ((imgblanca (make-image))
	(imgnegra  (make-image)))
    (image-load imgblanca "./proyecto/imagenes/liebre.gif")
    (image-load imgnegra  "./proyecto/imagenes/perro.gif")
    (configure (aref *casillas* (first (first *posiciones*)) (rest (first *posiciones*)))
	       :image imgblanca)
    (loop for i from 1 to 3 do
	  (configure (aref *casillas* (first (nth i *posiciones*)) (rest (nth i *posiciones*)))
		     :image imgnegra))))



(defun crea-estado-inicial2 ()
  (setf *tablero* (make-array '(3 5) :initial-element 0))
  (setf (aref *tablero* 0 1) 2) 
  (setf (aref *tablero* 1 0) 2)
  (setf (aref *tablero* 2 1) 2)
  (setf (aref *tablero* 1 4) 1)
  (setf (aref *tablero* 0 0) -1)   ;; A las 4 esquinas de la matriz les asigno el valor -1
  (setf (aref *tablero* 0 4) -1)   ;; así consigo que no se procesen.
  (setf (aref *tablero* 2 0) -1)
  (setf (aref *tablero* 2 4) -1))


(defun inicializa-juego2 ()
  (let ((img (make-image)))
    (image-load img "./proyecto/imagenes/tablero2.gif")
    (configure *ventana* :image img)
    (setf *turno* 2) 
    (setf *posiciones* (list '(1 . 4) '(0 . 1) '(1 . 0) '(2 . 1)))
    (setf *contador* 0)
    (crea-estado-inicial2)
    (setf *casillas* (make-array '(3 5)))
    (loop for i from 0 to 2 do
	  (loop for j from 0 to 4 when (not (= -1 (aref *tablero* i j))) do
		(setf (aref *casillas* i j) (make-instance 'button
							   :master *ventana*))
		(place (aref *casillas* i j) (+ 50 (* 110 j)) (+ 157 (* 110 i))
		       :width 65 :height 65)))
    (imprime-fichas2)
    (elige-bando2)))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;                                 ;;;;
;;;;                                 ;;;;
;;;;   JUEGO EL ZORRO Y LOS GANSOS   ;;;;
;;;;                                 ;;;;
;;;;                                 ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(defun f3-estatica-1 (tablero posiciones turno)
  (let ((valor (1- *maximo-valor*)))
    (setf valor (- valor (* 1000 (- 6 (first (first posiciones))))))
    (setf valor (- valor (no-ocas-sobrepasados posiciones)))
    (setf valor (- valor (* 40 (length posiciones))))
    valor))


(defun f3-estatica-2 (tablero posiciones turno)
  (let ((valor (1- *maximo-valor*)))
    (setf valor (- valor (* 1000 (- 6 (first (first posiciones))))))
   ; (setf valor (- valor (no-ocas-sobrepasados posiciones)))
   ; (setf valor (- valor (* 10 (length posiciones))))
    valor))

(defun f3-estatica-3 (tablero posiciones turno)
  (let ((valor (1- *maximo-valor*)))
    (setf valor (- valor (* 50 (- 6 (first (first posiciones))))))
   ; (setf valor (- valor (no-ocas-sobrepasados posiciones)))
    (setf valor (- valor (* 300 (length posiciones))))
    valor))


(defun no-ocas-sobrepasados (posiciones)
  (let ((contador 0))
    (loop for posicion in (subseq posiciones 1 (length posiciones)) do
	  (if (> (first (first posiciones)) (first posicion))
	      (setf contador (1+ contador))))
    (* 50 contador)))


(defun f3-estatica-4 (tablero posiciones turno)
  (let ((valor (1+ *minimo-valor*)))
    (setf valor (+ valor (* 1000 (- 16 (length posiciones)))))
    (setf valor (+ valor (* 100 (first (first posiciones)))))
    (setf valor (+ valor (no-agrupados posiciones)))
    (setf valor (+ valor (no-ocas-sobrepasados posiciones)))
    (setf valor (+ valor (* 20 (loop for posicion in (subseq posiciones 1 (length posiciones)) 
				     summing (first posicion)))))
    (cond ((<= (rest (first posiciones)) 2)
	   (setf valor (+ valor (* 20
				(loop for posicion in (subseq posiciones 1 (length
					  posiciones)) when (>= (rest posicion) 4) 
					  summing (rest posicion))))))
	  ((>= (rest (first posiciones)) 4)
	   (setf valor (+ valor (* 20
			      (loop for posicion in (subseq posiciones 1 (length
				        posiciones)) when (<= (rest posicion) 2) 
					summing (rest posicion)))))))
    valor))


(defun f3-estatica-5 (tablero posiciones turno)
  (let ((valor (1+ *minimo-valor*)))
    (setf valor (+ valor (* 500 (- 16 (length posiciones)))))
    (setf valor (+ valor (no-agrupados posiciones)))
    (setf valor (+ valor (no-ocas-sobrepasados posiciones)))
    (setf valor (+ valor (* 100 (loop for posicion in (subseq posiciones 1 (length posiciones)) 
				     summing (first posicion)))))
    (cond ((<= (rest (first posiciones)) 2)
	   (setf valor (+ valor (* 70
				(loop for posicion in (subseq posiciones 1 (length
					  posiciones)) when (>= (rest posicion) 4) 
					  summing (rest posicion))))))
	  ((>= (rest (first posiciones)) 4)
	   (setf valor (+ valor (* 70
			      (loop for posicion in (subseq posiciones 1 (length
				        posiciones)) when (<= (rest posicion) 2) 
					summing (rest posicion)))))))
    valor))


(defun f3-estatica-6 (tablero posiciones turno)
  (let ((valor (1+ *minimo-valor*)))
    (setf valor (+ valor (* 1000 (- 16 (length posiciones)))))
    (setf valor (+ valor (no-agrupados posiciones)))
    (setf valor (+ valor (no-ocas-sobrepasados posiciones)))
    (cond ((<= (rest (first posiciones)) 2)
	   (setf valor (+ valor (* 10
				(loop for posicion in (subseq posiciones 1 (length
					  posiciones)) when (>= (rest posicion) 4) 
					  summing (rest posicion))))))
	  ((>= (rest (first posiciones)) 4)
	   (setf valor (+ valor (* 10
			      (loop for posicion in (subseq posiciones 1 (length
				        posiciones)) when (<= (rest posicion) 2) 
					summing (rest posicion)))))))
    valor))

(defun no-agrupados (posiciones)
  (let ((pos-i (loop for posicion in (subseq posiciones 1 (length posiciones)) collect (first posicion))))
    (* 1000 (abs (- (apply #'max pos-i) (apply #'min pos-i))))))

(defun restriccionDiagonal3 (origen posibilidad)
  (let ((restringido nil))
    (if (and (or (and (oddp (first origen))  ;; Si i impar y j par, o si i par y j impar 
		      (not (oddp (rest origen))))
		 (and (not (oddp (first origen)))
		      (oddp (rest origen))))
	     (or (equal posibilidad '(-1 . -1))  ;; Si posibilidad es diagonal
		 (equal posibilidad '(-1 . +1))
		 (equal posibilidad '(+1 . -1))
		 (equal posibilidad '(+1 . +1))))
	(setf restringido t))))
	
(defun puede-comer (tablero origen posibilidad)
  (let ((i-destino (+ (first origen) (* 2 (first posibilidad))))
	(j-destino (+ (rest origen) (* 2 (rest posibilidad)))))
    (and (>= i-destino 0)
	 (<= i-destino 6)
	 (>= j-destino 0)
	 (<= j-destino 6)
	 (not (= -1 (aref tablero (+ (first origen) (first posibilidad))
			            (+ (rest origen) (rest posibilidad)))))
	 (= 0 (aref tablero i-destino j-destino))))) 

(defun movimientos-validos3 (tablero origen turno)
  (cond ((= turno 1)
	 (loop for posibilidad in *movimientos-3*
	       when (and (>= (+ (first origen) (first posibilidad)) 0)
			 (<= (+ (first origen) (first posibilidad)) 6)
			 (>= (+ (rest origen) (rest posibilidad)) 0)
			 (<= (+ (rest origen) (rest posibilidad)) 6)
			 (not (restriccionDiagonal3 origen posibilidad))
			 (or (casilla-libre tablero (cons (+ (first origen) (first posibilidad))
							  (+ (rest origen) (rest posibilidad))))
			     (puede-comer tablero origen posibilidad))) collect
	       (if (casilla-libre tablero (cons (+ (first origen) (first posibilidad))
						(+ (rest origen) (rest posibilidad))))
		   (cons (+ (first origen) (first posibilidad))
			 (+ (rest origen) (rest posibilidad)))

		 ;; Si se entra entra en el cuerpo del bucle, y el
		 ;; destino no es una casilla libre, entonces con
		 ;; nuestro movimiento hemos "comido" un ganso, para
		 ;; indicar esto, pongo un '-' delante de la 'i'. 

		 (cons (-(+ (first origen) (* 2 (first posibilidad))))
		       (-(+ (rest origen) (* 2 (rest posibilidad))))))))
	((= turno 2)
	 (loop for posibilidad in (subseq *movimientos-3* 3 8)
	       when (and (>= (+ (first origen) (first posibilidad)) 0)
			 (<= (+ (first origen) (first posibilidad)) 6)
			 (>= (+ (rest origen) (rest posibilidad)) 0)
			 (<= (+ (rest origen) (rest posibilidad)) 6)
			 (not (restriccionDiagonal3 origen posibilidad))
			 (casilla-libre tablero (cons (+ (first origen) (first posibilidad))
						      (+ (rest origen) (rest posibilidad)))))
	       collect (cons (+ (first origen) (first posibilidad))
			     (+ (rest origen) (rest posibilidad)))))))


;;;; Añadir TURNO es los dos juegos anteriores

(defun numero-movimientos-posibles3 (tablero posiciones turno)  
  (let ((numero 0))
    (cond ((= turno 1)
	   (setf numero (length (movimientos-validos3 tablero (first posiciones) turno))))
	  ((= turno 2)
	   (loop for posicion in (subseq posiciones 1 (length posiciones)) do
		 (setf numero (+ numero (length (movimientos-validos3 tablero posicion turno)))))))
    numero))

;(minimizador3-alpha-beta (first *hola*) (rest *hola*) 2 -99999 0)
;(es-estado-ganador3 (first *hola*) (rest *hola*))
;(numero-movimientos-posibles3 (first *hola*) (rest *hola*))

(defun es-estado-ganador3 (tablero posiciones turno)
  (or (= 0 (numero-movimientos-posibles3 tablero posiciones turno))
      (= 1 (loop for i from 2 to 4 when (= 1 (aref tablero 6 i)) count i)) ;; Si la liebre ha llegado al principio.
      (= 10 *contador*)))


(defun crea-sucesor-comer (tablero posiciones origen destinoNoAbs turno)
  (let ((sucesor (make-array '(7 7)))
	(destino (cons (abs (first destinoNoAbs)) (abs (rest destinoNoAbs))))
	(posiciones-sucesor (loop for i in posiciones collect i))
	(nuevos-destinos))
    (loop for i from 0 to (1- (length posiciones)) when (eq origen (nth i posiciones)) do
	  (setf (nth i posiciones-sucesor) destino))
    (loop for fila from 0 to 6 do
	  (loop for columna from 0 to 6 do
		(setf (aref sucesor fila columna) (aref tablero fila columna))))
    (setf (aref sucesor (first origen) (rest origen)) 0)
    (setf (aref sucesor (first destino) (rest destino)) turno)

    ;; Ahora se actualiza el sucesor eliminando la ficha comida.

    (loop for i from 1 to (1- (length posiciones-sucesor))
	  when (equal (nth i posiciones-sucesor)
		      (cons (+ (/ (- (first destino) (first origen)) 2) (first origen))
			    (+ (/ (- (rest destino) (rest origen)) 2) (rest origen)))) do
			    (setf (aref sucesor (first (nth i posiciones-sucesor))
					(rest (nth i posiciones-sucesor))) 0)
			    (setf posiciones-sucesor (remove (nth i posiciones-sucesor) posiciones-sucesor)))

    (setf *sucesores* (append (list (cons sucesor posiciones-sucesor)) *sucesores*))
					     

    ;; Comprobamos si existe posibilidad de comer múltiples fichas.
    
    (loop for posibilidad in *movimientos-3* 
	  when (and (puede-comer sucesor destino posibilidad)
		    (not (restriccionDiagonal3 destino posibilidad))
		    (not (casilla-libre sucesor (cons (+ (first destino) (first posibilidad))
						      (+ (rest destino) (rest posibilidad)))))) do
		  (crea-sucesor-comer sucesor posiciones-sucesor destino 
					(cons (-(+ (first destino) (* 2 (first posibilidad)))) 
					      (-(+ (rest destino) (* 2 (rest posibilidad))))) turno))))




(defun crea-sucesor3 (tablero posiciones origen destino turno)
  (let ((sucesor (make-array '(7 7)))
	(posicion (loop for i in posiciones collect i)))
    (loop for i from 0 to (1- (length posiciones)) when (eq origen (nth i posiciones)) do
	  (setf (nth i posicion) destino))
    (loop for fila from 0 to 6 do
	  (loop for columna from 0 to 6 do
		(setf (aref sucesor fila columna) (aref tablero fila columna))))
    (setf (aref sucesor (first origen) (rest origen)) 0)
    (setf (aref sucesor (first destino) (rest destino)) turno)
    (setf *sucesores* (append *sucesores* (list (cons sucesor posicion))))))



;Funcion auxiliar para el algoritmo minimax. Dado un tablero y un
;turno pasados como parametro, calcula todos los sucesores de dicho
;tablero.

(defun calcula-sucesores3 (tablero posiciones turno)
  (setf *sucesores* nil)
  (let ((origen nil))
    (cond ((= turno 1)
	   (setf origen (first posiciones))
	   (loop for posibilidad in (movimientos-validos3 tablero origen turno) do
		 (if (or (< (first posibilidad) 0)
			 (< (rest posibilidad) 0))
		     (crea-sucesor-comer tablero posiciones origen posibilidad turno)
		   (crea-sucesor3 tablero posiciones origen posibilidad turno))))
	  ((= turno 2)
	   (setf origen (subseq posiciones 1 (length posiciones)))
	   (loop for orig in origen do
		 (loop for posibilidad in (movimientos-validos3 tablero orig turno) do
		       (crea-sucesor3 tablero posiciones orig posibilidad turno)))))
    *sucesores*))


;Funcion recursiva con poda para el calculo del valor minimax de un nodo
;MAX. Si ha llegado a la profundidad maxima o el nodo es un tablero
;final, calcula el valor del nodo llamando a la funcion de evaluacion
;estatica *heuristica*. Si no realiza recursion.

(defun maximizador3-alpha-beta (tablero-sucesor posiciones profundidad alpha beta)
  (let ((valor-max *minimo-valor*))
    (cond ((es-estado-ganador3 tablero-sucesor posiciones 1)  
	  ; (setf valor-max *maximo-valor*))
	   (if (= profundidad *profundidad*)
	       (setf valor-max -10000)
	     (setf valor-max *minimo-valor*)))
	  ((= profundidad 0)
	   (setf valor-max (funcall *heuristica3-MAX* tablero-sucesor posiciones 1)))
	  (t
	   (let ((sucesores (calcula-sucesores3 tablero-sucesor posiciones 1)) 
		 (poda nil))
	     (loop for sucesor-actual in sucesores while (not poda) do
		   (setf valor-max (max (minimizador3-alpha-beta (first sucesor-actual) (rest sucesor-actual)
								(1- profundidad) alpha beta) 
					valor-max)) 
		   (if (>= valor-max beta)
		       (setf poda t)) 
		   (setf alpha (max alpha valor-max))))))
    valor-max))


;Funcion recursiva con poda para el calculo del valor minimax,
;equivalente a la anterior pero sobre un nodo MIN. Si ha llegado
;a la profundidad maxima o el nodo es un tablero final, calcula 
;el valor del nodo llamando a la funcion de evaluacion estatica 
;*heuristica*. Sino realiza recursion.

(defun minimizador3-alpha-beta (tablero-sucesor posiciones profundidad alpha beta)
  (let ((valor-min *maximo-valor*))
    (cond ((es-estado-ganador3 tablero-sucesor posiciones 2)
	   ;(setf valor-min *minimo-valor*))
	   (if (= profundidad *profundidad*)
	       (setf valor-min 10000)
	     (setf valor-min *maximo-valor*)))
	  ((= profundidad 0)
	   (setf valor-min (funcall *heuristica3-MIN* tablero-sucesor posiciones 2)))
	  (t
	   (let ((sucesores (calcula-sucesores3 tablero-sucesor posiciones 2))
		 (poda nil))
	     (loop for sucesor-actual in sucesores while (not poda) do
		   (setf valor-min (min (maximizador3-alpha-beta (first sucesor-actual) (rest sucesor-actual)
								(1- profundidad) alpha beta)
					valor-min))
		   (if (<= valor-min alpha)
		       (setf poda t))
		   (setf beta (min beta valor-min))))))
    valor-min))


;Funcion principal para el calculo de minimax sobre un nodo MAX, a
;partir de esta funcion comenzara la recursion, la profundidad y la
;poda alpha-beta. Devuelve el mejor tablero sucesor.


(defun minimax3-nodoMAX ()
  (let* ((valor-max *minimo-valor*) 
	 (sucesores (calcula-sucesores3 *tablero* *posiciones* 1)) 
	 (valor-actual 0)
	 (mejor-sucesor (first sucesores)))
    (loop for sucesor-actual in sucesores do
	  (setf valor-actual 
		(minimizador3-alpha-beta (first sucesor-actual) (rest sucesor-actual)
					*profundidad* valor-max *maximo-valor*))
	  (cond ((= valor-actual 10000)
		 (setf mejor-sucesor sucesor-actual)
		 (return))
		((> valor-actual valor-max)
		 (setf mejor-sucesor sucesor-actual)
		 (setf valor-max valor-actual))
		(t nil)))
    mejor-sucesor))


(defun minimax3-nodoMIN ()
  (let* ((valor-min *maximo-valor*)
	 (sucesores (calcula-sucesores3 *tablero* *posiciones* 2))
	 (valor-actual 0)
	 (mejor-sucesor (first sucesores)))
     (loop for sucesor-actual in sucesores when (not (and (= 3 *contador*)
		   (= (loop for posicion in 
			    (subseq (rest sucesor-actual) 1 (length (rest sucesor-actual))) summing 
			    (first posicion))
		      (loop for posicion in (subseq *posiciones* 1 (length *posiciones*)) summing 
			    (first posicion))))) do
	  (setf valor-actual 
		(maximizador3-alpha-beta (first sucesor-actual) (rest sucesor-actual)
					*profundidad* *minimo-valor* valor-min))
	  (cond ((= valor-actual -10000)
		 (setf mejor-sucesor sucesor-actual)
		 (return))
		((< valor-actual valor-min)
		 (setf mejor-sucesor sucesor-actual)
		 (setf valor-min valor-actual))
		(t nil)))
     mejor-sucesor))


(defun finaliza-juego3 ()
  (cond ((= *contador* 10)
	 (do-msg "Ha ganado el zorro"))
	((= *turno* 1)
	 (do-msg "Han ganado las ocas"))
	((= *turno* 2)
	 (do-msg "Ha ganado el zorro"))))


(defun comprueba-si-fin3 ()
  (if (= *turno* 1)
      (setf *turno* 2)
    (setf *turno* 1))
  (cond ((not (es-estado-ganador3 *tablero* *posiciones* *turno*))
	 (escribe-jugadas (list *tablero*) "./proyecto/save/zorra-ocas.txt")
	 (bind *Boton-Ayuda* "<ButtonPress-1>" (lambda (evt)
						 (pide-ayuda3)))
	 (selecciona-ficha3))
	(t
	 (bind *Boton-Ayuda* "<ButtonPress-1>" ())
	 (finaliza-juego3))))


(defun aplica-movimiento3 (origen boton-destino posibilidades)
  (let* ((imgvacia (make-image))
	 (imgblanca (make-image))
	 (imgnegra (make-image))
	 (destinoNoAbs (first (loop for posibilidad in posibilidades 
				    when (eq (aref *casillas* (abs (first posibilidad)) (abs (rest posibilidad)))
					     boton-destino) collect
					     posibilidad)))
	 (destino (cons (abs (first destinoNoAbs)) (abs (rest destinoNoAbs)))))
    
    ;; Actualizamos el tablero...  
    (format t "~a " destinoNoAbs)
    (loop for i from 0 to (1- (length *posiciones*)) when (eq (nth i *posiciones*) origen) do
	  (setf (nth i *posiciones*) destino))
    (setf (aref *tablero* (first origen) (rest origen)) 0)
    (configure (aref *casillas* (first origen) (rest origen)) :image imgvacia)
    (cond ((= *turno* 1)
	   (setf (aref *tablero* (first destino) (rest destino)) 1)
	   (image-load imgblanca "./proyecto/imagenes/zorro.gif")
	   (configure boton-destino :image imgblanca))
	  ((= *turno* 2)
	   (setf (aref *tablero* (first destino) (rest destino)) 2)
	   (image-load imgnegra "./proyecto/imagenes/oca.gif")
	   (configure boton-destino :image imgnegra)))

    ;; Actualizamos *contador* si....

    (if (or (and (= *modo* 1)
		 (= *jugador* 2))
	    (and (= *modo* 2)
		 (= *turno* 2)))
	(if (or (and (= (first origen) (first destino))
		     (= (1- (rest origen)) (rest destino)))
		(and (= (first origen) (first destino))
		     (= (1+ (rest origen)) (rest destino))))
	    (setf *contador* (1+ *contador*))
	  (setf *contador* 0)))

    ;; Comprobamos si en el movimientos hemos comido una ficha...

    (if (or (< (first destinoNoAbs) 0)
	    (< (rest destinoNoAbs) 0))
	(aplica-movimiento-comer origen destino)
      (comprueba-si-fin3))))



(defun aplica-movimiento-comer (origen destino)
  (let ((eliminada)
	(imgvacia (make-image))
	(boton-destino (aref *casillas* (first destino) (rest destino)))
	(nuevos-destinos)
	(posibilidades))
    
    ;; Primero actualizamos el tablero eliminando del juego la ficha comida.

    (loop for i from 1 to (1- (length *posiciones*))
	  when (equal (nth i *posiciones*)
		      (cons (+ (/ (- (first destino) (first origen)) 2) (first origen))
			    (+ (/ (- (rest destino) (rest origen)) 2) (rest origen)))) do
			    (setf eliminada (nth i *posiciones*))
			    (configure (aref *casillas* (first eliminada)
					     (rest eliminada)) :image imgvacia)
			    (setf (aref *tablero* (first eliminada) (rest eliminada)) 0)
			    (setf *posiciones* (remove eliminada *posiciones*)))

    ;; Comprobamos si existe posibilidad de comer múltiples fichas. 

    (loop for posibilidad in *movimientos-3* 
	  when (and (puede-comer *tablero* destino posibilidad)
		    (not (restriccionDiagonal3 destino posibilidad))
		    (not (casilla-libre *tablero* (cons (+ (first destino) (first posibilidad))
							(+ (rest destino) (rest posibilidad)))))) do 
		    (setf posibilidades (append posibilidades 
						(list (cons (-(+ (first destino) (* 2 (first posibilidad)))) 
							    (-(+ (rest destino) (* 2 (rest posibilidad))))))))
		    (setf nuevos-destinos (append nuevos-destinos 
						  (list (aref  *casillas* 
							       (+ (first destino) (* 2 (first posibilidad))) 
							       (+ (rest destino) (* 2 (rest posibilidad))))))))

    ;; En caso de tener posibilidad de seguir comiendo...

    (cond ((endp posibilidades)
	   (comprueba-si-fin3))
	  (t
     (mapcar #'(lambda (x) (configure x :background :green)) nuevos-destinos)
	   (configure boton-destino :background :blue)
	   (bind boton-destino "<ButtonPress-1>"
		 (lambda (evt)
		   (configure boton-destino :background :#bbbab8)
		   (mapcar #'(lambda (x) (configure x :background :#bbbab8)) nuevos-destinos)
		   (bind boton-destino "<ButtonPress-1>" ())
		   (mapcar #'(lambda (x) (bind x "<ButtonPress-1>" ())) nuevos-destinos)
		   (comprueba-si-fin3)))	    
	   (mapcar #'(lambda (nuevo-destino)
		       (bind nuevo-destino "<ButtonPress-1>"
			     (lambda (evt)
			       (configure boton-destino :background :#bbbab8)
			       (mapcar #'(lambda (x) (configure x :background :#bbbab8)) nuevos-destinos)
			       (bind boton-destino "<ButtonPress-1>" ())
			       (mapcar #'(lambda (x) (bind x "<ButtonPress-1>" ())) nuevos-destinos)
			       (aplica-movimiento3 destino nuevo-destino posibilidades)))) nuevos-destinos)))))




(defun selecciona-destino-ocas (boton-origen botones)
  (let* ((origen (first (loop for i from 1 to (1- (length *posiciones*)) 
			      when (eq (nth i botones) boton-origen) collect (nth i *posiciones*))))
	 (posibilidades (movimientos-validos3 *tablero* origen *turno*))
	 (botones-destinos (loop for posibilidad in posibilidades collect
				 (aref *casillas* (first posibilidad) (rest posibilidad)))))
    (mapcar #'(lambda (x) (configure x :background :green)) botones-destinos)
    (mapcar #'(lambda (cambio-origen) 
		(bind cambio-origen "<ButtonPress-1>"
		      (lambda (evt)
			(configure boton-origen :background  :#bbbab8)
			(configure cambio-origen :background :green)
			(mapcar #'(lambda (x) (configure x :background  :#bbbab8)) botones-destinos)
			(mapcar #'(lambda (x) (bind x "<ButtonPress-1>" ())) botones-destinos)
			(selecciona-destino-ocas cambio-origen botones)))) (subseq botones 1 (length *posiciones*)))
    (mapcar #'(lambda (boton-destino)
		(bind boton-destino "<ButtonPress-1>"
		      (lambda (evt)
			(configure boton-origen :background  :#bbbab8)
			(mapcar #'(lambda (x) (configure x :background  :#bbbab8)) botones-destinos)
			(mapcar #'(lambda (x) (bind x "<ButtonPress-1>" ())) botones)
			(mapcar #'(lambda (x) (bind x "<ButtonPress-1>" ())) botones-destinos)
			(aplica-movimiento3 origen boton-destino posibilidades)))) botones-destinos)))



(defun selecciona-destino-zorro (origen)
  (let* ((posibilidades (movimientos-validos3 *tablero* origen *turno*))
	 (botones (loop for posibilidad in posibilidades collect
			(aref *casillas* (abs (first posibilidad)) (abs (rest posibilidad)))))) 
    ;; Utilizo valor absoluto ya que uso numero negativo para indicar acción de comer
    (mapcar #'(lambda (x) (configure x :background :green)) botones)
    (mapcar #'(lambda (boton-destino)
		(bind boton-destino "<ButtonPress-1>"
		      (lambda (evt)
			(configure (aref *casillas* (first origen) (rest origen)) :background :#bbbab8)
			(bind (aref *casillas* (first origen) (rest origen)) "<ButtonPress-1>" ())
			(mapcar #'(lambda (x) (configure x :background :#bbbab8)) botones)
			(mapcar #'(lambda (x) (bind x "<ButtonPress-1>" ())) botones)
			(aplica-movimiento3 origen boton-destino posibilidades)))) botones)))



(defun movimiento-minimax-zorro ()
  (let ((salto nil)
	(tablero-posiciones nil)
	(posiciones-anterior *posiciones*)
	(imgeliminada (make-image))
	(imgblanca (make-image))
	(imgvacia (make-image)))
    (image-load imgeliminada "./proyecto/imagenes/eliminada.gif")
    (image-load imgblanca "./proyecto/imagenes/zorro.gif")
   ; (configure (aref *casillas* (first (first *posiciones*)) (rest (first *posiciones*))) :image imgvacia)
    (setf tablero-posiciones (minimax3-nodoMAX))
    (setf *tablero* (first tablero-posiciones))
    (setf *posiciones* (rest tablero-posiciones))
    (loop for pos in (subseq posiciones-anterior 1 (length posiciones-anterior))
	  when (not (member pos *posiciones*)) do
	  (setf salto t)
	  (configure (aref *casillas* (first pos) (rest pos)) :image imgeliminada))
    (configure (aref *casillas* (first (first posiciones-anterior)) (rest (first posiciones-anterior))) :image imgvacia)
    (configure (aref *casillas* (first (first *posiciones*)) (rest (first *posiciones*))) :image imgblanca)
    (cond (salto           ;;; Si hemos saltado alguna oca...
	   (sleep 2)       ;;; Esperamos dos segundos antes de...
	   (loop for pos in (subseq posiciones-anterior 1 (length posiciones-anterior))
		 when (not (member pos *posiciones*)) do
		 (configure (aref *casillas* (first pos) (rest pos)) :image imgvacia))))     
    (comprueba-si-fin3)))



(defun movimiento-minimax-ocas ()
   (let ((tablero-posiciones nil)
	 (imgvacia (make-image))
	 (pos-anteriores *posiciones*))
     (setf tablero-posiciones (minimax3-nodoMIN))
     (setf *tablero* (first tablero-posiciones))
     (setf *posiciones* (rest tablero-posiciones))
     (loop for i from 1 to (1- (length *posiciones*)) when (not (eq (nth i pos-anteriores)
								   (nth i *posiciones*))) do
       (configure (aref *casillas* (first (nth i pos-anteriores)) (rest (nth i pos-anteriores)))
		  :image imgvacia)
       (if (or (and (= (first (nth i pos-anteriores)) (first (nth i *posiciones*)))
		    (= (1- (rest (nth i pos-anteriores))) (rest (nth i *posiciones*))))
	       (and (= (first (nth i pos-anteriores)) (first (nth i *posiciones*)))
		    (= (1+ (rest (nth i pos-anteriores))) (rest (nth i *posiciones*)))))
	   (setf *contador* (1+ *contador*))
	 (setf *contador* 0)))
     (imprime-fichas3)
     (comprueba-si-fin3)))

(defun pide-ayuda3 ()
  (let ((posiciones nil)
	(salto nil))
    (cond ((= *turno* 1)
	   (setf posiciones (rest (minimax3-nodoMAX)))
	   

	   (loop for pos in (subseq *posiciones* 1 (length *posiciones*))
		 when (not (member pos posiciones)) do
		 (setf salto t)
		 (configure (aref *casillas* (first pos) (rest pos)) :background :red))
	   (configure (aref *casillas* (first (first *posiciones*)) (rest (first *posiciones*))) :background :blue)
	   (configure (aref *casillas* (first (first posiciones)) (rest (first posiciones))) :background :blue)
	   (cond (salto           ;;; Si hemos saltado alguna oca...
		  (sleep 1)
	   (configure (aref *casillas* (first (first *posiciones*)) (rest (first *posiciones*))) :background :#bbbab8)
	   (configure (aref *casillas* (first (first posiciones)) (rest (first posiciones))) :background ::#bbbab8)
	   (loop for pos in (subseq *posiciones* 1 (length *posiciones*))
		 when (not (member pos posiciones)) do
		 (configure (aref *casillas* (first pos) (rest pos)) :background :#bbbab8)))
		 (t
		  (sleep 1)
	   (configure (aref *casillas* (first (first *posiciones*)) (rest (first *posiciones*))) :background :#bbbab8)
	   (configure (aref *casillas* (first (first posiciones)) (rest (first posiciones))) :background ::#bbbab8))))
		  

	  ; (configure (aref *casillas* (first (first *posiciones*)) (rest (first *posiciones*)))
		;      :background :blue)
	  ; (configure (aref *casillas* (first (first posiciones)) (rest (first posiciones)))
		;      :background :blue)
	  ; (sleep 1)
	  ; (configure (aref *casillas* (first (first *posiciones*)) (rest (first *posiciones*)))
		;      :background :#bbbab8)
	  ; (configure (aref *casillas* (first (first posiciones)) (rest (first posiciones)))
		;      :background :#bbbab8))
	  ((= *turno* 2)
	   (setf posiciones (rest (minimax3-nodoMIN)))
	   (loop for i from 1 to (1- (length *posiciones*)) when (not (eq (nth i posiciones)
									  (nth i *posiciones*))) do
	     (configure (aref *casillas* (first (nth i *posiciones*)) (rest (nth i *posiciones*)))
			:background :blue)
	     (configure (aref *casillas* (first (nth i posiciones)) (rest (nth i posiciones)))
			:background :blue)
	     (sleep 1)
	     (configure (aref *casillas* (first (nth i *posiciones*)) (rest (nth i *posiciones*)))
			:background :#bbbab8)
	     (configure (aref *casillas* (first (nth i posiciones)) (rest (nth i posiciones)))
			:background :#bbbab8))))))



(defun selecciona-ficha3 ()
  (let ((botones (loop for posicion in *posiciones* collect
		       (aref *casillas* (first posicion) (rest posicion))))
	(imgvacia (make-image)))
    (cond ((or (and (= *modo* 1)     
		    (= *turno* 1)
		    (= *jugador* 1))
	       (and (= *modo* 2)
		    (= *turno* 1)))
	   (bind (nth 0 botones) "<ButtonPress-1>" 
		 (lambda (evt)
		   (configure (nth 0 botones) :background :green)
		   (bind (nth 0 botones) "<ButtonPress-1>" ())
		   (bind *Boton-Ayuda* "<ButtonPress-1>" ())
		   ;;Se llama a selecciona-destino con el par punteado donde está la liebre
		   (selecciona-destino-zorro (nth 0 *posiciones*))))) 	  
	  ((or (and (= *modo* 1)
		    (= *turno* 1)   
		    (= *jugador* 2))
	       (and (= *modo* 3)
		    (= *turno* 1)))
	   (movimiento-minimax-zorro))
	  ((or (and (= *modo* 1)     
		    (= *turno* 2)
		    (= *jugador* 1))
	       (and (= *modo* 3)
		    (= *turno* 2)))
	   (movimiento-minimax-ocas))
	  ((or (and (= *modo* 1)     
		    (= *turno* 2)
		    (= *jugador* 2))
	       (and (= *modo* 2)
		    (= *turno* 2)))
	   (mapcar #'(lambda (boton-origen)
		       (bind boton-origen "<ButtonPress-1>"
			     (lambda (evt)  
			       (configure boton-origen :background :green)
			       (mapcar #'(lambda (x) (bind x "<ButtonPress-1>" ())) botones)
			       (bind *Boton-Ayuda* "<ButtonPress-1>" ())
			       (selecciona-destino-ocas boton-origen botones))))
		   (subseq botones 1 (length *posiciones*)))))))


(defun elige-bando3 ()
  (setf *Boton-Ayuda* (make-instance 'button :master *ventana* :text "Ayuda" :activebackground :#feffc3))
  (let ((img1 (make-image))
	(img2 (make-image))
	(img3 (make-image))
	(img4 (make-image))
	(boton1 (make-instance 'button
			       :master *ventana*
			       :text "Zorra"))
	(boton2 (make-instance 'button
			       :master *ventana*
			       :text "Gansos"))
	(boton3 (make-instance 'button
			       :master *ventana*
			       :text "Menú")))
    (place boton1 595 100 :width 150 :height 150)
    (place boton2 595 350 :width 150 :height 150)
    (image-load img1 "./proyecto/imagenes/zorro2.gif")
    (image-load img2 "./proyecto/imagenes/oca2.gif")
    (image-load img3 "./proyecto/imagenes/ayuda.gif")
    (image-load img4 "./proyecto/imagenes/menu.gif")
    (configure boton1 :image img1)
    (configure boton2 :image img2)
    (bind boton1 "<ButtonPress-1>" (lambda (evt)
				     (setf *jugador* 1)
				     (destroy boton1)
				     (destroy boton2)
				     (place *Boton-Ayuda* 620 50 :width 100 :height 150)
				     (configure *Boton-Ayuda* :image img3)
				     (place boton3 620 300 :width 100 :height 150)
				     (configure boton3 :image img4)
				     (bind *Boton-Ayuda* "<ButtonPress-1>" (lambda (evt)
								      (pide-ayuda3)))
				     (bind boton3 "<ButtonPress-1>" (lambda (evt)
				     (loop for i from 0 to 6 do
					   (loop for j from 0 to 6 
						 when (not (= -1 (aref *tablero* i j))) do
						 (destroy (aref *casillas* i j))))
				     (destroy *Boton-Ayuda*)
				     (destroy boton3)
				     (destroy *botonSalir*)
				     (elige-juego)))
				     (selecciona-ficha3)))
    (bind boton2 "<ButtonPress-1>" (lambda (evt)
				     (setf *jugador* 2)
				     (destroy boton1)
				     (destroy boton2)
				     (place *Boton-Ayuda* 620 50 :width 100 :height 150)
				     (configure *Boton-Ayuda* :image img3)
				     (place boton3 620 300 :width 100 :height 150)
				     (configure boton3 :image img4)
				     (bind *Boton-Ayuda* "<ButtonPress-1>" (lambda (evt)
								      (pide-ayuda3)))
				     (bind boton3 "<ButtonPress-1>" (lambda (evt)
				     (loop for i from 0 to 6 do
					   (loop for j from 0 to 6 
						 when (not (= -1 (aref *tablero* i j))) do
						 (destroy (aref *casillas* i j))))
				     (destroy *Boton-Ayuda*)
				     (destroy boton3)
				     (destroy *botonSalir*)
				     (elige-juego)))
				     (selecciona-ficha3)))))




(defun imprime-fichas3 ()
  (let ((imgblanca (make-image))
	(imgnegra  (make-image)))
    (image-load imgblanca "./proyecto/imagenes/zorro.gif")
    (image-load imgnegra  "./proyecto/imagenes/oca.gif")
    (configure (aref *casillas* (first (first *posiciones*)) (rest (first *posiciones*)))
	       :image imgblanca)
    (loop for i from 1 to (1- (length *posiciones*)) do
	  (configure (aref *casillas* (first (nth i *posiciones*)) (rest (nth i *posiciones*)))
		     :image imgnegra))))



(defun crea-estado-inicial3 ()
  (setf *tablero* (make-array '(7 7) :initial-element 0))
  (loop for posicion in (subseq *posiciones* 1 16) do
	(setf (aref *tablero* (first posicion) (rest posicion)) 2))
  (setf (aref *tablero* 3 3) 1)
  (setf (aref *tablero* 0 0) -1)   ;; A las esquinas de la matriz les asigno el valor -1
  (setf (aref *tablero* 0 1) -1)   ;; así consigo que no se procesen.
  (setf (aref *tablero* 0 5) -1)
  (setf (aref *tablero* 0 6) -1)
  (setf (aref *tablero* 1 0) -1)
  (setf (aref *tablero* 1 1) -1)
  (setf (aref *tablero* 1 5) -1)
  (setf (aref *tablero* 1 6) -1)
  (setf (aref *tablero* 5 0) -1)
  (setf (aref *tablero* 5 1) -1)
  (setf (aref *tablero* 5 5) -1)
  (setf (aref *tablero* 5 6) -1)
  (setf (aref *tablero* 6 0) -1)
  (setf (aref *tablero* 6 1) -1)
  (setf (aref *tablero* 6 5) -1)
  (setf (aref *tablero* 6 6) -1))


(defun inicializa-juego3 () 
  (let ((img (make-image)))
    (image-load img "./proyecto/imagenes/tablero3.gif")
    (configure *ventana* :image img)
    (setf *turno* 1)
    (setf *posiciones* (list '(3 . 3) '(3 . 0) '(3 . 6) '(4 . 0) '(4 . 1) '(4 . 2) '(4 . 3) '(4 . 4)
			     '(4 . 5) '(4 . 6) '(5 . 2) '(5 . 3) '(5 . 4) '(6 . 2) '(6 . 3) '(6 . 4)))
    (setf *contador* 0)
    (crea-estado-inicial3)
    (setf *casillas* (make-array '(7 7)))
    (loop for i from 0 to 6 do
	  (loop for j from 0 to 6 when (not (= -1 (aref *tablero* i j))) do
		(setf (aref *casillas* i j) (make-instance 'button
							   :master *ventana*
							   :relief :raised))
		(place (aref *casillas* i j) (+ 20 (* 80 j)) (+ 20 (* 80 i))
		       :width 65 :height 65)))
    (imprime-fichas3)
    (elige-bando3)))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;                                 ;;;;
;;;;                                 ;;;;
;;;;        INICIO APLICACIÓN        ;;;;
;;;;                                 ;;;;
;;;;                                 ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(defun elige-estrategia2 ()
  (let ((img  (make-image))
	(img1 (make-image))
	(img2 (make-image))
	(img3 (make-image))
	(imgvacia (make-image))
	(boton1 (make-instance 'button
			       :master *ventana*
			       :text "Fácil"))
	(boton2 (make-instance 'button
			       :master *ventana*
			       :text "Normal"))
	(boton3 (make-instance 'button
			       :master *ventana*
			       :text "Difícil")))
    (place boton1  50 200 :width 200 :height 200)
    (place boton2 300 200 :width 200 :height 200)
    (place boton3 550 200 :width 200 :height 200)
    (image-load img  "./proyecto/imagenes/nodoMIN.gif")
    (image-load img1 "./proyecto/imagenes/Avanzar.gif")
    (image-load img2 "./proyecto/imagenes/Equilibrar.gif")
    (image-load img3 "./proyecto/imagenes/Defender.gif")
    (configure *ventana* :image img)
    (configure boton1 :image img1
	              :cursor :hand2
		      :activebackground :white)
    (configure boton2 :image img2
	              :cursor :hand2
		      :activebackground :white)
    (configure boton3 :image img3
	              :cursor :hand2
                      :activebackground :white)
    (bind boton1 "<ButtonPress-1>" (lambda (evt)			
				     (destroy boton1)
				     (destroy boton2)
				     (destroy boton3)
				     (configure *ventana* :image imgvacia)
				     (place *botonSalir* 620 545 :width 100 :height  50)
				     (cond ((= *juego* 1)
					    (setf *heuristica-MIN* 'f1-estatica-5)
					    (inicializa-juego1))
					   ((= *juego* 2)
					    (setf *heuristica2-MIN* 'f2-estatica-5)
					    (inicializa-juego2))
					   ((= *juego* 3)
					    (setf *heuristica3-MIN* 'f3-estatica-5)
					    (inicializa-juego3)))))
    (bind boton2 "<ButtonPress-1>" (lambda (evt)
				     (destroy boton1)
				     (destroy boton2)
				     (destroy boton3)
				     (configure *ventana* :image imgvacia)
				     (place *botonSalir* 620 545 :width 100 :height  50)
				     (cond ((= *juego* 1)
					    (setf *heuristica-MIN* 'f1-estatica-4)
					    (inicializa-juego1))
					   ((= *juego* 2)
					    (setf *heuristica2-MIN* 'f2-estatica-4)
					    (inicializa-juego2))
					   ((= *juego* 3)
					    (setf *heuristica3-MIN* 'f3-estatica-4)
					    (inicializa-juego3)))))
    (bind boton3 "<ButtonPress-1>" (lambda (evt)
				     (destroy boton1)
				     (destroy boton2)
				     (destroy boton3)
				     (configure *ventana* :image imgvacia)
				     (place *botonSalir* 620 545 :width 100 :height  50)
				     (cond ((= *juego* 1)
					    (setf *heuristica-MIN* 'f1-estatica-6)
					    (inicializa-juego1))
					   ((= *juego* 2)
					    (setf *heuristica2-MIN* 'f2-estatica-6)
					    (inicializa-juego2))
					   ((= *juego* 3)
					    (setf *heuristica3-MIN* 'f3-estatica-6)
					    (inicializa-juego3)))))))



(defun elige-estrategia1 ()
  (let ((img  (make-image))
	(img1 (make-image))
	(img2 (make-image))
	(img3 (make-image))
	(imgvacia (make-image))
	(boton1 (make-instance 'button
			       :master *ventana*
			       :text "Fácil"))
	(boton2 (make-instance 'button
			       :master *ventana*
			       :text "Normal"))
	(boton3 (make-instance 'button
			       :master *ventana*
			       :text "Difícil")))
    (place boton1  50 200 :width 200 :height 200)
    (place boton2 300 200 :width 200 :height 200)
    (place boton3 550 200 :width 200 :height 200)
    (image-load img  "./proyecto/imagenes/nodoMAX.gif")
    (image-load img1 "./proyecto/imagenes/Avanzar.gif")
    (image-load img2 "./proyecto/imagenes/Equilibrar.gif")
    (image-load img3 "./proyecto/imagenes/Atacar.gif")
    (configure *ventana* :image img)
    (configure boton1 :image img1
	              :cursor :hand2
		      :activebackground :white)
    (configure boton2 :image img2
	              :cursor :hand2
		      :activebackground :white)
    (configure boton3 :image img3
	              :cursor :hand2
                      :activebackground :white)
    (bind boton1 "<ButtonPress-1>" (lambda (evt)			
				     (destroy boton1)
				     (destroy boton2)
				     (destroy boton3)
				     (configure *ventana* :image imgvacia)
				     (cond ((= *juego* 1)
					    (setf *heuristica-MAX* 'f1-estatica-2)
					    (elige-estrategia2))
					   ((= *juego* 2)
					    (setf *heuristica2-MAX* 'f2-estatica-2)
					    (elige-estrategia2))
					   ((= *juego* 3)
					    (setf *heuristica3-MAX* 'f3-estatica-2)
					    (elige-estrategia2)))))
    (bind boton2 "<ButtonPress-1>" (lambda (evt)
				     (destroy boton1)
				     (destroy boton2)
				     (destroy boton3)
				     (configure *ventana* :image imgvacia)
				     (cond ((= *juego* 1)
					    (setf *heuristica-MAX* 'f1-estatica-1)
					    (elige-estrategia2))
					   ((= *juego* 2)
					    (setf *heuristica2-MAX* 'f2-estatica-1)
					    (elige-estrategia2))
					   ((= *juego* 3)
					    (setf *heuristica3-MAX* 'f3-estatica-1)
					    (elige-estrategia2)))))
    (bind boton3 "<ButtonPress-1>" (lambda (evt)
				     (destroy boton1)
				     (destroy boton2)
				     (destroy boton3)
				     (configure *ventana* :image imgvacia)
				     (cond ((= *juego* 1)
					    (setf *heuristica-MAX* 'f1-estatica-3)
					    (elige-estrategia2))
					   ((= *juego* 2)
					    (setf *heuristica2-MAX* 'f2-estatica-3)
					    (elige-estrategia2))
					   ((= *juego* 3)
					    (setf *heuristica3-MAX* 'f3-estatica-3)
					    (elige-estrategia2)))))))
				    


(defun elige-dificultad ()
  (let ((img  (make-image))
	(img1 (make-image))
	(img2 (make-image))
	(img3 (make-image))
	(imgvacia (make-image))
	(boton1 (make-instance 'button
			       :master *ventana*
			       :text "Fácil"))
	(boton2 (make-instance 'button
			       :master *ventana*
			       :text "Normal"))
	(boton3 (make-instance 'button
			       :master *ventana*
			       :text "Difícil")))
    (place boton1  50 200 :width 200 :height 200)
    (place boton2 300 200 :width 200 :height 200)
    (place boton3 550 200 :width 200 :height 200)
    (image-load img  "./proyecto/imagenes/selecciona-dificultad.gif")
    (image-load img1 "./proyecto/imagenes/facil.gif")
    (image-load img2 "./proyecto/imagenes/normal.gif")
    (image-load img3 "./proyecto/imagenes/dificil.gif")
    (configure *ventana* :image img)
    (configure boton1 :image img1
	              :cursor :hand2
		      :activebackground :white)
    (configure boton2 :image img2
	              :cursor :hand2
		      :activebackground :white)
    (configure boton3 :image img3
	              :cursor :hand2
                      :activebackground :white)
    (bind boton1 "<ButtonPress-1>" (lambda (evt)			
				     (destroy boton1)
				     (destroy boton2)
				     (destroy boton3)
				     (configure *ventana* :image imgvacia)
				     (setf *profundidad* 5)
				     (elige-estrategia1)))
    (bind boton2 "<ButtonPress-1>" (lambda (evt)
				     (destroy boton1)
				     (destroy boton2)
				     (destroy boton3)
				     (configure *ventana* :image imgvacia)
				     (setf *profundidad* 7)
				     (elige-estrategia1)))
    (bind boton3 "<ButtonPress-1>" (lambda (evt)
				     (destroy boton1)
				     (destroy boton2)
				     (destroy boton3)
				     (configure *ventana* :image imgvacia)
				     (setf *profundidad* 9)
				     (elige-estrategia1)))))


(defun elige-modo ()
  (let ((img  (make-image))
        (img1 (make-image))
	(img2 (make-image))
        (img3 (make-image))
	(imgvacia (make-image))
	(boton1 (make-instance 'button
			       :master *ventana*
			       :text "Modo 1"))
	(boton2 (make-instance 'button
			       :master *ventana*
			       :text "Modo 2"))
	(boton3 (make-instance 'button
			       :master *ventana*
			       :text "Modo 3")))
    (place boton1  50 200 :width 200 :height 200)
    (place boton2 300 200 :width 200 :height 200)
    (place boton3 550 200 :width 200 :height 200)
    (image-load img  "./proyecto/imagenes/selecciona-modo.gif")
    (image-load img1 "./proyecto/imagenes/humanvscpu.gif")
    (image-load img2 "./proyecto/imagenes/humanvshuman.gif")
    (image-load img3 "./proyecto/imagenes/cpuvscpu.gif")
    (configure *ventana* :image img)
    (configure boton1 :image img1
	              :cursor :hand2)
    (configure boton2 :image img2
	              :cursor :hand2)
    (configure boton3 :image img3
	              :cursor :hand2)
			      ;;:activebackground :white)
    (bind boton1 "<ButtonPress-1>" (lambda (evt) 
				     (destroy boton1)
				     (destroy boton2)
				     (destroy boton3)
				     (setf *modo* 1)
				     (configure *ventana* :image imgvacia)
				     (elige-dificultad)))
    (bind boton2 "<ButtonPress-1>" (lambda (evt) 
				     (destroy boton1)
				     (destroy boton2)
				     (destroy boton3)
				     (setf *modo* 2)
				     (configure *ventana* :image imgvacia)
				     (elige-dificultad)))
    (bind boton3 "<ButtonPress-1>" (lambda (evt) 
				     (destroy boton1)
				     (destroy boton2)
				     (destroy boton3)
				     (setf *modo* 3)
				     (configure *ventana* :image imgvacia)
				     (elige-dificultad)))))



(defun elige-juego ()
  (setf *botonSalir* (make-instance 'button
				    :master *ventana*
				    :text "Salir"
				    :command (lambda ()
					       (do-msg "¡Hasta la próxima!")
					       (setf *exit-mainloop* t))))
  (let ((img  (make-image))
        (img1 (make-image))
	(img2 (make-image))
        (img3 (make-image))
	(img4 (make-image))
	(imgvacia (make-image))
	(boton1 (make-instance 'button
			       :master *ventana*
			       :text "Juego 1"))
	(boton2 (make-instance 'button
			       :master *ventana*
			       :text "Juego 2"))
	(boton3 (make-instance 'button
			       :master *ventana*
			       :text "Juego 3")))
    (place boton1  50 200 :width 200 :height 200)
    (place boton2 300 200 :width 200 :height 200)
    (place boton3 550 200 :width 200 :height 200)
    (place *botonSalir* 350 545 :width 100 :height  50)
    (image-load img  "./proyecto/imagenes/selecciona-juego.gif")
    (image-load img1 "./proyecto/imagenes/tom-jerry.gif")
    (image-load img2 "./proyecto/imagenes/liebre-perros.gif")
    (image-load img3 "./proyecto/imagenes/zorra-ocas.gif")
    (image-load img4 "./proyecto/imagenes/exit.gif")
    (configure *ventana* :image img)
    (configure boton1 :image img1
	              :cursor :hand2)
    (configure boton2 :image img2
	              :cursor :hand2)
    (configure boton3 :image img3
	              :cursor :hand2)
    (configure *botonSalir* :image img4
			    :cursor :hand2)
			      ;;:activebackground :white)
    (bind boton1 "<ButtonPress-1>" (lambda (evt) 
				     (destroy boton1)
				     (destroy boton2)
				     (destroy boton3)
				     (setf *juego* 1)
				     (configure *ventana* :image imgvacia)
				     (elige-modo)))
    (bind boton2 "<ButtonPress-1>" (lambda (evt) 
				     (destroy boton1)
				     (destroy boton2)
				     (destroy boton3)
				     (setf *juego* 2)
				     (configure *ventana* :image imgvacia)
				     (elige-modo)))
    (bind boton3 "<ButtonPress-1>" (lambda (evt) 
				     (destroy boton1)
				     (destroy boton2)
				     (destroy boton3)
				     (setf *juego* 3)
				     (configure *ventana* :image imgvacia)
				     (elige-modo)))))



(defun inicio ()
  (with-ltk ()
	    (setf *ventana* (make-instance 'label 
					   :master nil
					   :width 800
					   :height 600))
	    (let ((img (make-image))
		  (imgvacia (make-image)))
	      (pack *ventana*)
	      (image-load img "./proyecto/imagenes/portada.gif")
	      ;(image-load img "./proyecto/imagenes/portada.gif")
	      (configure *ventana* :image img) 
	      (bind *ventana* "<ButtonPress-1>" 
		    (lambda (evt)
		      (bind *ventana* "<ButtonPress-1>" ())
		      (configure *ventana* :image imgvacia)
		      (elige-juego))))))


(inicio)
