handle ueberreizung

src/Skat/Preperation.hs

@@ -3,11 +3,11 @@
 
 module Skat.Preperation (
     Bidder(..), Bid, BD(..), Bidders(..), PrepEnv(..), runPreperation,
-    publishGameResults, bidder
+    publishGameResults, bidder, makePrep
 ) where
 
 import Control.Monad.IO.Class
-import Control.Monad.Reader
+import Control.Monad.State
 
 import Skat.Pile
 import Skat.Card
@@ -15,13 +15,15 @@ import Skat.Player (PL, Players(..))
 import Skat.Bidding
 import Skat (SkatEnv, mkSkatEnv)
 
-type Bid = Int
-
 data PrepEnv = PrepEnv { piles :: Piles
-                       , bidders :: Bidders }
+                       , bidders :: Bidders
+                       , current :: Bid }
                deriving Show
 
-type Preperation = ReaderT PrepEnv IO
+makePrep :: Piles -> Bidders -> PrepEnv
+makePrep ps bd = PrepEnv ps bd 0
+
+type Preperation = StateT PrepEnv IO
 
 class Bidder a where
     hand :: a -> Hand
@@ -36,7 +38,7 @@ class Bidder a where
     onBid _ _ _ _ = return ()
     onResponse :: MonadIO m => a -> Bool -> Hand -> Hand -> m ()
     onResponse _ _ _ _ = return ()
-    onGame :: MonadIO m => a -> Game -> Hand -> m ()
+    onGame :: MonadIO m => a -> HideGame -> Hand -> m ()
     onGame _ _ _ = return ()
     onResult :: MonadIO m => a -> Result -> m ()
     onResult _ _ = return ()
@@ -80,7 +82,7 @@ toPlayers single (Bidders b1 b2 b3) =
 
 runPreperation :: Preperation (Maybe SkatEnv)
 runPreperation = do
-    bds <- asks bidders
+    bds <- gets bidders
     onStart (bidder bds Hand1)
     onStart (bidder bds Hand2)
     onStart (bidder bds Hand3)
@@ -101,6 +103,7 @@ runBidding startingBid reizer gereizter = do
         Just val
             | val > startingBid -> do
                 publishBid first (hand reizer) (hand gereizter)
+                modify $ \env -> env { current = val }
                 response <- askResponse gereizter (hand reizer) val
                 publishResponse response (hand reizer) (hand gereizter)
                 if response then runBidding val reizer gereizter
@@ -114,8 +117,8 @@ runBidding startingBid reizer gereizter = do
 
 initGame :: Hand -> Bid -> Preperation SkatEnv
 initGame single bid = do
-    ps <- asks piles
-    bds <- asks bidders
+    ps <- gets piles
+    bds <- gets bidders
     -- ask if player wants to play hand
     noSkat <- askHand (bidder bds single) bid
     -- either return piles or ask for skat cards and modify piles
@@ -129,15 +132,11 @@ initGame single bid = do
 
 handleGame :: BD -> Bid -> Bool -> Preperation Game
 handleGame bd bid noSkat = do
+    cards <- (\ps -> map toCard (handCards (hand bd) ps) ++ skatCards ps) <$> gets piles
     -- ask bidder for game
     proposal <- askGame bd bid
     -- check if proposal is allowed
-    case proposal of
-        g@(Colour col mod) -> if isHand mod == noSkat
-            then return g else handleGame bd bid noSkat
-        g@(Grand mod) -> if isHand mod == noSkat
-            then return g else handleGame bd bid noSkat
-        g -> return g
+    if isHand proposal == noSkat then return proposal else handleGame bd bid noSkat
 
 handleSkat :: BD -> Bid -> Piles -> Preperation Piles
 handleSkat bd bid ps = do
@@ -155,7 +154,7 @@ publishGameResults res bidders = do
     onResult (bidder bidders Hand3) res
 
 publishGameStart :: Game -> Hand -> Preperation ()
-publishGameStart game sglPlayer = mapBidders (\b -> onGame b game sglPlayer)
+publishGameStart game sglPlayer = mapBidders (\b -> onGame b (HideGame game) sglPlayer)
 
 publishBid :: Maybe Bid -> Hand -> Hand -> Preperation ()
 publishBid bid reizer gereizter = mapBidders (\b -> onBid b bid reizer gereizter)
@@ -168,7 +167,7 @@ publishNoGame = mapBidders onNoGame
 
 mapBidders :: (BD -> Preperation ()) -> Preperation ()
 mapBidders f = do
-    bds <- asks bidders
+    bds <- gets bidders
     f (bidder bds Hand1)
     f (bidder bds Hand2)
     f (bidder bds Hand3)