module Robo where import qualified Board import qualified Event import qualified Opts import qualified Pack import IO import Maybe(isNothing) import Monad(when) import Utils type Bid = Integer data Cmd = Move Board.Dir | Pick [Pack.ID] | Drop [Pack.ID] deriving (Read,Show) type Reply = (Bid,Cmd) type ID = Int data T = Mk { uid :: ID , pos :: Mutable Board.Pos , packs :: Mutable [Pack.T] , money :: Mutable Integer , weight :: Mutable Integer -- kind of = sum (map wight packs) , score :: Mutable Integer , talkTo :: Handle , reboot :: Mutable Bool , alive :: Mutable (Maybe String) , turnLog :: Mutable [Event.T] , capacity :: Integer } create opts _uid h = do posR <- new (Opts.initPos opts) packsR <- new [] moneyR <- new (Opts.fuel opts) weightR <- new 0 scoreR <- new 0 aliveR <- new Nothing rebootR <- new False turnLogR <- new [Event.Spawned (Opts.initPos opts)] return $ Robo.Mk { uid = _uid , pos = posR , packs = packsR , money = moneyR , weight = weightR , score = scoreR , talkTo = h , alive = aliveR , reboot = rebootR , capacity = Opts.capacity opts , turnLog = turnLogR } isRebooting r = r `get` reboot isAlive r = isNothing # r `get` alive isEmpty r = null # r `get` packs r `endTurn` rsp = do r `sendStrLn` rsp (r `set` turnLog) [] (r `set` reboot) False r `moved` d = (r `upd` turnLog) (Event.Moved d :) r `picked` p = (r `upd` turnLog) (Event.Picked p :) r `dropped` p = (r `upd` turnLog) (Event.Dropped p :) r `delivered` p = (r `upd` turnLog) (Event.Delivered p :) wasPushed r = (r `upd` turnLog) (Event.WasPushed :) goodPush r = (r `upd` turnLog) (Event.GoodPush :) badPush r = (r `upd` turnLog) (Event.BadPush :) r `badDrop` p = (r `upd` turnLog) (Event.BadDrop p :) r `badPick` p = (r `upd` turnLog) (Event.BadPick p :) r `sendStr` msg = (talkTo r `hPutStr` msg) `catch` \e -> kill "won't listen" r r `sendStrLn` msg = (talkTo r `hPutStrLn` msg) `catch` \e -> kill "won't listen" r receive :: Maybe Int -> T -> IO (Either String Reply) receive opt_timeout r = do let h = talkTo r ifM (maybe (return True) (hWaitForInput h) opt_timeout) (do ln <- hGetLine h case parseReply (words ln) of Nothing -> return (Left ln) Just rep -> return (Right rep)) (return (Left "Timed out")) `catch` \e -> return (Left "") parseReply :: [String] -> Maybe Reply parseReply (tbid:tact:params) = do bid <- parse tbid act <- case tact of "Move" | null params -> Nothing | otherwise -> Move # parse (head params) "Pick" -> Pick # mapM parse params "Drop" -> Drop # mapM parse params _ -> Nothing return (bid,act) parseReply _ = Nothing kill :: String -> T -> IO () kill why r = whenM (isAlive r) $ do (r `set` alive) (Just why) -- notify them... balance <- r `get` money points <- r `get` score (r `upd` turnLog) (Event.Died why points balance:) let epi = "Robot " ++ show (uid r) ++ " died.\n" ++ "*** Reason: " ++ why ++ "\n" ++ "*** Score : " ++ show points ++ "\n" ++ "*** Money : " ++ show balance talkTo r `hPutStrLn` epi hClose (talkTo r) `catch` const (return ()) addPackage :: Robo.T -> Pack.T -> IO Bool addPackage r p = do w <- r `get` weight let pw = Pack.weight p if w + pw <= capacity r then do (r `upd` packs) (p:) (r `upd` weight) (pw+) r `picked` Pack.uid p return True else r `badPick` Pack.uid p >> return False dropPackage :: Robo.T -> Pack.ID -> IO (Maybe (Bool,Pack.T)) dropPackage r pid = do carry <- r `get` packs case findFilter ((pid ==) . Pack.uid) carry of Nothing -> r `badDrop` pid >> return Nothing Just (pack,otherPacks) -> do (r `set` packs) otherPacks (r `upd` weight) (subtract (Pack.weight pack)) loc <- r `get` pos if loc == Pack.dest pack then do (r `upd` score) (Pack.weight pack+) r `delivered` pid return (Just (True,pack)) else do r `dropped` pid return (Just (False,pack))