153 lines
3.9 KiB
JavaScript
153 lines
3.9 KiB
JavaScript
function Hanafuda() {
|
|
var Flower = Object.freeze({
|
|
Pine: 0,
|
|
Plum: 1,
|
|
Cherry: 2,
|
|
Wisteria: 3,
|
|
Iris: 4,
|
|
Peony: 5,
|
|
BushClover: 6,
|
|
SusukiGrass: 7,
|
|
Chrysanthemum: 8,
|
|
Maple: 9,
|
|
Willow: 10,
|
|
Paulownia: 11
|
|
});
|
|
var Card = Object.freeze({
|
|
Pine0: 0, Pine1: 1, PinePoetry: 2, Crane: 3,
|
|
Plum0: 4, Plum1: 5, PlumPoetry: 6, BushWarbler: 7,
|
|
Cherry0: 8, Cherry1: 9, CherryPoetry: 10, CampCurtain: 11,
|
|
Wisteria0: 12, Wisteria1: 13, WisteriaRed: 14, Cuckoo: 15,
|
|
Iris0: 16, Iris1: 17, IrisRed: 18, EightPlankBridge: 19,
|
|
Peony0: 20, Peony1: 21, PeonyBlue: 22, Butterflies: 23,
|
|
BushClover0: 24, BushClover1: 25, BushCloverRed: 26, Boar: 27,
|
|
SusukiGrass0: 28, SusukiGrass1: 29, Geese: 30, FullMoon: 31,
|
|
Chrysanthemum0: 32, Chrysanthemum1: 33, ChrysanthemumBlue: 34, SakeCup: 35,
|
|
Maple0: 36, Maple1: 37, MapleBlue: 38, Deer: 39,
|
|
Lightning: 40, WillowRed: 41, Swallow: 42, RainMan: 43,
|
|
Paulownia0: 44, Paulownia1: 45, Sand: 46, Phoenix: 47
|
|
});
|
|
|
|
return {
|
|
Flower: Flower,
|
|
Card: Card,
|
|
flower: flower,
|
|
sameMonth: sameMonth
|
|
};
|
|
|
|
function flower(card) {
|
|
return Math.floor(card / 4);
|
|
}
|
|
|
|
function sameMonth(card) {
|
|
var first = 4 * flower(card);
|
|
return [0,1,2,3].map(function(i) {return first + i;});
|
|
}
|
|
|
|
/*
|
|
data Flower =
|
|
Pine
|
|
| Plum
|
|
| Cherry
|
|
| Wisteria
|
|
| Iris
|
|
| Peony
|
|
| BushClover
|
|
| SusukiGrass
|
|
| Chrysanthemum
|
|
| Maple
|
|
| Willow
|
|
| Paulownia
|
|
deriving (Eq, Ord, Enum, Show)
|
|
|
|
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, Show)
|
|
|
|
flower :: Card -> Flower
|
|
flower = toEnum . (`div` 4) . fromEnum
|
|
|
|
type Monthly a = Reader Flower a
|
|
|
|
newtype Pack = Pack { unpack :: Word64 } deriving (Eq)
|
|
|
|
empty :: Pack
|
|
empty = Pack 0
|
|
|
|
packOfCards :: [Card] -> Pack
|
|
packOfCards = foldl add empty
|
|
|
|
smallest :: Pack -> Card
|
|
smallest = toEnum . countTrailingZeros . unpack
|
|
|
|
cardsOfPack :: Pack -> [Card]
|
|
cardsOfPack (Pack 0) = []
|
|
cardsOfPack p =
|
|
let c = smallest p in
|
|
c : cardsOfPack (remove p c)
|
|
|
|
instance Show Pack where
|
|
show = ("packOfCards " ++) . show . cardsOfPack
|
|
|
|
portEnum :: Enum e => (Word64 -> Int -> b) -> Pack -> e -> b
|
|
portEnum f (Pack p) = f p . fromEnum
|
|
|
|
contains :: Pack -> Card -> Bool
|
|
contains = portEnum testBit
|
|
|
|
size :: Pack -> Int
|
|
size (Pack p) = popCount p
|
|
|
|
add :: Pack -> Card -> Pack
|
|
add p = Pack . portEnum setBit p
|
|
|
|
remove :: Pack -> Card -> Pack
|
|
remove p = Pack . portEnum clearBit p
|
|
|
|
portBinary :: (Word64 -> Word64 -> Word64) -> Pack -> Pack -> Pack
|
|
portBinary operator (Pack a) (Pack b) = Pack $ operator a b
|
|
|
|
intersection :: Pack -> Pack -> Pack
|
|
intersection = portBinary (.&.)
|
|
|
|
difference :: Pack -> Pack -> Pack
|
|
difference = portBinary (\a b -> a `xor` (a .&. b))
|
|
|
|
sameMonth :: Card -> Pack
|
|
sameMonth card = Pack $ 0xf `shift` (fromEnum card .&. 0xfc)
|
|
|
|
cards :: [Card]
|
|
cards = [Pine0 .. Phoenix]
|
|
|
|
shuffle :: [a] -> IO [a]
|
|
shuffle l =
|
|
aux (length l) l
|
|
where
|
|
aux _ [] = return []
|
|
aux n (h:t) = do
|
|
cut <- randomRIO (0, n-1)
|
|
shuffled <- shuffle t
|
|
let (top, bottom) = splitAt cut shuffled
|
|
return $ top ++ h : bottom
|
|
|
|
match :: Card -> Pack -> Either String (Pack, [Card])
|
|
match card pack =
|
|
let sameMonthCards = sameMonth card `intersection` pack in
|
|
case size sameMonthCards of
|
|
0 -> Right (add pack card, [])
|
|
1 -> Right (difference pack sameMonthCards, card : cardsOfPack sameMonthCards)
|
|
_ -> Left "This card can match several others"
|
|
*/
|
|
}
|