Compare commits

...

3 Commits

5 changed files with 271 additions and 115 deletions

View File

@ -1,3 +1,18 @@
Tarotinator
===========
Description
-----------
Ce projet est avant tout une librairie afin que des développeurs puissent créer leur propres implémentations d'IA dédiées au Tarot à 5.
Une IA est présentée mais est tellement idiote que finalement, la bataille aurait peut-être été plus intéréssante. Ce n'est pas là le cœur du projet.
La classe était initialement concue sans monade, puis la monade IO a été rajoutée après, permettant à l'utilisateur de jouer directement une IA, ou d'utiliser d'autres choses (comme de l'aléatoire).
Une IA est une classe associée à un type, ce type représente un état de l'IA qui devra être initialisé par l'utilisateur. Chaque méthode de la classe renverra une nouvelle IA qui devra être considéré comme «l'état qu'a pris l'IA après avoir envoyé sa valeur».
Utilisation
-----------
@ -6,17 +21,26 @@ Vous pouvez utiliser la commande `cabal run [paramètres]` afin de lancer direct
Si toutefois vous souhaitez seulement le compiler, vous pouvez lancer `cabal build`.
Notes d'implémentation
----------------------
Normalement, des ensembles devaient être utilisées en lieu et place de liste (type Set). Hélas, par manque de compréhension de Haskell, ce ne sera ajouté que plus tard.
Pour l'indicage des listes, les conventions ne sont pas claires. L'indice 0 est le premier élément d'une liste, mais aussi le dernier élément ajouté, ce qui, je trouve, n'est pas cohérent avec une structure chainée par exemple pour considérer un pli, il semble logique que le pli soit «construit» petit à petit, mais alors la première carte a un indice 0. C'est pour cela que dans le code, vous verrez des listes écrites element0:element1:element2:[], pour indiquer qu'elles respectent l'ordre «chronologique».
Les «points» de chaque camp sont multipliés par deux, afin d'éviter l'utilisation inutile de flottants imprécis.
Dans un soucis de généralité, beaucoup de fonctions sont «moches» puisqu'elle ressemble à elles-même en cinq exemplaires. Cela est dû à la généralité de la librairie qui peut utiliser des types d'IA tous différents, compactés dans un pentuplet.
Pour aller plus loin
--------------------
(Ceci est une TODO list)
Ajouter la possiblité de random l'IA (avec par exemple une classe qui fonctionne avec de IO)
Faire une HumainIA (fera pareil avec IO).
Faire en sorte que les imports soient explicites.
Utiliser Set partout où c'est adéquat.
Essayer de trouver un type pour (liste de taille 5), qui permette de rendre les fonctions complètement définies.

View File

@ -105,14 +105,22 @@ deleteOrError e (h:l)
| otherwise = h:(deleteOrError e l)
-- Appelle la fonction précisée par le second paramètre.
pentuplator :: (j0,j1,j2,j3,j4) -> Int -> ((j0 -> (a,j0)),(j1 -> (a,j1)),(j2 -> (a,j2)),(j3 -> (a,j3)),(j4 -> (a,j4))) -> (a,(j0,j1,j2,j3,j4))
pentuplator (s0,s1,s2,s3,s4) 0 (f0,f1,f2,f3,f4) = let (o,s') = f0 s0 in (o,(s',s1,s2,s3,s4))
pentuplator (s0,s1,s2,s3,s4) 1 (f0,f1,f2,f3,f4) = let (o,s') = f1 s1 in (o,(s0,s',s2,s3,s4))
pentuplator (s0,s1,s2,s3,s4) 2 (f0,f1,f2,f3,f4) = let (o,s') = f2 s2 in (o,(s0,s1,s',s3,s4))
pentuplator (s0,s1,s2,s3,s4) 3 (f0,f1,f2,f3,f4) = let (o,s') = f3 s3 in (o,(s0,s1,s2,s',s4))
pentuplator (s0,s1,s2,s3,s4) 4 (f0,f1,f2,f3,f4) = let (o,s') = f4 s4 in (o,(s0,s1,s2,s3,s'))
pentuplatorM :: Monad m => (j0,j1,j2,j3,j4) -> Int -> ((j0 -> m (a,j0)),(j1 -> m (a,j1)),(j2 -> m (a,j2)),(j3 -> m (a,j3)),(j4 -> m (a,j4))) -> m (a,(j0,j1,j2,j3,j4))
pentuplatorM (s0,s1,s2,s3,s4) 0 (f0,f1,f2,f3,f4) = do (o,s') <- f0 s0; return (o,(s',s1,s2,s3,s4))
pentuplatorM (s0,s1,s2,s3,s4) 1 (f0,f1,f2,f3,f4) = do (o,s') <- f1 s1; return (o,(s0,s',s2,s3,s4))
pentuplatorM (s0,s1,s2,s3,s4) 2 (f0,f1,f2,f3,f4) = do (o,s') <- f2 s2; return (o,(s0,s1,s',s3,s4))
pentuplatorM (s0,s1,s2,s3,s4) 3 (f0,f1,f2,f3,f4) = do (o,s') <- f3 s3; return (o,(s0,s1,s2,s',s4))
pentuplatorM (s0,s1,s2,s3,s4) 4 (f0,f1,f2,f3,f4) = do (o,s') <- f4 s4; return (o,(s0,s1,s2,s3,s'))
--pentuplator p0 i p2 = pentuplator p0 (mod i 5) p2 -- Enlevé pour que ça plante et que ce soit mieux détéctable.
-- Inverse les paramètres de la fonction.
parametinverter :: (a -> b -> c) -> (b -> a -> c)
parametinverter f x y = f y x
parametinverterM :: Monad m => (a -> b -> m c) -> (b -> a -> m c)
parametinverterM f x y = f y x
monadCouple :: Monad m => m (a,b) -> (m a, m b)
monadCouple mcp = (mcp>>=(return . fst),mcp>>=(return . snd))
firstTriMonad :: Monad m => m (m a,b,c) -> m (a,b,c)
firstTriMonad mcc = mcc >>= ttt
where ttt (mx,y,z) = mx >>= (\x -> return (x,y,z))

View File

@ -25,11 +25,10 @@ main :: HasCallStack => IO ()
main = do
tasDeCartes <- shuffleM $ Data.Set.toList deck
--putStrLn $ show $ distribuer tasDeCartes [1,6,23] 2
let
states0 = (MonJeu [], MonJeu [], MonJeu [], MonJeu [], MonJeu [])
let states0 = (MonJeu [], MonJeu [], MonJeu [], MonJeu [], MonJeu [])
-- On décide que joueur 3 commence.
(steps,pointsAttaque,attaquant) = jouerPartie states0 tasDeCartes 2 [1,6,23]
(steps,pointsAttaque,attaquant) <- jouerPartie states0 tasDeCartes 2 [1,6,23]
if (Data.List.null steps)

View File

@ -10,21 +10,21 @@ 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
distrib :: s -> [Carte] -> Int -> IO s
-- Renvoie le type de prise que «je» compte faire après les annonces des autres.
prise :: s -> [Maybe TypePrise] -> (Maybe TypePrise, s)
prise :: s -> [Maybe TypePrise] -> IO (Maybe TypePrise, s)
-- Renvoie les annonces faites aux autres.
annonce :: s -> ([Annonce],s)
annonce :: s -> IO ([Annonce],s)
-- Renvoie la carte appelée pour accompagner l'attaque.
carte :: s -> (Carte,s)
carte :: s -> IO (Carte,s)
-- Si la prise éfféctuée le demande, on envoie le chien, et on demande l'ecart.
ecart :: s -> [Carte] -> ([Carte],s)
ecart :: s -> [Carte] -> IO ([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
debutPartie :: s -> Int -> TypePrise -> Carte -> [Carte] -> [[Annonce]] -> IO 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)
jouer :: s -> [Carte] -> IO (Carte, s)
-- finTour informe des cartes qui ont été jouées pendant le tour.
finTour :: s -> [Carte] -> s
finTour :: s -> [Carte] -> IO s
data CouleurPli = CCouleur Couleur | CAtout | CExcuse deriving Eq
@ -136,47 +136,48 @@ calculerJeuPli main etats jeux pli points = (EtatPartie (vraiIndiceGagnant, etat
-- 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:[]
calculerPliJoue :: (JoueurIA j1, JoueurIA j2, JoueurIA j3, JoueurIA j4, JoueurIA j5) => Int -> (j1,j2,j3,j4,j5) -> IO ([Carte],(j1,j2,j3,j4,j5))
calculerPliJoue i (jr1,jr2,jr3,jr4,jr5) = do
(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:[])
let pli = c5:c4:c3:c2:c1:[]
return (pli,(e1,e2,e3,e4,e5))
-- 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
jouerPli :: (JoueurIA j1, JoueurIA j2, JoueurIA j3, JoueurIA j4, JoueurIA j5) => EtatPartie j1 j2 j3 j4 j5 -> IO ((EtatPartie j1 j2 j3 j4 j5), [Carte])
jouerPli (EtatPartie (0,(jr1,jr2,jr3,jr4,jr5),jeux,points)) = do (pli,(e1,e2,e3,e4,e5)) <- calculerPliJoue 0 (jr1,jr2,jr3,jr4,jr5); return (calculerJeuPli 0 (e1,e2,e3,e4,e5) jeux pli points)
jouerPli (EtatPartie (1,(jr1,jr2,jr3,jr4,jr5),jeux,points)) = do (pli,(e2,e3,e4,e5,e1)) <- calculerPliJoue 1 (jr2,jr3,jr4,jr5,jr1); return (calculerJeuPli 1 (e1,e2,e3,e4,e5) jeux pli points)
jouerPli (EtatPartie (2,(jr1,jr2,jr3,jr4,jr5),jeux,points)) = do (pli,(e3,e4,e5,e1,e2)) <- calculerPliJoue 2 (jr3,jr4,jr5,jr1,jr2); return (calculerJeuPli 2 (e1,e2,e3,e4,e5) jeux pli points)
jouerPli (EtatPartie (3,(jr1,jr2,jr3,jr4,jr5),jeux,points)) = do (pli,(e4,e5,e1,e2,e3)) <- calculerPliJoue 3 (jr4,jr5,jr1,jr2,jr3); return (calculerJeuPli 3 (e1,e2,e3,e4,e5) jeux pli points)
jouerPli (EtatPartie (4,(jr1,jr2,jr3,jr4,jr5),jeux,points)) = do (pli,(e5,e1,e2,e3,e4)) <- calculerPliJoue 4 (jr5,jr1,jr2,jr3,jr4); return (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:[]
calculerPrisesAux :: (JoueurIA j1, JoueurIA j2, JoueurIA j3, JoueurIA j4, JoueurIA j5) => (j1,j2,j3,j4,j5) -> IO ([Maybe TypePrise],(j1,j2,j3,j4,j5))
calculerPrisesAux (s0,s1,s2,s3,s4) = do
(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:[])
let prises = prise4:prise3:prise2:prise1:prise0:[]
return (prises,(s0',s1',s2',s3',s4'))
-- «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'))
calculerPrises :: (JoueurIA j1, JoueurIA j2, JoueurIA j3, JoueurIA j4, JoueurIA j5) => (j1,j2,j3,j4,j5) -> Int -> IO ([Maybe TypePrise],(j1,j2,j3,j4,j5))
calculerPrises (s0,s1,s2,s3,s4) 0 = do (prises, (s0',s1',s2',s3',s4')) <- calculerPrisesAux (s0,s1,s2,s3,s4) ; return (prises, (s0',s1',s2',s3',s4'))
calculerPrises (s0,s1,s2,s3,s4) 1 = do (prises, (s1',s2',s3',s4',s0')) <- calculerPrisesAux (s1,s2,s3,s4,s0) ; return (prises, (s0',s1',s2',s3',s4'))
calculerPrises (s0,s1,s2,s3,s4) 2 = do (prises, (s2',s3',s4',s0',s1')) <- calculerPrisesAux (s2,s3,s4,s0,s1) ; return (prises, (s0',s1',s2',s3',s4'))
calculerPrises (s0,s1,s2,s3,s4) 3 = do (prises, (s3',s4',s0',s1',s2')) <- calculerPrisesAux (s3,s4,s0,s1,s2) ; return (prises, (s0',s1',s2',s3',s4'))
calculerPrises (s0,s1,s2,s3,s4) 4 = do (prises, (s4',s0',s1',s2',s3')) <- calculerPrisesAux (s4,s0,s1,s2,s3) ; return (prises, (s0',s1',s2',s3',s4'))
-- Renvoie les points de l'attaquant (la défense a fait les autres)
@ -198,65 +199,82 @@ calculerPointsJoueurs pointsJoueurs attaquant (Just coattaquant) typePrise 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 numéro 1, 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) => (Show j0, Show j1, Show j2, Show j3, Show 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
Int -> Maybe TypePrise -> (j0, j1, j2, j3, j4) -> [Carte] -> [[Carte]] -> [Maybe TypePrise] -> IO ([(EtatPartie j0 j1 j2 j3 j4,[Carte])],[Carte],Int)
vraimentJouerPartie _ Nothing _ _ _ _ = return ([],[],-1)
vraimentJouerPartie meneur (Just typePrise) (s20,s21,s22,s23,s24) chien cartesInitiales prises = do
let attaque :: Int
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.
(carteAppelee,(s30,s31,s32,s33,s34)) <- (pentuplatorM (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
let ecarteur :: JoueurIA j => j -> IO ([Carte],j)
ecarteur = parametinverterM ecart chien
(ecartEffectue,(s40,s41,s42,s43,s44)) <- case (faireEcart typePrise) of { -- Demande juste à l'attaquant de faire son écart, si son type de prise le demande.
True -> pentuplatorM (s30,s31,s32,s33,s34) attaque (ecarteur,ecarteur,ecarteur,ecarteur,ecarteur);
False -> return ([],(s30,s31,s32,s33,s34)); -- Sinon, met le chien à vide.
}
((annonces0,s50),(annonces1,s51),(annonces2,s52),(annonces3,s53),(annonces4,s54)) = (annonce s40, annonce s41, annonce s42, annonce s43, annonce s44)
(annonces0,s50)<-annonce s40;(annonces1,s51)<-annonce s41;(annonces2,s52)<-annonce s42;(annonces3,s53)<-annonce s43;(annonces4,s54)<-annonce s44;
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
let cartesApresEcart = case (faireEcart typePrise) of {
True -> replaceNth cartesInitiales attaque (deleteAllOrError ecartEffectue ((cartesInitiales !! attaque) ++ chien)); -- on ajoute le chien à la main, puis on enlève l'écart.
False -> cartesInitiales;
}
annonces = [annonces0,annonces1,annonces2,annonces3,annonces4]
let 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
let debutPartieAux :: JoueurIA j => j -> Int -> IO 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 [chienOuEcart,[],[],[],[]]) -- état initial de la partie, l'écart à défaut le chien est dans les point de l'attaquant.
s60<-debutPartieAux s50 0;s61<-debutPartieAux s51 1;s62<-debutPartieAux s52 2;s63<-debutPartieAux s53 3;s64<-debutPartieAux s54 4;
let chienOuEcart = case (Data.List.null ecartEffectue) of {
True -> chien;
False -> ecartEffectue;
}
let etat0 = EtatPartie (meneur,(s60,s61,s62,s63,s64),cartesApresEcart,rotate attaque [chienOuEcart,[],[],[],[]]) -- état initial de la partie, l'écart à défaut le chien est dans les point de l'attaquant.
let --cartesJouees :: (JoueurIA j0, JoueurIA j1, JoueurIA j2, JoueurIA j3, JoueurIA j4) => [IO (EtatPartie j0 j1 j2 j3 j4,[Carte])]
cartesJouees = iterate (\s -> ((fst $ monadCouple s)>>=jouerPli)) (return (etat0,[]))
let steps = Prelude.take 15 $ cartesJouees
(EtatPartie (_,_,_,pointsJoueurs),_) <- last steps
let coattaquant = findIndex (\l -> elem carteAppelee l) cartesInitiales
let pointsAttaque = calculerPointsJoueurs pointsJoueurs attaque coattaquant typePrise chien ecartEffectue
let out = (return (sequence steps,pointsAttaque,attaque)) >>= ttt
where
chienOuEcart
| Data.List.null ecartEffectue = chien
| otherwise = ecartEffectue
cartesJouees = iterate (jouerPli . fst) (etat0,[])
steps = Prelude.take 15 $ cartesJouees
(EtatPartie (_,_,_,pointsJoueurs),_) = last steps
coattaquant = findIndex (\l -> elem carteAppelee l) cartesInitiales
pointsAttaque = calculerPointsJoueurs pointsJoueurs attaque coattaquant typePrise chien ecartEffectue
ttt (mx,y,z) = mx >>= (\x -> return (x,y,z))
out
-- 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) => (Show j0, Show j1, Show j2, Show j3, Show 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 (-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
(j0, j1, j2, j3, j4) -> [Carte] -> Int -> [Int] -> IO ([(EtatPartie j0 j1 j2 j3 j4,[Carte])],[Carte],Int)
jouerPartie (s00,s01,s02,s03,s04) tasDeCartes meneur indicesChien = do
typePriseM = maximum prises
let (cartes,chien) = distribuer tasDeCartes indicesChien meneur
let cartesInitiales = rotate (mod (-meneur) 5) cartes -- le premier joueur recoit le (5-meneur)-ième tas.
let [cartesJ0,cartesJ1,cartesJ2,cartesJ3,cartesJ4] = cartesInitiales
s10 <- distrib s00 cartesJ0 (mod (meneur-0) 5)
s11 <- distrib s01 cartesJ1 (mod (meneur-1) 5)
s12 <- distrib s02 cartesJ2 (mod (meneur-2) 5)
s13 <- distrib s03 cartesJ3 (mod (meneur-3) 5)
s14 <- 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
let typePriseM = maximum prises
vraimentJouerPartie meneur typePriseM (s20,s21,s22,s23,s24) chien cartesInitiales prises

View File

@ -2,6 +2,7 @@ module TarotIAs where
import Data.List
import Data.Set (toList)
import Data.Foldable (for_)
import Safe.Foldable (maximumMay)
import Cartes
import Tarot
@ -10,15 +11,121 @@ import Tarot
data RandomIA = MonJeu ([Carte]) deriving Show
instance JoueurIA RandomIA where
distrib self cartes pos = MonJeu cartes -- Notre état est les cartes que l'on a, on se fiche de notre passé.
distrib self cartes pos = return $ MonJeu cartes -- Notre état est les cartes que l'on a, on se fiche de notre passé.
prise (MonJeu cartes) prises -- On ne prend que si on a le 21 d'atout et que personne n'a fait plus qu'une garde.
| (elem (Atout(21)) cartes) && ((maximumMay prises) < Just (Just Garde)) = (Just Garde, (MonJeu cartes))
| otherwise = (Nothing, (MonJeu cartes))
carte (MonJeu(cartes)) = (maximum $ filter (\x -> not (estAtout x)) $ filter (\x -> not (elem x cartes)) $ (toList deck), MonJeu(cartes))
ecart (MonJeu(cartes)) chien = let grosTas = sort (chien ++ cartes) in (take 3 grosTas,MonJeu(drop 3 grosTas))
annonce self = ([], self) -- On ne fait pas d'annonce. Jamais.
debutPartie self typePrise carteAppelee chien annonces i = self -- On s'en fiche de l'info.
jouer (MonJeu cartes) pli = (joué, MonJeu (delete joué cartes)) -- On joue la plus petite carte que l'on aie.
| (elem (Atout(21)) cartes) && ((maximumMay prises) < Just (Just Garde)) = return (Just Garde, (MonJeu cartes))
| otherwise = return (Nothing, (MonJeu cartes))
carte (MonJeu(cartes)) = return $ (maximum $ filter (\x -> not (estAtout x)) $ filter (\x -> not (elem x cartes)) $ (toList deck), MonJeu(cartes))
ecart (MonJeu(cartes)) chien = return $ let grosTas = sort (chien ++ cartes) in (take 3 grosTas,MonJeu(drop 3 grosTas))
annonce self = return ([], self) -- On ne fait pas d'annonce. Jamais.
debutPartie self typePrise carteAppelee chien annonces i = return self -- On s'en fiche de l'info.
jouer (MonJeu cartes) pli = return (joué, MonJeu (delete joué cartes)) -- On joue la plus petite carte que l'on aie.
where joué = minimum [carte | carte<-cartes, peutJouer carte cartes pli]
finTour self pli = self -- On s'en fiche de l'info.
finTour self pli = return self -- On s'en fiche de l'info.
playerSort :: Carte -> Carte -> Ordering
playerSort (Valeur(col1,val1)) (Valeur(col2,val2))
| col1==col2 = compare val1 val2
| otherwise = compare col1 col2
playerSort (Valeur(_,_)) _ = LT
playerSort _ (Valeur(_,_)) = GT
playerSort (Atout(k)) (Atout(l)) = compare k l
playerSort (Atout(_)) Excuse = LT
playerSort Excuse (Atout(_)) = GT
playerSort Excuse Excuse = EQ
annoncePriseJoueur :: Int -> Maybe TypePrise -> IO ()
annoncePriseJoueur i t = putStrLn $ "Le joueur "++(show (i+1))++" a "++(case t of {
Nothing -> "passé.";
Just Prise -> "pris.";
Just Garde -> "pris en garde.";
Just GardeSans -> "pris en garde sans le chien.";
Just GardeContre -> "pris en garde avec le chien à la défence.";
Just Chelem -> "annoncé un Grand Chelem.";
})
annoncePriseMoi :: Maybe TypePrise -> String
annoncePriseMoi t = (case t of {
Nothing -> "Je passe.";
Just Prise -> "Je prends.";
Just Garde -> "Je prends en garde.";
Just GardeSans -> "Je prend en garde sans le chien.";
Just GardeContre -> "Je prend en garde avec le chien à la défence.";
Just Chelem -> "J'annonce un Grand Chelem.";
})
allPrises = [Nothing,Just Prise, Just Garde, Just GardeSans, Just GardeContre, Just Chelem]
readUntilIntIn :: String -> [Int] -> IO Int
readUntilIntIn s l = do
putStr s
istr <- getLine
let i = (read istr :: Int)
if elem i l
then return i
else readUntilIntIn s l
data VraiJoueurIA = VraiJeu ([Carte])
instance JoueurIA VraiJoueurIA where
distrib self cartes pos = do
let jeu = sortBy playerSort cartes
putStrLn "Voici votre jeu : "
for_ jeu (putStrLn . show)
return (VraiJeu(jeu))
prise (VraiJeu cartes) prises = do
let nprises = length prises
if nprises==0
then putStrLn "Vous êtes le premier à parler !"
else for_ [(nprises-1)..0] (\i -> annoncePriseJoueur (mod (-i) 5) (prises !! i))
let maxPrise = maximum prises
if maxPrise==Just Chelem
then do
putStrLn "Vous ne pouvez pas monter là dessus, souhaitez-lui bonne chance !"
return (Nothing,VraiJeu cartes)
else do
let availablePrises = filter (maxPrise<) allPrises
let aplength = length availablePrises
for_ [0..(aplength-1)] (\i -> putStrLn $ (show (i+1))++" -> "++(annoncePriseMoi (availablePrises !! i)))
i <- readUntilIntIn "Qu'annoncez-vous : " [1..aplength]
let laprise = availablePrises !! (i-1)
return (laprise,VraiJeu cartes)
annonce self = return ([], self) -- TODO, pour l'instant on ne fait pas d'annonce.
carte (VraiJeu cartes) = do
putStrLn "Liste des cartes : "
let availableCartes = filter (\s -> not $ estUnBout s) (toList deck)
let aclength = length availableCartes
for_ [0..(aclength-1)] (\i -> putStrLn $ (show (i+1))++" -> "++(show (availableCartes !! i)))
i <- readUntilIntIn "Quelle carte appelez-vous ? " [1..aclength]
let lacarte = availableCartes !! (i-1)
return (lacarte,VraiJeu cartes)
ecart (VraiJeu(cartes)) chien = do
putStrLn "Vos cartes, avec le chien :"
let toutesCartes = (cartes ++ chien)
let clength = length toutesCartes
for_ [0..(clength-1)] (\i -> putStrLn $ (show (i+1))++" -> "++(show (toutesCartes !! i)))
i1 <- readUntilIntIn "Quelle est la première carte de l'écart ? " [1..clength]
let carte1 = toutesCartes !! (i1-1)
i2 <- readUntilIntIn "Quelle est la seconde carte de l'écart ? " (delete i1 [1..clength])
let carte2 = toutesCartes !! (i2-1)
i3 <- readUntilIntIn "Quelle est la troisième carte de l'écart ? " (delete i1 $ delete i2 [1..clength])
let carte3 = toutesCartes !! (i3-1)
let ecartEffectue = [carte1,carte2,carte3]
return (ecartEffectue, VraiJeu (deleteAllOrError ecartEffectue toutesCartes))