214 lines
7.3 KiB
Haskell
214 lines
7.3 KiB
Haskell
module Tarot where
|
||
|
||
import Cartes
|
||
import Data.List
|
||
import Data.Maybe
|
||
import Data.List.HT (rotate)
|
||
|
||
-- Du point de vue du joueur, la position d'un joueur est le nombre de tours que notre joueur a d'avance. Donc le joueur 1 est celui qui joue après nous, 0 est nous-même et 9 est celui qui joue avant nous.
|
||
class JoueurIA s where
|
||
-- Distrib crée l'état initial lorsque les cartes ont été distribuées. l'entier est la position du joueur qui commence.
|
||
distrib :: [Carte] -> Int -> s
|
||
-- debutPartie est appelee avant le premier pli. l'entier est la position du joueur qui a pris
|
||
debutPartie :: s -> Int -> s
|
||
-- Jouer indique la carte à jouer à partir des cartes jouees par les joueurs précédents. Si le second parametre est vide, c'est qu'on commence le tour.
|
||
jouer :: s -> [Carte] -> (Carte, s)
|
||
-- finTour informe des cartes qui ont été jouées pendant le tour.
|
||
finTour :: s -> [Carte] -> s
|
||
|
||
|
||
data CouleurPli = CCouleur Couleur | CAtout | CExcuse deriving Eq
|
||
|
||
-- Renvoie la couleur qu'une première carte induit à un pli.
|
||
couleurPliFromCarte :: Carte -> CouleurPli
|
||
couleurPliFromCarte (Valeur (_, c)) = CCouleur c
|
||
couleurPliFromCarte (Atout _) = CAtout
|
||
couleurPliFromCarte Excuse = CExcuse
|
||
|
||
-- Renvoie la couleur du pli suivant les cartes posées.
|
||
couleurPli :: [Carte] -> CouleurPli
|
||
couleurPli [] = CExcuse
|
||
couleurPli (e:s)
|
||
| z==CExcuse = couleurPliFromCarte e
|
||
| otherwise = z
|
||
where z = couleurPli s
|
||
|
||
-- Renvoie la carte qui a fait le pli
|
||
gagnantPli :: [Carte] -> Maybe Carte
|
||
gagnantPli [] = Nothing
|
||
pli (e:s) = case (e, w) of {
|
||
(_, Nothing) -> Just e; -- La seule carte d'un pli le gagne
|
||
(_, Just Excuse) -> Just e; -- Si juste une excuse a été jouée, la nouvelle carte gagne le pli.
|
||
(Atout n, Just (Atout m)) -> Just (Atout (max n m)); -- L'atout le plus haut gagne
|
||
(Atout _, _) -> Just e; -- Seul un atout peut batter un atout.
|
||
(Valeur (f,c), Just (Atout _)) -> w; -- On s'est pissé dessus, on ne prend pas le pli
|
||
(Valeur (f,c), Just (Valeur (f',c'))) -> meilleur f f' c c'
|
||
}
|
||
where w = gagnantPli s
|
||
meilleur f f' c c'
|
||
| c==c' = Just (Valeur (max f f', c)) -- On joue la bonne couleur, le meilleur gagne.
|
||
| otherwise = w -- Notre couleur est pas la bonne, on pert.
|
||
|
||
grosAtout :: [Carte] -> Maybe Int
|
||
grosAtout [] = Nothing
|
||
grosAtout ((Atout k):s) = case (grosAtout s) of {
|
||
Nothing -> Just k;
|
||
Just m -> Just (max k m)
|
||
}
|
||
grosAtout (e:s) = grosAtout s
|
||
|
||
hasAtout [] = False
|
||
hasAtout ((Atout k):s) = True
|
||
hasAtout (_:s) = hasAtout s
|
||
|
||
hasCouleur c [] = False
|
||
hasCouleur c ((Valeur (_,col)):s) = (c==col) || (hasCouleur c s)
|
||
hasCouleur c (_:s) = hasCouleur c s
|
||
|
||
-- Indique si un joueur peut jouer une carte
|
||
-- Paramètres: Carte à tester, mon jeu, le pli
|
||
-- On suppose que la carte a jouer est dans le jeu
|
||
peutJouer :: Carte -> [Carte] -> [Carte] -> Bool
|
||
peutJouer c jeu pli = case (couleurPli pli,c) of {
|
||
(CExcuse,_) -> True; -- On joue ce qu'on veut si le pli n'a pas de couleur.
|
||
(_,Excuse) -> True; -- On joue l'excuse quand on veut.
|
||
(CAtout, Atout atoutJoue) -> let (Just grosJoue, Just grosJeu)=(grosAtout pli,grosAtout jeu) in (grosJoue<atoutJoue) || (grosJeu<grosJoue); -- Si on est monté, OK, sinon, c'est qu'on a pas au dessus.
|
||
(CAtout, _) -> not (hasAtout jeu); -- On peut se pisser dessus que si on a plus d'atout.
|
||
(CCouleur c, Atout atoutJoue) -> not (hasCouleur c jeu) && (case (grosAtout pli) of {Nothing -> True; Just grosJoue -> let (Just grosJeu)=(grosAtout jeu) in (grosJoue<atoutJoue) || (grosJeu<grosJoue)}); -- Idem que deux lignes au dessus, mais on doit vérifier que on aie pas la couleur.
|
||
(CCouleur c, Valeur (_,c')) -> (c==c') || ((not (hasCouleur c jeu)) && (not (hasAtout jeu))) -- Soit on a joué la couleur demandée, soit on avait ni la couleur, ni l'atout.
|
||
}
|
||
|
||
|
||
distribuer :: [Carte] -> ([[Carte]],[Carte])
|
||
distribuer l = ([j1,j2,j3,j4,j5],chien)
|
||
where
|
||
(j1,r1) = splitAt 15 l
|
||
(j2,r2) = splitAt 15 r1
|
||
(j3,r3) = splitAt 15 r2
|
||
(j4,r4) = splitAt 15 r3
|
||
(j5,chien) = splitAt 15 r4
|
||
|
||
newtype EtatPartie j1 j2 j3 j4 j5 = EtatPartie (Int,(j1,j2,j3,j4,j5),[[Carte]],[[Carte]])
|
||
|
||
|
||
jouerPliAux :: (JoueurIA j1, JoueurIA j2, JoueurIA j3, JoueurIA j4, JoueurIA j5) => Int -> (j1,j2,j3,j4,j5) -> [[Carte]] -> [Carte] -> [[Carte]] -> (EtatPartie j1 j2 j3 j4 j5, [Carte])
|
||
jouerPliAux main etats jeux pli points = (EtatPartie (vraiIndiceGagnant, etats, [delete c jeu | (c,jeu)<-(zip (rotate (5-main) pli) jeux)], replaceNth points vraiIndiceGagnant (pli ++ (points !! vraiIndiceGagnant))), pli)
|
||
where
|
||
vraiIndiceGagnant = (mod (main+indiceGagnant) 5)
|
||
indiceGagnant = fromJust $ elemIndex (fromJust $ gagnantPli pli) (pli)
|
||
|
||
|
||
-- Le premier élément de la liste de joueur (le plus profond) est le premier joueur
|
||
-- Renvoie le nouvel état de la partie ainsi qu'une copie du pli joué.
|
||
jouerPli :: (JoueurIA j1, JoueurIA j2, JoueurIA j3, JoueurIA j4, JoueurIA j5) => (EtatPartie j1 j2 j3 j4 j5) -> (EtatPartie j1 j2 j3 j4 j5, [Carte])
|
||
jouerPli (EtatPartie (0,joueurs,jeux,points)) = jouerPliAux 0 etats jeux pli points -- TODO l'excuse n'est pas gérée
|
||
where
|
||
(c1,e1) = jouer (fst5 joueurs) []
|
||
(c2,e2) = jouer (snd5 joueurs) [c1]
|
||
(c3,e3) = jouer (thr5 joueurs) [c1,c2]
|
||
(c4,e4) = jouer (frh5 joueurs) [c1,c2,c3]
|
||
(c5,e5) = jouer (fih5 joueurs) [c1,c2,c3,c4]
|
||
etats = (e1,e2,e3,e4,e5)
|
||
pli = [c1,c2,c3,c4,c5]
|
||
|
||
jouerPli (EtatPartie (1,joueurs,jeux,points)) = jouerPliAux 1 etats jeux pli points -- TODO l'excuse n'est pas gérée
|
||
where
|
||
(c2,e2) = jouer (snd5 joueurs) []
|
||
(c3,e3) = jouer (thr5 joueurs) [c2]
|
||
(c4,e4) = jouer (frh5 joueurs) [c2,c3]
|
||
(c5,e5) = jouer (fih5 joueurs) [c2,c3,c4]
|
||
(c1,e1) = jouer (fst5 joueurs) [c2,c3,c4,c5]
|
||
etats = (e1,e2,e3,e4,e5)
|
||
pli = [c2,c3,c4,c5,c1]
|
||
|
||
jouerPli (EtatPartie (2,joueurs,jeux,points)) = jouerPliAux 2 etats jeux pli points -- TODO l'excuse n'est pas gérée
|
||
where
|
||
(c3,e3) = jouer (thr5 joueurs) []
|
||
(c4,e4) = jouer (frh5 joueurs) [c3]
|
||
(c5,e5) = jouer (fih5 joueurs) [c3,c4]
|
||
(c1,e1) = jouer (fst5 joueurs) [c3,c4,c5]
|
||
(c2,e2) = jouer (snd5 joueurs) [c3,c4,c5,c1]
|
||
etats = (e1,e2,e3,e4,e5)
|
||
pli = [c3,c4,c5,c1,c2]
|
||
|
||
jouerPli (EtatPartie (3,joueurs,jeux,points)) = jouerPliAux 3 etats jeux pli points -- TODO l'excuse n'est pas gérée
|
||
where
|
||
-- (pli,etats)=foldr (\joueur -> \(pli,etats) -> let (carte,etat) = jouer joueur pli in (carte:pli,etat:etats)) ([],[]) joueurs
|
||
(c4,e4) = jouer (frh5 joueurs) []
|
||
(c5,e5) = jouer (fih5 joueurs) [c4]
|
||
(c1,e1) = jouer (fst5 joueurs) [c4,c5]
|
||
(c2,e2) = jouer (snd5 joueurs) [c4,c5,c1]
|
||
(c3,e3) = jouer (thr5 joueurs) [c4,c5,c1,c2]
|
||
etats = (e1,e2,e3,e4,e5)
|
||
pli = [c4,c5,c1,c2,c3]
|
||
|
||
jouerPli (EtatPartie (4,joueurs,jeux,points)) = jouerPliAux 4 etats jeux pli points -- TODO l'excuse n'est pas gérée
|
||
where
|
||
(c5,e5) = jouer (fih5 joueurs) []
|
||
(c1,e1) = jouer (fst5 joueurs) [c5]
|
||
(c2,e2) = jouer (snd5 joueurs) [c5,c1]
|
||
(c3,e3) = jouer (thr5 joueurs) [c5,c1,c2]
|
||
(c4,e4) = jouer (frh5 joueurs) [c5,c1,c2,c3]
|
||
etats = (e1,e2,e3,e4,e5)
|
||
pli = [c5,c1,c2,c3,c4]
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|