Plus d'avancée, notament sur l'IA.

tarotinator/src/TarotIAs.hs

@@ -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
@@ -22,3 +23,109 @@ instance JoueurIA RandomIA where
         where joué = minimum [carte | carte<-cartes, peutJouer carte cartes pli]
     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))
+            
+            
+            
+            
+            
+            
+            
+            
+            
+            
+            
+