Initial Checkin
authorJoachim Breitner <mail@joachim-breitner.de>
Fri, 4 Jul 2008 21:34:13 +0000 (21:34 +0000)
committerJoachim Breitner <mail@joachim-breitner.de>
Fri, 4 Jul 2008 21:34:13 +0000 (21:34 +0000)
Dummy.hs [new file with mode: 0644]
Partty.hs [new file with mode: 0644]

diff --git a/Dummy.hs b/Dummy.hs
new file mode 100644 (file)
index 0000000..e77f4e8
--- /dev/null
+++ b/Dummy.hs
@@ -0,0 +1,24 @@
+module Dummy where
+
+cb Disconnect = do
+       liftIO $ putStrln "I’m gone"
+
+cb (GotHint player hint) = do
+       pi <- getPlayerInfo player
+       somewhere <- getU
+       when (meist nicht gelogen (pi)) $ case hint of
+               PartyAt there -> setU there
+               NoPartyAt there -> if (there == somewhere) then 
+                       tell otherplayer (Liar player)
+       
+cb (GotHint player hint) = do
+       pi <- getPlayerInfo player
+       somewhere <- getU
+       when (meist nicht gelogen (pi)) $ do
+               tellPlayer player (PartyAt somewhere)
+
+cb _ = return ()       
+
+main = do
+       runPartty "localhost" 1111 "me" cb
+
diff --git a/Partty.hs b/Partty.hs
new file mode 100644 (file)
index 0000000..801410c
--- /dev/null
+++ b/Partty.hs
@@ -0,0 +1,120 @@
+{-# LANGUAGE FlexibleContexts #-}
+module Partty where
+
+import Data.Map
+import Control.Monad.State
+import Control.Monad.Reader
+import Control.Monad.Writer
+import Network
+import System.IO
+
+type Player = Int
+type Day = Int
+type Place = Int
+
+data Hint = PartyAt Place
+         | NoPartyAt Place
+         | Liar Player
+         | NoLiar Player
+
+data PlayerInformation = PlayerInformation
+       { piSeen        :: [Day]
+       , piHints       :: [(Day,Hint)]
+       }
+
+data Score = NoScore | ToFew | Scored
+
+data IncomingMessage = InternalMessage InternalMessage
+                     | DayMessage      DayMessage
+                     | NightMessage    NightMessage
+       
+-- Events that we want to send to the user code and that
+-- can be reacted upon
+data DayMessage      = DayStarts
+-- Events that we want to send to the user code and that
+-- can NOT be reacted upon
+data NightMessage    = NightStarts
+-- Pure bookkeeping events
+data InternalMessage = MyPlayerId Player
+
+
+{- Einzusortieren:
+                    | PlayerJoined Player  -- the game
+                    | PlayerLeft Player
+                    | PlayerEnters Player Place
+                    | PlayerLeaves Player Place
+                    | GotHint Hint
+                    | PlayerList [Player]
+                    | PlayerScore [(Player, Int)]
+                    | PlayerNames [(Player, String)]
+                    | GameStarted
+                    | DayStarts
+                    | DayEndsIn Int
+                    | DayEnds
+                    | NightStarts
+                    | NightEndsIn Int
+                    | NightEnds
+                    | GameEnded
+                    | PartyHint Place
+                    | PlayerPosition Player Place -- wann bekommt man das?
+                     | GotScore Score
+                    | ActionsLeft Int
+                    | NewContact Player
+-} 
+
+data ClientMessage = Tell Player Hint
+                  | Goto Place
+
+type DayCallback d   = DayMessage -> DayMonad d ()
+type NightCallback d = NightMessage -> NightMonad d ()
+
+data ParttyState = ParttyState
+       { psHandle      :: Handle
+       , psDay         :: Day
+       , psPlayerInfo  :: Map Player PlayerInformation
+       , psPartyHistory:: [(Day,Place)]
+       , psPlace       :: Place
+       , psPlayers     :: [Player]
+       }
+
+type DayMonad d   = WriterT [ClientMessage] (ReaderT ParttyState (StateT d IO))
+type NightMonad d =                          ReaderT ParttyState (StateT d IO)
+
+
+-- Start
+
+-- Hostname, Port, Playername, Callback
+runPartty :: String -> Int -> String -> DayCallback d -> NightCallback d -> IO ()
+runPartty = undefined
+
+
+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
+       loop ps' d'
+
+getNextUserMessage :: Handle -> ParttyState -> IO (Either DayMessage NightMessage, ParttyState)
+getNextUserMessage h ps = do
+       line <- hGetLine h
+       e <- undefined {- parseIncomingMessage -} line
+       let ps' = undefined {- updateState -} e ps
+       case e of
+               InternalMessage ue -> getNextUserMessage h ps'
+               DayMessage dm -> return (Left dm, ps')
+               NightMessage nm -> return (Right nm, ps')
+
+-- Convenience functions for accessing the state
+
+whoIsHere :: (MonadReader ParttyState m) => m [Player]
+whoIsHere = asks psPlayers
+
+gameDay :: (MonadReader ParttyState m) => m Day
+gameDay = asks psDay
+
+-- Interaction: use “tell”
+