Remove unused and broken modules
This commit is contained in:
Sasha
parent
6dbd72cf36
commit
c2a324b905
38
Game.hs
38
Game.hs
|
|
@ -1,38 +0,0 @@
|
|||
module Game where
|
||||
|
||||
import Card
|
||||
|
||||
data Yaku =
|
||||
Junk Int
|
||||
| Ribbons Int
|
||||
| SpecialRibbons Int
|
||||
| Animals Int
|
||||
| InoShikaCho
|
||||
| Sake Int
|
||||
| Lights Int
|
||||
|
||||
data Taken = Taken {
|
||||
junk :: [ Flower ]
|
||||
, animals :: [ Animal ]
|
||||
, ribbons :: [ Ribbon ]
|
||||
, lights :: [ Light ]
|
||||
}
|
||||
|
||||
data Player = Player {
|
||||
hand :: [ Card ]
|
||||
, taken :: Taken
|
||||
}
|
||||
|
||||
score :: Yaku -> Int
|
||||
score (Junk n) = 1 + n
|
||||
score (Ribbons n) = 1 + n
|
||||
score (SpecialRibbons 0) = 3
|
||||
score (SpecialRibbons _) = 9
|
||||
score (Animals n) = 1 + n
|
||||
score InoShikaCho = 5
|
||||
score (Sake 0) = 5
|
||||
score (Sake _) = 15
|
||||
score (Lights 0) = 5
|
||||
score (Lights 1) = 8
|
||||
score (Lights 2) = 10
|
||||
score (Lights 3) = 15
|
||||
191
KoiKoi.hs
191
KoiKoi.hs
|
|
@ -1,191 +0,0 @@
|
|||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
module KoiKoi where
|
||||
|
||||
import CCard
|
||||
import Data.Bits (popCount, (.|.), (.&.))
|
||||
import Data.Map (Map, adjust, empty, fromList, 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
|
||||
} deriving (Show)
|
||||
|
||||
data Turn = Player1 | Player2 deriving (Eq, Ord, Show)
|
||||
|
||||
switch :: Turn -> Turn
|
||||
switch Player1 = Player2
|
||||
switch _ = Player1
|
||||
|
||||
data Step = PlayACard | ChooseWhichCard Card | Scored deriving (Show)
|
||||
|
||||
data Game = Game {
|
||||
players :: Map Turn Player
|
||||
, river :: Pack
|
||||
, deck :: [ Card ]
|
||||
, turn :: Turn
|
||||
, month :: Flower
|
||||
, step :: Step
|
||||
} | Over {
|
||||
winner :: Turn
|
||||
} deriving (Show)
|
||||
|
||||
data Move = Drop Card | Take (Card, Card) | Choose Card | KoiKoi 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 :: Flower -> Pack -> [Card] -> (Score, Pack)
|
||||
capture month pack cards =
|
||||
let newPack = foldl add pack cards in
|
||||
let monthYakus = (unionWith (++) yakus . index $ tsukiFuda month) in
|
||||
let yakuFinders = foldl (\finders card -> monthYakus ! card ++ finders) [] cards in
|
||||
(foldl (\score -> foldr (uncurry insert) score . ($newPack)) empty yakuFinders, newPack)
|
||||
|
||||
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 Game
|
||||
deal = do
|
||||
shuffled <- shuffle cards
|
||||
let [hand1,hand2,river,deck] = foldApply (take 3 . repeat $ splitAt 8) [shuffled]
|
||||
let players = fromList [
|
||||
(Player1, Player {hand = packOfCards hand1, captured = packOfCards [], scored = empty})
|
||||
, (Player2, Player {hand = packOfCards hand2, captured = packOfCards [], scored = empty})
|
||||
]
|
||||
return $ Game {
|
||||
players
|
||||
, river = packOfCards river
|
||||
, deck
|
||||
, turn = Player1
|
||||
, month = Pine
|
||||
, step = PlayACard
|
||||
}
|
||||
|
||||
makeSure :: Bool -> String -> Either String ()
|
||||
makeSure check message = if check then return () else fail message
|
||||
|
||||
{-
|
||||
playACard :: Game -> Card -> Card -> Either String Game
|
||||
playACard (Game {players, river, month}) c1 c2 = do
|
||||
makeSure (hand `contains` c1) "You don't have that card"
|
||||
capture
|
||||
-}
|
||||
|
||||
turnOver :: Game -> Either String Game
|
||||
turnOver game@(Game { players, river, deck, turn, month, step }) =
|
||||
case deck of
|
||||
[] -> fail "Deck got empty"
|
||||
next : cards ->
|
||||
let game = game { deck = cards } in
|
||||
let canTake = sameMonth next .&. river in
|
||||
Right $ case popCount canTake of
|
||||
0 -> game { river = add river next }
|
||||
1 ->
|
||||
let current@(Player { captured, scored }) = players ! turn in
|
||||
let (score, newPack) = capture month captured (next:cardsOfPack canTake) in
|
||||
let game = game { players = insert turn (current { captured = newPack, scored = unionWith max scored score }) players } in
|
||||
if null score
|
||||
then game { step = PlayACard, turn = switch turn }
|
||||
else game { step = Scored }
|
||||
_ -> game { step = ChooseWhichCard next }
|
||||
|
||||
{-
|
||||
play :: Game -> Move -> Either String Game
|
||||
play game@(Game { players, river, deck, turn, month, step }) = playFrom step
|
||||
where
|
||||
playFrom PlayACard (Drop card) = do
|
||||
makeSure (month card .&. river == 0) "This card takes another one in the river"
|
||||
return $ game {
|
||||
player =
|
||||
river = add card river
|
||||
}
|
||||
playFrom PlayACard (Take (card1, card2)) = do
|
||||
makeSure (card1 `pair` card2) "Cards aren't from the same month"
|
||||
makeSure (river `contains` card2) "That card isn't in the river"
|
||||
let player = case turn of
|
||||
Player1 -> fst players
|
||||
_ -> snd players
|
||||
playACard player c1 c2
|
||||
|
||||
playFrom (ChooseWhichCard card1) (Choose card2) =
|
||||
makeSure (card1 `pair` card2) "Cards aren't from the same month"
|
||||
makeSure (river `contains` card2) "That card isn't in the river"
|
||||
|
||||
playFrom Scored (KoiKoi yes) =
|
||||
|
||||
playFrom _ _ = fail "Invalid move"
|
||||
-}
|
||||
Loading…
Reference in New Issue