lib/KoiKoi.hs

101 lines
2.8 KiB
Haskell

{-# LANGUAGE NamedFieldPuns #-}
module KoiKoi where
import CCard
import Data.Bits (popCount, (.|.), (.&.), shift, xor)
import Data.Map (Map, empty, insert, unionWith, (!))
data Yaku =
Goko
| Shiko
| AmeShiko
| Sanko
| InoShikaCho
| Tane
| Akatan
| Aotan
| Tan
| Kasu
| TsukimiZake
| HanamiZake
| TsukiFuda
deriving (Eq, Ord, Show)
type Points = Int
type YakuFinder = Pack -> Maybe (Yaku, Points)
type Score = Map Yaku Points
data Player = Player {
hand :: Pack
, captured :: Pack
, scored :: Score
}
data State = State {
players :: (Player, Player)
, river :: Pack
, deck :: [ Card ]
, month :: Flower
, turn :: Bool
}
fixed :: (Yaku, Points) -> Pack -> YakuFinder
fixed points indicatorSet pack = if pack == indicatorSet then Just points else Nothing
moreThan :: Int -> Yaku -> (Pack -> YakuFinder)
moreThan count yaku _ =
(\n -> if n > 0 then Just (yaku, n) else Nothing) . ($count) . (-) . popCount
lights :: [Card]
lights = [Crane, CampCurtain, FullMoon, RainMan, Phoenix]
hikari :: Pack -> YakuFinder
hikari _ pack = rate (popCount pack) (pack `contains` RainMan)
where
rate 5 _ = Just (Goko, 10)
rate 4 hasRainMan = if hasRainMan then Just (AmeShiko, 7) else Just (Shiko, 8)
rate n hasRainMan = if not hasRainMan && n > 2 then Just (Sanko, 5) else Nothing
tsukiFuda :: Flower -> ([Card], Pack -> YakuFinder)
tsukiFuda flower = (map toEnum $ map (fromEnum flower * 4 +) [0..3], fixed (TsukiFuda, 8))
index :: ([Card], Pack -> YakuFinder) -> Map Card [YakuFinder]
index (cards, scorer) =
let pack = packOfCards cards in
foldl (\map card -> insert card [scorer pack . (.&.) pack] map) empty cards
inoshikacho :: [Card]
inoshikacho = [Butterflies, Boar, Deer]
animals :: [Card]
animals = [BushWarbler, Cuckoo, EightPlankBridge, Geese, SakeCup, Swallow] ++ inoshikacho
blue :: [Card]
blue = [PeonyBlue, ChrysanthemumBlue, MapleBlue]
poetry :: [Card]
poetry = [PinePoetry, PlumPoetry, CherryPoetry]
ribbons = [WisteriaRed, IrisRed, BushCloverRed, WillowRed] ++ blue ++ poetry
plain :: [Card]
plain = (foldl (++) [] [map toEnum [4*i, 4*i+1] | i <- [0..10]]) ++ Lightning : [Paulownia0 .. Sand]
yakus :: Map Card [YakuFinder]
yakus = foldl (\map -> unionWith (++) map . index) empty [
(lights, hikari)
, (inoshikacho, fixed (InoShikaCho, 5))
, (animals, moreThan 4 Tane)
, (poetry, fixed (Akatan, 5))
, (blue, fixed (Aotan, 5))
, (ribbons, moreThan 4 Tan)
, (plain, moreThan 9 Kasu)
, ([SakeCup, FullMoon], fixed (TsukimiZake, 5))
, ([SakeCup, CampCurtain], fixed (HanamiZake, 5))
]
capture :: State -> Card -> Pack -> (Pack, Score)
capture (State {month}) card pack =
let newPack = add pack card in
let yakuFinders = (unionWith (++) yakus . index $ tsukiFuda month) ! card in
(newPack, foldl (\score -> foldr (uncurry insert) score . ($newPack)) empty yakuFinders)