diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,4 +1,17 @@ -# Revision history for hanabi-dealer + # Revision history for hanabi-dealer + + ## 0.7.1.0 -- 2020-03-13 + + * fix freeze after invalid move when played locally + + * improve the menu GUI for rules and verbosity + + * fix problems related to the 6th-color + + * slightly substantiate the function set for implementing strategies + + * slightly improve SimpleStrategy + ## 0.7.0.0 -- 2020-02-28 * start games locally when possible. diff --git a/Game/Hanabi.hs b/Game/Hanabi.hs --- a/Game/Hanabi.hs +++ b/Game/Hanabi.hs @@ -1,15 +1,15 @@ {-# LANGUAGE CPP, MultiParamTypeClasses, FlexibleInstances, Safe, DeriveGeneric, RecordWildCards #-} module Game.Hanabi( -- * Functions for Dealing Games - main, selfplay, start, createGame, run, + main, selfplay, start, createGame, startFromCards, createGameFromCards, run, createDeck, prettyEndGame, isMoveValid, checkEndGame, help, -- * Datatypes -- ** The Class of Strategies - Strategies, Strategy(..), StrategyDict(..), mkSD, DynamicStrategy, mkDS, mkDS', Verbose(..), STDIO, stdio, Blind, ViaHandles(..), Verbosity(..), verbose, + Strategies, Strategy(..), StrategyDict(..), mkSD, DynamicStrategy, mkDS, mkDS', Verbose(..), STDIO, stdio, Blind, ViaHandles(..), Verbosity(..), verbose, quiet, -- ** Audience Peeker, peek, -- ** The Game Specification - GameSpec(..), defaultGS, Rule(..), defaultRule, isRuleValid, colors, + GameSpec(..), defaultGS, Rule(..), defaultRule, isRuleValid, colors, handSize, setHandSize, -- ** The Game State and Interaction History Move(..), Index, State(..), PrivateView(..), PublicInfo(..), Result(..), EndGame(..), -- ** The Cards @@ -18,11 +18,13 @@ -- ** Hints isCritical, isUseless, bestPossibleRank, achievedRank, isPlayable, isHinted, currentScore, achievableScore, isMoreObviouslyUseless, isObviouslyUseless, isDefinitelyUseless, isMoreObviouslyPlayable, isObviouslyPlayable, isDefinitelyPlayable, obviousChopss, definiteChopss, isDoubleDrop, + tryMove, (|||), ifA, -- ** Minor ones what'sUp, what'sUp1, ithPlayer, recentEvents, prettyPI, prettySt, ithPlayerFromTheLast, view, replaceNth, shuffle, showPossibilities, showColorPossibilities, showNumberPossibilities, showTrial) where -- module Hanabi where import qualified Data.IntMap as IM import System.Random +import Control.Applicative((<*>)) import Control.Monad(when) import Control.Monad.IO.Class(MonadIO, liftIO) import Data.Char(isSpace, isAlpha, isAlphaNum, toLower, toUpper) @@ -40,7 +42,7 @@ readsColorChar :: ReadS Color readsColorChar (c:str) | isSpace c = readsColorChar str - | otherwise = case lookup (toUpper c) [(head $ show i, i) | i <- [White, Yellow, Red, Green, Blue]] of + | otherwise = case lookup (toUpper c) [(head $ show i, i) | i <- [White .. Multicolor]] of Nothing -> [] Just i -> [(i, str)] readsColorChar [] = [] @@ -108,7 +110,7 @@ -- -- See also the definition of 'checkEndGame'. data Rule = R { numBlackTokens :: Int -- ^ E.g., if this is 3, the third failure ends the game with failure. - , funPlayerHand :: [Int] -- ^ memoized function taking the number of players; the default is [5,5,4,4,4,4,4,4,4,4,4,4,4,4] + , funPlayerHand :: [Int] -- ^ memoized function taking the number of players; the default is [5,5,4,4,4,4,4,4,4,4] , numColors :: Int -- ^ number of colors. 5 for the normal rule, and 6 for Variant 1-3 of the rule book. , prolong :: Bool -- ^ continue even after a round after the pile is exhausted. @True@ for Variant 4 of the rule book. , earlyQuit :: Bool -- ^ quit the game when the best possible score is achieved. @@ -117,11 +119,14 @@ -- x , multicolor :: Bool -- ^ multicolor play, or Variant 3 } deriving (Show, Read, Eq, Generic) isRuleValid :: Rule -> Bool -isRuleValid R{..} = numBlackTokens > 0 && all (>0) funPlayerHand && numColors>0 && numColors <=6 && (numColors < 6 || all (>0) numMulticolors) +isRuleValid rl@R{..} = numBlackTokens > 0 && and [ h>0 && h<=mh | (h,mh) <- zip funPlayerHand maxPlayerHand ] && numColors>0 && numColors <=6 && (numColors < 6 || all (>0) numMulticolors) + where maxPlayerHand = [ succ (numberOfCards rl) `div` numP | numP <- [2..]] + -- This makes sure that there is at least one card on the deck. + -- | @defaultRule@ is the normal rule from the rule book of the original card game Hanabi. defaultRule :: Rule defaultRule = R { numBlackTokens = 3 - , funPlayerHand = [5,5]++take 12 (repeat 4) + , funPlayerHand = [5,5]++take 8 (repeat 4) , numColors = 5 , prolong = False , earlyQuit = False @@ -130,11 +135,15 @@ } defaultGS :: GameSpec defaultGS = GS{numPlayers=2, rule=defaultRule} +numberOfCards :: Rule -> Int +numberOfCards rl = sum (take (numColors rl) $ [10,10,10,10,10]++[sum (numMulticolors rl)]) initialPileNum :: GameSpec -> Int -initialPileNum gs = sum (take (numColors $ rule gs) $ [10,10,10,10,10]++[sum (numMulticolors $ rule gs)]) - - numPlayerHand gs * numPlayers gs -numPlayerHand :: GameSpec -> Int -numPlayerHand gs = (funPlayerHand (rule gs) ++ repeat 4) !! (numPlayers gs - 2) +initialPileNum gs = numberOfCards (rule gs) + - handSize gs * numPlayers gs +handSize :: GameSpec -> Int +handSize GS{..} = (funPlayerHand rule ++ repeat 1) !! (numPlayers - 2) +setHandSize :: GameSpec -> Int -> Rule +setHandSize GS{..} n = rule{funPlayerHand = snd $ replaceNth (numPlayers - 2) n $ funPlayerHand rule} data GameSpec = GS {numPlayers :: Int, rule :: Rule} deriving (Read, Show, Eq, Generic) -- | State consists of all the information of the current game state, including public info, private info, and the hidden deck. @@ -179,10 +188,10 @@ -- | the best achievable rank for each color. bestPossibleRank :: PublicInfo -> Color -> Number -bestPossibleRank pub iro = toEnum $ length $ takeWhile (/=0) $ zipWith subtract (numCards (gameSpec pub) iro) +bestPossibleRank pub iro = toEnum $ length $ takeWhile (/=0) $ zipWith subtract (numEachCard (gameSpec pub) iro) (map ((discarded pub IM.!) . cardToInt . C iro) [K1 .. K5]) -numCards :: GameSpec -> Color -> [Int] -numCards gs iro = if iro==Multicolor then numMulticolors $ rule gs else [3,2,2,2,1] +numEachCard :: GameSpec -> Color -> [Int] +numEachCard gs iro = if iro==Multicolor then numMulticolors $ rule gs else [3,2,2,2,1] -- | isUseless pi card means either the card is already played or it is above the bestPossibleRank. isUseless :: PublicInfo -> Card -> Bool isUseless pub card = number card <= achievedRank pub (color card) -- the card is already played @@ -192,7 +201,7 @@ -- Unmarked critical card on the chop should be marked. isCritical :: PublicInfo -> Card -> Bool isCritical pub card = not (isUseless pub card) - && succ (discarded pub IM.! cardToInt card) == (numCards (gameSpec pub) (color card) !! (pred $ fromEnum $ number card)) + && succ (discarded pub IM.! cardToInt card) == (numEachCard (gameSpec pub) (color card) !! (pred $ fromEnum $ number card)) isPlayable :: PublicInfo -> Card -> Bool isPlayable pub card = pred (number card) == achievedRank pub (color card) @@ -300,6 +309,14 @@ achievableScore :: PublicInfo -> Int achievableScore pub = sum [ fromEnum $ bestPossibleRank pub k | k <- colors pub ] +tryMove :: PrivateView -> Move -> Move -> Move +tryMove pv m alt | isMoveValid pv m = m + | otherwise = alt +(|||) :: (PrivateView -> Move) -> (PrivateView -> Move) -> PrivateView -> Move +a ||| b = tryMove <*> a <*> b +ifA :: (PrivateView -> Bool) -> (PrivateView -> Move) -> (PrivateView -> Move) -> PrivateView -> Move +ifA pred at af = (\pv t f -> if pred pv then t else f) <*> at <*> af + -- | 'Result' is the result of the last move. data Result = None -- ^ Hinted or at the beginning of the game | Discard Card | Success Card | Fail Card deriving (Read, Show, Eq, Generic) @@ -351,8 +368,9 @@ chopSet = concat $ take 1 $ definiteChopss pv myHand myPos prettySt :: (Int -> Int -> String) -> State -> String prettySt ithP st@St{publicState=pub} = prettyPI pub ++ concat (zipWith4 (prettyHand verbose pub (ithP $ numPlayers $ gameSpec pub)) [0..] (hands st) (givenHints pub) (possibilities pub)) -verbose :: Verbosity -verbose = V{warnCritical=True,markUseless=True,markPlayable=True,markObviouslyUseless=True,markObviouslyPlayable=True,markHints=True,markPossibilities=True,markChops=True,warnDoubleDrop=True} +verbose, quiet :: Verbosity +verbose = V{warnCritical=True, markUseless=True, markPlayable=True, markObviouslyUseless=True, markObviouslyPlayable=True, markHints=True, markPossibilities=True, markChops=True, warnDoubleDrop=True} +quiet = V{warnCritical=False,markUseless=False,markPlayable=False,markObviouslyUseless=False,markObviouslyPlayable=False,markHints=False,markPossibilities=False,markChops=False,warnDoubleDrop=False} prettyHand :: Verbosity -> PublicInfo -> (Int->String) -> Int -> [Card] -> [Marks] -> [Possibilities] -> String prettyHand v pub ithPnumP i cards hl ps = "\n\n" ++ ithPnumP i ++ " hand:\n" -- ++ concat (replicate (length cards) " __") ++ " \n" @@ -480,6 +498,11 @@ start gs audience players gen = let (st, g) = createGame gs gen in fmap (\e -> (e,g)) $ run audience [st] [] players +startFromCards :: (Monad m, Strategies ps m) => + GameSpec -> [Peeker m] -> ps -> [Card] -> m ((EndGame, [State], [Move]), ps) +startFromCards gs audience players shuffled = let + st = createGameFromCards gs shuffled + in run audience [st] [] players run :: (Monad m, Strategies ps m) => [Peeker m] -> [State] -> [Move] -> ps -> m ((EndGame, [State], [Move]), ps) run audience states moves players = do ((mbeg, sts, mvs), ps) <- runARound (\sts@(st:_) mvs -> let myOffset = turn (publicState st) in mapM_ (\p -> p st mvs) audience >> broadcast (zipWith rotate [-myOffset, 1-myOffset ..] sts) mvs players (myOffset `mod` numPlayers (gameSpec $ publicState st)) >> return ()) states moves players @@ -654,11 +677,11 @@ case reads str of [(mv, rest)] | all isSpace rest -> if isMoveValid v mv then return mv else hPutStrLn hout "Invalid Move" >> repeatReadingAMoveUntilSuccess hin hout v _ -> hPutStr hout ("Parse error.\n"++help) >> repeatReadingAMoveUntilSuccess hin hout v - -createGame :: RandomGen g => GameSpec -> g -> (State, g) -- Also returns the new RNG state, in order not to require safe 'split' for collecting statistics. RNG is only used for initial shuffling. -createGame gs gen = splitCons (numPlayers gs) [] shuffled +-- | 'createGameFromCards' deals cards and creates the initial state. +createGameFromCards :: GameSpec -> [Card] -> State +createGameFromCards gs = splitCons (numPlayers gs) [] where splitCons 0 hnds stack - = (St {publicState = PI {gameSpec = gs, + = St {publicState = PI {gameSpec = gs, pileNum = initialPileNum gs, played = IM.fromAscList [ (i, Empty) | i <- [0 .. pred $ numColors $ rule gs] ], discarded = IM.fromList [ (cardToInt $ C i k, 0) | i <- take (numColors $ rule gs) [White .. Multicolor], @@ -668,15 +691,21 @@ lives = numBlackTokens $ rule gs, hintTokens = 8, deadline = Nothing, - givenHints = replicate (numPlayers gs) $ replicate (numPlayerHand gs) (Nothing, Nothing), - possibilities = replicate (numPlayers gs) $ replicate (numPlayerHand gs) (unknown gs), + givenHints = replicate (numPlayers gs) $ replicate (handSize gs) (Nothing, Nothing), + possibilities = replicate (numPlayers gs) $ replicate (handSize gs) (unknown gs), result = None }, pile = stack, hands = hnds - }, g) - splitCons n hnds stack = case splitAt (numPlayerHand gs) stack of (tk,dr) -> splitCons (pred n) (tk:hnds) dr - (shuffled, g) = shuffle (cardBag $ rule gs) gen + } + splitCons n hnds stack = case splitAt (handSize gs) stack of (tk,dr) -> splitCons (pred n) (tk:hnds) dr +createGame :: RandomGen g => GameSpec -> g -> (State, g) -- Also returns the new RNG state, in order not to require safe 'split' for collecting statistics. RNG is only used for initial shuffling. +createGame gs gen = (createGameFromCards gs shuffled, g) where + (shuffled, g) = createDeck (rule gs) gen +createDeck :: RandomGen g => Rule -> g -> ([Card], g) +createDeck r gen = shuffle (cardBag r) gen + + numAssoc :: [(Number, Int)] numAssoc = zip [K1 ..K5] [3,2,2,2,1] cardAssoc :: Rule -> [(Card,Int)] diff --git a/Game/Hanabi/Client.hs b/Game/Hanabi/Client.hs --- a/Game/Hanabi/Client.hs +++ b/Game/Hanabi/Client.hs @@ -68,9 +68,9 @@ -- https://github.com/dmjio/miso/blob/master/frontend-src/Miso/Subscription/WebSocket.hs clientJSM :: Game.Hanabi.Msg.Options -> JSM () -clientJSM options = do mvStr <- newMVarStrategy +clientJSM options = do mvStr <- liftIO newMVarStrategy startApp App{ - model = Model{tboxval = Message "available", players = ["via WebSocket"], from = Just 0, rule = defaultRule, received = [], fullHistory = False, showVerbosity = False, verbosity = verbose, play = True, localStrategy = mvStr, local = False}, + model = Model{tboxval = Message "available", players = ["via WebSocket"], from = Just 0, rule = defaultRule{numMulticolors=replicate 5 1}, received = [], fullHistory = False, showVerbosity = False, verbosity = verbose, play = True, localStrategy = mvStr, local = False}, update = updateModel options, view = appView strNames $ version options, subs = [ websocketSub uri protocols HandleWebSocket ], @@ -100,7 +100,7 @@ updateModel _ (SendMessage msg@(Message str)) model = model{fullHistory=False, showVerbosity=False} <# -- connect uri protocols >> if local model then case reads $ S.unpack str of - [(m,str)] -> do + [(m,str)] -> liftIO $ do putMVar (mvMov $ localStrategy model) m msg <- takeMVar (mvMsg $ localStrategy model) return $ ProcMsg msg @@ -108,7 +108,7 @@ else send msg >> return Id updateModel _ (SendMove mov) model = model{fullHistory=False, showVerbosity=False} <# -- connect uri protocols >> if local model - then do + then liftIO $ do putMVar (mvMov $ localStrategy model) mov msg <- takeMVar (mvMsg $ localStrategy model) return $ ProcMsg msg @@ -144,7 +144,7 @@ ) updateModel _ (WriteLocalResult fs@(_,sts,mvs)) model = model{received = CreateGame : PrettyEndGame (Just fs) : zipWith Watch (tail sts) (iterate (drop 1) $ drop 1 mvs) ++ received model} <# return (SendMessage $ Message "available") -updateModel opt PlayLocally model = model{local=True} <# do +updateModel opt PlayLocally model = model{local=True} <# liftIO (do let constructor algIx = fromJust $ lookup algIx $ strategies opt playerList <- mapM (constructor . S.unpack) $ reverse $ players model let thePlayerList = mkDS "local strategy" (localStrategy model) : playerList @@ -160,11 +160,13 @@ putMVar (mvMsg $ localStrategy model) $ PrettyEndGame $ Just fs msg <- takeMVar (mvMsg $ localStrategy model) return $ ProcMsg msg + ) updateModel _ (ProcMsg msg@(PrettyEndGame (Just fs))) model = model{local=False, received = CreateGame : msg : received model} <# return (SendMessage $ Message "available") updateModel _ (ProcMsg msg@(WhatsUp _ _ _)) model = noEff model{received = msg : received model} -updateModel _ (ProcMsg msg) model = model{received = msg : received model} <# do +updateModel _ (ProcMsg msg) model = model{received = msg : received model} <# liftIO (do msg <- takeMVar (mvMsg $ localStrategy model) return $ ProcMsg msg + ) #ifdef DEBUG updateModel _ (HandleWebSocket act) model = noEff model{received = Str (show act) : received model } #endif @@ -236,19 +238,22 @@ ] renderVerbosity :: Verbosity -> View Action renderVerbosity v = div_ [] [ - mkChx v "mark unhinted critical cards" (\b -> v{warnCritical=b}) warnCritical, - mkChx v "mark useless cards" (\b -> v{markUseless=b}) markUseless, - mkChx v "mark playable cards" (\b -> v{markPlayable=b}) markPlayable, - mkChx v "mark useless cards without looking at the cards" (\b -> v{markObviouslyUseless=b}) markObviouslyUseless, - mkChx v "mark playable cards without looking at the cards" (\b -> v{markObviouslyPlayable=b}) markObviouslyPlayable, - mkChx v "shade the chop card(s)" (\b -> v{markChops=b}) markChops, - mkChx v "warn possible double-dropping"(\b -> v{warnDoubleDrop=b}) warnDoubleDrop, - mkChx v "mark hints" (\b -> v{markHints=b}) markHints, - mkChx v "mark possibilities" (\b -> v{markPossibilities=b}) markPossibilities + mkChx span_ v "beginner" (\b -> if b then verbose else v) (==verbose), + mkChx span_ v "expert" (\b -> if b then quiet else v) (==quiet), + hr_ [], + mkChx div_ v "mark unhinted critical cards" (\b -> v{warnCritical=b}) warnCritical, + mkChx div_ v "mark useless cards" (\b -> v{markUseless=b}) markUseless, + mkChx div_ v "mark playable cards" (\b -> v{markPlayable=b}) markPlayable, + mkChx div_ v "mark useless cards without looking at the cards" (\b -> v{markObviouslyUseless=b}) markObviouslyUseless, + mkChx div_ v "mark playable cards without looking at the cards" (\b -> v{markObviouslyPlayable=b}) markObviouslyPlayable, + mkChx div_ v "shade the chop card(s)" (\b -> v{markChops=b}) markChops, + mkChx div_ v "warn possible double-dropping"(\b -> v{warnDoubleDrop=b}) warnDoubleDrop, + mkChx div_ v "mark hints" (\b -> v{markHints=b}) markHints, + mkChx div_ v "mark possibilities" (\b -> v{markPossibilities=b}) markPossibilities ] -mkChx verb label update access = div_ [] [ +mkChx divspan verb label update access = divspan [] [ input_ [ type_ "checkbox", id_ idName, onClick (UpdateVerbosity $ update $ not $ access verb), checked_ $ access verb ], label_ [ for_ idName ] [text label] ] @@ -331,10 +336,10 @@ -- div_ [] [text $ "Rules"], -- div_ [] [input_ [type_ "text", onInput (UpdateRule . head . (++[rule mdl]) . map fst . reads . S.unpack), value_ $ S.pack $ show $ rule mdl, style_ $ M.fromList [("width","70%")]]], - let mkTR label updater access = tr_ [] [ + let mkTR list label updater access = tr_ [] [ td_ [] [text label], td_ [] [ - input_ [type_ "text", onInput (UpdateRule . updater . head . (++[access $ rule mdl]) . map fst . reads . S.unpack), value_ $ S.pack $ show $ access $ rule mdl] + input_ $ list ++ [type_ "text", onInput (UpdateRule . updater . head . (++[access $ rule mdl]) . map fst . reads . S.unpack), (if null list then value_ else placeholder_) $ S.pack $ show $ access $ rule mdl] ] ] mkTRd label updater access options = tr_ [] [ @@ -342,17 +347,23 @@ td_ [] [ dropdownLiteral options (UpdateRule . updater) (access $ rule mdl) ] - ] in - table_ [solid] [ + ] + gs = GS{numPlayers = length (players mdl) + if play mdl then 1 else 0, + Game.Hanabi.rule = rule mdl} + in + table_ [solid] $ [ caption_ [] [text "Rules"], mkTRd "Number of lives" (\n -> (rule mdl){numBlackTokens=n}) numBlackTokens [1 .. 9], mkTRd "Number of colors" (\n -> (rule mdl){numColors=n}) numColors [1 .. 6], mkTRd "Continue the game after the pile is exhausted" (\n -> (rule mdl){prolong=n}) prolong [False,True], mkTRd "Quit the game when no more score is possible" (\n -> (rule mdl){earlyQuit=n}) earlyQuit [False,True], - mkTR "numMulticolors" (\n -> (rule mdl){numMulticolors=n}) numMulticolors, - mkTR "funPlayerHand" (\n -> (rule mdl){funPlayerHand=n}) funPlayerHand - ], - +-- mkTR [] "funPlayerHand" (\n -> (rule mdl){funPlayerHand=n}) funPlayerHand + mkTRd "Hand size" (setHandSize gs) (const (handSize gs)) [1 .. 9] + ] ++ + if numColors (rule mdl) == 6 then [ + mkTR [list_ "numMulticolors"] "Numbers of M1 .. M5" (\n -> (rule mdl){numMulticolors=n}) numMulticolors + ] else [], + datalist_ [id_ "numMulticolors"] [option_ [value_ "[1, 1, 1, 1, 1]"] [text "[1, 1, 1, 1, 1]"], option_ [value_ "[3, 2, 2, 2, 1]"] [text "[3, 2, 2, 2, 1]"]], button_ [onClick $ if all (not . isWS . S.unpack) (players mdl) then if play mdl then PlayLocally else ObserveLocally @@ -604,12 +615,15 @@ data MVarStrategy = MVS {mvMsg :: MVar Msg, mvMov :: MVar Move} deriving Eq instance Strategy MVarStrategy IO where strategyName _ = return "local player" - move pvs mvs mvstr@(MVS mvmsg mvmov) = do + move pvs@(pv:_) mvs mvstr@(MVS mvmsg mvmov) = do putMVar mvmsg $ WhatsUp "local player" pvs mvs - mov <- takeMVar mvmov + mov <- getMoveUntilSuccess pv mvstr return (mov, mvstr) observe (v:_) (m:_) (MVS mvmsg mvmov) = putMVar mvmsg $ WhatsUp1 v m - +getMoveUntilSuccess pv mvstr@(MVS mvmsg mvmov) = do + m <- takeMVar mvmov + if isMoveValid pv m then return m else do putMVar mvmsg $ Str "invalid move" + getMoveUntilSuccess pv mvstr newMVarStrategy = do mvmsg <- newEmptyMVar mvmov <- newEmptyMVar diff --git a/Game/Hanabi/Strategies/SimpleStrategy.hs b/Game/Hanabi/Strategies/SimpleStrategy.hs --- a/Game/Hanabi/Strategies/SimpleStrategy.hs +++ b/Game/Hanabi/Strategies/SimpleStrategy.hs @@ -2,29 +2,40 @@ module Game.Hanabi.Strategies.SimpleStrategy where import Game.Hanabi hiding (main) import System.Random +import Data.Maybe(isNothing) -- An example of a simple and stupid strategy. data Simple = S instance Monad m => Strategy Simple m where strategyName ms = return "Stupid example strategy" - move (pv:_) (Hint 1 (Left c) : _) s = return (Play $ length $ takeWhile ((/=Just c) . fst) $ head $ givenHints $ publicView pv, s) - move (pv:_) _mvs s = let pub = publicView pv - tsuginohitoNoTe = head $ handsPV pv ::[Card] - tsuginohitoNoHint = givenHints pub !! 1 - numHand = length $ head $ givenHints pub - mov | hintTokens pub >= 1 = case filter (\(ix, te, hint) -> hint == (Nothing,Nothing) && isCritical pub te) $ zip3 [0..] tsuginohitoNoTe tsuginohitoNoHint of + move (pv:_) mvs s = let pub = publicView pv + nextPlayersHand = head $ handsPV pv ::[Card] + nextPlayersHints = givenHints pub !! 1 + nextPlayer = zip3 [0..] nextPlayersHand nextPlayersHints + myHints = head $ givenHints pub + myPos = head $ possibilities pub + numHand = length myHints + mov = case filter (\(ix, te, hint) -> not (isHinted hint) && isCritical pub te) nextPlayer of [] -> foo - us -> Hint 1 $ Right (number $ sndOf3 $ last us) - | otherwise = foo - where foo = case filter ((==(Nothing,Nothing)) . snd) $ zip [0..] $ head $ givenHints pub of - ts@(_:_) | hintTokens pub < 4 -> Drop (fst $ last ts) - | otherwise -> case break (isPlayable pub) tsuginohitoNoTe of - (_,d:_) -> Hint 1 $ Left $ color d - (_,[]) | hintTokens pub < 8 -> Drop (fst $ last ts) - | otherwise -> Hint 1 $ Right $ number $ last $ tsuginohitoNoTe - _ | hintTokens pub < 1 -> Drop $ pred $ length $ head $ givenHints pub - | otherwise -> Hint 1 $ Right $ number $ last $ tsuginohitoNoTe + us -> tryMove pv (Hint 1 $ Right (number $ sndOf3 $ last us)) foo + where foo = case break (\(_,card,_) -> isPlayable pub card) nextPlayer of + (ts,(_,d,(Nothing, _)) :_) | hintTokens pub >= 3 && all (\(_,c,_) -> color c /= color d) ts -> Hint 1 $ Left $ color d + (ts,(_,d,(Just _, Nothing)):_) | hintTokens pub >= 4 -> Hint 1 $ Right $ number d -- This should actually be ANY card. + _ -> + case filter (\(i,marks,pos) -> isDefinitelyPlayable pv marks pos) $ zip3 [0..] myHints myPos of + (i,_,_):_ -> Play i + [] -> + case mvs of + Hint 1 (Left c) : _ | isDefinitelyUseless pv (myHints!!i) (myPos!!i) -> tryMove pv (Drop i) rest + | otherwise -> Play i + where i = length $ takeWhile ((/=Just c) . fst) $ head $ givenHints $ publicView pv + _ -> rest + where rest = case definiteChopss pv myHints myPos of + ((i:_):_) -> tryMove pv (Drop i) + (Hint 1 $ Right $ number $ last $ nextPlayersHand) + _ -> tryMove pv (Hint 1 $ Right $ number $ last $ nextPlayersHand) + (Drop $ pred numHand) in return (mov, s) sndOf3 (_,b,_) = b diff --git a/hanabi-dealer.cabal b/hanabi-dealer.cabal --- a/hanabi-dealer.cabal +++ b/hanabi-dealer.cabal @@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.7.0.0 +version: 0.7.1.0 -- A short (one-line) description of the package. synopsis: Hanabi card game