-- | Defines an abstraction for the game controller and the functions to read
-- it.
--
-- Lower-level devices replicate the higher-level API, and should accomodate to
-- it. Each device should:
--
-- - Upon initialisation, return any necessary information to poll it again.
--
-- - Update the controller with its own values upon sensing.
--
-- In this case, we only have one: mouse/keyboard combination.
--
module Input where
-- External imports
import Data.IORef
import Graphics.UI.SDL as SDL
-- Internal imports
import Control.Extra.Monad
import Data.Extra.IORef
import Graphics.UI.Extra.SDL
-- * Game controller
-- | Controller info at any given point.
data Controller = Controller
{ controllerPos :: (Double, Double)
, controllerLeft :: Bool
, controllerRight :: Bool
, controllerClick :: Bool
, controllerStop :: Bool
, controllerPause :: Bool
, controllerExit :: Bool
, controllerFast :: Bool
, controllerSlow :: Bool
, controllerSuperSlow :: Bool
, controllerReverse :: Bool
, controllerHalt :: Bool
, controllerFullscreen :: Bool
, controllerCheckPointSave :: Bool
, controllerCheckPointRestore :: Bool
}
-- | Controller info at any given point, plus a pointer
-- to poll the main device again. This is safe,
-- since there is only one writer at a time (the device itself).
newtype ControllerRef =
ControllerRef { controllerData :: (IORef Controller, Controller -> IO Controller) }
-- * General API
-- | Initialize the available input devices. This operation
-- returns a reference to a controller, which enables
-- getting its state as many times as necessary. It does
-- not provide any information about its nature, abilities, etc.
initializeInputDevices :: IO ControllerRef
initializeInputDevices = do
nr <- newIORef defaultInfo
return $ ControllerRef (nr, sdlGetController)
where defaultInfo = Controller (0,0) False False -- Position and direction
False -- Fire
False -- Stop balls
False -- Pause
False -- Exit
False False False -- Speed control
False -- Reverse time
False -- Halt
False -- Fullscreen
False -- CheckpointSave
False -- CheckpointRestore
-- | Sense from the controller, providing its current
-- state. This should return a new Controller state
-- if available, or the last one there was.
--
-- It is assumed that the sensing function is always
-- callable, and that it knows how to update the
-- Controller info if necessary.
senseInput :: ControllerRef -> IO Controller
senseInput (ControllerRef (cref, sensor)) =
modifyIORefIO cref sensor
type ControllerDev = IO (Maybe (Controller -> IO Controller))
-- * SDL API (mid-level)
-- ** Sensing
-- | Sense the SDL keyboard and mouse and update
-- the controller. It only senses the mouse position,
-- the primary mouse button, and the p key to pause
-- the game.
--
-- We need a non-blocking controller-polling function.
-- TODO: Check http://gameprogrammer.com/fastevents/fastevents1.html
sdlGetController :: Controller -> IO Controller
sdlGetController info =
foldLoopM info pollEvent (not.isEmptyEvent) ((return .) . handleEvent)
handleEvent :: Controller -> SDL.Event -> Controller
handleEvent c e =
case e of
MouseMotion x y _ _ -> c { controllerPos = (fromIntegral x, fromIntegral y)}
MouseButtonDown _ _ ButtonLeft -> c { controllerClick = True }
MouseButtonUp _ _ ButtonLeft -> c { controllerClick = False }
KeyDown (Keysym { symKey = SDLK_LEFT }) -> c { controllerLeft = True }
KeyUp (Keysym { symKey = SDLK_LEFT }) -> c { controllerLeft = False }
KeyDown (Keysym { symKey = SDLK_RIGHT }) -> c { controllerRight = True }
KeyUp (Keysym { symKey = SDLK_RIGHT }) -> c { controllerRight = False }
KeyUp (Keysym { symKey = SDLK_p }) -> c { controllerPause = not (controllerPause c) }
KeyUp (Keysym { symKey = SDLK_f }) -> c { controllerFullscreen = not (controllerFullscreen c) }
KeyDown (Keysym { symKey = SDLK_w }) -> c { controllerSuperSlow = True }
KeyUp (Keysym { symKey = SDLK_w }) -> c { controllerSuperSlow = False }
KeyDown (Keysym { symKey = SDLK_s }) -> c { controllerSlow = True }
KeyUp (Keysym { symKey = SDLK_s }) -> c { controllerSlow = False }
KeyDown (Keysym { symKey = SDLK_x }) -> c { controllerFast = True }
KeyUp (Keysym { symKey = SDLK_x }) -> c { controllerFast = False }
KeyDown (Keysym { symKey = SDLK_r }) -> c { controllerReverse = True }
KeyUp (Keysym { symKey = SDLK_r }) -> c { controllerReverse = False }
KeyDown (Keysym { symKey = SDLK_t }) -> c { controllerHalt = True }
KeyUp (Keysym { symKey = SDLK_t }) -> c { controllerHalt = False }
KeyDown (Keysym { symKey = SDLK_h }) -> c { controllerStop = True }
KeyUp (Keysym { symKey = SDLK_h }) -> c { controllerStop = False }
KeyDown (Keysym { symKey = SDLK_c }) -> c { controllerCheckPointSave = True }
KeyUp (Keysym { symKey = SDLK_c }) -> c { controllerCheckPointSave = False }
KeyDown (Keysym { symKey = SDLK_v }) -> c { controllerCheckPointRestore = True }
KeyUp (Keysym { symKey = SDLK_v }) -> c { controllerCheckPointRestore = False }
KeyDown (Keysym { symKey = SDLK_SPACE }) -> c { controllerClick = True }
KeyUp (Keysym { symKey = SDLK_SPACE }) -> c { controllerClick = False }
KeyDown (Keysym { symKey = SDLK_ESCAPE}) -> c { controllerExit = True }
_ -> c