;;; ==================================================
;;; Jeu de Puissance 4
;;; TP d'intelligence artificielle B3/SUPINFO OI
;;;
;;; ANSI Common Lisp Standard
;;;
;;; @author     Nicolas Defaÿ <www.defay.net>
;;; @license    CC by-nc-sa
;;; @version   	1.1 (16/12/09) 
;;;                  L'ordinateur de joue pas : deux joueurs s'affrontent
;;; ==================================================

; ------------------
; Variables globales
; ------------------

; Les joueurs (syntaxe) : (nom-du joueur1 pion-du-joueur1) (nom-du joueur2 pion-du-joueur2) 

(setq les_joueurs '((Joueur1 x) (Joueur2 o)))


; Le jeu est représenté par une liste (6 lignes) de liste (7 colonnes)
;
; indices :    
;             col  
;        0 1 2 3 4 5 6 
;      0 _ _ _ _ _ _ _
;      1 _ _ _ _ _ _ _
;      2 _ _ _ _ _ _ _
;  lig 3 _ _ _ _ _ _ _
;      4 _ _ _ _ _ _ _
;      5 _ _ _ _ _ _ _

(setq jeu_vierge '((_ _ _ _ _ _ _)
                         (_ _ _ _ _ _ _)
                         (_ _ _ _ _ _ _)
                         (_ _ _ _ _ _ _)
                         (_ _ _ _ _ _ _)
                         (_ _ _ _ _ _ _)));


; Les directions correspondent aux points cardinaux et précisent
; les changements sur les lignes et les colonnes

(setq les_directions '(nord -1 0 nord-est -1 +1 est 0 +1 sud-est +1 +1
                       sud +1 0 sud-ouest +1 -1 ouest 0 -1 nord-ouest -1 -1))						 

;                       0:nord
;                            |   
;      7:nord_ouest \  |  / 1:nord_est
;                          \ | /
;          6:ouest   ---    --- 2:est
;                          / | \
;       5:sud_ouest /  |  \ 3:sud_est
;                            |  
;                        4:sud						 
						 

; ----------------------------------
; Macros et autres fonctions utiles
; ----------------------------------

; Incrémente nb de 1
(defmacro incr (nb) 
  (list 'setq nb 
        (list '+ nb 1)))

; Dérémente nb de 1
(defmacro decr (nb) 
  (list 'setq nb (list '- nb 1))
)

; Boucle until
(defmacro until (test &body body)
  `(block until
     (loop
	(if (not ,test)
	    (progn ,@body)
	    (return-from until)))))

; Boucle while
(defmacro while (test &rest body)
‘(do () ((not ,test)) ,@body))

; Affiche tous les éléments d'une liste sur une ligne
(defun prinl (une_liste)
 (prog ()
  (terpri)
  (mapcar 'princ une_liste)
  (return t)
 )
)

;Remplace dans une liste le terme de rang une_pos par un autre
(defun remplacer (une_liste une_pos une_val) ; 
  (cond
   ((= une_pos 0) (rplaca une_liste une_val))
   (t (cons (car une_liste) (remplacer (cdr une_liste) (1- une_pos) une_val)))
  )
)


;;; =========== FONCTIONS DU JEU ===========

; Affiche la grille du jeu
; ------------------------
(defun afficherJeu (un_jeu)
  (terpri)
  (princ "Voici le jeu :")
  (until (null un_jeu)
    (print (car un_jeu))
    (setq un_jeu (cdr un_jeu))
   )
)

; Retourne le numéro du joueur associé à une case du jeu
; Retourne -1 si la case est vide
; Retourne nil si la case est hors jeu
;-------------------------------------------------------
(defun getJeu (un_jeu une_lig une_col)
 (prog (ligne pion_joueur)
  (setq ligne (nth une_lig un_jeu))
  (setq pion_joueur (nth une_col ligne))
  (if (find pion_joueur (car les_joueurs)) 
      (return 0)
      (if (find pion_joueur (cadr les_joueurs)) 
          (return 1)
          (if (equal pion_joueur '_)
              (return -1)
              (return nil))))
 )
)

; Affecte dans la liste représentant le jeu, le pion d'un joueur
; La position ainsi que le joueur doivent être valides
;---------------------------------------------------------------
(defun setJeu(un_jeu une_lig une_col un_num_joueur)
 (prog (ligne pion_joueur)
  (setq pion_joueur (cadr (nth un_num_joueur les_joueurs)))
  (setq ligne (remplacer (nth une_lig un_jeu) une_col pion_joueur))
  (remplacer un_jeu une_lig ligne)
 )
)

; Retourne la ligne à jouer pour une colonne donnée
; Retourne -1 si la colonne est pleine
;-----------------------------------------------------------
(defun getLigne(un_jeu une_col)
 (prog (la_lig)
   (setq la_lig 0)
   (while (equal (getJeu un_jeu la_lig une_col) -1)
      (incr la_lig))
  (return (1- la_lig))
 )
)

; Retourne la colonne saisie par un joueur
; Retourne Nil si la valeur n'est pas numérique
;-----------------------------------------------------------
(defun getChoix (un_num_joueur)
 (prog (ma_col)
   (terpri)
   (prinl `(,(car (nth un_num_joueur les_joueurs)) 
            " (" ,(cadr (nth un_num_joueur les_joueurs))  ") , Entrez une colonne :"))
   (setq ma_col (read))
   (if (numberp ma_col) (return (1- ma_col)) (return nil))
 )
)

; Joue dans une colonne pour un joueur
; Note : La colonne doit être valide
; Retourne T si le coup n'est pas gagnant
; Retourne le numéro du joueur pour un coup gagnant
;--------------------------------------------------
(defun jouer(un_jeu une_col un_num_joueur)
 (prog (la_lig)
  (setq la_lig (getLigne un_jeu une_col))
  (setJeu un_jeu la_lig une_col un_num_joueur)
  (if (coupGagnant un_jeu la_lig une_col un_num_joueur) 
    (return un_num_joueur)
    (return T))
 )
)


; Joue la colonne choisie par l'utilisateur si elle est valide
; Retourne T si la colonne est jouée
; Retourne le numéro du joueur si le coup est gagnant
; Retourne Nil si la colonne n'est pas numérique (-> Quitter le jeu)
;-------------------------------------------------------------------
(defun jouerJoueur(un_jeu un_num_joueur)
 (prog (une_col nb_col)
  encore
  (setq nb_col (list-length (car jeu_vierge)))
  (setq une_col (getChoix un_num_joueur))
    (if (numberp une_col) 
      (cond
       ((or (< une_col 0) (>= une_col nb_col))
            (prinl `("Erreur : Entrez une colonne entre 1 et " ,nb_col)) (go encore))
       ((< (getLigne un_jeu une_col) 0) 
	    (princ "Erreur : La colonne est pleine !") (go encore))
       (t 
            (return (jouer un_jeu une_col un_num_joueur))))
    (return nil)
   )
)
)

; Retourne une liste composée de :
; - la valeur de la case voisine en fonction de la direction.
; - La ligne correspondante
; - La colonne correspondante
; Retourne Nil si les coordonnées sont hors jeu
; ------------------------------------------------------------
(defun getVoisin (un_jeu une_lig une_col une_dir)
 (prog (nb_lig nb_col lig_vois col_vois)
   (setq nb_lig (list-length un_jeu))
   (setq nb_col (list-length (car un_jeu)))
   (setq lig_vois (+ une_lig (cadr (member une_dir les_directions))))
   (setq col_vois (+ une_col (caddr (member une_dir les_directions))))
   (if (and (<= lig_vois nb_lig) (>= lig_vois 0) (<= col_vois nb_col) (>= col_vois 0))
       (return (list (getJeu un_jeu lig_vois col_vois) lig_vois col_vois))
       (return nil)
   )
 )
)

; Retourne pour une direction donnée, le nombre pions alignés pour un joueur
;---------------------------------------------------------------------------
(defun nbAlignes (un_jeu une_lig une_col un_num_joueur une_dir)
 (prog (voisin)
     (setq voisin (getVoisin un_jeu une_lig une_col une_dir))
     (if (equal  (car voisin) un_num_joueur)
         (return  (+ 1 (nbAlignes un_jeu (cadr voisin) (caddr voisin) un_num_joueur une_dir)))
         (return 0)
   )
 )
)

; Retourne T si le coup passé en paramètre est un coup gagant pour le joueur
;---------------------------------------------------------------------------
(defun coupGagnant (un_jeu une_lig une_col un_num_joueur)
(prog ()
  (if (or (>= (+
         (nbAlignes un_jeu une_lig une_col un_num_joueur 'nord)
         (nbAlignes un_jeu une_lig une_col un_num_joueur 'sud) 1) 4)
           (>= (+
         (nbAlignes un_jeu une_lig une_col un_num_joueur 'ouest)
         (nbAlignes un_jeu une_lig une_col un_num_joueur 'est) 1) 4)
           (>= (+
         (nbAlignes un_jeu une_lig une_col un_num_joueur 'nord-ouest)
         (nbAlignes un_jeu une_lig une_col un_num_joueur 'sud-est) 1) 4)
           (>= (+
         (nbAlignes un_jeu une_lig une_col un_num_joueur 'nord-est)
         (nbAlignes un_jeu une_lig une_col un_num_joueur 'sud-ouest) 1) 4))
      (return t)
    (return nil)
  )                  
)
)


; Programme principal/Lancement du jeu 
; Saisir n'importe quelle lettre pour quitter le jeu
; --------------------------------------------------------
(defun p4JvsJ (&optional (un_jeu '()))
 (prog (mon_jeu nb_max_tour nb_tour num_joueur continue gagne coup_joueur)

   ; Initialisation du jeu
   (if (null un_jeu) (setq un_jeu jeu_vierge))
   (setq mon_jeu (copy-tree un_jeu))
   (setq nb_max_tour (* (list-length mon_jeu) (list-length (car mon_jeu))))
   (setq nb_tour 0 continue t gagne nil coup_joueur 0)

   ; Détermination du joueur qui commence la partie
   (setq num_joueur (random 2))
   (prinl `("Le joueur " ,(car (nth num_joueur les_joueurs)) " commence la partie"))
   (afficherJeu mon_jeu)

   ; Boucle du jeu
   (until (or (>= nb_tour nb_max_tour) (null continue) gagne)
     (setq coup_joueur (jouerJoueur mon_jeu num_joueur))
     (incr nb_tour)
     (if (equal coup_joueur T) ; Ce n'est pas un coup gagnant, la partie continue
      (progn
        (afficherJeu mon_jeu)
        (setq num_joueur (mod (1+ num_joueur) 2)))
       (if (numberp coup_joueur) ; C'est un coup gagnant !
           (setq gagne T)
           (setq continue nil))
    )
   )
   ; Analyse des sorties de la boucle
    (terpri)
    (if (numberp coup_joueur)
        (progn
          (afficherJeu mon_jeu)
          (terpri)
          (prinl `("Bravo " ,(car (nth coup_joueur les_joueurs)) ", vous avez gagné la partie !")))
        (if (null continue) 
            (princ "Abandon du jeu")
            (princ "Pas de gagnant")
        )
    )
    (terpri)
    (princ "Fin de partie")
 )
)

;;; ==================================================