astrds-0.1: src/UInputUtils.hs

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