diff --git a/tarotinator/README.md b/tarotinator/README.md new file mode 100644 index 0000000..20677b0 --- /dev/null +++ b/tarotinator/README.md @@ -0,0 +1,16 @@ +Utilisation +----------- + +Vous pouvez utiliser la commande `cabal run [paramètres]` afin de lancer directement le programme. + +Si toutefois vous souhaitez seulement le compiler, vous pouvez lancer `cabal build`. + + +Pour aller plus loin +-------------------- + +(Ceci est une TODO list) + +Ajouter la prise à l'IA. + +Ajouter la possiblité de random l'IA (avec par exemple une classe qui fonctionne avec de IO) diff --git a/tarotinator/src/Cartes.hs b/tarotinator/src/Cartes.hs index 5f697a3..9464d06 100644 --- a/tarotinator/src/Cartes.hs +++ b/tarotinator/src/Cartes.hs @@ -1,18 +1,32 @@ module Cartes where import Data.Set as Set -data Figure = Valet | Cavalier | Dame | Roi deriving (Eq, Ord, Show) +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 (Int, Couleur) | Tete (Figure, Couleur) | Atout Int | Excuse deriving (Eq, Ord) +data Carte = Valeur (ValeurCouleur, Couleur) | Atout Int | Excuse deriving (Eq, Ord) + instance Show Carte where show (Excuse) = "Excuse" show (Atout n) = (show n) ++ " d'atout" - show (Tete (f,c)) = (show f) ++ " de " ++ (show c) show (Valeur (n,c)) = (show n) ++ " de " ++ (show c) -allFigures = [Valet, Cavalier, Dame, Roi] +allValeurs = [As, Deux, Trois, Quatre, Cinq, Six, Sept, Huit, Neuf, Dix, Valet, Cavalier, Dame, Roi] allCouleurs = [Pique, Coeur, Carreau, Trefle] deck :: Set Carte -deck = fromList ([Valeur (n,c) | n<-[1..10], c<-allCouleurs] ++ [Tete (f,c) | f<- allFigures, c<- allCouleurs] ++ [Atout n | n<-[1..21]] ++ [Excuse]) +deck = fromList ([Valeur (n,c) | n<-allValeurs, c<-allCouleurs] ++ [Atout n | n<-[1..21]] ++ [Excuse]) + + + + + + + +-------------------------------------- +------------- List Utils ------------- +-------------------------------------- +replaceNth :: [a] -> Int -> a -> [a] +replaceNth (e:s) i newElement + | i==0 = newElement:s + | otherwise = replaceNth s (i-1) newElement diff --git a/tarotinator/src/Main.hs b/tarotinator/src/Main.hs index 1421706..5536db8 100644 --- a/tarotinator/src/Main.hs +++ b/tarotinator/src/Main.hs @@ -1,4 +1,17 @@ import Cartes +import System.Random.Shuffle +import Data.Set + main :: IO () -main = putStrLn (show (deck)) +main = do + donne <- shuffleM $ toList deck + let + taz = distribuer randomizedGame + infiniteSteps = iterate singleStep taz + steps = takeWhile (not . isDone) infiniteSteps + for_ steps $ \(x,y) -> do + print (length x, length y) + putStrLn $ prettyDeck x + putStrLn $ prettyDeck y + putStrLn "" diff --git a/tarotinator/src/Tarot.hs b/tarotinator/src/Tarot.hs index c912dac..9df9974 100644 --- a/tarotinator/src/Tarot.hs +++ b/tarotinator/src/Tarot.hs @@ -1,8 +1,102 @@ module Tarot where import Cartes +import Data.List +import Data.Maybe +-- 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. - distrib :: [Carte] -> s + -- 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 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 (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 + +type EtatPartie = ([[Carte]],[[Carte]]) + +-- 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 j => [j] -> EtatPartie -> ([j],EtatPartie,[Carte]) +jouerPli joueurs (jeux,points) = (etats, ([delete c jeu | (c,jeu)<-(zip pli jeux)], replaceNth points indiceGagnant (pli ++ (points !! indiceGagnant))), pli) -- 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 + indiceGagnant = fromJust $ elemIndex (fromJust $ gagnantPli pli) (pli) + + + + diff --git a/tarotinator/src/TarotIAs.hs b/tarotinator/src/TarotIAs.hs new file mode 100644 index 0000000..14b9aa0 --- /dev/null +++ b/tarotinator/src/TarotIAs.hs @@ -0,0 +1,15 @@ +module TarotIAs where + +import Data.List +import Cartes +import Tarot + + +data RandomIA = MonJeu ([Carte]) + +instance JoueurIA RandomIA where + distrib cartes pos = MonJeu cartes -- Notre état est les cartes que l'on a + debutPartie cartes i = cartes -- On s'en fiche de l'info + jouer (MonJeu cartes) pli = (joué, MonJeu (delete joué cartes)) + where joué = minimum [carte | carte<-cartes, peutJouer carte cartes pli] + finTour cartes pli = cartes diff --git a/tarotinator/tarotinator.cabal b/tarotinator/tarotinator.cabal index 2fbbb55..f4c2eca 100644 --- a/tarotinator/tarotinator.cabal +++ b/tarotinator/tarotinator.cabal @@ -17,16 +17,16 @@ cabal-version: >=1.10 library exposed-modules: Cartes, Tarot - other-modules: + other-modules: -- other-extensions: - build-depends: base >=4.11 && <4.12, containers + build-depends: base >=4.11 && <4.12, containers, random-shuffle, random, MonadRandom hs-source-dirs: src default-language: Haskell2010 executable tarotinator main-is: Main.hs - other-modules: Cartes, Tarot + other-modules: Cartes, Tarot, TarotIAs -- other-extensions: - build-depends: base >=4.11 && <4.12, containers + build-depends: base >=4.11 && <4.12, containers, random-shuffle, random, MonadRandom hs-source-dirs: src default-language: Haskell2010