HS-Poker/Card.hs at master · fffej/HS-Poker · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
module Card (
  Card(..),
  mkCard,
  Rank(..),
  Suit(..),
  getRank, --
  getSuit
  )where

import Data.Word
import Data.Bits

data Rank = Two | Three | Four | Five | Six | Seven
          | Eight | Nine | Ten | Jack | Queen
          | King | Ace deriving (Enum,Ord,Eq,Show)

data Suit = Heart | Diamond | Club | Spade deriving (Enum,Ord,Eq,Show)

newtype Card = Card Word32 deriving Eq

instance Show Card where
  show c = show (getRank c) ++ " of " ++ show (getSuit c)

{-
   +--------+--------+--------+--------+
   |xxxbbbbb|bbbbbbbb|cdhsrrrr|xxpppppp|
   +--------+--------+--------+--------+

   p = prime number of rank (deuce=2,trey=3,four=5,...,ace=41)
   r = rank of card (deuce=0,trey=1,four=2,five=3,...,ace=12)
   cdhs = suit of card (bit turned on based on suit of card)
   b = bit turned on depending on rank of card
-}
getRank :: Card -> Rank
getRank (Card c) = toEnum rrrr
  where
    rrrr = fromEnum ((c `shiftR` 8) .&. 0x0F)

getSuit :: Card -> Suit
getSuit (Card c)
  | testBit c 15 = Club
  | testBit c 14 = Diamond
  | testBit c 13 = Heart
  | testBit c 12 = Spade
  | otherwise = error ("Invalid card." ++ show c)

mkCard :: Rank -> Suit -> Card
mkCard r s = Card (mkCardWord64 r s)

mkCardWord64 :: Rank -> Suit -> Word32
mkCardWord64 r s =  p .|. byte2 .|. byte34
  where
    cdhs = suit s
    rrrr = cardRank r
    byte2 = shiftL (cdhs .|. rrrr) 8
    p = primeRank r
    b = cardBit r
    byte34 = shiftL b 16

suit :: Suit -> Word32
suit Club = bit 7
suit Diamond = bit 6
suit Heart = bit 5
suit Spade = bit 4

cardBit :: Rank -> Word32
cardBit = bit . fromIntegral . fromEnum

cardRank :: Rank -> Word32
cardRank = fromIntegral . fromEnum

primeRank :: Rank -> Word32
primeRank Two = 2
primeRank Three = 3
primeRank Four = 5
primeRank Five = 7
primeRank Six = 11
primeRank Seven = 13
primeRank Eight = 17
primeRank Nine = 19
primeRank Ten = 23
primeRank Jack = 29
primeRank Queen = 31
primeRank King = 37
primeRank Ace = 41