Initial state generation

This commit is contained in:
Sasha 2018-02-04 22:06:07 +01:00
parent b03e97bb81
commit ea96530511
2 changed files with 28 additions and 3 deletions

View File

@ -1,7 +1,7 @@
module CCard where module CCard where
import Data.Word (Word64) import Data.Word (Word64)
import Data.Bits (setBit, shift, testBit) import Data.Bits (clearBit, testBit, setBit, Bits)
import System.Random (randomRIO) import System.Random (randomRIO)
data Flower = data Flower =
@ -42,11 +42,17 @@ type Pack = Word64
packOfCards :: [Card] -> Pack packOfCards :: [Card] -> Pack
packOfCards = foldl setBit 0 . map fromEnum packOfCards = foldl setBit 0 . map fromEnum
port :: (Bits a, Enum e) => (a -> Int -> b) -> a -> e -> b
port f bits = f bits . fromEnum
contains :: Pack -> Card -> Bool contains :: Pack -> Card -> Bool
contains pack = testBit pack . fromEnum contains = port testBit
add :: Pack -> Card -> Pack add :: Pack -> Card -> Pack
add pack = setBit pack . fromEnum add = port setBit
remove :: Pack -> Card -> Pack
remove = port clearBit
pair :: Card -> Card -> Bool pair :: Card -> Card -> Bool
pair card1 card2 = flower card1 == flower card2 pair card1 card2 = flower card1 == flower card2

View File

@ -98,3 +98,22 @@ capture (State {month}) card pack =
let newPack = add pack card in let newPack = add pack card in
let yakuFinders = (unionWith (++) yakus . index $ tsukiFuda month) ! card in let yakuFinders = (unionWith (++) yakus . index $ tsukiFuda month) ! card in
(newPack, foldl (\score -> foldr (uncurry insert) score . ($newPack)) empty yakuFinders) (newPack, foldl (\score -> foldr (uncurry insert) score . ($newPack)) empty yakuFinders)
foldApply :: [[a] -> ([a], [a])] -> [[a]] -> [[a]]
foldApply [] init = init
foldApply (f:fs) [x] =
let (a,b) = f x in a : foldApply fs [b]
deal :: IO State
deal = do
shuffled <- shuffle cards
let [hand1,hand2,river,deck] = foldApply (take 3 . repeat $ splitAt 8) [shuffled]
let p1 = Player {hand = packOfCards hand1, captured = packOfCards [], scored = empty}
let p2 = Player {hand = packOfCards hand2, captured = packOfCards [], scored = empty}
return $ State {
players = (p1, p2)
, river = packOfCards river
, deck
, month = Pine
, turn = False
}