implement bidding score calculation

2020-03-26 16:47:35 +01:00
parent c2389a95c0
commit e8ce4d60f8
2 changed files with 83 additions and 1 deletions
@@ -0,0 +1,81 @@
+module Skat.Bidding (
+    biddingScore, Game(..), Modifier(..)
+) where
+
+import Skat.Card
+import Data.List (sortOn)
+import Data.Ord (Down(..))
+
+-- | different game types
+data Game = Colour Colour Modifier
+          | Grand Modifier
+          | Null
+          | NullHand
+          | NullOuvert
+          | NullOuvertHand
+            deriving (Show, Eq)
+
+-- | modifiers for grand and colour games
+data Modifier = Einfach
+              | Schneider
+              | Schwarz
+              | Hand
+              | HandSchneider
+              | HandSchneiderAngesagt
+              | HandSchneiderSchwarz
+              | HandSchneiderAngesagtSchwarz
+              | HandSchwarzAngesagt
+              | Ouvert
+                deriving (Show, Eq)
+
+-- | calculate the value of a game with given cards
+biddingScore :: HasCard c => Game -> [c] -> Int
+biddingScore game@(Grand           mod) cards = (spitzen game cards + modifierFactor mod) * 24
+biddingScore game@(Colour Clubs    mod) cards = (spitzen game cards + modifierFactor mod) * 12
+biddingScore game@(Colour Spades   mod) cards = (spitzen game cards + modifierFactor mod) * 11
+biddingScore game@(Colour Hearts   mod) cards = (spitzen game cards + modifierFactor mod) * 10
+biddingScore game@(Colour Diamonds mod) cards = (spitzen game cards + modifierFactor mod) * 9
+biddingScore Null                       _     = 23
+biddingScore NullHand                   _     = 35
+biddingScore NullOuvert                 _     = 46
+biddingScore NullOuvertHand             _     = 59
+
+-- | calculate the modifier based on the game kind
+modifierFactor :: Modifier -> Int
+modifierFactor Einfach                      = 1
+modifierFactor Schneider                    = 2
+modifierFactor Schwarz                      = 3
+modifierFactor Hand                         = 2
+modifierFactor HandSchneider                = 3
+modifierFactor HandSchneiderAngesagt        = 4
+modifierFactor HandSchneiderSchwarz         = 4
+modifierFactor HandSchneiderAngesagtSchwarz = 5
+modifierFactor HandSchwarzAngesagt          = 6
+modifierFactor Ouvert                       = 7
+
+-- | get all available trumps for a given game
+allTrumps :: Game -> [Card]
+allTrumps (Grand _) = jacks
+allTrumps (Colour col _) = jacks ++ [Card t col | t <- [Ace,Ten .. Seven] ]
+
+jacks :: [Card]
+jacks = [ Card Jack Clubs, Card Jack Spades, Card Jack Hearts, Card Jack Diamonds ]
+
+-- | calculate the spitzen count
+spitzen :: HasCard c => Game -> [c] -> Int
+spitzen game cards
+      | null trumps = length $ allTrumps game
+      | mit = foldl (\val (a, o) -> if a == o then val + 1 else val) 0 zipped
+      | otherwise = findOhne (allTrumps game) 0
+    where trumps = getTrumps game cards
+          zipped = zip (allTrumps game) trumps
+          mit = Card Jack Clubs == head trumps
+          findOhne []     acc = acc
+          findOhne (c:cs) acc = if c /= highest then findOhne cs (acc+1) else acc
+          highest = head trumps
+
+-- | get all trumps for a given game out of a hand of cards
+getTrumps :: HasCard c => Game -> [c] -> [Card]
+getTrumps (Grand _) cards = sortOn Down $ filter ((==Jack) . getType) $ map toCard cards
+getTrumps (Colour col _) cards = sortOn Down $ filter (isTrump col) $ map toCard cards
+getTrumps _              _      = []