diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Mahjong/Hand.hs | 27 | ||||
-rw-r--r-- | src/Mahjong/Pai.hs | 30 | ||||
-rw-r--r-- | src/Mahjong/Set.hs | 20 | ||||
-rw-r--r-- | src/Main.hs | 5 |
4 files changed, 82 insertions, 0 deletions
diff --git a/src/Mahjong/Hand.hs b/src/Mahjong/Hand.hs new file mode 100644 index 0000000..1d1bb80 --- /dev/null +++ b/src/Mahjong/Hand.hs @@ -0,0 +1,27 @@ +module Hand where + +import Set +import Pai + +data Hand = Hand {getHand::MSet, getCall::[MSet]} + +max2Win = 7 + +pairs c (h:hs) = (if length (filter (==h) hs) >= c then 1 else 0) + (pairs $ filter (/=h) hs) +pairs c [] = 0 + +seven h = 7 - (pairs 1 h) +mosou h = 14 - (pairs 0 h') - (if pairs 1 h' > 0 then 1 else 0) + where h' = filter is19 h + +costM a b = (sum $ zipWith (snd.sMmin) a b,zipWith (fst.sMmin) a b) +sMmin a b = if (a>b) then (a-b,0) else (0,b-a) + +parseCol xx@(a:b:c:xs) (t,m,p) = + concat [] +parseCol _ r = return r + +normal h = cm = + where cm = pairs 2 $ filter isCha h + cp = (pairs 1 $ filter isCha h) - cm + diff --git a/src/Mahjong/Pai.hs b/src/Mahjong/Pai.hs new file mode 100644 index 0000000..08115e9 --- /dev/null +++ b/src/Mahjong/Pai.hs @@ -0,0 +1,30 @@ +module Pai where + +import Data.Char (toUpper) + +data MCol = Man | Pin | Sou | Cha + deriving (Eq,Ord) +data MCard = MCard MCol Int + deriving (Eq,Ord) + +charMcol = [(Man,'M'),(Pin,'P'),(Sou,'S'),(Cha,'C')] +instance Show MCol where + show x = [snd a | a <-charMcol, fst a == x] + +instance Read MCol where + readsPrec p r = [(fst a,t)|(c,t) <- lex r, a <- charMcol, map toUpper c == [snd a]] + +instance Show MCard where + show (MCard a b) = show b ++ show a + +instance Read MCard where + readsPrec p r = [ (MCard col n,u) | (c1,t)<- lex r, + let n = (read c1)::Int, + (c2,u) <-lex t, + let col=(read c2)::MCol] + +isCha c@(MCard col n) = (col == Cha) +isLaoTou c@(MCard col n) = ((n == 1) || (n == 9)) && (not $ isCha c) +is19 c@(MCard col n) = (isCha c) || (isLaoTou c) + + diff --git a/src/Mahjong/Set.hs b/src/Mahjong/Set.hs new file mode 100644 index 0000000..4c3e799 --- /dev/null +++ b/src/Mahjong/Set.hs @@ -0,0 +1,20 @@ +module Set where + +import Pai +import Data.List (sort) +import Data.Char (isDigit) +import Data.Either + +data MSet = MSet {getMSet:: [MCard]} + +instance Show MSet where + show xs = fst $ foldr f ("",Nothing) $ sort $ getMSet xs + where f (MCard col n) (o,p) = let o' = show n ++ (if Just col == p then "" + else show col) ++ o in (o', Just col) + +readMSet r = fst $ foldr f ([],Man) $ map g r + where g x | isDigit x = Left ((read [x])::Int) + | otherwise = Right ((read [x])::MCol) + f (Left a) (xs,col) = ((MCard col a):xs,col) + f (Right a) (xs,col) = (xs,a) + diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 index 0000000..6a8ebb3 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,5 @@ +-- This is the default main +module Main where + +main = do + print "Just a test" |