Haskellで大富豪を作ろう (2)ターンを進めよう
前回までの記事
第ニ回 ターンを進めよう
実際にゲームとして動かすために, まずはいわゆるメインループにあたる部分を作ろう.
ゲームに必要な変数をGame型として定義しておこう. (ついでにlensも使った)
とりあえず, ターンを進めるために, プレイヤーの手札, 今誰のターンかを表す変数(mod (プレイヤー数)), プレイヤーの数を持っておくことにしよう.
data Game = Game { _decks :: IM.IntMap [Card], _turn :: Int, _players :: Int } makeLenses ''Game
ターンのカウンターが0のとき自分, それ以外はコンピュータのターンとする.
自分のターンには数字を入力し, 入力nに対してn番目のカードを捨てる.
コンピュータは何も考えず左端のカードを捨てる.
game :: StateT Game IO () game = do t <- use turn case t == 0 of True -> do lift $ putStrLn $ "あなたの番です." k <- player lift $ putStrLn $ "場札:" ++ show k False -> do lift $ putStrLn $ "CPU" ++ show t ++ "さんの番です." k <- auto lift $ putStrLn $ "場札:" ++ show k p <- use players turn %= nextTurn p game where player :: StateT Game IO Card player = do ds <- use (decks . ix 0) lift $ print ds lift $ putStrLn "捨てるカードNoを選択してください." n <- fmap (read :: String -> Int) $ lift getLine case 0 <= n && n <= length ds - 1 of True -> do decks %= IM.insert 0 (delete (ds !! n) ds) return $ ds !! n False -> do lift $ putStrLn "正しいカードNoを選択してください." player auto :: StateT Game IO Card auto = do t <- use turn ds <- use (decks . ix t) decks %= IM.insert t (delete (ds !! 0) ds) return $ ds !! 0 nextTurn p t | t == p-1 = 0 | otherwise = t+1
今はまだ1枚しか捨てられないが, 手札の中で「同じ数字で組を作る」ことができるようになれば, 実際の大富豪のように複数枚のカードを出せるようにできる.
というわけで次回はカードの組を作れるようにしよう.
実行例
Let's play 大富豪! あなたの番です. [♦3,♣3,♦4,♠5,♣6,♣7,♣8,♠10,♣10,♣J,♠2,♣2,Joker 1] 捨てるカードNoを選択してください. > 3 場札:♠5 CPU1さんの番です. 場札:♥3 CPU2さんの番です. 場札:♣4 CPU3さんの番です. 場札:♠3 あなたの番です. [♦3,♣3,♦4,♣6,♣7,♣8,♠10,♣10,♣J,♠2,♣2,Joker 1] 捨てるカードNoを選択してください.
使用したパッケージ
前回使用を宣言したものは省く.
なお2回目だけどインストールにはcabalじゃなくてstackとかを使うと便利.
ちなみにlensはStackageに登録されているのでコケることなく入ります.
- mtl: Monad classes, using functional dependencies | Hackage
- containers: Assorted concrete container types | Hackage
- lens: Lenses, Folds and Traversals | Hackage
ソースコード
{-# LANGUAGE TemplateHaskell #-} module Main where import Control.Lens import Control.Monad.State import Data.List import qualified Data.IntMap as IM import Data.List.Split (chunksOf) import System.Random.Shuffle (shuffleM) -- (2) ターンを進めよう data Suit = Spade | Club | Diamond | Heart deriving (Eq, Enum) data Number = N3 | N4 | N5 | N6 | N7 | N8 | N9 | N10 | N11 | N12 | N13 | N1 | N2 deriving (Eq, Ord, Enum) data JokerNumber = J1 | J2 deriving (Eq, Ord, Enum, Show) data Card = Card Suit Number | Joker JokerNumber deriving Eq allCards :: [Card] allCards = [Card s n | s <- [Spade .. Heart], n <- [N3 .. N2]] ++ [Joker j | j <- [J1,J2]] instance Show Suit where show Spade = "♠" show Club = "♣" show Diamond = "♦" show Heart = "♥" instance Show Number where show N1 = "A" show N11 = "J" show N12 = "Q" show N13 = "K" show k | k <= N13 = show $ fromEnum k + 3 | otherwise = show $ fromEnum k - 10 instance Show Card where show (Card s n) = show s ++ show n show (Joker k) = "Joker " ++ show (fromEnum k) -- 大富豪式順序 instance Ord Card where Joker j <= Joker j' = j <= j' Card _ _ <= Joker _ = True Joker _ <= Card _ _ = False Card _ k <= Card _ k' = k <= k' deal :: Int -> IO [[Card]] deal n = fmap (fmap sort . take n . chunksOf (length allCards `div` n)) $ shuffleM allCards data Game = Game { _decks :: IM.IntMap [Card], _turn :: Int, _players :: Int } makeLenses ''Game game :: StateT Game IO () game = do t <- use turn case t == 0 of True -> do lift $ putStrLn $ "あなたの番です." k <- player lift $ putStrLn $ "場札:" ++ show k False -> do lift $ putStrLn $ "CPU" ++ show t ++ "さんの番です." k <- auto lift $ putStrLn $ "場札:" ++ show k p <- use players turn %= nextTurn p game where player :: StateT Game IO Card player = do ds <- use (decks . ix 0) lift $ print ds lift $ putStrLn "捨てるカードNoを選択してください." n <- fmap (read :: String -> Int) $ lift getLine case 0 <= n && n <= length ds - 1 of True -> do decks %= IM.insert 0 (delete (ds !! n) ds) return $ ds !! n False -> do lift $ putStrLn "正しいカードNoを選択してください." player auto :: StateT Game IO Card auto = do t <- use turn ds <- use (decks . ix t) decks %= IM.insert t (delete (ds !! 0) ds) return $ ds !! 0 nextTurn p t | t == p-1 = 0 | otherwise = t+1 main = do putStrLn "Let's play 大富豪!" let pl = 4 d <- deal pl runStateT game $ Game (IM.fromList $ zip [0..pl-1] d) 0 pl ```