diff --git a/KoiKoi.hs b/KoiKoi.hs index 5972897..b16c33c 100644 --- a/KoiKoi.hs +++ b/KoiKoi.hs @@ -1,24 +1,8 @@ module KoiKoi where import CCard -import Data.Bits (popCount, (.&.)) -import System.Random (randomRIO) - -type Points = Int - -data Player = Player { - hand :: Pack - , captured :: Pack - , scored :: [Yaku] - } - -data State = State { - players :: (Player, Player) - , river :: Pack - , deck :: [ Card ] - , month :: Flower - , turn :: Bool - } +import Data.Bits (popCount, (.&.), shift, testBit) +import Data.Map (Map, empty, insert, unionWith) data Yaku = Goko @@ -33,37 +17,58 @@ data Yaku = | Kasu | TsukimiZake | HanamiZake + | TsukiFuda + deriving (Show) +type Points = Int +type Score = Pack -> Maybe (Yaku, Points) -yakus :: [ Pack -> Maybe (Yaku, Points) ] -yakus = [ - (\p -> lightsYaku (popCount p) (p `contains` RainMan)) . (lights .&.) - , is inoshikacho InoShikaCho +data Player = Player { + hand :: Pack + , captured :: Pack + , scored :: Map Yaku Points + } + +data State = State { + players :: (Player, Player) + , river :: Pack + , deck :: [ Card ] + , month :: Flower + , turn :: Bool + } + +has :: Pack -> (Yaku, Points) -> (Pack, Score) +has pack points = + (pack, \p -> if p == pack then Just points else Nothing) + +moreThan :: Int -> Pack -> Yaku -> (Pack, Score) +moreThan count pack yaku = + (pack, (\n -> if n > 0 then Just (yaku, n) else Nothing) . ($count) . (-) . popCount) + +hikari :: (Pack, Score) +hikari = (lights, \p -> rate (popCount p) (p `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 -> (Pack, Score) +tsukiFuda flower = has (0xf `shift` (fromEnum flower * 4)) (TsukiFuda, 8) + +index :: (Pack, Score) -> Map Card [Score] +index (pack, score) = + foldl (\map card -> + if testBit pack $ fromEnum card then insert card [score . (.&.) pack] map else map + ) empty cards + +yakus :: Map Card [Score] +yakus = foldl (\map -> unionWith (++) map . index) empty [ + hikari + , has inoshikacho (InoShikaCho, 5) , moreThan 4 animals Tane - , is poetry Akatan - , is blue Aotan + , has poetry (Akatan, 5) + , has blue (Aotan, 5) , moreThan 4 ribbons Tan , moreThan 9 plain Kasu - , is (set [SakeCup, FullMoon]) TsukimiZake - , is (set [SakeCup, CampCurtain]) HanamiZake + , has (set [SakeCup, FullMoon]) (TsukimiZake, 5) + , has (set [SakeCup, CampCurtain]) (HanamiZake, 5) ] - where - lightsYaku 5 _ = Just (Goko, 10) - lightsYaku 4 hasRainMan = if hasRainMan then Just (AmeShiko, 7) else Just (Shiko, 8) - lightsYaku n hasRainMan = if not hasRainMan && n > 2 then Just (Sanko, 8) else Nothing - moreThan points set yaku = - threshold yaku . (\x -> x - points) . popCount . (set .&.) - threshold yaku n - | n > 0 = Just (yaku, n) - | otherwise = Nothing - is set yaku pack = if set == pack then Just (yaku, 5) else Nothing - -shuffle :: [a] -> IO [a] -shuffle l = - aux (length l) l - where - aux n [] = return [] - aux n (h:t) = do - cut <- randomRIO (0, n-1) - shuffled <- shuffle t - let (top, bottom) = splitAt cut shuffled - return $ top ++ h : bottom