module UInputUtils where import qualified Graphics.UI.SDL as SDL import Data.Word import Options import Debug import UInputInterface standardUInputEngine :: Options -> UInputEngine standardUInputEngine opts = UInputEngine (updateUInput opts) (waitForAnyKey minWait) -- clean up the event queue cleanUpEventQueue :: IO () cleanUpEventQueue = do event <- SDL.pollEvent case event of SDL.NoEvent -> return () _ -> cleanUpEventQueue -- | Wait a specificed number of milliseconds, then wait for any key -- (or joystick button) being pressed and return the pressed key. waitForAnyKey :: Int -> IO UInput waitForAnyKey t = do SDL.delay (fromIntegral t) cleanUpEventQueue waitForAnyKey' -- | Wait for a key (or joystick button) being pressed. waitForAnyKey' :: IO UInput waitForAnyKey' = do event <- SDL.pollEvent case event of SDL.KeyUp k -> return $ addKey (sdlKeyToKey k) noInput SDL.JoyButtonUp _ x -> return $ addKey (joystickToKey x) noInput _ -> waitForAnyKey' -- Reminder: -- InputHandler :: UInput -> IO UInput updateUInput :: Options -> InputHandler updateUInput opts ui = do -- joystick handling ui' <- updateJoystick opts ui processEvents opts ui' -- TODO: This could theoretically lead into an infinite loop -- if processing an event takes longer than producing one processEvents :: Options -> InputHandler processEvents opts ui = do event <- SDL.pollEvent -- key handling case event of SDL.JoyButtonDown x y -> processEvents opts (processJoyButtonDown x y ui) SDL.JoyButtonUp x y -> processEvents opts (processJoyButtonUp x y ui) SDL.KeyDown k -> processEvents opts (processKeyDown k ui) SDL.KeyUp k -> processEvents opts (processKeyUp k ui) SDL.NoEvent -> return ui e -> do debug_msg opts (show e) return ui updateJoystick :: Options -> InputHandler updateJoystick opts ui = do let mj = joystick opts case mj of Nothing -> return ui Just j -> do SDL.update cs <- mapM (SDL.getAxis j) [0..1] let [x,y] = map ( (\ x -> if abs x < 0.05 then 0 else x) . (\ x -> x - 1) . (* 2) . (/ (2^16 - 1)) . (+ (2^15)) . fromIntegral ) cs debug_msg opts (show (x,y)) return (ui { axes = (x,y) }) processKeyDown :: SDL.Keysym -> UInput -> UInput processKeyDown = addKey . sdlKeyToKey processKeyUp :: SDL.Keysym -> UInput -> UInput processKeyUp = removeKey . sdlKeyToKey processJoyButtonDown :: Word8 -> Word8 -> UInput -> UInput processJoyButtonDown _ = addKey . joystickToKey processJoyButtonUp :: Word8 -> Word8 -> UInput -> UInput processJoyButtonUp _ _ = id -- has to be changed if more keys are added! -- | Convert joystick buttons into abstract keys. joystickToKey :: Word8 -> Key joystickToKey x | x == fromIntegral joystick_QUIT = KQuit | otherwise = KUnknown -- | Convert actual keys into abstract keys -- (i.e., for changing game controls redefine this function). sdlKeyToKey :: SDL.Keysym -> Key sdlKeyToKey k = case SDL.symKey k of SDL.SDLK_UP -> KUp SDL.SDLK_DOWN -> KDown SDL.SDLK_RIGHT -> KRight SDL.SDLK_LEFT -> KLeft SDL.SDLK_q -> KQuit _ -> KUnknown