hanabi-dealer 0.9.1.0 → 0.10.1.0

raw patch · 10 files changed

+299/−164 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +13/−0
• Game/Hanabi.hs +171/−96
• Game/Hanabi/Backend.lhs +10/−6
• Game/Hanabi/Client.hs +72/−49
• Game/Hanabi/FFI.hs +19/−0
• Game/Hanabi/Msg.hs +2/−2
• Game/Hanabi/Strategies/SimpleStrategy.hs +7/−7
• Game/Hanabi/Strategies/StatefulStrategy.hs +1/−1
• Game/Hanabi/Strategies/Stateless.hs +1/−1
• hanabi-dealer.cabal +3/−2

@@ -1,5 +1,18 @@ 	# Revision history for hanabi-dealer +	## 0.10.1.0 -- 2020-09-08++	* slightly improve the GUI++	## 0.10.0.0 -- 2020-05-26++	* improve the efficiency by using Data.Bits instead of IntMap+	  This changes PublicInfo and PrivateView.++	* add the preset-deck functionality to the GUI++	* show both definiteChopss and obviousChopss of the player's hand+ 	## 0.9.1.0 -- 2020-05-05  	* add efficiency-improved end-game search agents

@@ -11,21 +11,20 @@               -- ** The Game Specification               GameSpec(..), defaultGS, Rule(..), defaultRule, isRuleValid, makeRuleValid, colors, handSize, setHandSize,               -- ** The Game State and Interaction History-              Move(..), Index, State(..), PrivateView(..), PublicInfo(..), Result(..), EndGame(..),+              Move(..), Index, State(..), PrivateView(..), PublicInfo(..), Result(..), EndGame(..), discarded,               -- ** The Cards and Annotations-              Card(..), Color(..), Number(..), Marks, Possibilities, Annotation(..), cardToInt, intToCard, readsColorChar, readsNumberChar, colorToBitPos, numberToBitPos,+              Card(..), Color(..), Rank(..), Marks, Possibilities, Annotation(..), cardToInt, intToCard, readsColorChar, readsRankChar, colorToBitPos, rankToBitPos,               -- * Utilities               -- ** Hints-              isCritical, isUseless, bestPossibleRank, achievedRank, isPlayable, isHinted, currentScore, seeminglyAchievableScore, moreStrictlyAchievableScore, achievableScore,+              isCritical, isUseless, bestPossibleRank, achievedRank, isPlayable, isHinted, seeminglyAchievableScore, moreStrictlyAchievableScore, achievableScore,               definitely, obviously,               isMoreObviouslyUseless, isObviouslyUseless, isDefinitelyUseless, isDefinitelyUncritical, isDefinitelyCritical, isMoreObviouslyPlayable, isObviouslyPlayable, isDefinitelyPlayable, isObviouslyUnplayable, isDefinitelyUnplayable, obviousChopss, definiteChopss, isDoubleDrop, possibleCards, endGameMove, EndGameStrategy(..), EndGameMirrorStrategy(..), egms, EndGameLite(..), egl, EndGameMirrorLite(..), egml,               tryMove, (|||), ifA,-              -- ** Legacy functions-              givenHints, possibilities_until_Ver0720,+              -- ** Legacy functions and types+              givenHints, possibilities_until_Ver0720, Number, readsNumberChar, numberToBitPos, showNumberPossibilities,               -- ** Minor ones-              what'sUp, what'sUp1, ithPlayer, recentEvents, prettyPI, prettySt, ithPlayerFromTheLast, view, replaceNth, shuffle, showPossibilities, showColorPossibilities, showNumberPossibilities, showTrial, showDeck) where+              what'sUp, what'sUp1, ithPlayer, recentEvents, prettyPI, prettySt, ithPlayerFromTheLast, view, replaceNth, shuffle, showPossibilities, showColorPossibilities, showRankPossibilities, showTrial, showDeck, cardBag) where -- module Hanabi where-import qualified Data.IntMap as IM import qualified Data.Map as M import System.Random import Control.Applicative((<*>))@@ -38,12 +37,15 @@ import System.IO import Data.Dynamic import Data.Bits hiding (rotate)+import Data.Int(Int64)  import GHC.Generics hiding (K1) -data Number  = Empty | K1 | K2 | K3 | K4 | K5 deriving (Eq, Ord, Show, Read, Enum, Bounded, Generic)+data Rank  = Empty | K1 | K2 | K3 | K4 | K5 deriving (Eq, Ord, Show, Read, Enum, Bounded, Generic) data Color = White | Yellow | Red | Green | Blue | Multicolor   deriving (Eq, Ord, Show, Read, Enum, Bounded, Generic)+type Number = Rank+ readsColorChar :: ReadS Color readsColorChar (c:str)   | isSpace c = readsColorChar str@@ -51,26 +53,30 @@                            Nothing -> []                            Just i  -> [(i, str)] readsColorChar [] = []-readsNumberChar :: ReadS Number-readsNumberChar xs = [ (toEnum d, rest) | (d, rest) <- reads xs, d<=5 ]+readsRankChar :: ReadS Rank+readsRankChar xs = [ (toEnum d, rest) | (d, rest) <- reads xs, d<=5 ]+readsNumberChar = readsRankChar -data Card = C {color :: Color, number :: Number} deriving (Eq, Ord, Generic)+data Card = C {color :: Color, rank :: Rank} deriving (Eq, Ord, Generic) instance Show Card where   showsPrec _ (C color number) = (head (show color) :) . (show (fromEnum number) ++)   showList = foldr (.) id . map shows instance Read Card where-  readsPrec _ str = [(C i k, rest) | (i, xs) <- readsColorChar str, (k, rest) <- readsNumberChar xs]+  readsPrec _ str = [(C i k, rest) | (i, xs) <- readsColorChar str, (k, rest) <- readsRankChar xs]   readList xs = case reads xs of []       -> [([],xs)]                                  [(c,ys)] -> [ (c:cs, zs) | (cs,zs) <- readList ys ] cardToInt :: Card -> Int-cardToInt c = fromEnum (color c) * (succ $ fromEnum (maxBound::Number)) + fromEnum (number c)+cardToInt c = fromEnum (color c) * succ (fromEnum (maxBound::Rank)) + fromEnum (rank c)+-- cardToQitPos is a variant of cardToInt whose value is less than 32. Since the Empty rank is never used for a card, there is no reason to use cardToInt, but it exists mainly for backward compatibility.+-- cardToQitPos c = fromEnum (color c) * fromEnum (maxBound::Rank) + pred (fromEnum $ rank c)+cardToQitPos c = pred (fromEnum $ rank c) * (succ $ fromEnum (maxBound :: Color)) + fromEnum (color c) -- This is preferred over the above for efficient implementation of bestPossibleRank. intToCard :: Int -> Card-intToCard i = case i `divMod` (succ $ fromEnum (maxBound::Number)) of (c,k) -> C (toEnum c) (toEnum k)+intToCard i = case i `divMod` (succ $ fromEnum (maxBound::Rank)) of (c,k) -> C (toEnum c) (toEnum k) type Index = Int -- starts from 0  data Move = Drop {index::Index}            -- ^ drop the card (0-origin)           | Play {index::Index}            -- ^ play the card (0-origin)-          | Hint Int (Either Color Number) -- ^ give hint to the ith next player+          | Hint Int (Either Color Rank) -- ^ give hint to the ith next player             deriving (Eq, Ord, Generic) instance Show Move where     showsPrec _ (Drop i) = ("Drop"++) . shows i@@ -92,7 +98,7 @@                  where parseHint xs = [(Hint i eith, rest) | let (istr, ys) = splitAt 1 $ dropWhile isSpace xs -- These two lines is similar to @(i, ys) <- reads xs@,                                                            , (i, _) <- reads istr                              -- but additionally accepts something like "hint12".                                                            , let ys' = dropWhile isSpace ys-                                                           , (eith, rest) <- [ (Left c, zs) | (c,zs) <- readsColorChar ys' ] ++ [ (Right c, zs) | (c,zs) <- readsNumberChar ys' ] ]+                                                           , (eith, rest) <- [ (Left c, zs) | (c,zs) <- readsColorChar ys' ] ++ [ (Right c, zs) | (c,zs) <- readsRankChar ys' ] ]  -- | The help text. help :: String@@ -165,19 +171,34 @@                                     --   In the current implementation (arguably), this represents [current player's hand, next player's hand, second next player's hand, ...]                                     --   and this is rotated every turn.                 } deriving (Read, Show, Eq, Generic)+type ColorToRank = Int+-- | CardTo4 is the type synonym for Int64, representing Card -> {0,1,2,3}+type CardTo4     = Int64+lookupCardTo4 :: CardTo4 -> Card -> Int+lookupCardTo4 ct4 c = fromIntegral ((ct4 `shiftR` (cardToQitPos c * 2)) .&. 3)+deleteACard :: Card -> CardTo4 -> CardTo4+deleteACard c ct4 = ct4 - bit (cardToQitPos c * 2)+insertACard :: Card -> CardTo4 -> CardTo4+insertACard c ct4 = ct4 + bit (cardToQitPos c * 2)+-- something like @fmap abs@+absCardTo4 :: CardTo4 -> CardTo4+absCardTo4 ct4 = (ct4 .&. 0x5555555555555555) .|. ((ct4.&. 0x2AAAAAAAAAAAAAAA ) `shiftR` 1)+cardTo4ToList :: CardTo4 -> [Card]+cardTo4ToList ct4 = ctl ct4 [ C i k | k <- [K1 .. K5], i <- [White .. Multicolor] ]+ctl 0 _      = []+ctl n (c:cs) = replicate (fromIntegral n .&. 3) c ++ ctl (n `shiftR` 2) cs  -- | PublicInfo is the info that is available to all players. data PublicInfo = PI { gameSpec  :: GameSpec                      , pileNum   :: Int               -- ^ The number of cards at the pile.-                     , played    :: IM.IntMap Number  -- ^ @'Color' -> 'Number'@. The maximum number of successfully played cards of etch number.--                                                      -- Just a list with length 5 or 6 could do the job.-                     , discarded :: IM.IntMap Int     -- ^ @'Card' -> Int@. The multiset of discarded cards.+                     , currentScore :: Int+                     , nextToPlay :: CardTo4          -- ^ 3(4) or 11(2) if the card is playable (ignoring whether it is extinct or not), and 0(4) or 00(2) otherwise.+                     , kept     :: CardTo4           -- ^ The multiset of not-discarded cards, packed into Int64. -                     , nonPublic :: IM.IntMap Int     -- ^ @'Card' -> Int@. The multiset of Cards that have not been revealed to the public.-                                                      --   This does not include cards whose Color and Number are both revealed.+                     , nonPublic :: CardTo4     -- ^ The multiset of Cards that have not been revealed to the public.+                                                      --   This does not include cards whose Color and Rank are both revealed.                                                       ---                                                      --   This is redundant information that can be computed from 'played' and 'discarded'.+                                                      --   This is redundant information that can be computed from 'achieved' and 'discarded'.                      , turn      :: Int               -- ^ How many turns have been completed since the game started. This can be computed from 'pileNum', 'deadline', and @map length 'annotations'@.                      , lives      :: Int              -- ^ The number of black tokens. decreases at each failure                      , hintTokens :: Int              -- ^ The number of remaining hint tokens.@@ -194,18 +215,19 @@ possibilities_until_Ver0720 = map (map possibilities) . annotations  -- | 'Marks' is the type synonym representing the hint trace of a card.-type Marks = (Maybe Color, Maybe Number)+type Marks = (Maybe Color, Maybe Rank) --- | A 'Possibilities' is a pair of data that are instances of Bits. The first represents which colors are possible, and the second is for numbers.+-- | A 'Possibilities' is a pair of data that are instances of Bits. The first represents which colors are possible, and the second is for ranks. type Possibilities = (Int, Int)  colorToBitPos  :: Color -> Int colorToBitPos  i = 5 - fromEnum i-numberToBitPos :: Number -> Int-numberToBitPos k = 5 - fromEnum k+rankToBitPos :: Rank -> Int+rankToBitPos k = 5 - fromEnum k+numberToBitPos = rankToBitPos  data Annotation = Ann {ixDeck :: Int                   -- ^ Index in the initial deck-                      , marks :: Marks                 -- ^ The Number and Color hints given to the card.+                      , marks :: Marks                 -- ^ The Rank and Color hints given to the card.                       , possibilities :: Possibilities}   deriving (Eq, Generic) instance Show Annotation where@@ -214,24 +236,50 @@   readsPrec p str = [ (Ann i ms ps, rest) | ((i,ms,ps), rest) <- readsPrec p str ]    -- | the best achievable rank for each color.-bestPossibleRank :: PublicInfo -> Color -> Number+bestPossibleRank :: PublicInfo -> Color -> Rank+bestPossibleRank pub iro = toEnum $ (countTrailingZeros    ((((kept pub `shiftR` (fromEnum iro * 2)) .&. 0x3003003003003) - 0x1001001001001) .&. 0x4004004004004)   ) `div` 12+{- bestPossibleRank pub iro = toEnum $ length $ takeWhile (/=0) $ zipWith subtract (numEachCard (gameSpec pub) iro)-                                                                                (map ((discarded pub IM.!) . cardToInt . C iro) [K1 .. K5])+                                                                                [ discarded pub (C iro k) | k <- [K1 .. K5] ]+-}++-- | @discarded pub c@ represents the number of discarded @c@. Please rewrite old @discarded pub Data.IntMap.! cardToInt c@ into @discarded pub c@.+--   Implementation of @discarded@ is not very fast, and 'kept'/'keptCards' should be used instead for efficient implementation of your algorithms.+discarded :: PublicInfo -> Card -> Int+discarded pub c = (numEachCard (gameSpec pub) (color c) !! pred (fromEnum $ rank c)) - keptCards pub c+keptCards, nonPublicCards :: PublicInfo -> Card -> Int+keptCards pub = lookupCardTo4 (kept pub)+nonPublicCards = lookupCardTo4 . nonPublic+invisibleBagCards :: PrivateView -> Card -> Int+invisibleBagCards = lookupCardTo4 . invisibleBag numEachCard :: GameSpec -> Color -> [Int] numEachCard gs iro = if iro==Multicolor then numMulticolors $ rule gs else [3,2,2,2,1]+{-+packedNumEachCard :: GameSpec -> CardTo4+packedNumEachCard gs = 0x1AB6ADAB6ADAB .|. pack4 (numMulticolors $ rule gs) `shiftL` 50 -- <reverse numMulticolors>1222312223122231222312223 in base 4+pack4 :: [Int] -> CardTo4+pack4 [] = 0+pack4 (x:xs) = fromIntegral x .|. (pack4 xs `shiftL` 2) +-}+packedNumEachCard :: GameSpec -> CardTo4+packedNumEachCard gs = 0x1552AA2AA2AA3FF .|. (pack4 (numMulticolors $ rule gs) `shiftL` 10) -- <reverse numMulticolors> .|. 11111022222022222022222033333 in base 4+pack4 :: [Int] -> CardTo4+pack4 [] = 0+pack4 (x:xs) = fromIntegral x .|. (pack4 xs `shiftL` 12)+ -- | 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-                   || number card > bestPossibleRank pub (color card)+isUseless pub card =  rank card <= achievedRank pub (color card) -- the card is already played+                   || rank card > bestPossibleRank pub (color card) -- | A critical card is a useful card and the last card that has not been dropped. -- --   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) == (numEachCard (gameSpec pub) (color card) !! (pred $ fromEnum $ number card))+                      && keptCards pub card == 1  isPlayable :: PublicInfo -> Card -> Bool-isPlayable pub card = pred (number card) == achievedRank pub (color card)+isPlayable pub card = pred (rank card) == achievedRank pub (color card)  isHinted :: Marks -> Bool isHinted = not . (==(Nothing, Nothing))@@ -247,29 +295,38 @@ isMoreObviouslyPlayable pub = iOP (nonPublic pub) pub  obviously :: (PublicInfo -> Card -> Bool) -> PublicInfo -> Possibilities -> Bool-obviously predicate pub (pc,pn) = all (\card -> (nonPublic pub IM.! cardToInt card) == 0 || predicate pub card)-                                      [ C color number | color <- colorPossibilities pc, number <- numberPossibilities pn ]+obviously predicate pub pos@(pc,pn) = all (predicate pub) $ cardTo4ToList $ absCardTo4 $ possibilitiesQits pos .&. nonPublic pub+{-+obviously predicate pub (pc,pn) = all (\card -> (nonPublicCards pub card) == 0 || predicate pub card)+                                      [ C color number | color <- colorPossibilities pc, number <- rankPossibilities pn ]+-}+obviouslyQits :: (PublicInfo -> CardTo4) -> PublicInfo -> Possibilities -> Bool+obviouslyQits predicate pub pos = (possibilitiesQits pos .&. nonPublic pub .&. complement (predicate pub)) == 0 --- | In addition to 'isMoreObviouslyPlayable', 'isObviouslyPlayable' also looks into the color/number possibilities of the card and decides if the card is surely playable.+-- | In addition to 'isMoreObviouslyPlayable', 'isObviouslyPlayable' also looks into the color/rank possibilities of the card and decides if the card is surely playable. isObviouslyPlayable :: PublicInfo -> Possibilities -> Bool-isObviouslyPlayable = obviously isPlayable+isObviouslyPlayable = obviouslyQits nextToPlay  isObviouslyUnplayable :: PublicInfo -> Possibilities -> Bool-isObviouslyUnplayable = obviously (\pub -> not . isPlayable pub)+isObviouslyUnplayable = obviouslyQits (complement . nextToPlay)  definitely :: (PrivateView -> Card -> Bool) -> PrivateView -> Annotation -> Bool definitely predicate pv ann = all (predicate pv) $ possibleCards pv ann+definitelyQits :: (PrivateView -> CardTo4) -> PrivateView -> Annotation -> Bool+definitelyQits predicate pv Ann{marks = (Just c, Just n)} = predicate pv `testBit` (cardToQitPos (C c n) * 2) -- The condition is indispensable, because now invisibleBag considers fully-marked cards visible.+definitelyQits predicate pv Ann{possibilities = pos@(pc,pn)} = (possibilitiesQits pos .&. invisibleBag pv .&. complement (predicate pv)) == 0 + -- | In addition to 'isObviouslyPlayable', 'isDefinitelyPlayable' also looks at other players' hand and decides if the card is surely playable. {- This is a weaker version not looking into the possibilities. isDefinitelyPlayable :: PrivateView -> Marks -> Bool isDefinitelyPlayable pv = iOP (invisibleBag pv) (publicView pv) -} isDefinitelyPlayable :: PrivateView -> Annotation -> Bool-isDefinitelyPlayable = definitely (isPlayable . publicView)+isDefinitelyPlayable = definitelyQits (nextToPlay . publicView)  isDefinitelyUnplayable :: PrivateView -> Annotation -> Bool-isDefinitelyUnplayable = definitely (\pv -> not . isPlayable (publicView pv))+isDefinitelyUnplayable = definitelyQits (complement . nextToPlay . publicView)  -- | Unlike 'isDefinitelyUseless', 'isDefinitelyUnciritical' does not care whether the card is the last one or not. 'isDefinitelyUncritical' is, in other words, safe to drop. isDefinitelyUncritical :: PrivateView -> Annotation -> Bool@@ -282,12 +339,12 @@  possibleCards :: PrivateView -> Annotation -> [Card] possibleCards pv Ann{marks = (Just c, Just n)} = [C c n] -- The condition is indispensable, because now invisibleBag considers fully-marked cards visible.-possibleCards pv Ann{possibilities = (pc,pn)}  = [ card | color <- colorPossibilities pc, number <- numberPossibilities pn, let card = C color number, (invisibleBag pv IM.! cardToInt card) /= 0 ]+possibleCards pv Ann{possibilities = pos@(pc,pn)}  = cardTo4ToList $ absCardTo4 $ possibilitiesQits pos .&. invisibleBag pv                             where pub = publicView pv -iOP :: IM.IntMap Int -> PublicInfo -> (Maybe Color, Maybe Number) -> Bool+iOP :: CardTo4 -> PublicInfo -> (Maybe Color, Maybe Rank) -> Bool iOP _   pub (Just c, Just n) = isPlayable pub $ C c n-iOP bag pub (Nothing,Just n) = all (\card -> (bag IM.! cardToInt card) == 0 || isPlayable pub card) [ C color n | color <- colors pub ]+iOP bag pub (Nothing,Just n) = all (\card -> (lookupCardTo4 bag card) == 0 || isPlayable pub card) [ C color n | color <- colors pub ] iOP _   _   _                = False  -- | 'isMoreObviouslyUseless' looks at the publicly available current info and decides if the card is surely useless.@@ -306,9 +363,9 @@ {- This is a weaker version not looking into the possibilities. isDefinitelyUseless :: PrivateView -> Marks -> Bool isDefinitelyUseless pv (Just c,  Just n)  = isUseless (publicView pv) $ C c n-isDefinitelyUseless pv (Just c,  Nothing) = all ((==0) . (invisibleBag pv IM.!) . cardToInt . C c . toEnum) [ succ $ fromEnum $ achievedRank (publicView pv) c .. fromEnum $ bestPossibleRank (publicView pv) c ] -isDefinitelyUseless pv (Nothing, Just n)  = all (\c -> n <= achievedRank (publicView pv) c || bestPossibleRank (publicView pv) c < n || (invisibleBag pv IM.! cardToInt (C c n)) == 0 ) $ colors $ publicView pv-isDefinitelyUseless pv (Nothing, Nothing) = all (\c -> all ((==0) . (invisibleBag pv IM.!) . cardToInt . C c . toEnum) [ succ $ fromEnum $ achievedRank (publicView pv) c .. fromEnum $ bestPossibleRank (publicView pv) c ]) $ colors $ publicView pv+isDefinitelyUseless pv (Just c,  Nothing) = all ((==0) . (invisibleBagCards pv) . C c . toEnum) [ succ $ fromEnum $ achievedRank (publicView pv) c .. fromEnum $ bestPossibleRank (publicView pv) c ] +isDefinitelyUseless pv (Nothing, Just n)  = all (\c -> n <= achievedRank (publicView pv) c || bestPossibleRank (publicView pv) c < n || (invisibleBagCards pv (C c n)) == 0 ) $ colors $ publicView pv+isDefinitelyUseless pv (Nothing, Nothing) = all (\c -> all ((==0) . (invisibleBagCards pv) . C c . toEnum) [ succ $ fromEnum $ achievedRank (publicView pv) c .. fromEnum $ bestPossibleRank (publicView pv) c ]) $ colors $ publicView pv -} -- In fact, invisibleBag should be included in PrivateView for efficiency of isDefinitelyUseless, etc., but should not be sent via WebSocket. This is the matter of Read and Show (or ToJSON and FromJSON). @@ -329,29 +386,20 @@ chops pub anns = concat $ map reverse $ obviousChopss pub anns  isDoubleDrop :: PrivateView -> Result -> [Index] -> Annotation -> Bool-isDoubleDrop pv@PV{publicView=pub} (Discard c@C{..}) [_i] Ann{possibilities=(pc,pn)} = not (any ((==(Just color, Just number)).marks) myAnns) &&  -- This pattern captures: the last player discards B1; I have a card which is hinted as B and 1; I don't know where the third B1 is.+isDoubleDrop pv@PV{publicView=pub} (Discard c@C{..}) [_i] Ann{possibilities=(pc,pn)} = not (any ((==(Just color, Just rank)).marks) myAnns) &&  -- This pattern captures: the last player discards B1; I have a card which is hinted as B and 1; I don't know where the third B1 is.                                                                                                                         -- This can be improved to check whether any card other than the chop is obviously the just-dropped card or not, by looking at the Possibilities.                                                                     isCritical pub c &&                                                                     color  `elem` colorPossibilities pc &&-                                                                    number `elem` numberPossibilities pn &&-                                                                    (invisibleBag pv IM.! cardToInt c) > 0+                                                                    rank   `elem` rankPossibilities pn &&+                                                                    invisibleBagCards pv c > 0                                          where myAnns = head $ annotations pub isDoubleDrop _pv _lastresult _chopset _anns = False  colors :: PublicInfo -> [Color] colors pub = take (numColors $ rule $ gameSpec pub) [minBound .. maxBound] -achievedRank :: PublicInfo -> Color -> Number-achievedRank pub k = case IM.lookup (fromEnum k) (played pub) of-                            Just n  -> n-#ifdef DEBUG-                            Nothing | numColors (rule $ gameSpec pub) <= k -> error "requesting invalid color."-                                    | otherwise                            -> error "PublicInfo is not initialized."-#else-                            Nothing -> Empty-#endif-currentScore :: PublicInfo -> Int-currentScore pub = sum [ fromEnum $ achievedRank pub k | k <- colors pub ]+achievedRank :: PublicInfo -> Color -> Rank+achievedRank pub k = toEnum  $  countTrailingZeros ((nextToPlay pub `shiftR` (2 * fromEnum k)) .&. 0x3003003003003)  `div`  12  -- | achievable score based on the info of extinct cards. seeminglyAchievableScore :: PublicInfo -> Int@@ -387,7 +435,7 @@                       , handsPV :: [[Card]]           -- ^ Other players' hands. [next player's hand, second next player's hand, ...]                                                       --   This is based on the viewer's viewpoint (unlike 'hands' which is based on the current player's viewpoint),                                                       --   and the view history @[PrivateView]@ must be from the same player's viewpoint (as the matter of course).-                      , invisibleBag :: IM.IntMap Int -- ^ @'Card' -> Int@. 'invisibleBag' is the bag of unknown cards (which are either in the pile or in the player's hand and not fully hinted).+                      , invisibleBag :: CardTo4       -- ^ 'invisibleBag' is the bag of unknown cards (which are either in the pile or in the player's hand and not fully hinted).                       } deriving (Generic) -- ToDo: Instance for Generic should also be specialized for efficiency. instance Show PrivateView where   showsPrec p (PV pub h _) = showsPrec p (pub,h)@@ -451,11 +499,11 @@  validMoves :: PrivateView -> [Move] validMoves pv@PV{publicView=pub@PI{gameSpec=gs,hintTokens=hints},handsPV=tlHands}-  = map Play [0 .. pred myHandSize] ++ (if hints > 0 then ([ Hint hintedpl eck | hintedpl <- [1 .. numPlayers gs - 1], eck <- map Left (colors pub) ++ map Right [K1 .. K5], not (null $ filter (either (\c -> (==c).color) (\k -> (==k).number) eck) (tlHands !! pred hintedpl)) ] ++) else id) (if hints < 8 then (map Drop [0 .. pred myHandSize]) else [])+  = map Play [0 .. pred myHandSize] ++ (if hints > 0 then ([ Hint hintedpl eck | hintedpl <- [1 .. numPlayers gs - 1], eck <- map Left (colors pub) ++ map Right [K1 .. K5], not (null $ filter (either (\c -> (==c).color) (\k -> (==k).rank) eck) (tlHands !! pred hintedpl)) ] ++) else id) (if hints < 8 then (map Drop [0 .. pred myHandSize]) else [])                   where myHandSize = length (head $ annotations pub)  evalMove :: (Monad m, Strategies ps m) => [(State, Int)] -> [PublicInfo] -> [Move] -> ps -> Move -> m Int-evalMove states pubs@(pub:_) mvs ps mv = fmap (sum . map (\(((eg,_,_),_),n) -> n * egToInt pub eg)) $ mapM (\(st,n) -> fmap (\a->(a,n)) $ tryAMove (stateToStateHistory pubs mvs st) mvs ps mv) states+evalMove states pubs@(pub:_) mvs ps mv = fmap (sum . map (\(((eg,st:_,_),_),n) -> n * egToInt st eg)) $ mapM (\(st,n) -> fmap (\a->(a,n)) $ tryAMove (stateToStateHistory pubs mvs st) mvs ps mv) states  -- | 'tryAMove' tries a 'Move' and then simulate the game to the end, using given 'Strategies'. Running this with empty history, such as @tryAMove [st] [] strs m@ is possible, but that assumes other strategies does not depend on the history. tryAMove :: (Monad m, Strategies ps m) => [State] -> [Move] -> ps -> Move -> m ((EndGame, [State], [Move]),ps)@@ -517,7 +565,7 @@ evalMoveLite statess@((st:_,_,_):_) mvs p mov = do                                     roundResults <- mapM (\sts ->tryAMoveARound sts mvs mov) statess                                     let pub = publicState st-                                        instantScore = sum [ egToInt pub eg * n | ((Just eg, _, _), _, n) <- roundResults ]+                                        instantScore = sum [ egToInt s eg * n | ((Just eg, s:_, _), _, n) <- roundResults ]                                         roundResultMap = groupARound pub roundResults                                     if M.null roundResultMap then return (roundResultMap, instantScore) else do                                        let roundResults = M.elems roundResultMap@@ -561,15 +609,15 @@ possiblePermutations :: PrivateView -> [([Card],[Card])] possiblePermutations pv@PV{publicView=PI{annotations=anns:_}} = possiblePerms anns (invisibleCards pv) invisibleCards :: PrivateView -> [Card]-invisibleCards PV{publicView=PI{annotations=anns}, invisibleBag=inv} = [ c | (k,v) <- IM.toList inv, c <- replicate v $ intToCard k ] -- x ++ [ C i k | (Just i, Just k) <- map marks anns ]+invisibleCards PV{publicView=PI{annotations=anns}, invisibleBag=inv} = cardTo4ToList inv -- x ++ [ C i k | (Just i, Just k) <- map marks anns ] possiblePerms :: [Annotation] -> [Card] -> [([Card],[Card])] possiblePerms [] cards = [([],cards)] possiblePerms (Ann{marks = (Just i, Just k)} : anns) cards = [ (C i k : hand, deck) | (hand, deck) <- possiblePerms anns cards ]-possiblePerms (Ann{possibilities = (pi, pk)} : anns) cards = [ (card : hand, deck) | card@(C i k) <- cards, (pi .&. bit (colorToBitPos i)) * (pk .&. bit (numberToBitPos k)) /= 0, (hand, deck) <- possiblePerms anns $ delete card cards ]+possiblePerms (Ann{possibilities = (pi, pk)} : anns) cards = [ (card : hand, deck) | card@(C i k) <- cards, (pi .&. bit (colorToBitPos i)) * (pk .&. bit (rankToBitPos k)) /= 0, (hand, deck) <- possiblePerms anns $ delete card cards ]  -- | 'mkPV' is the constructor of PrivateView. mkPV :: PublicInfo -> [[Card]] -> PrivateView-mkPV pub hs = PV pub hs $ foldr (IM.update (Just . pred)) (nonPublic pub) $ map cardToInt $ concat $ [ C c n | Ann{marks=(Just c, Just n)} <- head $ annotations pub ] : hs+mkPV pub hs = PV pub hs $ foldr deleteACard (nonPublic pub) $ concat $ [ C c n | Ann{marks=(Just c, Just n)} <- head $ annotations pub ] : hs  prettyPV :: Verbosity -> PrivateView -> String prettyPV v pv@PV{publicView=pub} = prettyPI pub ++ "\nYour hand:\n"@@ -624,11 +672,13 @@ showHintLine wrapper hl = concat [ wrapper $ '|' : maybe ' ' (head . show) mc : maybe ' ' (head . show . fromEnum) mk : "|" | (mc,mk) <- hl] ++ "\n" showPosLines :: [Possibilities] -> String showPosLines ps = concat [ ' ' : showColorPossibilities  cs | (cs,_) <- ps] ++ "\n"-               ++ concat [ showNumberPossibilities ns ++" " | (_,ns) <- ps]+               ++ concat [ showRankPossibilities ns ++" " | (_,ns) <- ps] -showColorPossibilities, showNumberPossibilities :: Int -> String+showColorPossibilities, showRankPossibilities :: Int -> String showColorPossibilities  = reverse . showPossibilities ' ' colorkeys-showNumberPossibilities = reverse . showPossibilities ' ' "54321 "+showRankPossibilities = reverse . showPossibilities ' ' "54321 "+showNumberPossibilities = showRankPossibilities+ colorkeys :: String colorkeys = map (head . show) [maxBound, pred maxBound .. minBound::Color] -- colorkeys == "MBGRYW", but I just prefer to make this robust to changes in the order. showPossibilities :: a -> [a] -> Int -> [a]@@ -637,10 +687,33 @@  colorPossibilities  :: Int -> [Color] -- The result is in the reverse order but I do not care. colorPossibilities  = concat . showPossibilities [] (map (:[]) [maxBound, pred maxBound .. minBound])-numberPossibilities :: Int -> [Number] -- The result is in the reverse order but I do not care.-numberPossibilities = concat . showPossibilities [] (map (:[]) [K5,K4 .. K1])-+rankPossibilities :: Int -> [Rank] -- The result is in the reverse order but I do not care.+rankPossibilities = concat . showPossibilities [] (map (:[]) [K5,K4 .. K1]) +possibilitiesQits :: (Int,Int) -> CardTo4+possibilitiesQits (c,r) = colorPossibilitiesQits c .&. rankPossibilitiesQits r+colorPossibilitiesQits :: Int -> CardTo4+colorPossibilitiesQits i = let bs = cpq i+                               qs = fromIntegral $ bs .|. (bs `shiftL` 1)+                               qs2 = qs .|. (qs `shiftL` 12) +                               qs4 = qs2 .|. (qs2 `shiftL` 24)+                               qs5 = qs .|. (qs4 `shiftL` 12)+                           in qs5+cpq :: Int -> Int+cpq i = (i .&. 32 .|. (i .&. 16) `shiftL` 3 .|. (i .&. 8) `shiftL` 6 .|. (i .&. 4) `shiftL` 9 .|. (i .&. 2) `shiftL` 12 .|. (i .&. 1) `shiftL` 15) `shiftR` 5+rankPossibilitiesQits :: Int -> CardTo4+rankPossibilitiesQits i = let r1 = rpq i+                              r2 = r1 .|. (r1 `shiftR` 1)+                              r4 = r2 .|. (r2 `shiftR` 2)+                              r8 = r4 .|. (r4 `shiftR` 4)+                              r12 = r4 .|. (r8 `shiftR` 4)+                          in r12+rpq :: Int -> CardTo4+rpq i = let i1 = fromIntegral $ i `shiftL` 7+            i2 = i1 .|. (i1 `shiftL` 13)+            i4 = i2 .|. (i2 `shiftL` 26)+            i5 = i1 .|. (i4 `shiftL` 13)+        in i5 .&. 0x800800800800800  -- | 'Verbosity' is the set of options used by verbose 'Strategy's data Verbosity = V { warnCritical :: Bool -- ^ mark unhinted critical cards with "!!" ("!^" if it is playable and markPlayable==True.)@@ -678,7 +751,7 @@                                    , let playedMax = achievedRank pub c                                          possible  = fromEnum $ bestPossibleRank pub c                                    ]-            ++ "\ndropped: " ++ concat [ '|' : concat (replicate n $ show $ intToCard ci) | (ci,n) <- IM.toList $ discarded pub ] ++"|\n"+            ++ "\ndropped: " ++ concat [ '|' : concat (replicate (discarded pub c) $ show c) | i <- colors pub, k <- [K1 .. maxBound], let c = C i k ] ++"|\n"  view :: State -> PrivateView view st = mkPV (publicState st) (tail $ hands st)@@ -927,13 +1000,14 @@ -- | 'createGameFromCards' deals cards and creates the initial state. createGameFromCards :: GameSpec -> [Card] -> State createGameFromCards gs cards = splitCons (numPlayers gs) [] [ (c, initAnn gs i) | (c,i) <- zip cards [0..] ]-           where splitCons 0 hnds stack-                   = St {publicState = PI {gameSpec   = gs,+           where pNEC = packedNumEachCard gs+                 splitCons 0 hnds stack+                    = 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],-                                                                                                   k <- [K1 ..K5] ],-                                            nonPublic  = cardMap $ rule gs,+                                            currentScore = 0,+                                            nextToPlay = 0xFFF,+                                            kept       = pNEC,+                                            nonPublic  = pNEC,                                             turn       = 0,                                             lives      = numBlackTokens $ rule gs,                                             hintTokens = 8,@@ -953,15 +1027,13 @@ createDeck r gen = shuffle (cardBag r) gen  -numAssoc :: [(Number, Int)]+numAssoc :: [(Rank, Int)] numAssoc = zip [K1 ..K5] [3,2,2,2,1] cardAssoc :: Rule -> [(Card,Int)] cardAssoc rule = take (5 * numColors rule) $                [ (C i k, n) | i <- [White .. pred Multicolor], (k,n) <- numAssoc ] ++ [ (C Multicolor k, n) | (k, n) <- zip [K1 ..K5] (numMulticolors rule) ] cardBag :: Rule -> [Card] cardBag rule = concat         [ replicate n c | (c,n) <- cardAssoc rule ]-cardMap :: Rule -> IM.IntMap Int-cardMap rule = IM.fromList [ (cardToInt c, n) | (c,n) <- cardAssoc rule ] unknown :: GameSpec -> Possibilities unknown gs = (64 - bit (6 - numColors (rule gs)),  31) @@ -982,7 +1054,7 @@                                            hintedpl > 0 && hintedpl < numPlayers (gameSpec pub) &&    -- existing player other than the current                                            not (null $ filter willBeHinted (tlHands !! pred hintedpl))     where willBeHinted :: Card -> Bool-          willBeHinted = either (\c -> (==c).color) (\k -> (==k).number) eck+          willBeHinted = either (\c -> (==c).color) (\k -> (==k).rank) eck pickNth :: Int -> [a] -> (a, [a]) pickNth    n   xs = case splitAt n xs of (tk,nth:dr) -> (nth,tk++dr) replaceNth :: Int -> a -> [a] -> (a, [a])@@ -1007,8 +1079,8 @@   prc (Drop _) = st{pile = nextPile,                     hands = nextHands,                     publicState = pub{pileNum = nextPileNum,-                                      discarded = IM.update (Just . succ) (cardToInt nth) $ discarded pub,-                                      nonPublic = IM.update (Just . pred) (cardToInt nth) $ nonPublic pub,+                                      kept = deleteACard nth $ kept pub,+                                      nonPublic = deleteACard nth $ nonPublic pub,                                       turn       = succ $ turn pub,                                       hintTokens = succ $ hintTokens pub,                                       annotations = nextAnns,@@ -1018,14 +1090,16 @@                | otherwise = st{pile = nextPile,                                 hands = nextHands,                                 publicState = pub{pileNum = nextPileNum,-                                                  played = IM.update (Just . succ) (fromEnum $ color nth) (played pub),-                                                  nonPublic = IM.update (Just . pred) (cardToInt nth) $ nonPublic pub,+                                                  currentScore = succ $ currentScore pub,+                                                  nextToPlay = ((nextToPlay pub .&. complement mask)  .|.  ((nextToPlay pub .&. mask) `shiftL` 12)) .&. 0xFFFFFFFFFFFFFFF,+                                                  nonPublic = deleteACard nth $ nonPublic pub,                                                   turn       = succ $ turn pub,-                                                  hintTokens = if hintTokens pub < 8 && number nth == K5 then succ $ hintTokens pub else hintTokens pub,+                                                  hintTokens = if hintTokens pub < 8 && rank nth == K5 then succ $ hintTokens pub else hintTokens pub,                                                   annotations = nextAnns,                                                   deadline   = nextDeadline,                                                   result = Success nth}}     where failure = not $ isPlayable pub nth+          mask = 0x3003003003003 `shiftL` (fromEnum (color nth) * 2)   prc (Hint hintedpl eik) = st{publicState = pub{hintTokens = pred $ hintTokens pub,                                                  turn       = succ $ turn pub,                                                  annotations = snd $ updateNth hintedpl newAnns (annotations pub),@@ -1039,7 +1113,7 @@                             where ibit = colorToBitPos i                           Right k | k == ka -> ann{marks=(mi, Just k), possibilities = (c, bit kbit)}                                   |otherwise-> ann{possibilities = (c, clearBit n kbit)}-                            where kbit = numberToBitPos k+                            where kbit = rankToBitPos k   -- | @'rotate' num@ rotates the first person by @num@ (modulo the number of players).@@ -1053,14 +1127,15 @@ data EndGame = Failure | Soso Int | Perfect deriving (Show,Read,Eq,Generic)  egToInt _   Failure  = 0-egToInt _   (Soso n) = n-egToInt pub Perfect  = 5 * numColors (rule $ gameSpec pub)+egToInt st  _        = currentScore $ publicState st  checkEndGame :: PublicInfo -> Maybe EndGame checkEndGame pub | lives pub == 0                                      = Just Failure-                 | all (==K5) [ achievedRank pub k | k <- colors pub ] = Just Perfect+                 | current == numColors r * 5                          = Just Perfect                  | deadline pub == Just 0 ||-                   (earlyQuit (rule $ gameSpec pub) && currentScore pub == seeminglyAchievableScore pub)-                                                                       = Just $ Soso $ IM.foldr (+) 0 $ fmap fromEnum $ played pub+                   (earlyQuit r && current == seeminglyAchievableScore pub)+                                                                       = Just $ Soso current                  | hintTokens pub == 0 && null (head $ annotations pub) = Just Failure -- No valid play is possible for the next player. This can happen when prolong==True.                  | otherwise                                           = Nothing+  where current = currentScore pub+        r = rule $ gameSpec pub

@@ -26,7 +26,7 @@ import System.IO.Error(isEOFError) import Control.Exception import Data.Char(isSpace)-+import Data.List(sort) import Data.Time  import System.Console.GetOpt@@ -215,10 +215,13 @@ interpret mbVerb inp params   = let sender :: String -> IO ()         sender = sendTextData (conn params) . endecodeX mbVerb . Str-        createR observe creater args = case reads args of [(rule,rest)] | isRuleValid rule -> create observe creater rule rest-                                                          _             -> create observe creater defaultRule args-        create :: Bool -> Maybe Int -> Rule -> String -> IO ()-        create observe from rule args =+        createR observe creater args = case reads args of [(rule,rest)] | isRuleValid rule -> createD observe creater rule rest+                                                          _             -> createD observe creater defaultRule args+        createD observe from rule args = case reads args of [(deck,';':rest)] | sort (cardBag rule) == sort deck -> create observe from rule deck args+                                                                              | otherwise                        -> sender $ "Invalid deck!\ndeck = " ++ show deck+                                                            _             -> create observe from rule [] args+        create :: Bool -> Maybe Int -> Rule -> [Card] -> String -> IO ()+        create observe from rule deck args =                               case wordsBy (==',') args of                                 is | numAllies > 0 -> if numAllies >= 9                                                       then sender "Too many teammates!\n"@@ -242,7 +245,8 @@                                                                let playerList | observe = ixSs                                                                               |otherwise= mkDS "via WebSocket" (VWS (conn params) mbVerb sendFullHistoryInFact) : ixSs                                                                    (playOrder,g) = orderPlayers from (gen params) playerList-                                                                   (shuffled, _) = createDeck rule g+                                                                   shuffled | null deck = fst $ createDeck rule g+                                                                            | otherwise = deck                                                                eithFinalSituation <- try $ if observe then sender ("The initial deck is " ++ show shuffled) >>                                                                                                            startFromCards (GS numAllies rule)        [watch (conn params) mbVerb] playOrder shuffled                                                                                                       else startFromCards (GS (succ numAllies) rule) []                           playOrder shuffled

@@ -16,7 +16,7 @@ import qualified Data.Map as M import qualified Data.IntMap as IM import Data.Maybe(fromJust, isNothing)-import Data.List(intersperse, transpose)+import Data.List(sort, intersperse, transpose)  import           Miso         hiding (Fail) import           Miso.String  (MisoString)@@ -31,6 +31,8 @@  import Control.Concurrent +import Game.Hanabi.FFI+ #ifdef ghcjs_HOST_OS client :: Game.Hanabi.Msg.Options -> IO () client options = clientJSM options@@ -82,10 +84,10 @@                            defStr = maybe "via WebSocket" id $ lookup "strategy" query                        mvStr <- liftIO newMVarStrategy                        startApp App{-    model  = Model{tboxval = Message "available", players = [S.pack defStr], from = Just 0, rule = defaultRule{numMulticolors=replicate 5 1}, received = [CreateGame], fullHistory = False, showVerbosity = False, verbosity = verbose, play = True, localStrategy = mvStr, local = False},+    model  = Model{tboxval = Message "available", players = [S.pack defStr], from = Just 0, rule = defaultRule{numMulticolors=replicate 5 1}, received = [CreateGame], shownHistory = defaultShownHistory, showVerbosity = False, verbosity = verbose, play = True, localStrategy = mvStr, local = False, initialDeck = [], lastMoves = [], preset = False},     update = updateModel options,     view   = appView strNames $ version options,-    subs   = [ websocketSub wsURI protocols HandleWebSocket ],+    subs   = [ websocketSub wsURI protocols HandleWebSocket, windowBottomSub ViewMore Id ],     events = defaultEvents,     initialAction = Id,     -- initialAction = SendMessage $ Message "available", -- Seemingly sending as initialAction does not work, even if connect is executed before send.@@ -123,7 +125,7 @@ updateModel :: Game.Hanabi.Msg.Options -> Action -> Model -> Effect Action Model updateModel _ (HandleWebSocket (WebSocketMessage (Message m))) model   = noEff model{ received = {- take lenHistory $ -} suppressCG $ decodeMsg m : received model }-updateModel _ (SendMessage msg@(Message str)) model = model{fullHistory=False, showVerbosity=False} <# -- connect uri protocols >>+updateModel _ (SendMessage msg@(Message str)) model = model{shownHistory=defaultShownHistory, showVerbosity=False} <# -- connect uri protocols >>                                                 if local model                                                 then case reads $ S.unpack str of                                                        [(m,str)] -> liftIO $ do@@ -132,7 +134,7 @@                                                          return $ ProcMsg msg                                                        _         -> return $ ProcMsg $ Str "Could not parse as a Move."                                                 else send msg >> return Id-updateModel _ (SendMove mov)    model = model{fullHistory=False, showVerbosity=False} <# -- connect uri protocols >>+updateModel _ (SendMove mov)    model = model{shownHistory=defaultShownHistory, showVerbosity=False} <# -- connect uri protocols >>                                                 if local model                                                 then liftIO $ do                                                          putMVar (mvMov $ localStrategy model) mov@@ -150,16 +152,20 @@ updateModel _ (UpdatePlayer ix pl) model = noEff model{players = snd $ replaceNth ix pl $ players model} updateModel _ (UpdateRule r)    model = noEff model{rule=makeRuleValid r} updateModel _ (UpdateVerbosity v) model = noEff model{verbosity = v}-updateModel _ Toggle            model = noEff model{fullHistory = not $ fullHistory model}+updateModel _ (UpdateDeck ds)   model = noEff $ case reads $ S.unpack ds of [(d, rs)] | all isSpace rs -> model{initialDeck = d}+                                                                            _         -> model+updateModel _ ViewMore          model = noEff model{shownHistory = shownHistory model + historyUnit} updateModel _ ToggleVerbosity   model = noEff model{showVerbosity = not $ showVerbosity model} updateModel _ TogglePlay        model | play model && length (players model) < 2 = noEff model{play = False, players = head (players model) : players model}                                       | otherwise                                = noEff model{play = not $ play model}+updateModel _ TogglePreset     model = noEff model{preset = not $ preset model} updateModel opt ObserveLocally model = model <# liftIO (do                                                    let constructor algIx = fromJust $ lookup algIx $ strategies opt                                                    playerList <- mapM (constructor . S.unpack) $ reverse $ players model                                                    gen <- newGen                                                    let (playOrder,g) = orderPlayers (from model) gen playerList-                                                       (shuffled, _) = createDeck (rule model) g+                                                       shuffled | preset model && sort (cardBag $ rule model) == sort (initialDeck model) = initialDeck model -- sort (cardBag $ rule model) could be memoized if necessary.+                                                                | otherwise    = fst $ createDeck (rule model) g                                                    (fs,_) <- startFromCards (GS (length playerList) (rule model)) [] playOrder shuffled                                                    return $ WriteLocalResult shuffled fs                                                 )@@ -171,13 +177,14 @@                                                    let thePlayerList = mkDS "local strategy" (localStrategy model) : playerList                                                    gen <- newGen                                                    let (playOrder,g) = orderPlayers (from model) gen thePlayerList-                                                       (shuffled, _) = createDeck (rule model) g+                                                       shuffled | preset model && sort (cardBag $ rule model) == sort (initialDeck model) = initialDeck model -- sort (cardBag $ rule model) could be memoized if necessary.+                                                                | otherwise    = fst $ createDeck (rule model) g                                                    forkIO $ do (fs,_) <- startFromCards (GS (length thePlayerList) (rule model)) [] playOrder shuffled                                                                putMVar (mvMsg $ localStrategy model) $ PrettyEndGame shuffled $ Just fs                                                    msg <- takeMVar (mvMsg $ localStrategy model)                                                    return $ ProcMsg msg                                                 )-updateModel _ (ProcMsg msg@(PrettyEndGame shuffled (Just fs))) model = model{local=False, received = CreateGame : msg : received model} <# return (SendMessage $ Message "available")+updateModel _ (ProcMsg msg@(PrettyEndGame shuffled (Just fs@(_,_,mvs)))) model = model{local=False, received = CreateGame : msg : received model, initialDeck = shuffled, lastMoves = mvs} <# return (SendMessage $ Message "available") updateModel _ (ProcMsg msg@(WhatsUp _ _ _))           model = noEff model{received = msg : received model} updateModel _ (ProcMsg msg)                           model = model{received = msg : received model} <# liftIO (do                                                    msg <- takeMVar (mvMsg $ localStrategy model)@@ -205,13 +212,15 @@   | UpdatePlayer Int MisoString   | UpdateRule Rule   | UpdateVerbosity Verbosity-  | Toggle+  | ViewMore   | ToggleVerbosity   | TogglePlay   | ObserveLocally   | WriteLocalResult [Card] (EndGame, [State], [Move])   | PlayLocally   | ProcMsg Msg+  | TogglePreset+  | UpdateDeck MisoString   | Id  data Model = Model {@@ -220,16 +229,20 @@   , from :: Maybe Int   , rule :: Rule   , received :: [Msg]-  , fullHistory :: Bool+  , shownHistory :: Int   , showVerbosity :: Bool   , verbosity :: Verbosity   , play :: Bool   , localStrategy :: MVarStrategy   , local :: Bool+  , initialDeck :: [Card]+  , lastMoves :: [Move]+  , preset :: Bool   } deriving (Show, Eq) -lenShownHistory :: Int-lenShownHistory = 10+defaultShownHistory, historyUnit :: Int+defaultShownHistory = 10+historyUnit = 10 appView :: [MisoString] -> String -> Model -> View Action appView strategies versionInfo mdl@Model{..} = div_ [] [    input_  [ type_ "text", placeholder_ "You can also use your keyboard.", size_ "25", onInput UpdateTBoxVal, onEnter (SendMessage tboxval) ]@@ -244,11 +257,11 @@   , span_ [style_ $ M.fromList [("clear","both"), ("font-size","10px"), ("float","right")]] [text $ S.pack $ "hanabi-dealer client "++versionInfo] -- , hr_ []- , div_ [style_ $ M.fromList [("clear","both")]] $ ((if fullHistory then id else take lenShownHistory) $ map (renderMsg strategies verbosity mdl) received)- , div_ [] $ if null $ drop lenShownHistory received then [] else [+ , div_ [style_ $ M.fromList [("clear","both")]] $ take shownHistory $ map (renderMsg strategies verbosity mdl) received+ , div_ [] $ if null $ drop shownHistory received then [] else [      hr_ []-   , input_ [ type_ "checkbox", id_ "showhist", onClick Toggle, checked_ fullHistory]-   , label_ [for_ "showhist"] [text "Show full history"]+   , input_ [ type_ "checkbox", id_ "showhist", onClick ViewMore, checked_ False] -- This should be replaced with a button.+   , label_ [for_ "showhist"] [text "Show more history"]    ]  ] renderVerbosity :: Verbosity -> View Action@@ -304,7 +317,10 @@ renderMsg _ _    _ (Str xs)             = div_ [] [hr_ [], pre_ [] [ text $ S.pack xs ]] renderMsg _ verb _ (WhatsUp name ps ms) = renderWhatsUp  verb name ps ms renderMsg _ verb _ (WhatsUp1     p  m)  = renderWhatsUp1 verb p m-renderMsg _ _    _ (PrettyEndGame initDeck Nothing)     = pre_ [] [ text $ S.pack $ prettyMbEndGame Nothing ++ "By the way, the initial deck was " ++ shows initDeck ".\n"]+renderMsg _ _    _ (PrettyEndGame initDeck Nothing)     = p_ [style_ $ M.fromList [("font-size", "2vw")]] [+    text $ S.pack $ prettyMbEndGame Nothing ++ "By the way, the initial deck was ",+    span_ [style_ $ M.fromList [("font-family", "monospace"), ("font-size", "1.5vw")]] [ text $ S.pack $ shows initDeck "."]+  ] renderMsg _ verb _ (PrettyEndGame initDeck (Just tup))  = renderEndGame verb initDeck tup -- pre_ [] [ text $ S.pack $ prettyEndGame initDeck tup] renderMsg _ verb _ (Watch st [])           = div_ [style_ $ M.fromList [("font-size", "2vmin")]] [          hr_ [],@@ -325,13 +341,13 @@            caption_ [] [text $ S.pack "Available games", button_ [onClick $ SendMessage $ Message "available"] [text $ S.pack "refresh"]] :            tr_ [] [ th_ [solid] [text $ S.pack str] | str <- ["Game ID", "available", "total"] ] :            map renderAvailable games,-      div_ [] $ renderCreateGame True strategies mdl,+      renderCreateGame True strategies mdl,       hr_ []     ]-renderMsg strategies _ mdl CreateGame = div_ [] $ renderCreateGame False strategies mdl-renderCreateGame :: Bool -> [MisoString] -> Model -> [View Action]+renderMsg strategies _ mdl CreateGame = renderCreateGame False strategies mdl+renderCreateGame :: Bool -> [MisoString] -> Model -> View Action renderCreateGame online strategies mdl-    = [+    = div_ [style_ $ M.fromList [{- ("border-style","solid"), -} ("display","inline-block")]] $ [            table_ [solid] $ caption_ [textProp "text-align" "left", textProp "margin-left" "auto"] [ -- Seemingly these styles do not work.              text "Players",              button_ [onClick IncreasePlayers] [text $ S.pack "+"],@@ -366,7 +382,7 @@                  gs = GS{numPlayers = length (players mdl) + if play mdl then 1 else 0,                          Game.Hanabi.rule = rule mdl}              in-               table_ [solid] $ [+               table_ [style_ $ M.fromList [("margin","1%"),("border-style","solid")]] $ [ -- Use "1% auto" instead in order to centralize.                    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],@@ -379,13 +395,18 @@                    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]"]],+             span_ [] $+                      input_ [ type_ "checkbox", id_ "preset", onClick TogglePreset, checked_ $ preset mdl ] :+                      label_ [for_ "preset"] [text "preset deck"] : -- [if preset mdl then text "preset deck" else s_ [] [text "preset deck"]] :+                      if preset mdl || not (null $ initialDeck mdl) then [input_ [type_ "text", onInput UpdateDeck, (if preset mdl then value_ else placeholder_) $ S.pack $ show $ initialDeck mdl]] else [],              button_ [onClick $                         if not online && all (not . isWS . S.unpack) (players mdl)                            then if play mdl then PlayLocally else ObserveLocally                            else SendMessage $ Message $ S.pack $ (case from mdl of Just n  | play mdl  -> "from " ++ shows n " "                                                                                            | otherwise -> "observe " ++ shows n " "                                                                                    Nothing | play mdl  -> "shuffle "-                                                                                           | otherwise -> "observe ") ++ show (rule mdl) ++ concat (intersperse "," $ map S.unpack $ reverse $ players mdl)+                                                                                           | otherwise -> "observe ") ++ show (rule mdl) ++ (if preset mdl then shows (initialDeck mdl) . (';':) else id) (concat (intersperse "," $ map S.unpack $ reverse $ players mdl)),+                      style_ $ M.fromList [("float","right")]                      ] [text $ S.pack "create a game"]       ]     where you =  span_[][@@ -440,12 +461,21 @@          hr_ [],          renderSt verb ithPlayerFromTheLast st,          hr_ [],-         text $ S.pack $ "By the way, the initial deck was " ++ shows initDeck "\n and the move histories are" ++ tail (foldr showsMoves "." histories),-         hr_ []+         span_ [style_ $ M.fromList [("font-size", "2.5vmin")]] [+             text $ S.pack $ "By the way, the initial deck was ",+             div_ [style_ $ M.fromList [("font-family", "monospace"), ("font-size", "1.5vw")]] [+                 text $ S.pack $ show initDeck+                 ],+             span_ [] (if length histories > 9 then [text " and the move histories are ",+                                                     div_ [style_ $ M.fromList [("font-family", "monospace"), ("font-size", "1.5vw")]] [ text $ S.pack $ tail (foldr showsMoves "." $ transpose histories) ]+                                                    ]+                                               else []),+             hr_ []+           ]          ]-    where histories = transpose $ chopEvery (numPlayers $ gameSpec $ publicState st) $ reverse mvs+    where histories = chopEvery (numPlayers $ gameSpec $ publicState st) $ reverse mvs           showsMoves :: [Move] -> ShowS-          showsMoves mvs rest = ", " ++ filter (\c -> not (isLower c || c == 'H')) (foldr shows rest mvs)+          showsMoves mvs rest = ",\n" ++ filter (\c -> not (isLower c || c == 'H')) (foldr shows rest mvs) chopEvery n xs = case splitAt n xs of ([], _) -> []                                       (tk,dr) -> tk : chopEvery n dr @@ -492,32 +522,30 @@               [text $ S.pack $ "(" ++ shows current " / " ++ shows achievable ")"],         text $ S.pack ": ", --        span_ [] [ span_ [] $ text (S.pack "|") : [ renderCardInline verb pub $ C c k | k <- [K1 .. playedMax] ] ++ map (text . S.pack) (replicate (possible - fromEnum playedMax) "__" ++ replicate (5 - possible) "XX")-        span_ [] [ span_ [] $ text (S.pack "|") : renderCardsInline verb pub c [K1 .. playedMax] : map (text . S.pack) (replicate (possible - fromEnum playedMax) "_" ++ replicate (5 - possible) "X")+        span_ [style_ $ M.fromList [("font-family", "monospace"),("font-size", "3vmin")]] $ [ span_ [] $ text (S.pack "|") : renderCardsInline verb pub c [K1 .. playedMax] : map (text . S.pack) (replicate (possible - fromEnum playedMax) "_" ++ replicate (5 - possible) "X")                                                             | c <- colors pub                                                             , let playedMax = achievedRank pub c                                                                   possible  = fromEnum $ bestPossibleRank pub c-                                                            ],-        text $ S.pack "|"+                                                            ] ++ [text $ S.pack "|"]       ],        div_ [] [         text $ S.pack $ "dropped: ", --        span_ [] [ span_ [] $ text (S.pack "|") : (replicate n $ renderCardInline verb pub $ intToCard ci) | (ci, n) <- IM.toList $ discarded pub ],-        span_ [] [ span_ [] [text (S.pack "|"), renderCardsInline verb pub c (replicate n r)] | (ci, n) <- IM.toList $ discarded pub, n>0, let C c r = intToCard ci ],-        text $ S.pack "|"+        span_ [style_ $ M.fromList [("font-family", "monospace"),("font-size", "3vmin")]] $ [ span_ [] [text (S.pack "|"), renderCardsInline verb pub c (replicate n r)] | c <- colors pub, r <- [K1 .. maxBound], let n = discarded pub $ C c r, n>0 ] ++ [text $ S.pack "|"]       ]      ]     where current    = currentScore pub           achievable = seeminglyAchievableScore pub  -- renderCardsInline is a compact version of renderCardInline that prints the color letter only once.-renderCardsInline :: Verbosity -> PublicInfo -> Color -> [Number] -> View Action-renderCardsInline v pub c ns = span_ [style_ $ M.fromList [("font-family", "monospace"),("font-size", "4vmin"),("color", colorStr $ Just c),("background-color","#000000")]] $ span_ [] [text $ S.pack $ take 1 $ show c] : map (numberStrInline v pub c) ns+renderCardsInline :: Verbosity -> PublicInfo -> Color -> [Rank] -> View Action+renderCardsInline v pub c ns = span_ [style_ $ M.fromList [("color", colorStr $ Just c),("background-color","#000000")]] $ span_ [] [text $ S.pack $ take 1 $ show c] : map (rankStrInline v pub c) ns -numberStrInline v pub c n = cardStrInline v pub (C c n) $ show $ fromEnum n+rankStrInline v pub c n = cardStrInline v pub (C c n) $ show $ fromEnum n  renderCardInline :: Verbosity -> PublicInfo -> Card -> View Action-renderCardInline v pub c = span_ [style_ $ M.fromList [("font-family", "monospace"),("font-size", "4vmin"),("color", colorStr $ Just $ color c),("background-color","#000000")]] [cardStrInline v pub c $ head (show $ color c) : show (fromEnum $ number c)]+renderCardInline v pub c = span_ [style_ $ M.fromList [("font-family", "monospace"),("font-size", "4vmin"),("color", colorStr $ Just $ color c),("background-color","#000000")]] [cardStrInline v pub c $ head (show $ color c) : show (fromEnum $ rank c)]  cardStrInline v pub c xs = (if useless then s_ else span_) [style] [ --                                    text $ S.pack $ show c@@ -573,7 +601,8 @@      maybe (button_ [ onClick (SendMessage $ Message $ S.pack $ 'p':show i), style_ $ M.fromList [("width", S.pack $ shows cardWidth "vmin"),                                                                                                   ("font-size", S.pack $ shows (cardWidth / 5) "vmin" -- "0.3em"                                                                                                   )] ] [ text (S.pack "play") ]) (const $ span_[][]) mbc,-     div_ [style_ $ M.fromList [{- ("height", S.pack $ shows (cardWidth / 2) "vmin"), -} ("font-family", "serif"), ("font-size", S.pack $ shows (if isNothing mbc then cardWidth / 3 else cardWidth * (4/9)) "vmin")]] [   --  "1.2em")]] [+     div_ [style_ $ M.fromList $ (if isNothing mbc then (("background-color", if warnDoubleDrop v && isDoubleDrop pv (result pub) chopSet ann && i `elem` chopSet then "#880000" else+                                                                              if markChops v && i `elem` chopSet then "#888888" else "#000000") :) else id) [{- ("height", S.pack $ shows (cardWidth / 2) "vmin"), -} ("font-family", "serif"), ("font-size", S.pack $ shows (if isNothing mbc then cardWidth / 3 else cardWidth * (4/9)) "vmin")]] [   --  "1.2em")]] [         cardStr v pub pli mbc tup      ],      (if useless then s_ [] . (:[]) else id) $ div_ [style_ $ M.fromList $ ("text-align","center") : ("font-size", S.pack $ shows (cardWidth / 3) "vmin") : myStyle] [text $ S.pack $ if markHints v then maybe '_' (head . show) mc : ' ' : [maybe '_' (head . show . fromEnum) mk] else "_ _" ],@@ -582,17 +611,11 @@                                                                                                   )] ] [ text (S.pack "drop") ]) (const $ span_[][]) mbc,      if markPossibilities v then div_ [style_ $ M.fromList [("font-size", S.pack $ shows (cardWidth / 7) "vmin" -- "0.3em"                                                                                                   )]] [text $ S.pack $ showColorPossibilities pc, -- br_[],-                                                                                                       text $ S.pack $ showNumberPossibilities pn] else span_[][]+                                                                                                       text $ S.pack $ showRankPossibilities pn] else span_[][]   ] where           pub = publicView pv           cardWidth = 90 / fromIntegral (handSize $ gameSpec pub)-          (useless,myStyle) | isNothing mbc = (markObviouslyUseless v && isDefinitelyUseless pv ann,-                                                        [ ("background-color", if warnDoubleDrop v && isDoubleDrop pv (result pub) chopSet ann && i `elem` chopSet then "#880000" else-                                                                               if markChops v && i `elem` chopSet then "#888888" else "#000000"),-                                                          ("font-weight", if useless then "100" else "normal"),-                                                          ("font-style",  if markObviouslyPlayable v && isDefinitelyPlayable pv ann then "oblique" else "normal")]-                                              )-                            | otherwise     = (markObviouslyUseless v && isObviouslyUseless pub ptup,+          (useless,myStyle) = (markObviouslyUseless v && isObviouslyUseless pub ptup,                                                         [ ("background-color",if markChops v && i `elem` concat (take 1 $ obviousChopss pub anns) then "#888888" else "#000000"),                                                           ("font-weight", if useless then "100" else "normal"),                                                           ("font-style",  if markObviouslyPlayable v && isObviouslyPlayable pub ptup then "oblique" else "normal")]@@ -617,7 +640,7 @@      ]   ] -}-cardStr :: Verbosity -> PublicInfo -> Int -> Maybe Card -> (Maybe Color, Maybe Number) -> View Action+cardStr :: Verbosity -> PublicInfo -> Int -> Maybe Card -> (Maybe Color, Maybe Rank) -> View Action -- Not sure which style is better. #ifdef BUTTONSONCARDS cardStr v pub pli mbc tup = case mbc of@@ -625,7 +648,7 @@           Just c  -> (if useless then s_ else span_) [] [ --                                    text $ S.pack $ show c                                     button_ [onClick (SendMessage $ Message $ S.pack $ shows pli $ take 1 $ show $ color c), style] [text $ S.pack $ take 1 $ show $ color c],-                                    button_ [onClick (SendMessage $ Message $ S.pack $ shows pli $ show $ fromEnum $ number c), style][text $ S.pack $ show $ fromEnum $ number c]+                                    button_ [onClick (SendMessage $ Message $ S.pack $ shows pli $ show $ fromEnum $ rank c), style][text $ S.pack $ show $ fromEnum $ rank c]                              ]                      where style = style_ $ M.fromList [                               ("font-family", if critical then "sans-serif" else "serif"),@@ -641,7 +664,7 @@                                               onClick (SendMessage $ Message $ S.pack $ shows pli $ take 1 $ show $ color c)] [text $ S.pack $ take 1 $ show $ color c],                                     text " ",                                     span_ [ -- style_ $ M.fromList [("font-size","1.3em")],-                                              onClick (SendMessage $ Message $ S.pack $ shows pli $ show $ fromEnum $ number c)][text $ S.pack $ show $ fromEnum $ number c]+                                              onClick (SendMessage $ Message $ S.pack $ shows pli $ show $ fromEnum $ rank c)][text $ S.pack $ show $ fromEnum $ rank c]                              ]                      where style = style_ $ M.fromList [-- ("width","30px"),                               ("font-family", if critical then "sans-serif" else "serif"),

@@ -0,0 +1,19 @@+{-# LANGUAGE OverloadedStrings #-}+module Game.Hanabi.FFI where++import Miso+import Control.Monad+import Control.Monad.IO.Class(liftIO)++foreign import javascript unsafe "var html = window.document.documentElement; $r = html.scrollHeight - html.clientHeight - (window.document.body.scrollTop || html.scrollTop);"+   getBottom :: IO Int++atTheBottom :: IO Bool+atTheBottom =  (<=0) <$> getBottom++windowBottomSub :: action    -- ^ ActionToBeTaken+                   -> action -- ^ NoAction+                   -> Sub action+windowBottomSub action noAction sink = windowAddEventListener "scroll" $ \_e -> do+  b <- atTheBottom+  liftIO $ sink $ if b then action else noAction

@@ -27,8 +27,8 @@ instance FromJSON Card instance ToJSON Color instance FromJSON Color-instance ToJSON Number-instance FromJSON Number+instance ToJSON Rank+instance FromJSON Rank instance ToJSON GameSpec instance FromJSON GameSpec instance ToJSON Rule

@@ -21,26 +21,26 @@                            numHand = length myAnns                            isColorMarkable col = isPlayable pub (head [ c | (j,c,Ann{marks=(_,Nothing)}) <- nextPlayer, color c == col ])                                                || any (isPlayable pub) [ c | (j,c,Ann{marks=(Nothing,Just num)}) <- nextPlayer, color c == col ]-                           isNewestOfColor i d = null [ () | (j,c,Ann{marks=(_,Nothing)}) <- nextPlayer, color c == color d, j < i ] -- True if there is no newer number-unmarked card of the same color in nextPlayer.+                           isNewestOfColor i d = null [ () | (j,c,Ann{marks=(_,Nothing)}) <- nextPlayer, color c == color d, j < i ] -- True if there is no newer rank-unmarked card of the same color in nextPlayer.                            markCandidates = filter (\(_,card,ann) -> isPlayable pub card && not (isObviouslyPlayable pub $ possibilities ann)) $ reverse nextPlayer  -- Playable cards that are not enough hinted, old to new.-                           markUnhintedCritical = take 1 [ Hint 1 (if isColorMarkable (color te) then Left $ color te else Right $ number te) | (_ix, te, ann) <- reverse nextPlayer, not (isHinted $ marks ann), isCritical pub te ]+                           markUnhintedCritical = take 1 [ Hint 1 (if isColorMarkable (color te) then Left $ color te else Right $ rank te) | (_ix, te, ann) <- reverse nextPlayer, not (isHinted $ marks ann), isCritical pub te ]                            keep2 = take 1 [ Hint 1 $ Right $ K2 | (_ix, te@(C _ K2), ann) <- reverse nextPlayer, not (isHinted $ marks ann), not $ isUseless pub te ]                            unhintedNon2 = [ t | t@(_, C c n, ann) <- nextPlayer, n/=K2, not $ isHinted $ marks ann ]                            colorMarkUnmarkedPlayable = take 1 [ Hint 1 $ Left $ color d | (i,d,Ann{marks=(Nothing, Nothing)}) <- markCandidates,  -- Mark the color if a (not obviously) playable card is not marked                                                                                           isNewestOfColor i d, -- but be cautious not to color-mark newer cards.                                                                                           not $ havePlayableCardWithTheSameColor $ color d ] -- refrain marking if I have a playable card with the same color-                           colorMarkNumberMarkedPlayable = take 1 [ Hint 1 $ Left $ color d | (_,d,Ann{marks=(Nothing, Just _)}) <- markCandidates,  -- Mark the color if a (not obviously) playable card is only number-marked.+                           colorMarkNumberMarkedPlayable = take 1 [ Hint 1 $ Left $ color d | (_,d,Ann{marks=(Nothing, Just _)}) <- markCandidates,  -- Mark the color if a (not obviously) playable card is only rank-marked.                                                                                               not $ havePlayableCardWithTheSameColor $ color d -- refrain marking if I have a playable card with the same color                                                                                             ]-                           numberMarkPlayable = take 1 [ Hint 1 $ Right $ number d | (_,d,Ann{marks=(_, Nothing)}) <- markCandidates, -- Mark the number if a (not obviously) playable card is not number-marked.+                           numberMarkPlayable = take 1 [ Hint 1 $ Right $ rank d | (_,d,Ann{marks=(_, Nothing)}) <- markCandidates, -- Mark the rank if a (not obviously) playable card is not rank-marked.                                                                                      not $ havePlayableCardWithTheSameColor $ color d -- refrain marking if I have a playable card with the same color                                                                                    ]                            havePlayableCardWithTheSameColor c = or [ isDefinitelyPlayable pv ann | (_,ann@Ann{marks=(Just d,_)}) <- myHand, c==d ]-                           numberMarkUselessIfInformative = take 1 [ Hint 1 $ Right $ number d | (_,d,Ann{possibilities=p@(pc, _)}) <- nextPlayer, not $ isObviouslyUseless pub p, isObviouslyUseless pub (pc, bit $ numberToBitPos (number d)) ]+                           numberMarkUselessIfInformative = take 1 [ Hint 1 $ Right $ rank d | (_,d,Ann{possibilities=p@(pc, _)}) <- nextPlayer, not $ isObviouslyUseless pub p, isObviouslyUseless pub (pc, bit $ rankToBitPos (rank d)) ]                            colorMarkUselessIfInformative = take 1 [ Hint 1 $ Left $ color d | (i,d,Ann{possibilities=p@(_, pn)}) <- reverse nextPlayer, not $ isObviouslyUseless pub p, isObviouslyUseless pub (bit $ colorToBitPos (color d), pn),                                                                                               isNewestOfColor i d ] -- but be cautious not to color-mark newer cards.-                           numberMarkUnmarked       = take 1 [ Hint 1 $ Right $ number d | (_,d,Ann{marks=(Nothing, Nothing),possibilities=p}) <- nextPlayer, not $ isObviouslyUseless pub p ]-                           numberMarkNumberUnmarked = take 1 [ Hint 1 $ Right $ number d | (_,d,Ann{marks=(Just _, Nothing),possibilities=p}) <- nextPlayer, not $ isObviouslyUseless pub p ]+                           numberMarkUnmarked       = take 1 [ Hint 1 $ Right $ rank d | (_,d,Ann{marks=(Nothing, Nothing),possibilities=p}) <- nextPlayer, not $ isObviouslyUseless pub p ]+                           numberMarkNumberUnmarked = take 1 [ Hint 1 $ Right $ rank d | (_,d,Ann{marks=(Just _, Nothing),possibilities=p}) <- nextPlayer, not $ isObviouslyUseless pub p ]                            colorMarkColorUnmarked   = take 1 [ Hint 1 $ Left  $ color d  | (i,d,Ann{marks=(Nothing, Just _),possibilities=p}) <- reverse nextPlayer, not $ isObviouslyUseless pub p,                                                                                            isNewestOfColor i d ] -- but be cautious not to color-mark newer cards.                            playPlayable5 = take 1 [ Play i | (i,ann@Ann{marks=(_,Just K5)}) <- myHand, isDefinitelyPlayable pv ann ]

@@ -32,7 +32,7 @@                                                 | c <- hintedColors,                                                   let i   = length $ takeWhile ((/=Just c) . fst . marks) myAnns                                                       ann = myAnns !! i-                                                      newNumberPos = bit $ numberToBitPos (succ $ achievedRank pub c), -- This is undefined when achievedRank pub c == K5, but then isDefinitelyUnplayable pv ann should be True.+                                                      newNumberPos = bit $ rankToBitPos (succ $ achievedRank pub c), -- This is undefined when achievedRank pub c == K5, but then isDefinitelyUnplayable pv ann should be True.                                                   not $ isDefinitelyUnplayable pv ann,                                                   newNumberPos .&. snd (possibilities ann) /= 0 ]                            pub = publicView pv

@@ -29,7 +29,7 @@                                         , not $ or [ isObviouslyPlayable pubInQ m | Ann{marks=(Just i, _),possibilities=m} <- myAnnsInQ, c==i ] -- Exclude if there is a playable card with the color.                                          , ann <- take 1 [ ann | ann@Ann{marks=(Just i,_)} <- myAnnsInQ, c==i ]-                                        , let newNumberPos = bit $ numberToBitPos (succ $ achievedRank pubInQ c) -- This is undefined when achievedRank pub c == K5, but then isDefinitelyUnplayable pv ann should be True.+                                        , let newNumberPos = bit $ rankToBitPos (succ $ achievedRank pubInQ c) -- This is undefined when achievedRank pub c == K5, but then isDefinitelyUnplayable pv ann should be True.                                         , ixDeck ann == ix                                          , not $ isDefinitelyUnplayable pvInQ ann

@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.9.1.0+version:             0.10.1.0  -- A short (one-line) description of the package. synopsis:            Hanabi card game@@ -131,6 +131,7 @@   if impl(ghcjs) --                || flag(jsaddle)       exposed-modules:     Game.Hanabi.Client+      other-modules:       Game.Hanabi.FFI       ghcjs-options:      -dedupe -O       build-depends:      base >=4.12 && <4.13, jsaddle-warp >=0.9, aeson, miso, time >=1.6, network-uri >=2.6       if flag(official)@@ -140,7 +141,7 @@  executable hanabiq   main-is: all.hs-  other-modules: Game.Hanabi, Game.Hanabi.Msg, Game.Hanabi.Backend, Game.Hanabi.Client, Game.Hanabi.Strategies.SimpleStrategy, Game.Hanabi.Strategies.StatefulStrategy+  other-modules: Game.Hanabi, Game.Hanabi.Msg, Game.Hanabi.Backend, Game.Hanabi.Client, Game.Hanabi.FFI, Game.Hanabi.Strategies.SimpleStrategy, Game.Hanabi.Strategies.StatefulStrategy --  if !flag(all)   if !flag(jsaddle)     buildable: False