71 lines
2.2 KiB
Haskell
71 lines
2.2 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
module Hanafuda.KoiKoi (
|
|
Action(..)
|
|
, Card(..)
|
|
, Environment
|
|
, Game
|
|
, GameBlueprint(..)
|
|
, GameID
|
|
, Mode(..)
|
|
, Move(..)
|
|
, PlayerID
|
|
, Score
|
|
, Source(..)
|
|
, Step(..)
|
|
, Yaku(..)
|
|
, new
|
|
, play
|
|
) where
|
|
|
|
import Hanafuda (Card(..), Flower(Pine), contains, flower, match, remove)
|
|
import qualified Hanafuda.Player as Player (players, random, scores)
|
|
import Hanafuda.KoiKoi.Yaku (Yaku(..), Score)
|
|
import Hanafuda.KoiKoi.Game (
|
|
Action(..), Environment, Game, GameBlueprint(..), GameID, Mode(..), Move(..), PlayerID
|
|
, Source(..), Step(..)
|
|
)
|
|
import qualified Hanafuda.KoiKoi.Round as Round (deal, next)
|
|
import qualified Hanafuda.KoiKoi.Turn as Turn (catch, end, next)
|
|
import Control.Monad.Except (MonadError(..))
|
|
import Control.Monad.IO.Class (MonadIO)
|
|
|
|
play :: Environment m => Move -> Game -> m Game
|
|
play move game@(Game {river, step}) =
|
|
case (step, move) of
|
|
(ToPlay, Play card) ->
|
|
either throwError (Turn.catch game card) $ match card river
|
|
(ToPlay, Capture (card, caught)) ->
|
|
if card `canCatch` caught
|
|
then Turn.catch game card (remove river caught, [card, caught])
|
|
else throwError "You can't choose that card"
|
|
(Turned card, Choose caught) ->
|
|
if card `canCatch` caught
|
|
then Turn.end game card (remove river caught, [card, caught])
|
|
else throwError "You can't choose that card"
|
|
(Scored, KoiKoi keepGame) -> (if keepGame then Turn.next else Round.next) game
|
|
(Over, _) -> throwError "This game is over"
|
|
(_, _) -> throwError "You can't play this move in that state"
|
|
where
|
|
canCatch card1 card2 = flower card1 == flower card2 && river `contains` card2
|
|
|
|
new :: MonadIO m => (PlayerID, PlayerID) -> Mode -> m Game
|
|
new (playerA, playerB) mode = do
|
|
playing <- Player.random players
|
|
Round.deal $ Game {
|
|
mode
|
|
, scores = Player.scores players [0, 0]
|
|
, month = Pine
|
|
, players
|
|
, playing
|
|
, winning = playing
|
|
, oyake = playing
|
|
, deck = undefined
|
|
, river = undefined
|
|
, step = ToPlay
|
|
, trick = []
|
|
, rounds = []
|
|
}
|
|
where
|
|
players = Player.players [playerA, playerB]
|