Only update nonfull maps
[darcs-mirror-haskell-partty.git] / CrowdSurfer.hs
1 import Control.Monad.Trans
2 import Control.Monad.State
3 import Control.Monad.Reader
4 import System.Random
5 import Partty
6
7 import qualified Data.Map as M
8 import Data.List
9 import Data.Ord
10
11 {- 
12  - Stupid player: Goes to a party it knows about for sure, otherwise guesses
13  -}
14 type UserData = M.Map Place Int
15
16 countUsers :: DayMonad UserData ()
17 countUsers = do
18         map <- get
19         unless (M.size map == 10) $ do
20                 room <- asks psPlace
21                 present <- asks psPlayersHere
22                 say $ "Room " ++ show room ++ " has " ++ show (length present) ++ " people."
23                 modify (M.insert room (length present))
24
25 nextRoom :: DayMonad UserData ()
26 nextRoom = do
27         seen <- gets M.keys
28         case filter (`notElem` seen) [0..9] of
29           []  -> gotoBest
30           r:_ -> do say $ "Testing room " ++ show r
31                     send (Goto r)
32
33 gotoBest :: DayMonad UserData ()
34 gotoBest = do
35         map <- get
36         current <- asks psPlace
37         actionsLeft <- asks psActionsLeft
38         let (best,num) = maximumBy (comparing snd) (M.assocs map)
39         when (best /= current) $ do
40                 if actionsLeft > 0
41                   then do
42                         say $ "Going to room " ++ show best ++ " with " ++ show num ++ " people."
43                         send (Goto best)
44                   else say $ "No actions left, got to stay where we are"
45
46 dcb :: DayCallback UserData
47 dcb (PlayerEnter player room) = do
48         myId <- asks psMyName
49         when (myId == player) $ do
50                 countUsers
51                 nextRoom
52
53 dcb (DayEndsIn 2) = do
54         countUsers
55         nextRoom
56
57 dcb e = return ()
58
59 ncb :: NightCallback UserData
60 -- Round over, forget everything
61 ncb (NightEnds) = do
62         say $ "New Day, forget about yesterday"
63         put M.empty
64 -- Output the score
65 ncb (GotScore score) = say $ "Got score: " ++ show score
66
67 ncb e = return ()
68
69 main = parttyMain dcb ncb M.empty