runPartty rough code
authorJoachim Breitner <mail@joachim-breitner.de>
Fri, 4 Jul 2008 22:16:08 +0000 (22:16 +0000)
committerJoachim Breitner <mail@joachim-breitner.de>
Fri, 4 Jul 2008 22:16:08 +0000 (22:16 +0000)
Partty.hs

index 801410c..f02f899 100644 (file)
--- a/Partty.hs
+++ b/Partty.hs
@@ -9,7 +9,7 @@ import Control.Monad.Writer
 import Network
 import System.IO
 
-type Player = Int
+type Player = String
 type Day = Int
 type Place = Int
 
@@ -34,9 +34,15 @@ data IncomingMessage = InternalMessage InternalMessage
 data DayMessage      = DayStarts
 -- Events that we want to send to the user code and that
 -- can NOT be reacted upon
-data NightMessage    = NightStarts
+data NightMessage    = Initialize
+                    | NightStarts
 -- Pure bookkeeping events
 data InternalMessage = MyPlayerId Player
+                     | Welcome
+                    | PlayerJoined String
+                    | GameStarting
+                    | MyIdIs Player
+                    | PlayerEnter Player Place
 
 
 {- Einzusortieren:
@@ -70,7 +76,7 @@ type DayCallback d   = DayMessage -> DayMonad d ()
 type NightCallback d = NightMessage -> NightMonad d ()
 
 data ParttyState = ParttyState
-       { psHandle      :: Handle
+       { psMyName      :: Player
        , psDay         :: Day
        , psPlayerInfo  :: Map Player PlayerInformation
        , psPartyHistory:: [(Day,Place)]
@@ -84,18 +90,55 @@ type NightMonad d =                          ReaderT ParttyState (StateT d IO)
 
 -- Start
 
--- Hostname, Port, Playername, Callback
-runPartty :: String -> Int -> String -> DayCallback d -> NightCallback d -> IO ()
-runPartty = undefined
+-- Hostname, Port, Playername, Password, Callback
+runPartty :: String -> Int -> String -> String -> DayCallback d -> NightCallback d -> d -> IO ()
+runPartty host port username password dcb ncb initialData = do 
+       h <- connectTo host (PortNumber (fromIntegral port))
+       InternalMessage Welcome <- parseIncomingMessage `liftM` hGetLine h
+       hPutStrLn h $ unwords ["login", username, password]
+       InternalMessage (PlayerJoined myName) <- parseIncomingMessage `liftM` hGetLine h
+       when (myName /= username) $ error "Server returned a different name for me"
+
+       -- login has been successful, wait for the server start event
+       fix $ \loop -> do
+               msg <- parseIncomingMessage `liftM` hGetLine h
+               case msg of 
+                       (InternalMessage GameStarting) -> return ()
+                       otherwise                      -> do
+                               putStrLn "Waiting for game start..."
+                               loop
+       
+       -- We expect two more fixed events. If the server changes, this breaks!
+       
+       InternalMessage (MyIdIs myId) <- parseIncomingMessage `liftM` hGetLine h
+       InternalMessage (PlayerEnter player startPlace) <- parseIncomingMessage `liftM` hGetLine h
+       when (player /= myId) $ error "Server did not tell us where we start"
+
+       let initialState = ParttyState
+               { psMyName      = myId
+               , psDay         = 0
+               , psPlayerInfo  = empty
+               , psPartyHistory= []
+               , psPlace       = startPlace
+               , psPlayers     = []
+               }
+
+       -- The rest of the events are handled in the regular loop. Run the initial event
+       -- and call the runner
+       
+       d' <- undefined {- run -} ncb initialState initialData Initialize
+
+       runner h dcb ncb initialState d'
 
 
 runner :: Handle -> DayCallback d -> NightCallback d -> ParttyState -> d -> IO ()
 runner h dcb ncb = fix $ \loop ps d -> do
        (e,ps') <- getNextUserMessage h ps
-       (client_messages, d') <- case e of
-               Left dm  -> undefined {- run -} dcb dm
-               Right nm -> undefined {- run -} dcb nm
-       undefined -- send_client_messages client_messages
+       d' <- case e of
+               Left dm  -> do (client_messages, d') <- undefined {- run -} dcb dm
+                              undefined -- send_client_messages client_messages
+                              return d'
+               Right nm -> undefined {- run -} ncb nm
        loop ps' d'
 
 getNextUserMessage :: Handle -> ParttyState -> IO (Either DayMessage NightMessage, ParttyState)
@@ -108,6 +151,9 @@ getNextUserMessage h ps = do
                DayMessage dm -> return (Left dm, ps')
                NightMessage nm -> return (Right nm, ps')
 
+parseIncomingMessage :: String -> IncomingMessage
+parseIncomingMessage = undefined
+
 -- Convenience functions for accessing the state
 
 whoIsHere :: (MonadReader ParttyState m) => m [Player]