Initial state generation
This commit is contained in:
parent
b03e97bb81
commit
ea96530511
2 changed files with 28 additions and 3 deletions
12
CCard.hs
12
CCard.hs
|
@ -1,7 +1,7 @@
|
|||
module CCard where
|
||||
|
||||
import Data.Word (Word64)
|
||||
import Data.Bits (setBit, shift, testBit)
|
||||
import Data.Bits (clearBit, testBit, setBit, Bits)
|
||||
import System.Random (randomRIO)
|
||||
|
||||
data Flower =
|
||||
|
@ -42,11 +42,17 @@ type Pack = Word64
|
|||
packOfCards :: [Card] -> Pack
|
||||
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 = testBit pack . fromEnum
|
||||
contains = port testBit
|
||||
|
||||
add :: Pack -> Card -> Pack
|
||||
add pack = setBit pack . fromEnum
|
||||
add = port setBit
|
||||
|
||||
remove :: Pack -> Card -> Pack
|
||||
remove = port clearBit
|
||||
|
||||
pair :: Card -> Card -> Bool
|
||||
pair card1 card2 = flower card1 == flower card2
|
||||
|
|
19
KoiKoi.hs
19
KoiKoi.hs
|
@ -98,3 +98,22 @@ 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)
|
||||
|
||||
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
|
||||
}
|
||||
|
|
Loading…
Add table
Reference in a new issue