2018-01-30 17:34:28 +01:00
|
|
|
module CCard where
|
|
|
|
|
|
|
|
import Data.Word (Word64)
|
2018-02-01 12:23:44 +01:00
|
|
|
import Data.Bits (setBit, (.|.), (.&.), shift, xor, testBit)
|
2018-01-30 17:34:28 +01:00
|
|
|
|
|
|
|
data Flower =
|
|
|
|
Pine
|
|
|
|
| Plum
|
|
|
|
| Cherry
|
|
|
|
| Wisteria
|
|
|
|
| Iris
|
|
|
|
| Peony
|
|
|
|
| BushClover
|
|
|
|
| SusukiGrass
|
|
|
|
| Chrysanthemum
|
|
|
|
| Maple
|
|
|
|
| Willow
|
|
|
|
| Paulownia
|
|
|
|
deriving (Eq, Ord, Enum, Show)
|
|
|
|
|
2018-02-01 12:23:44 +01:00
|
|
|
data Card =
|
|
|
|
Pine0 | Pine1 | PinePoetry | Crane
|
|
|
|
| Plum0 | Plum1 | PlumPoetry | BushWarbler
|
|
|
|
| Cherry0 | Cherry1 | CherryPoetry | CampCurtain
|
|
|
|
| Wisteria0 | Wisteria1 | WisteriaRed | Cuckoo
|
|
|
|
| Iris0 | Iris1 | IrisRed | EightPlankBridge
|
|
|
|
| Peony0 | Peony1 | PeonyBlue | Butterflies
|
|
|
|
| BushClover0 | BushClover1 | BushCloverRed | Boar
|
|
|
|
| SusukiGrass0 | SusukiGrass1 | Geese | FullMoon
|
|
|
|
| Chrysanthemum0 | Chrysanthemum1 | ChrysanthemumBlue | SakeCup
|
|
|
|
| Maple0 | Maple1 | MapleBlue | Deer
|
|
|
|
| Lightning | WillowRed | Swallow | RainMan
|
|
|
|
| Paulownia0 | Paulownia1 | Sand | Phoenix
|
|
|
|
deriving (Eq, Ord, Enum)
|
|
|
|
|
|
|
|
type Pack = Word64
|
|
|
|
|
2018-01-30 17:34:28 +01:00
|
|
|
flower :: Card -> Flower
|
2018-02-01 12:23:44 +01:00
|
|
|
flower = toEnum . (`div` 4) . fromEnum
|
|
|
|
|
|
|
|
set :: [Card] -> Pack
|
|
|
|
set = foldl setBit 0 . map fromEnum
|
2018-01-30 17:34:28 +01:00
|
|
|
|
2018-02-01 12:23:44 +01:00
|
|
|
contains :: Pack -> Card -> Bool
|
|
|
|
contains pack = testBit pack . fromEnum
|
2018-01-30 17:34:28 +01:00
|
|
|
|
|
|
|
inoshikacho :: Pack
|
2018-02-01 12:23:44 +01:00
|
|
|
inoshikacho = set [Butterflies, Boar, Deer]
|
2018-01-30 17:34:28 +01:00
|
|
|
|
|
|
|
animals :: Pack
|
2018-02-01 12:23:44 +01:00
|
|
|
animals = set [BushWarbler, Cuckoo, EightPlankBridge, Geese, SakeCup, Swallow] .|. inoshikacho
|
2018-01-30 17:34:28 +01:00
|
|
|
|
|
|
|
blue :: Pack
|
2018-02-01 12:23:44 +01:00
|
|
|
blue = set [PeonyBlue, ChrysanthemumBlue, MapleBlue]
|
2018-01-30 17:34:28 +01:00
|
|
|
|
|
|
|
poetry :: Pack
|
2018-02-01 12:23:44 +01:00
|
|
|
poetry = set [PinePoetry, PlumPoetry, CherryPoetry]
|
2018-01-30 17:34:28 +01:00
|
|
|
|
2018-02-01 12:23:44 +01:00
|
|
|
ribbons = set [WisteriaRed, IrisRed, BushCloverRed, WillowRed] .|. blue .|. poetry
|
2018-01-30 17:34:28 +01:00
|
|
|
|
|
|
|
lights :: Pack
|
2018-02-01 12:23:44 +01:00
|
|
|
lights = set [Crane, CampCurtain, FullMoon, RainMan, Phoenix]
|
2018-01-30 18:17:52 +01:00
|
|
|
|
|
|
|
plain :: Pack
|
|
|
|
plain = pack `xor` (lights .|. ribbons .|. animals) .&. pack
|
|
|
|
|
|
|
|
pack :: Pack
|
2018-02-01 12:23:44 +01:00
|
|
|
pack = 1 `shift` (fromEnum Phoenix + 1) - 1
|
2018-01-30 18:17:52 +01:00
|
|
|
|
2018-01-30 17:34:28 +01:00
|
|
|
pair :: Card -> Card -> Bool
|
|
|
|
pair card1 card2 = flower card1 == flower card2
|
|
|
|
|
|
|
|
cards :: [Card]
|
2018-02-01 12:23:44 +01:00
|
|
|
cards = [Pine0 .. Phoenix]
|