summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Mahjong/Hand.hs27
-rw-r--r--src/Mahjong/Pai.hs30
-rw-r--r--src/Mahjong/Set.hs20
-rw-r--r--src/Main.hs5
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"