hanafuda
/
lib
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add and expose more useful functions on Hanafuda cards and use them in Yakus computations

This commit is contained in:
Tissevert 2019-08-22 17:45:33 +02:00
parent 3b50479612
commit 3615c29a47
2 changed files with 18 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/Hanafuda.hs
View File

@ -5,8 +5,10 @@ module Hanafuda (
, Pack , Pack
, add , add
, cards , cards
, cardsOf
, cardsOfPack , cardsOfPack
, contains , contains
, difference
, empty , empty
, flower , flower
, intersection , intersection
@ -16,6 +18,7 @@ module Hanafuda (
, sameMonth , sameMonth
, shuffle , shuffle
, size , size
, union
) where ) where
import Data.Word (Word64) import Data.Word (Word64)
@ -27,6 +30,7 @@ import Data.Bits (
, testBit , testBit
, xor , xor
, (.&.) , (.&.)
, (.|.)
, countTrailingZeros , countTrailingZeros
) )
import System.Random (randomRIO) import System.Random (randomRIO)
@ -112,6 +116,12 @@ intersection = portBinary (.&.)
difference :: Pack -> Pack -> Pack difference :: Pack -> Pack -> Pack
difference = portBinary (\a b -> a `xor` (a .&. b)) difference = portBinary (\a b -> a `xor` (a .&. b))
union :: Pack -> Pack -> Pack
union = portBinary (.|.)
cardsOf :: Flower -> Pack
cardsOf = Pack . shift 0xf . (* 4) . fromEnum
sameMonth :: Card -> Pack -> Pack sameMonth :: Card -> Pack -> Pack
sameMonth card (Pack p) = Pack $ (0xf `shift` (fromEnum card .&. 0xfc)) .&. p sameMonth card (Pack p) = Pack $ (0xf `shift` (fromEnum card .&. 0xfc)) .&. p

12
src/Hanafuda/KoiKoi/Yaku.hs
View File

@ -6,11 +6,15 @@ module Hanafuda.KoiKoi.Yaku (
, sumYakus , sumYakus
) where ) where
import Hanafuda (Card(..), Monthly, Pack, add, contains, intersection, packOfCards, size) import Hanafuda (
Card(..), Monthly, Pack
, add, cardsOf, cardsOfPack, contains, difference, intersection, packOfCards
, size
)
import Hanafuda.Player (Points) import Hanafuda.Player (Points)
import qualified Data.Map as M (Map, empty, insert, unionWith, (!)) import qualified Data.Map as M (Map, empty, insert, unionWith, (!))
import qualified Data.Set as S (Set, empty, singleton, union) import qualified Data.Set as S (Set, empty, singleton, union)
import Control.Monad.Reader (reader) import Control.Monad.Reader (asks)
data Yaku = data Yaku =
Lights Lights
@ -73,7 +77,7 @@ index (yaku, cards, scorer) =
finders :: Monthly YakusByCard finders :: Monthly YakusByCard
finders = do finders = do
monthCardPlus <- reader $ (+) . (4*) . fromEnum monthCards <- cardsOfPack <$> asks cardsOf
return $ foldl (\yakusByCard -> M.unionWith S.union yakusByCard . index) M.empty [ return $ foldl (\yakusByCard -> M.unionWith S.union yakusByCard . index) M.empty [
(Lights, [Crane, CampCurtain, FullMoon, RainMan, Phoenix], lights) (Lights, [Crane, CampCurtain, FullMoon, RainMan, Phoenix], lights)
, (InoShikaCho, inoshikacho, fixed 5) , (InoShikaCho, inoshikacho, fixed 5)
@ -84,7 +88,7 @@ finders = do
, (Kasu, plains, moreThan 9) , (Kasu, plains, moreThan 9)
, (TsukimiZake, [SakeCup, FullMoon], fixed 3) , (TsukimiZake, [SakeCup, FullMoon], fixed 3)
, (HanamiZake, [SakeCup, CampCurtain], fixed 3) , (HanamiZake, [SakeCup, CampCurtain], fixed 3)
, (TsukiFuda, map (toEnum . monthCardPlus) [0..3], fixed 5) , (TsukiFuda, monthCards, fixed 5)
] ]
where where
inoshikacho = [Butterflies, Boar, Deer] inoshikacho = [Butterflies, Boar, Deer]