Lots of more messages parsed
authorJoachim Breitner <mail@joachim-breitner.de>
Fri, 4 Jul 2008 23:11:07 +0000 (23:11 +0000)
committerJoachim Breitner <mail@joachim-breitner.de>
Fri, 4 Jul 2008 23:11:07 +0000 (23:11 +0000)
Partty.hs

index 90281d9..fa9e164 100644 (file)
--- a/Partty.hs
+++ b/Partty.hs
@@ -28,6 +28,7 @@ data Score = NoScore | ToFew | Scored
 data IncomingMessage = InternalMessage InternalMessage
                      | DayMessage      DayMessage
                      | NightMessage    NightMessage
+                    | UnknownMessage  String
                     deriving (Show, Eq)
        
 -- Events that we want to send to the user code and that
@@ -37,7 +38,7 @@ data DayMessage      = DayStarts
 -- Events that we want to send to the user code and that
 -- can NOT be reacted upon
 data NightMessage    = Initialize
-                    | NightStarts
+                    | PartyHint Place
                     deriving (Show, Eq)
 -- Pure bookkeeping events
 data InternalMessage = MyPlayerId Player
@@ -46,6 +47,7 @@ data InternalMessage = MyPlayerId Player
                     | GameStarting
                     | MyIdIs Player
                     | PlayerEnter Player Place
+                    | Noise
                     deriving (Show, Eq)
 
 
@@ -75,6 +77,7 @@ data InternalMessage = MyPlayerId Player
 
 data ClientMessage = Tell Player Hint
                   | Goto Place
+                    deriving (Show, Eq)
 
 type DayCallback d   = DayMessage -> DayMonad d ()
 type NightCallback d = NightMessage -> NightMonad d ()
@@ -167,6 +170,8 @@ getNextUserMessage h ps = do
        let ps' = updateState msg ps
        case msg of
                InternalMessage ue -> getNextUserMessage h ps'
+               UnknownMessage s-> do putStrLn $"Got an unknown message:\n"++s
+                                     getNextUserMessage h ps'
                DayMessage dm -> return (Left dm, ps')
                NightMessage nm -> return (Right nm, ps')
 
@@ -175,9 +180,25 @@ updateState msg ps = ps -- TODO: this is a stub
 
 parseIncomingMessage :: String -> IncomingMessage
 parseIncomingMessage msg = case id of
+       -- Errors, no proper handling for now
+       07 -> error "Game is already in progress, try again later..."
+
+       -- Regular Messages
        71 -> InternalMessage (Welcome)
        20 -> InternalMessage (PlayerJoined s1)
-       _  -> error $ "Unkown or unparseable message:\n" ++ msg
+       70 -> InternalMessage (Noise) -- welcome
+       40 -> InternalMessage (Noise) -- waiting for at least .. players
+       41 -> InternalMessage (Noise) -- game will start in...
+       42 -> InternalMessage (GameStarting)
+       43 -> InternalMessage (MyIdIs s1)
+       22 -> InternalMessage (PlayerEnter s1 int2)
+
+       50 -> DayMessage      (DayStarts)
+
+       60 -> NightMessage    (PartyHint int1)
+       
+       _  -> UnknownMessage msg
+       --_  -> error $ "Unkown or unparseable message:\n" ++ msg
  where (id_s : num_params : rest) = words msg
        id = read id_s
        param_s = take (read num_params) rest
@@ -187,7 +208,8 @@ parseIncomingMessage msg = case id of
        int2 = read (param_s !! 2) :: Int
 
 sendClientMessage :: Handle -> ClientMessage -> IO ()
-sendClientMessage h msg = hPutStrLn h (toString msg)
+sendClientMessage h msg = do putStrLn $ "Client says: " ++ (show msg)
+                             hPutStrLn h (toString msg)
   where toString (Goto place)                    = unwords ["goto", show place]
         toString (Tell player (PartyAt place))   = unwords ["party",    show player, show place]
         toString (Tell player (NoPartyAt place)) = unwords ["no_party", show player, show place]