314 lines
16 KiB
Haskell
314 lines
16 KiB
Haskell
{-# LANGUAGE ConstraintKinds #-}
|
|
module Tarot where
|
|
|
|
import Cartes
|
|
import Data.List
|
|
import Data.Maybe
|
|
import Data.List.HT (rotate)
|
|
import Safe.Foldable (maximumMay)
|
|
|
|
-- 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 par rapport à «moi»
|
|
distrib :: s -> [Carte] -> Int -> s
|
|
-- Renvoie le type de prise que «je» compte faire après les annonces des autres.
|
|
prise :: s -> [Maybe TypePrise] -> (Maybe TypePrise, s)
|
|
-- Renvoie les annonces faites aux autres.
|
|
annonce :: s -> ([Annonce],s)
|
|
-- Renvoie la carte appelée pour accompagner l'attaque.
|
|
carte :: s -> (Carte,s)
|
|
-- Si la prise éfféctuée le demande, on envoie le chien, et on demande l'ecart.
|
|
ecart :: s -> [Carte] -> ([Carte],s)
|
|
-- debutPartie est appelee avant le premier pli. l'entier est la position du joueur qui a pris, le type de sa prise, la carte appelée, le chien si il a été révélé et la liste de toutes les annonces.
|
|
debutPartie :: s -> Int -> TypePrise -> Carte -> [Carte] -> [[Annonce]] -> 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
|
|
gagnantPli (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.
|
|
(Excuse, _) -> w; -- L'excuse ne peut remporter 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 battre 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 forcément.
|
|
|
|
-- Renvoie la valeur de l'atout le plus gros atout du tas, si il y en a un
|
|
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
|
|
|
|
-- Renvoie true ssi il y a un atout dans le tas paramètre.
|
|
hasAtout :: [Carte] -> Bool
|
|
hasAtout [] = False
|
|
hasAtout ((Atout k):s) = True
|
|
hasAtout (_:s) = hasAtout s
|
|
|
|
-- Renvoie true ssi la couleur spécifiée est présente dans le tas paramètre.
|
|
hasCouleur :: Couleur -> [Carte] -> Bool
|
|
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.
|
|
}
|
|
|
|
-- distribue le jeu à la manière du tarot
|
|
-- L'entrée est le tas de toutes les cartes (déjà coupé) puis trois entiers distincts dans l'ordre croissant entre 1 et 23, le premier à recevoir sa carte.
|
|
-- Ces entiers correspondent à la carte à mettre dans le chien. Ou plutot après combien de groupes de trois il faut la mettre dans le chien.
|
|
distribuer :: [Carte] -> [Int] -> Int -> ([[Carte]],[Carte])
|
|
distribuer l ci premier = distribuerAux l ci premier [[],[],[],[],[]] [] -- 0 est le premier joueur
|
|
where
|
|
distribuerAux :: [Carte] -> [Int] -> Int -> [[Carte]] -> [Carte] -> ([[Carte]], [Carte])
|
|
distribuerAux [] _ _ tempCartes tempChien = (tempCartes, tempChien)
|
|
distribuerAux l (0:r) i tempCartes tempChien =
|
|
distribuerAux (tail l) r i tempCartes ((head l):tempChien)
|
|
distribuerAux l r i tempCartes tempChien =
|
|
distribuerAux (drop 3 l) (map (\x -> x-1) r) (mod (i+1) 5) (addToNth tempCartes i (take 3 l)) tempChien
|
|
|
|
-- Paramètres correspondants à : À qui de jouer, joueurs, jeux de chaque joueur, points gagnés par chaque joueur.
|
|
newtype EtatPartie j1 j2 j3 j4 j5 = EtatPartie (Int,(j1,j2,j3,j4,j5),[[Carte]],[[Carte]]) deriving Show
|
|
|
|
|
|
|
|
|
|
|
|
-- À partir du pli, des points qu'ont les joueurs, des jeux de chaque joueur avant de jouer et l'indice global du gagnant du pli, renvoie la nouvelle liste des points des joueurs.
|
|
calculerPoints :: [Carte] -> [[Carte]] -> [[Carte]] -> Int -> [[Carte]]
|
|
calculerPoints pli points jeux vraiIndiceGagnant
|
|
| elem Excuse pli = let indiceExcuse = (fromJust $ findIndex (elem Excuse) jeux) in replaceNth (replaceNth points vraiIndiceGagnant (delete Excuse newPoints)) indiceExcuse (Excuse:(points !! indiceExcuse))-- On ne donne pas de demi point de compensation
|
|
| otherwise = replaceNth points vraiIndiceGagnant newPoints
|
|
where
|
|
newPoints = (pli ++ (points !! vraiIndiceGagnant))
|
|
|
|
-- Ici, les indices des joueurs sont locaux, et non globaux.
|
|
calculerJeuPli :: (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])
|
|
calculerJeuPli main etats jeux pli points = (EtatPartie (vraiIndiceGagnant, etats, newJeux, calculerPoints pli points jeux vraiIndiceGagnant), pli)
|
|
where
|
|
indiceGagnant = 5-(fromJust $ elemIndex (fromJust $ gagnantPli pli) (pli))
|
|
vraiIndiceGagnant = (mod (main+indiceGagnant-1) 5)
|
|
newJeux = [deleteOrError c jeu | (c,jeu)<-(zip (rotate (main-1) pli) jeux)]
|
|
|
|
|
|
|
|
-- Cette fonction calcule le prochain pli renvoyé par les joueurs, avec i l'indice du joueur qui commence.
|
|
-- Dans cette fonction, jr1 est le premier joueur à JOUER LE PLI, il s'agit en réalité du ième joueur
|
|
-- De la même facon, le premier élément du pentuple d'états renvoyé est le nouvel état du premier joueur à jouer le pli.
|
|
calculerPliJoue :: (JoueurIA j1, JoueurIA j2, JoueurIA j3, JoueurIA j4, JoueurIA j5) => int -> (j1,j2,j3,j4,j5) -> ([Carte],(j1,j2,j3,j4,j5))
|
|
calculerPliJoue i (jr1,jr2,jr3,jr4,jr5) = (pli,(e1,e2,e3,e4,e5))
|
|
where
|
|
(c1,e1) = jouer jr1 []
|
|
(c2,e2) = jouer jr2 (c1:[])
|
|
(c3,e3) = jouer jr3 (c2:c1:[])
|
|
(c4,e4) = jouer jr4 (c3:c2:c1:[])
|
|
(c5,e5) = jouer jr5 (c4:c3:c2:c1:[])
|
|
pli = c5:c4:c3:c2:c1:[]
|
|
|
|
|
|
-- Dans cette fonction, jr1 est le premier joueur de l'index, celui qui commence le pli est le i-ème
|
|
-- Cette fonction «change le référentiel» càd que dans les sous-fonctions, les premiers éléments des tuple correspondent aux premier joueurs à jouer le pli.
|
|
-- On est obligé d'écrire les cinq règles différement, parce que
|
|
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,(jr1,jr2,jr3,jr4,jr5),jeux,points)) = let (pli,(e1,e2,e3,e4,e5))=calculerPliJoue 0 (jr1,jr2,jr3,jr4,jr5) in calculerJeuPli 0 (e1,e2,e3,e4,e5) jeux pli points
|
|
jouerPli (EtatPartie (1,(jr1,jr2,jr3,jr4,jr5),jeux,points)) = let (pli,(e2,e3,e4,e5,e1))=calculerPliJoue 1 (jr2,jr3,jr4,jr5,jr1) in calculerJeuPli 1 (e1,e2,e3,e4,e5) jeux pli points
|
|
jouerPli (EtatPartie (2,(jr1,jr2,jr3,jr4,jr5),jeux,points)) = let (pli,(e3,e4,e5,e1,e2))=calculerPliJoue 2 (jr3,jr4,jr5,jr1,jr2) in calculerJeuPli 2 (e1,e2,e3,e4,e5) jeux pli points
|
|
jouerPli (EtatPartie (3,(jr1,jr2,jr3,jr4,jr5),jeux,points)) = let (pli,(e4,e5,e1,e2,e3))=calculerPliJoue 3 (jr4,jr5,jr1,jr2,jr3) in calculerJeuPli 3 (e1,e2,e3,e4,e5) jeux pli points
|
|
jouerPli (EtatPartie (4,(jr1,jr2,jr3,jr4,jr5),jeux,points)) = let (pli,(e5,e1,e2,e3,e4))=calculerPliJoue 4 (jr5,jr1,jr2,jr3,jr4) in calculerJeuPli 4 (e1,e2,e3,e4,e5) jeux pli points
|
|
|
|
-- «Demande» réellement aux IAs la prise qu'elles comptent effectuer.
|
|
-- Params: Pentuple d'IAs, avec s0 le premier joueur à parler.
|
|
calculerPrisesAux :: (JoueurIA j1, JoueurIA j2, JoueurIA j3, JoueurIA j4, JoueurIA j5) => (j1,j2,j3,j4,j5) -> ([Maybe TypePrise],(j1,j2,j3,j4,j5))
|
|
calculerPrisesAux (s0,s1,s2,s3,s4) = (prises,(s0',s1',s2',s3',s4'))
|
|
where
|
|
(prise0,s0') = prise s0 []
|
|
(prise1,s1') = prise s1 (prise0:[])
|
|
(prise2,s2') = prise s2 (prise1:prise0:[])
|
|
(prise3,s3') = prise s3 (prise2:prise1:prise0:[])
|
|
(prise4,s4') = prise s4 (prise3:prise2:prise1:prise0:[])
|
|
prises = prise4:prise3:prise2:prise1:prise0:[]
|
|
|
|
-- «Demande» aux IOs la prise qu'elles comptent effectuer.
|
|
-- Params: Pentuple d'IAs, avec s0 le premier joueur de l'index, le second paramètre est le numéro du joueur qui parle en premier.
|
|
calculerPrises :: (JoueurIA j1, JoueurIA j2, JoueurIA j3, JoueurIA j4, JoueurIA j5) => (j1,j2,j3,j4,j5) -> Int -> ([Maybe TypePrise],(j1,j2,j3,j4,j5))
|
|
calculerPrises (s0,s1,s2,s3,s4) 0 = let (prises, (s0',s1',s2',s3',s4')) = calculerPrisesAux (s0,s1,s2,s3,s4) in (prises, (s0',s1',s2',s3',s4'))
|
|
calculerPrises (s0,s1,s2,s3,s4) 1 = let (prises, (s1',s2',s3',s4',s0')) = calculerPrisesAux (s1,s2,s3,s4,s0) in (prises, (s0',s1',s2',s3',s4'))
|
|
calculerPrises (s0,s1,s2,s3,s4) 2 = let (prises, (s2',s3',s4',s0',s1')) = calculerPrisesAux (s2,s3,s4,s0,s1) in (prises, (s0',s1',s2',s3',s4'))
|
|
calculerPrises (s0,s1,s2,s3,s4) 3 = let (prises, (s3',s4',s0',s1',s2')) = calculerPrisesAux (s3,s4,s0,s1,s2) in (prises, (s0',s1',s2',s3',s4'))
|
|
calculerPrises (s0,s1,s2,s3,s4) 4 = let (prises, (s4',s0',s1',s2',s3')) = calculerPrisesAux (s4,s0,s1,s2,s3) in (prises, (s0',s1',s2',s3',s4'))
|
|
|
|
|
|
-- Renvoie les points de l'attaquant (la défense a fait les autres)
|
|
calculerPointsJoueurs :: [[Carte]] -> Int -> Maybe Int -> TypePrise -> [Carte] -> [Carte] -> [Carte]
|
|
calculerPointsJoueurs pointsJoueurs attaquant Nothing typePrise chien ecart = calculerPointsJoueurs pointsJoueurs attaquant (Just attaquant) typePrise chien ecart
|
|
calculerPointsJoueurs pointsJoueurs attaquant (Just coattaquant) typePrise chien ecart = (pointsJoueurs !! attaquant) ++ (pointsCoattaquant) ++ (pointsSupplementaires)
|
|
where
|
|
pointsCoattaquant
|
|
| coattaquant == attaquant = []
|
|
| otherwise = pointsJoueurs !! coattaquant
|
|
pointsSupplementaires = case typePrise of {
|
|
Prise -> ecart;
|
|
Garde -> ecart;
|
|
GardeSans -> chien;
|
|
GardeContre -> [];
|
|
Chelem -> chien;
|
|
}
|
|
|
|
-- Cette fonction joue une partie, et ne fait rien si personne ne prend.
|
|
-- Params: numéro du joueur qui commence, le type de prise éfféctué, le pentuple des IAs, le chien issu de la distribution, la liste des cartes des joueurs dont le premier élément est celui du premier à jouer, la liste des prises efféctuées (l'élément le plus profond est la première prise).
|
|
vraimentJouerPartie :: (JoueurIA j0, JoueurIA j1, JoueurIA j2, JoueurIA j3, JoueurIA j4) =>
|
|
Int -> Maybe TypePrise -> (j0, j1, j2, j3, j4) -> [Carte] -> [[Carte]] -> [Maybe TypePrise] -> ([(EtatPartie j0 j1 j2 j3 j4,[Carte])],[Carte],Int)
|
|
vraimentJouerPartie _ Nothing _ _ _ _ = ([],[],-1)
|
|
vraimentJouerPartie meneur (Just typePrise) (s20,s21,s22,s23,s24) chien cartesInitiales prises = (steps,pointsAttaque,attaque)
|
|
where
|
|
attaque = mod (meneur+4-(fromJust $ elemIndex (Just typePrise) prises)) 5 -- L'attaque est le numéro du joueur qui a pris la plus grande prise.
|
|
|
|
(carteAppelee,(s30,s31,s32,s33,s34)) = pentuplator (s20,s21,s22,s23,s24) attaque (carte,carte,carte,carte,carte) -- Demande juste à l'attaquant la carte qu'il appelle.
|
|
|
|
(ecartEffectue,(s40,s41,s42,s43,s44)) -- Demande juste à l'attaquant de faire son écart, si son type de prise le demande.
|
|
| faireEcart typePrise = pentuplator (s30,s31,s32,s33,s34) attaque (ecarteur,ecarteur,ecarteur,ecarteur,ecarteur)
|
|
| otherwise = ([],(s30,s31,s32,s33,s34)) -- Sinon, met le chien à vide.
|
|
where
|
|
ecarteur :: JoueurIA j => j -> ([Carte],j)
|
|
ecarteur = parametinverter ecart chien
|
|
|
|
((annonces0,s50),(annonces1,s51),(annonces2,s52),(annonces3,s53),(annonces4,s54)) = (annonce s40, annonce s21, annonce s22, annonce s23, annonce s24)
|
|
|
|
cartesApresEcart
|
|
| faireEcart typePrise = replaceNth cartesInitiales attaque (deleteAllOrError ecartEffectue ((cartesInitiales !! attaque) ++ chien)) -- on ajoute le chien à la main, puis on enlève l'écart.
|
|
| otherwise = cartesInitiales
|
|
|
|
annonces = [annonces0,annonces1,annonces2,annonces3,annonces4]
|
|
|
|
(s60,s61,s62,s63,s64) = (debutPartieAux s50 0, debutPartieAux s51 1, debutPartieAux s52 2, debutPartieAux s53 3,debutPartieAux s54 4)
|
|
where
|
|
debutPartieAux :: JoueurIA j => j -> Int -> j
|
|
debutPartieAux s i -- initialise l'IA s avec i le numéro du joueur
|
|
| faireEcart typePrise = debutPartie s (mod (attaque-i) 5) typePrise carteAppelee chien (rotate i annonces)
|
|
| otherwise = debutPartie s (mod (attaque-i) 5) typePrise carteAppelee [] (rotate i annonces)
|
|
|
|
etat0 = EtatPartie (meneur,(s60,s61,s62,s63,s64),cartesApresEcart,rotate attaque [chien,[],[],[],[]])
|
|
|
|
cartesJouees = iterate (jouerPli . fst) (etat0,[])
|
|
|
|
steps = Prelude.take 15 $ Prelude.drop 1 cartesJouees
|
|
|
|
(EtatPartie (_,_,_,pointsJoueurs),_) = last steps
|
|
|
|
coattaquant = findIndex (\l -> elem carteAppelee l) cartesInitiales
|
|
|
|
pointsAttaque = calculerPointsJoueurs pointsJoueurs attaque coattaquant typePrise chien ecartEffectue
|
|
|
|
|
|
-- Cette fonction joue une partie.
|
|
-- Params: pentuple d'IAs, tas de carte à distribuer, numéro du joueur qui commence, les trois nombres entre 1 et 23 à mettre dans le chien.
|
|
jouerPartie :: (JoueurIA j0, JoueurIA j1, JoueurIA j2, JoueurIA j3, JoueurIA j4) =>
|
|
(j0, j1, j2, j3, j4) -> [Carte] -> Int -> [Int] -> ([(EtatPartie j0 j1 j2 j3 j4,[Carte])],[Carte],Int)
|
|
jouerPartie (s00,s01,s02,s03,s04) tasDeCartes meneur indicesChien = vraimentJouerPartie meneur typePriseM (s20,s21,s22,s23,s24) chien cartesInitiales prises
|
|
where
|
|
(cartes,chien) = distribuer tasDeCartes indicesChien meneur
|
|
cartesInitiales = rotate (mod (4-meneur) 5) cartes -- le premier joueur recoit le (5-meneur)-ième tas.
|
|
[cartesJ0,cartesJ1,cartesJ2,cartesJ3,cartesJ4] = cartesInitiales
|
|
(s10,s11,s12,s13,s14) = (distrib s00 cartesJ0 (mod (meneur-0) 5), distrib s01 cartesJ1 (mod (meneur-1) 5), distrib s02 cartesJ2 (mod (meneur-2) 5), distrib s03 cartesJ3 (mod (meneur-3) 5), distrib s04 cartesJ4 (mod (meneur-4) 5))
|
|
(prises,(s20,s21,s22,s23,s24)) = calculerPrises (s10,s11,s12,s13,s14) meneur -- meneur est le premier à annoncer sa prise
|
|
|
|
typePriseM = maximum prises
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|