-- -- | -- Module : CopFSM -- Authors : Sean Seefried (http://www.cse.unsw.edu.au/~sseefried) -- Don Stewart (http://www.cse.unsw.edu.au/~dons) -- Copyright : (c) 2005 -- License : GPL version 2 or later -- Created : 25 Jun 2005 -- module CopFSM where import FSM import CR import Logging import Syntax ---------------------------------------------------------------------- -- Receive states -- mkStateInitial :: Name -> CR State mkStateInitial copName = do registerMsg <- appCopStrat csMkRegisterMsg copName let stateInitial = SendState { sstate_name = "initial" , sstate_data = MsgRegister registerMsg , sstate_trans = initial2waitingForWorld } return $ SState stateInitial -- -- waiting_for_world -- stateWaitingForWorld :: RecvState stateWaitingForWorld = RecvState { rstate_name = "waiting_for_world" , rstate_selectFun = waitingForWorldSkel , rstate_parseflag = DontCareSt } where waitingForWorldSkel (MsgWorldSkel m) = SelectorResult (m, waitingForWorld2waitingForTurn) waitingForWorld2waitingForTurnSel _ = NoSelectorResult -- -- waiting_for_turn -- stateWaitingForTurn :: RecvState stateWaitingForTurn = RecvState { rstate_name = "waiting_for_turn" , rstate_selectFun = waitingForTurnSel , rstate_parseflag = DontCareSt } where waitingForTurnSel (MsgWorld m) = SelectorResult (m, waitingForTurn2inform) waitingForTurnSel (MsgGameOver GameOver) = SelectorResult (GameOver, waitingForTurn2gameOver) waitingForTurnSel _ = NoSelectorResult -- -- r_waiting_for_turn -- stateRWaitingForTurn :: RecvState stateRWaitingForTurn = RecvState { rstate_name = "r_waiting_for_turn" , rstate_selectFun = rwaitingForTurnSel , rstate_parseflag = DontCareSt } where rwaitingForTurnSel (MsgWorld m) = SelectorResult (m, rwaitingForTurn2rinform) rwaitingForTurnSel (MsgGameOver GameOver) = SelectorResult (GameOver, rwaitingForTurn2gameOver) rwaitingForTurnSel (MsgAccused Accused) = SelectorResult (GameOver, rwaitingForTurn2gameOver) rwaitingForTurnSel _ = NoSelectorResult -- -- waiting_for_inform -- stateWaitingForInform :: RecvState stateWaitingForInform = RecvState { rstate_name = "waiting_for_inform" , rstate_selectFun = waitingForInformSel , rstate_parseflag = InformSt } where waitingForInformSel (MsgFromInf m) = SelectorResult (m, waitingForInform2planning) waitingForInformSel _ = NoSelectorResult -- -- r_waiting_for_inform -- stateRWaitingForInform :: RecvState stateRWaitingForInform = RecvState { rstate_name = "r_waiting_for_inform" , rstate_selectFun = rwaitingForInformSel , rstate_parseflag = InformSt } where rwaitingForInformSel (MsgFromInf m) = SelectorResult (m, rwaitingForInform2rplanning) rwaitingForInformSel _ = NoSelectorResult -- -- waiting_for_plans -- stateWaitingForPlans :: RecvState stateWaitingForPlans = RecvState { rstate_name = "waiting_for_plans" , rstate_selectFun = waitingForPlansSel , rstate_parseflag = PlanSt } where waitingForPlansSel (MsgFromPlan m) = SelectorResult (m, waitingForPlans2voting) waitingForPlansSel _ = NoSelectorResult -- -- r_waiting_for_plans -- stateRWaitingForPlans :: RecvState stateRWaitingForPlans = RecvState { rstate_name = "r_waiting_for_plans" , rstate_selectFun = rwaitingForPlansSel , rstate_parseflag = PlanSt } where rwaitingForPlansSel (MsgFromPlan m) = SelectorResult (m, rwaitingForPlans2rvoting) rwaitingForPlansSel _ = NoSelectorResult -- -- waiting_for_results -- stateWaitingForResults :: RecvState stateWaitingForResults = RecvState { rstate_name = "waiting_for_results" , rstate_selectFun = waitingForResultsSel , rstate_parseflag = DontCareSt } where waitingForResultsSel (MsgVoteRes m) = SelectorResult (m, waitingForResults2moving) -- -- r_waiting_for_results -- stateRWaitingForResults :: RecvState stateRWaitingForResults = RecvState { rstate_name = "r_waiting_for_results" , rstate_selectFun = rwaitingForResultsSel , rstate_parseflag = DontCareSt } where rwaitingForResultsSel (MsgVoteRes m) = SelectorResult (m, rwaitingForResults2waitingForTurn) ---------------------------------------------------------------------- -- Transitions -- initial2waitingForWorld :: DummyTrans initial2waitingForWorld = return $ RState stateWaitingForWorld waitingForWorld2waitingForTurn :: Trans WorldSkeleton waitingForWorld2waitingForTurn m = do info "storing world-skeleton..." appCopStrat csStoreWorldSkel m info "world-skeleton stored" return $ RState stateWaitingForTurn waitingForTurn2inform :: Trans World waitingForTurn2inform m = do info "storing world..." appCopStrat csStoreWorld m info "world stored" informMsg <- appCopStrat0 csMkInformMsg -- -- inform -- let stateInform = SendState "inform" (MsgInform informMsg) inform2waitingForInform return $ SState stateInform inform2waitingForInform :: DummyTrans inform2waitingForInform = return $ RState stateWaitingForInform waitingForInform2planning :: Trans FromInform waitingForInform2planning fromInfMsgs = do info "planning..." planMsg <- appCopStrat csMkPlanMsg fromInfMsgs info "finished planning" -- -- planning -- let statePlanning = SendState "planning" (MsgPlan planMsg) planning2waitingForPlans return $ SState statePlanning planning2waitingForPlans :: DummyTrans planning2waitingForPlans = do info "going to waiting_for_plans" return $ RState stateWaitingForPlans waitingForPlans2voting :: Trans FromPlan waitingForPlans2voting fromPlanMsgs = do voteMsg <- appCopStrat csMkVoteMsg fromPlanMsgs -- -- voting -- let stateVoting = SendState "voting" (MsgVote voteMsg) voting2waitingForResults return $ SState stateVoting voting2waitingForResults :: DummyTrans voting2waitingForResults = do return $ RState stateWaitingForResults waitingForResults2moving :: Trans VoteResult waitingForResults2moving voteRes = do debug "computing next move" (moveMsg, dirtyFlag) <- appCopStrat csMkMoveMsg voteRes debug $ "computation of next move done: " ++ show moveMsg -- -- moving -- let trans = case dirtyFlag of Dirty -> moving2rwaitingForTurn NotDirty -> moving2waitingForTurn stateMoving = SendState "moving" (MsgCopMove moveMsg) trans return $ SState stateMoving moving2waitingForTurn :: DummyTrans moving2waitingForTurn = return $ RState stateWaitingForTurn waitingForTurn2gameOver :: Trans GameOver waitingForTurn2gameOver _ = do -- -- game_over -- let stateGameOver = FinalState return stateGameOver -- Transitions for dirty cops -- moving2rwaitingForTurn :: DummyTrans moving2rwaitingForTurn = return $ RState stateRWaitingForTurn rwaitingForTurn2gameOver :: Trans GameOver rwaitingForTurn2gameOver _ = return FinalState rwaitingForTurn2rinform :: Trans World rwaitingForTurn2rinform m = do appCopStrat csDirtyStoreWorld m informMsg <- appCopStrat0 csDirtyMkInformMsg -- -- inform -- let stateInform = SendState "r_inform" (MsgInform informMsg) rinform2rwaitingForInform return $ SState stateInform rinform2rwaitingForInform :: DummyTrans rinform2rwaitingForInform = return $ RState stateRWaitingForInform rwaitingForInform2rplanning :: Trans FromInform rwaitingForInform2rplanning fromInfMsgs = do planMsg <- appCopStrat csDirtyMkPlanMsg fromInfMsgs -- -- planning -- let statePlanning = SendState "r_planning" (MsgPlan planMsg) rplanning2rwaitingForPlans return $ SState statePlanning rplanning2rwaitingForPlans :: DummyTrans rplanning2rwaitingForPlans = return $ RState stateRWaitingForPlans rwaitingForPlans2rvoting :: Trans FromPlan rwaitingForPlans2rvoting fromPlanMsgs = do voteMsg <- appCopStrat csDirtyMkVoteMsg fromPlanMsgs -- -- voting -- let stateVoting = SendState "r_voting" (MsgVote voteMsg) rvoting2rwaitingForResults return $ SState stateVoting rvoting2rwaitingForResults :: DummyTrans rvoting2rwaitingForResults = return $ RState stateRWaitingForResults rwaitingForResults2waitingForTurn :: Trans VoteResult rwaitingForResults2waitingForTurn voteRes = do appCopStrat csDirtyHandleVoteRes voteRes return $ RState stateWaitingForTurn