Réécriture et commentaires des fonctions.
This commit is contained in:
parent
5291863f7e
commit
15822dca91
GPG Key ID:
DBA23608F23F5A10
@ -1,10 +1,14 @@
|
||||
module Cartes where
|
||||
import Data.Set as Set
|
||||
import Data.List (map)
|
||||
|
||||
data ValeurCouleur = As | Deux | Trois | Quatre | Cinq | Six | Sept | Huit | Neuf | Dix | Valet | Cavalier | Dame | Roi deriving (Eq, Ord, Show)
|
||||
data Couleur = Pique | Coeur | Carreau | Trefle deriving (Eq, Show, Ord)
|
||||
data Carte = Valeur (ValeurCouleur, Couleur) | Atout Int | Excuse deriving (Eq, Ord)
|
||||
|
||||
data TypePrise = Prise | Garde | GardeSans | GardeContre | Chelem
|
||||
data Annonce = MisereTete | MisereAtout | Poignee of [Carte] | DoublePoignee of [Carte] | TriplePoignee of [Carte]
|
||||
|
||||
instance Show Carte where
|
||||
show (Excuse) = "Excuse"
|
||||
show (Atout n) = (show n) ++ " d'atout"
|
||||
@ -17,8 +21,20 @@ deck :: Set Carte
|
||||
deck = fromList ([Valeur (n,c) | n<-allValeurs, c<-allCouleurs] ++ [Atout n | n<-[1..21]] ++ [Excuse])
|
||||
|
||||
|
||||
------ Valeur des cartes ------
|
||||
|
||||
valeurCarte :: Carte -> Int
|
||||
valeurCarte (Valeur (Roi, _)) = 9
|
||||
valeurCarte (Valeur (Dame, _)) = 7
|
||||
valeurCarte (Valeur (Cavalier, _)) = 5
|
||||
valeurCarte (Valeur (Valet, _)) = 3
|
||||
valeurCarte (Atout (1)) = 9
|
||||
valeurCarte (Atout (21)) = 9
|
||||
valeurCarte Excuse = 9
|
||||
valeurCarte _ = 1
|
||||
|
||||
valeurTas :: [Carte] -> Int
|
||||
valeurTas l = sum $ Data.List.map valeurCarte l
|
||||
|
||||
|
||||
|
||||
@ -32,6 +48,9 @@ replaceNth (e:s) i newElement
|
||||
| i==0 = newElement:s
|
||||
| otherwise = e:(replaceNth s (i-1) newElement)
|
||||
|
||||
addToNth :: [[a]] -> Int -> [a] -> [[a]]
|
||||
addToNth lliste i toAdd = replaceNth lliste i (toAdd ++ (lliste !! i))
|
||||
|
||||
toPentuple :: [a] -> (a,a,a,a,a)
|
||||
toPentuple [j1,j2,j3,j4,j5] = (j1,j2,j3,j4,j5)
|
||||
|
||||
|
||||
@ -22,7 +22,7 @@ main :: IO ()
|
||||
main = do
|
||||
donne <- shuffleM $ Data.Set.toList deck
|
||||
let
|
||||
(cartes,chien) = distribuer donne
|
||||
(cartes,chien) = distribuer donne [1,2,3] 0
|
||||
[cartes1,cartes2,cartes3,cartes4,cartes5] = cartes
|
||||
(s0,s1,s2,s3,s4) = (distrib cartes1 0, distrib cartes2 1, distrib cartes3 2, distrib cartes4 3, distrib cartes5 4) :: (RandomIA,RandomIA,RandomIA,RandomIA,RandomIA)
|
||||
-- C'est le premier qui prends, parce que ..... j'ai décidé.
|
||||
@ -34,6 +34,7 @@ main = do
|
||||
|
||||
steps = Prelude.take 15 $ Prelude.drop 1 cartesJouees
|
||||
for_ (zip [1..5] cartes) (uncurry printDecks)
|
||||
printDecks 6 chien
|
||||
putStrLn ""
|
||||
for_ steps $ \(EtatPartie(i,ias,jeux,points),pli) -> do
|
||||
putStrLn $ show $ reverse pli
|
||||
|
||||
@ -33,19 +33,6 @@ couleurPli (e:s)
|
||||
| otherwise = z
|
||||
where z = couleurPli s
|
||||
|
||||
valeurCarte :: Carte -> Int
|
||||
valeurCarte (Valeur (Roi, _)) = 9
|
||||
valeurCarte (Valeur (Dame, _)) = 7
|
||||
valeurCarte (Valeur (Cavalier, _)) = 5
|
||||
valeurCarte (Valeur (Valet, _)) = 3
|
||||
valeurCarte (Atout (1)) = 9
|
||||
valeurCarte (Atout (21)) = 9
|
||||
valeurCarte Excuse = 9
|
||||
valeurCarte _ = 1
|
||||
|
||||
valeurTas :: [Carte] -> Int
|
||||
valeurTas l = sum $ map valeurCarte l
|
||||
|
||||
-- Renvoie la carte qui a fait le pli
|
||||
gagnantPli :: [Carte] -> Maybe Carte
|
||||
gagnantPli [] = Nothing
|
||||
@ -54,15 +41,16 @@ gagnantPli (e:s) = case (e, w) of {
|
||||
(_, 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 batter un atout.
|
||||
(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.
|
||||
| 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 {
|
||||
@ -71,10 +59,14 @@ grosAtout ((Atout k):s) = case (grosAtout s) of {
|
||||
}
|
||||
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
|
||||
@ -92,36 +84,49 @@ peutJouer c jeu pli = case (couleurPli pli,c) of {
|
||||
(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)
|
||||
-- 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
|
||||
(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
|
||||
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
|
||||
|
||||
|
||||
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, newJeux, calculerPoints pli points jeux vraiIndiceGagnant), pli)
|
||||
where
|
||||
indiceGagnant = 5-(fromJust $ elemIndex (fromJust $ gagnantPli pli) (pli))
|
||||
vraiIndiceGagnant = (mod (main+indiceGagnant-1) 5)
|
||||
newJeux = [delete c jeu | (c,jeu)<-(zip (rotate (5-main) pli) jeux)]
|
||||
|
||||
|
||||
|
||||
-- À 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 = [delete c jeu | (c,jeu)<-(zip (rotate (5-main) 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
|
||||
jouerPliAAux :: (JoueurIA j1, JoueurIA j2, JoueurIA j3, JoueurIA j4, JoueurIA j5) => int -> (j1,j2,j3,j4,j5) -> ([Carte],(j1,j2,j3,j4,j5))
|
||||
jouerPliAAux i (jr1,jr2,jr3,jr4,jr5) = (pli,(e1,e2,e3,e4,e5))
|
||||
-- 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:[])
|
||||
@ -132,13 +137,14 @@ jouerPliAAux i (jr1,jr2,jr3,jr4,jr5) = (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))=jouerPliAAux 0 (jr1,jr2,jr3,jr4,jr5) in jouerPliAux 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))=jouerPliAAux 1 (jr2,jr3,jr4,jr5,jr1) in jouerPliAux 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))=jouerPliAAux 2 (jr3,jr4,jr5,jr1,jr2) in jouerPliAux 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))=jouerPliAAux 3 (jr4,jr5,jr1,jr2,jr3) in jouerPliAux 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))=jouerPliAAux 4 (jr5,jr1,jr2,jr3,jr4) in jouerPliAux 4 (e1,e2,e3,e4,e5) jeux pli points
|
||||
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
|
||||
|
||||
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user