module Match.State.Controls(handleInput) where import Control.Monad import Control.Monad.State as State import Data.Maybe import Graphics.UI.SDL as SDL import FVector import SDLUtils import Match.Player import Match.State.MatchBase import Match.State.MatchState import Match.State.Actions keyChanges :: [SDL.Event] -> [(SDLKey, Bool)] keyChanges = catMaybes . map f where f (KeyDown (Keysym n _ _)) = Just (n, True) f (KeyUp (Keysym n _ _)) = Just (n, False) f _ = Nothing updateKeyMap :: [(SDLKey, Bool)] -> [SDLKey] -> [SDLKey] updateKeyMap [] m = m updateKeyMap ((k, True):ns) m = updateKeyMap ns (k:m) updateKeyMap ((k, False):ns) m = updateKeyMap ns (filter (/= k) m) handleInput :: (Integral a) => a -> Match Bool handleInput dt = do evts <- liftIO $ pollAllSDLEvents sModCurrkeys $ updateKeyMap (keyChanges evts) s <- State.get let ks = currkeys s mquits <- handleControls dt evts return (mquits || ((ctrlquitkey (params s)) `elem` ks)) handleControls :: (Integral a) => a -> [SDL.Event] -> Match Bool handleControls dt evts = do s <- State.get let ks = currkeys s when (keyWasPressed (ctrlpausekey (params s)) evts) $ do sModPaused not when (not (paused s)) $ do case controlledpl s of Nothing -> return () Just c -> case findPlayer c s of Nothing -> return () Just p -> do let xd = if ((ctrlrightkey (params s)) `elem` ks) then 10 else if ((ctrlleftkey (params s)) `elem` ks) then -10 else 0 yd = if ((ctrlupkey (params s)) `elem` ks) then 10 else if ((ctrldownkey (params s)) `elem` ks) then -10 else 0 tgt = (xd, yd) `add2` (plposition p) act p (Goto tgt) when ((xd, yd) /= (0, 0)) $ do when ((ctrlshootkey (params s)) `elem` ks) $ do sModKickpower (+(fromIntegral dt)) when (((ctrlshootkey (params s)) `notElem` ks && (kickpower s > 0)) || (kickpower s > 1000)) $ do if kickpower s < 100 then act p (Kick (xd * 4, yd * 4, 0)) else act p (Kick (xd * (200 + fromIntegral (kickpower s)) / 100, yd * (200 + fromIntegral (kickpower s)) / 100, (200 + fromIntegral (kickpower s)) / 1000 * 30)) sModKickpower $ const 0 return (fromMaybe False (liftM (>2000) (finishedSince (ballplay s))) && (ctrlshootkey (params s)) `elem` ks)