はじめに
前回のコードを載せてから、いくつか気になる点や不具合が見つかったので、改良・修正してみました。以前よりはだいぶすっきりした作りになったと思います。
不具合 ... スコアの計算
前回のコードでは、A(エース) を 1 として計算する scoreNaiveと、A(エース)を 11 として計算する scoreWithAce10 を比較して、後者が21以下なら後者を、そうでなければ 前者をスコアとすることで対応していました。
でもよく考えたら、A,5,A といったカードの時、二枚のエースのうち片方を1、もう片方を11として計算しなくてはらない訳で、これには対応出来ていませんでした。すみません。
そこで、次のような実装に変更しました。
まずはAを1としてナイーブな得点を計算します。次に、カードの中に1枚でもAがあれば、そのナイーブな得点より10足したものを仮の得点とします。
仮の得点が21以下なら、仮の得点を本当の得点とします。そうでなければ、最初に計算したナイーブな得点を本当の得点とするようにしました。
scoreNaive :: [Card] -> Int
scoreNaive cards =
foldr (+) 0 $ map (\card ->
let n = num card in if n <= 10 then n else 10
) cards
countAce :: [Card] -> Int
countAce cards =
foldr (+) 0 $ map (\card@(Card suit num) -> if num == 1 then 1 else 0) cards
score :: [Card] -> Int
score cards =
let s = scoreNaive cards
c = countAce cards
in if c > 0 && s + 10 <= 21 then s + 10 else s
ゲームの状況を管理するデータ構造を導入
前回のコードでは、ゲームの処理をmain関数の中で逐次実行していました。また、メッセージも各関数の中で処理していました。これだと、あまり汎用性がなくて、例えば処理GUIアプリにしようとしても、再利用できない形式になっていたので、これをやめました。
Phase
まず、Phaseというデータを用意しました。
data Phase = Phase1 | Phase2 Int | Phase3 Int | Phase4 | Phase5 Int | PhaseFinal deriving (Show, Eq)
Phase1〜Phase5とPhaseFinalの6段階でゲームを管理します。また、Phase 2, Phase 3, Phase5 では、さらに細かく段階を分けるために、Intが導入されています。
- Phase1 ゲーム開始
- Phase2 i 最初のカード配布処理(i=1,2はプレイヤーへのカードの配布、i=3,4はディー ラーへのカード配布)
- Phase3 i プレイヤーへの追加カード配布 (1枚ひくごとに、iが追加されていく)
- Phase4 ディーラーの2枚目のカードのopen。
- Phase5 i ディーラーへの追加カード配布 (1枚ひくごとに、iが追加されていく）
- PhaseFinal 勝敗決定。ゲーム終了
Scene
また、デッキ、プレイヤーの手、ディーラーの手の状態をまとめて表すデータ構造として、Sceneを導入しました。
data Scene = Scene { sceneDeck :: [Card], sceneHumanPlayer :: Player ,
sceneComPlayer :: Player } deriving Show
GameCondition
上記のPhaseとSceneをまとめたものとして、GameConditionを導入しました。
data GameCondition = GameCondition { gamePhase :: Phase, gameScene :: Scene } deriving Show
ゲームのループ処理は、このGameConditionを次々と変化させていくことで実現しました。
ゲームの具体的処理
アクションの導入
ゲームを進めるために、ユーザープレイヤーおよびディーラーが追加カードを「ひく」「ひかない」がありますが、これをGameActionというデータで表現することにしました。
data GameAction = GameActionDummy | GameActionDraw | GameActionHold deriving (Show,Eq)
- GameActionDraw カードを引く（ヒットする）ことを意味します
- GameActionHold カードを引かない（スタンドする）ことを意味します
また、GameActionDummyは、Phase3とPhase5以外で呼ばれる便宜上のActionです。これは何もしません。
アクションを決定するロジックの導入
ユーザープレイヤーの場合はコマンドからの入力により、また、ディーラーの場合は現在のディーラーの手札の計算により、次のアクションをどうするかを決定します。この決定処理をgameLogic関数として実装しました
gameLogic :: GameCondition -> IO GameAction
gameLogic condition@(GameCondition phase scene@(Scene deck humanPlayer@(Player humanName humanHands) comPlayer@(Player comName comHands))) = case phase of
Phase3 step -> do -- human logic
if (score humanHands) <= 21 -- バーストするまでカードをひける
then do
putStr "もう一枚引きますか？ (y/n):"
i <- getLine
if i == "y"
then return GameActionDraw
else return GameActionHold
else return GameActionHold
Phase5 step -> do -- com logic
if (score humanHands) <= 21 -- 人間がバーストしていない時のみカードをひく
then do
if (score comHands) <= 16 -- 得点が16以下のときのみ、カードをひく
then return GameActionDraw
else return GameActionHold
else return GameActionHold
_ -> return GameActionDummy
コントローラーの導入
現在のゲームの状態(GameCondition)と、上記のActionにより、次の状態(GameCondition)が決定します。この処理をgameController関数で処理することにしました。
gameController :: GameCondition -> GameAction -> GameCondition
gameController condition@(GameCondition phase scene@(Scene deck humanPlayer comPlayer)) act = case phase of
Phase1 -> GameCondition (Phase2 1) scene
Phase2 step -> case step of
1 -> GameCondition (Phase2 2) (Scene deck' humanPlayer' comPlayer)
where (deck',humanPlayer') = playerDrawCard deck humanPlayer
2 -> GameCondition (Phase2 3) (Scene deck' humanPlayer' comPlayer)
where (deck',humanPlayer') = playerDrawCard deck humanPlayer
3 -> GameCondition (Phase2 4) (Scene deck' humanPlayer comPlayer')
where (deck',comPlayer') = playerDrawCard deck comPlayer
x -> GameCondition (Phase3 1) (Scene deck' humanPlayer comPlayer')
where (deck',comPlayer') = playerDrawCard deck comPlayer
Phase3 step -> case act of
GameActionDraw -> GameCondition (Phase3 (step + 1)) (Scene deck' humanPlayer' comPlayer)
where (deck',humanPlayer') = playerDrawCard deck humanPlayer
GameActionHold -> GameCondition Phase4 scene
Phase4 -> GameCondition (Phase5 1) scene
Phase5 step -> case act of
GameActionDraw -> GameCondition (Phase5 (step + 1)) (Scene deck' humanPlayer comPlayer')
where (deck',comPlayer') = playerDrawCard deck comPlayer
GameActionHold -> GameCondition PhaseFinal scene
_ -> condition
ゲームのループ処理
アクションとコントローラーにより、ゲームを進めていくのは、次のように比較的汎用的に実装したgameLoop関数で行うようにしました。
gameLoop :: (Monad m) => (gs->Bool) -> (gs -> m (gs)) -> gs -> m gs
gameLoop checker process gs = do
gs' <- process gs
let ch' = checker gs'
if ch'
then gameLoop checker process gs'
else return $ gs'
このgameLoop関数を用いて、main関数内で次のように処理しています。
condition' <- gameLoop gameChecker gameProcess condition
ゲーム内で表示されるメッセージ
gameLoopにより、ゲームが進められますが、その都度、前回のGameCondition、今回選んだAction、それにより変更された新しいGameConditionを引数として、ゲーム内のメッセージを管理しているgameMessage関数でメッセージを決定し、表示するようにしました。
gameMessage :: GameAction -> GameCondition -> GameCondition -> String
gameMessage act condition@(GameCondition phase scene)
condition'@(GameCondition phase' scene'@(Scene deck humanPlayer@(Player humanName humanHands) comPlayer@(Player comName comHands))) = case phase of
Phase1 -> "★☆★☆★☆★☆★☆ ようこそブラックジャックへ ★☆★☆★☆★☆★☆\n"
Phase2 step -> case step of
1 -> messageForDraw humanName humanHands
2 -> (messageForDraw humanName humanHands) ++ (messageForScore humanName humanHands) ++ "\n"
3 -> messageForDraw comName comHands
4 -> (messageForDrawHide comName comHands) ++ (messageForScoreHide comName) ++ "\n"
_ -> ""
Phase3 step -> if act == GameActionDraw
then (messageForDraw humanName humanHands) ++ (messageForScore humanName humanHands)
else ""
Phase4 -> (messageForDraw' comName comHands) ++ (messageForScore comName comHands)
Phase5 step -> if act == GameActionDraw
then (messageForDraw comName comHands) ++ (messageForScore comName comHands)
else ""
PhaseFinal -> (let humanScore = score humanHands
comScore = score comHands
in (messageForFinalScore humanName humanHands) ++ "\n" ++
(messageForFinalScore comName comHands) ++ "\n" ++
case (humanScore,comScore) of
(x,y) | x <= 21 && (y > 21 || x > y ) -> "あなたの勝ちです"
(x,y) | x > 21 || y > x -> "あなたの負けです"
_ -> "引き分けです"
++ "\n")
ゲームをGUIにしたいといった場合は、おおまかに、このgameMessageと、この結果を実際に表示している処理を置き換えて（例えばアニメーション処理をするなど）やれば、改修出来るようになったのではないかと思っています。
コード全文
以上の修正・追加を行い、コード全文は次のようになりました。
module BlackJack where
import Control.Monad
import System.Random
import Data.Char
data Suit = Spades | Hearts | Clubs | Diamonds deriving Enum
instance Show Suit where
show Spades = "スペード"
show Hearts = "ハート"
show Clubs = "クラブ"
show Diamonds = "ダイア"
data Card = Card { suit :: Suit, num :: Int }
instance Show Card where
show Card { suit = s, num = n } = (show s) ++ "の" ++ rank
where rank = case n of
11 -> "J"
12 -> "Q"
13 -> "K"
1 -> "A"
x -> (show $ x)
allCards = foldr (++) [] $ map (\x -> map (\y -> Card { suit = x, num = y }) [1..13]) [Hearts ..]
shuffle :: [a] -> IO [a]
shuffle [] = return []
shuffle list = do
n <- getStdRandom $ randomR (0, length list - 1) :: IO Int
list2 <- shuffle $ take n list ++ drop (n+1) list
return $ (list !! n) : list2
drawCard :: [a] -> [a] -> ([a],[a])
drawCard deck cards =
let x:xs = deck
in (xs, cards ++ [x])
scoreNaive :: [Card] -> Int
scoreNaive cards =
foldr (+) 0 $ map (\card ->
let n = num card in if n <= 10 then n else 10
) cards
countAce :: [Card] -> Int
countAce cards =
foldr (+) 0 $ map (\card@(Card suit num) -> if num == 1 then 1 else 0) cards
score :: [Card] -> Int
score cards =
let s = scoreNaive cards
c = countAce cards
in if c > 0 && s + 10 <= 21 then s + 10 else s
data Phase = Phase1 | Phase2 Int | Phase3 Int | Phase4 | Phase5 Int | PhaseFinal deriving (Show, Eq)
data Scene = Scene { sceneDeck :: [Card], sceneHumanPlayer :: Player ,
sceneComPlayer :: Player } deriving Show
data Player = Player { playerName :: String, playerHands :: [Card] } deriving Show
data GameCondition = GameCondition { gamePhase :: Phase, gameScene :: Scene } deriving Show
data GameAction = GameActionDummy | GameActionDraw | GameActionHold deriving (Show,Eq)
playerDrawCard :: [Card] -> Player -> ([Card],Player)
playerDrawCard deck player@(Player name hands) = (deck', Player name hands')
where (deck',hands') = drawCard deck hands
gameController :: GameCondition -> GameAction -> GameCondition
gameController condition@(GameCondition phase scene@(Scene deck humanPlayer comPlayer)) act = case phase of
Phase1 -> GameCondition (Phase2 1) scene
Phase2 step -> case step of
1 -> GameCondition (Phase2 2) (Scene deck' humanPlayer' comPlayer)
where (deck',humanPlayer') = playerDrawCard deck humanPlayer
2 -> GameCondition (Phase2 3) (Scene deck' humanPlayer' comPlayer)
where (deck',humanPlayer') = playerDrawCard deck humanPlayer
3 -> GameCondition (Phase2 4) (Scene deck' humanPlayer comPlayer')
where (deck',comPlayer') = playerDrawCard deck comPlayer
x -> GameCondition (Phase3 1) (Scene deck' humanPlayer comPlayer')
where (deck',comPlayer') = playerDrawCard deck comPlayer
Phase3 step -> case act of
GameActionDraw -> GameCondition (Phase3 (step + 1)) (Scene deck' humanPlayer' comPlayer)
where (deck',humanPlayer') = playerDrawCard deck humanPlayer
GameActionHold -> GameCondition Phase4 scene
Phase4 -> GameCondition (Phase5 1) scene
Phase5 step -> case act of
GameActionDraw -> GameCondition (Phase5 (step + 1)) (Scene deck' humanPlayer comPlayer')
where (deck',comPlayer') = playerDrawCard deck comPlayer
GameActionHold -> GameCondition PhaseFinal scene
_ -> condition
messageForDraw :: String -> [Card] -> String
messageForDraw name cards =
name ++ " " ++ (show num) ++ "枚目のカードは" ++ (show newCard) ++ "です。"
where newCard = last cards
num = length cards
messageForDraw' :: String -> [Card] -> String
messageForDraw' name cards = name ++ " " ++ (show num) ++ "枚目のカードは" ++ (show newCard) ++ "でした。"
where newCard = last cards
num = length cards
messageForDrawHide :: String -> [Card] -> String
messageForDrawHide name cards = name ++ " " ++ (show num) ++ "枚目のカードは秘密です。"
where num = length cards
messageForScore :: String -> [Card] -> String
messageForScore name cards = name ++ "の現在の得点は" ++ (show $ score cards) ++ "です。"
messageForScoreHide :: String -> String
messageForScoreHide name = name ++ "の現在の得点は秘密です。"
messageForFinalScore :: String -> [Card] -> String
messageForFinalScore name cards =
name ++ "の最終得点は" ++ (show $ score cards) ++ "です。" ++ bust
where bust = if (score cards) > 21 then (name ++ "はバーストしました") else ""
gameLoop :: (Monad m) => (gs->Bool) -> (gs -> m (gs)) -> gs -> m gs
gameLoop checker process gs = do
gs' <- process gs
let ch' = checker gs'
if ch'
then gameLoop checker process gs'
else return $ gs'
gameChecker :: GameCondition -> Bool
gameChecker condition = (stg /= PhaseFinal)
where stg = gamePhase condition
gameMessage :: GameAction -> GameCondition -> GameCondition -> String
gameMessage act condition@(GameCondition phase scene)
condition'@(GameCondition phase' scene'@(Scene deck humanPlayer@(Player humanName humanHands) comPlayer@(Player comName comHands))) = case phase of
Phase1 -> "★☆★☆★☆★☆★☆ ようこそブラックジャックへ ★☆★☆★☆★☆★☆\n"
Phase2 step -> case step of
1 -> messageForDraw humanName humanHands
2 -> (messageForDraw humanName humanHands) ++ (messageForScore humanName humanHands) ++ "\n"
3 -> messageForDraw comName comHands
4 -> (messageForDrawHide comName comHands) ++ (messageForScoreHide comName) ++ "\n"
_ -> ""
Phase3 step -> if act == GameActionDraw
then (messageForDraw humanName humanHands) ++ (messageForScore humanName humanHands)
else ""
Phase4 -> (messageForDraw' comName comHands) ++ (messageForScore comName comHands)
Phase5 step -> if act == GameActionDraw
then (messageForDraw comName comHands) ++ (messageForScore comName comHands)
else ""
PhaseFinal -> (let humanScore = score humanHands
comScore = score comHands
in (messageForFinalScore humanName humanHands) ++ "\n" ++
(messageForFinalScore comName comHands) ++ "\n" ++
case (humanScore,comScore) of
(x,y) | x <= 21 && (y > 21 || x > y ) -> "あなたの勝ちです"
(x,y) | x > 21 || y > x -> "あなたの負けです"
_ -> "引き分けです"
++ "\n")
gameLogic :: GameCondition -> IO GameAction
gameLogic condition@(GameCondition phase scene@(Scene deck humanPlayer@(Player humanName humanHands) comPlayer@(Player comName comHands))) = case phase of
Phase3 step -> do -- human logic
if (score humanHands) <= 21 -- バーストするまでカードをひける
then do
putStr "もう一枚引きますか？ (y/n):"
i <- getLine
if i == "y"
then return GameActionDraw
else return GameActionHold
else return GameActionHold
Phase5 step -> do -- com logic
if (score humanHands) <= 21 -- 人間がバーストしていない時のみカードをひく
then do
if (score comHands) <= 16 -- 得点が16以下のときのみ、カードをひく
then return GameActionDraw
else return GameActionHold
else return GameActionHold
_ -> return GameActionDummy
main :: IO ()
main = do
deck <- shuffle allCards
let humanPlayer = Player { playerName = "あなた", playerHands = [] }
let comPlayer = Player { playerName = "ディーラー", playerHands = [] }
let scene = Scene deck humanPlayer comPlayer
let condition = GameCondition Phase1 scene
let putGameMessage act condition condition' = putStrLn $ gameMessage act condition condition'
let gameProcess = \condition ->
do
act <- gameLogic condition
let condition' = gameController condition act
putGameMessage act condition condition'
return condition'
condition' <- gameLoop gameChecker gameProcess condition
putGameMessage GameActionDummy condition' condition'
putStrLn "ブラックジャック終了！また遊んでね★"