-- -- Copyright (c) 2005 Don Stewart - http://www.cse.unsw.edu.au/~dons -- Sean Seefried -- Stefan Wehr -- GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html) -- module RobberFSM where import FSM import CR import Syntax -- -- initial -- mkStateInitial :: Name -> CR State mkStateInitial robberName = do registerMsg <- appRobberStrat rsMkRegisterMsg robberName 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 = waitingForWorldSel , rstate_parseflag = DontCareSt } where waitingForWorldSel (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 m) = SelectorResult (m, waitingForTurn2gameOver) waitingForTurnSel _ = 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 -- -- 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 -- -- waiting_for_results -- stateWaitingForResults :: RecvState stateWaitingForResults = RecvState { rstate_name = "waiting_for_results" , rstate_selectFun = waitingForResultsSel , rstate_parseflag = DontCareSt } where waitingForResultsSel (MsgVoteRes m) = SelectorResult (m, waitingForResults2bribing) -- -- waiting_for_offers -- stateWaitingForOffers :: RecvState stateWaitingForOffers = RecvState { rstate_name = "waiting_for_offers" , rstate_selectFun = waitingForOffersSel , rstate_parseflag = DontCareSt } where waitingForOffersSel (MsgOfferedCops{- dons -} m) = SelectorResult (m, waitingForOffers2moving) ---------------------------------------------------------------------- -- Transitions -- initial2waitingForWorld :: DummyTrans initial2waitingForWorld = do return $ RState stateWaitingForWorld waitingForWorld2waitingForTurn :: Trans WorldSkeleton waitingForWorld2waitingForTurn m = do appRobberStrat rsStoreWorldSkel m return $ RState stateWaitingForTurn waitingForTurn2inform :: Trans World waitingForTurn2inform m = do appRobberStrat rsStoreWorld m informMsg <- appRobberStrat0 rsMkInformMsg -- -- inform -- let stateInform = SendState "inform" (MsgInform informMsg) inform2waitingForInform return $ SState stateInform inform2waitingForInform :: DummyTrans inform2waitingForInform = return $ RState stateWaitingForInform waitingForInform2planning :: Trans FromInform waitingForInform2planning fromInfMsgs = do planMsg <- appRobberStrat rsMkPlanMsg fromInfMsgs -- -- planning -- let statePlanning = SendState "planning" (MsgPlan planMsg) planning2waitingForPlans return $ SState statePlanning planning2waitingForPlans :: DummyTrans planning2waitingForPlans = do return $ RState stateWaitingForPlans waitingForPlans2voting :: Trans FromPlan waitingForPlans2voting fromPlanMsgs = do voteMsg <- appRobberStrat rsMkVoteMsg fromPlanMsgs -- -- voting -- let stateVoting = SendState "voting" (MsgVote voteMsg) voting2waitingForResults return $ SState stateVoting voting2waitingForResults :: DummyTrans voting2waitingForResults = do return $ RState stateWaitingForResults waitingForResults2bribing :: Trans VoteResult waitingForResults2bribing voteRes = do bribeMsg <- appRobberStrat rsMkBribeMsg voteRes -- -- bribing -- let stateBribing = SendState "bribing" (MsgBribe bribeMsg) bribing2waitingForOffers return $ SState stateBribing bribing2waitingForOffers :: DummyTrans bribing2waitingForOffers = do return $ RState stateWaitingForOffers waitingForOffers2moving :: Trans OfferedCops waitingForOffers2moving offeredCops = do moveMsg <- appRobberStrat rsMkMoveMsg offeredCops -- -- moving -- let stateMoving = SendState "moving" (MsgRobberMove moveMsg) moving2waitingForTurn return $ SState stateMoving moving2waitingForTurn :: DummyTrans moving2waitingForTurn = return $ RState stateWaitingForTurn waitingForTurn2gameOver :: Trans GameOver waitingForTurn2gameOver _ = return stateGameOver where stateGameOver = FinalState