diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 diff --git a/Game/Hanabi.hs b/Game/Hanabi.hs --- a/Game/Hanabi.hs +++ b/Game/Hanabi.hs @@ -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 -- 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) -- .|. 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 diff --git a/Game/Hanabi/Backend.lhs b/Game/Hanabi/Backend.lhs --- a/Game/Hanabi/Backend.lhs +++ b/Game/Hanabi/Backend.lhs @@ -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 diff --git a/Game/Hanabi/Client.hs b/Game/Hanabi/Client.hs --- a/Game/Hanabi/Client.hs +++ b/Game/Hanabi/Client.hs @@ -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"), diff --git a/Game/Hanabi/FFI.hs b/Game/Hanabi/FFI.hs new file mode 100644 --- /dev/null +++ b/Game/Hanabi/FFI.hs @@ -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 diff --git a/Game/Hanabi/Msg.hs b/Game/Hanabi/Msg.hs --- a/Game/Hanabi/Msg.hs +++ b/Game/Hanabi/Msg.hs @@ -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 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 @@ -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 ] diff --git a/Game/Hanabi/Strategies/StatefulStrategy.hs b/Game/Hanabi/Strategies/StatefulStrategy.hs --- a/Game/Hanabi/Strategies/StatefulStrategy.hs +++ b/Game/Hanabi/Strategies/StatefulStrategy.hs @@ -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 diff --git a/Game/Hanabi/Strategies/Stateless.hs b/Game/Hanabi/Strategies/Stateless.hs --- a/Game/Hanabi/Strategies/Stateless.hs +++ b/Game/Hanabi/Strategies/Stateless.hs @@ -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 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.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