{-# LANGUAGE DeriveGeneric, CPP #-} module Game.Hanabi.Msg where import Game.Hanabi import GHC.Generics import System.Random #ifdef TFRANDOM import System.Random.TF #endif #ifdef AESON import Data.Aeson instance ToJSON Msg instance FromJSON Msg instance ToJSON State instance FromJSON State instance ToJSON PrivateView instance FromJSON PrivateView instance ToJSON PublicInfo instance FromJSON PublicInfo instance ToJSON EndGame instance FromJSON EndGame instance ToJSON Move instance FromJSON Move instance ToJSON Card instance FromJSON Card instance ToJSON Color instance FromJSON Color instance ToJSON Rank instance FromJSON Rank instance ToJSON GameSpec instance FromJSON GameSpec instance ToJSON Rule instance FromJSON Rule instance ToJSON Game.Hanabi.Result instance FromJSON Game.Hanabi.Result #endif -- WhatsUp and WhatsUp1 should be minimized after better clients are implemented. 効率上はminimizeすべきだが、テスト目的ではとりあえずこのままの方がやりやすい。 data Msg = Str String | WhatsUp String [PrivateView] [Move] | WhatsUp1 PrivateView Move | PrettyEndGame [Card] (Maybe (EndGame, [State], [Move])) | Watch State [Move] | PrettyAvailable [(Int, (Int, Int))] | CreateGame deriving (Show, Read, Eq, Generic) prettyMsg :: Verbosity -> Msg -> String prettyMsg _ (Str xs) = xs prettyMsg verb (WhatsUp name ps ms) = what'sUp verb name ps ms prettyMsg verb (WhatsUp1 p m) = what'sUp1 verb p m prettyMsg _ (PrettyEndGame cards tup) = prettyMbEndGame tup ++ "By the way, the initial deck was " ++ shows cards ".\n" prettyMsg _ (Watch st []) = prettySt ithPlayerFromTheLast st prettyMsg _ (Watch st (mv:_)) = replicate 20 '-' ++ '\n' : showTrial (const "") undefined (view st) mv ++ '\n' : replicate 20 '-' ++ '\n' : prettySt ithPlayerFromTheLast st prettyMsg _ (PrettyAvailable available) = unlines $ map prettyAvailableGame available prettyMbEndGame :: Maybe (EndGame, [State], [Move]) -> String prettyMbEndGame Nothing = "Game ended abnormally, possibly by connection failure.\n" prettyMbEndGame (Just tup) = prettyEndGame tup prettyAvailableGame :: (Int, (Int, Int)) -> String prettyAvailableGame (gameid, (missing, total)) = "Game ID " ++ shows gameid ": available " ++ shows missing " out of " ++ shows total "." -- Both CreateGame and PrettyAvailable have the "Create a Game" UI. Since CreateGame can work offline, sometimes CreateGame is printed before PrettyAvailable is printed. That looks redundant when online, so in such cases CreateGame is removed when PrettyAvailable is received. suppressCG :: [Msg] -> [Msg] suppressCG (pr@(PrettyAvailable _) : CreateGame : rest) = pr : rest suppressCG (pr@(PrettyAvailable _) : PrettyAvailable _ : rest) = pr : rest -- this line makes the state less informative, but makes the UI more sophisticated suppressCG xs = xs defaultOptions :: Options defaultOptions = Opt{version = error "The verion field should be set to Game.Hanabi.VersionInfo.versionInfo", port = 8720, strategies = [] } data Options = Opt{ version :: String -- ^ the version string to be shown by the `version' command. -- This is supposed to be set to 'versionInfo', but can just be @""@ , port :: Int -- ^ the port number. This can be overridden by `-p' option. , strategies :: [(String, IO (DynamicStrategy IO))] -- ^ the association list of the tuples of the strategy name and (the constructor for) the strategy. } isWS :: String -> Bool isWS = (`elem` ["0", "WS", "via WebSocket"]) # ifdef TFRANDOM newGen :: IO TFGen newGen = newTFGen # else newGen :: IO StdGen newGen = newStdGen # endif orderPlayers :: (RandomGen g) => Maybe Int -> g -> [p] -> ([p], g) orderPlayers (Just n) gen players = (dr++tk, gen) where (tk,dr) = splitAt n players orderPlayers Nothing gen players = shuffle players gen