module FRP.Helm.Joystick (
Joystick,
available,
name,
open,
index,
availableAxes,
availableBalls,
availableHats,
availableButtons,
axis,
hat,
button,
ball
) where
import Control.Applicative
import Data.Int (Int16)
import FRP.Elerea.Simple
import qualified Graphics.UI.SDL as SDL
type Joystick = SDL.Joystick
available :: SignalGen (Signal Int)
available = effectful SDL.countAvailable
name :: Int -> SignalGen (Signal String)
name i = effectful $ SDL.name i
open :: Int -> SignalGen (Signal Joystick)
open i = effectful $ SDL.open i
index :: Joystick -> SignalGen (Signal Int)
index j = return $ return $ SDL.index j
availableAxes :: Joystick -> SignalGen (Signal Int)
availableAxes j = return $ return $ SDL.axesAvailable j
availableBalls :: Joystick -> SignalGen (Signal Int)
availableBalls j = return $ return $ SDL.ballsAvailable j
availableHats :: Joystick -> SignalGen (Signal Int)
availableHats j = return $ return $ SDL.hatsAvailable j
availableButtons :: Joystick -> SignalGen (Signal Int)
availableButtons j = return $ return $ SDL.buttonsAvailable j
axis :: Joystick -> Int -> SignalGen (Signal Int)
axis j i = effectful $ SDL.update >> fromIntegral <$> SDL.getAxis j (fromIntegral i)
hat :: Joystick -> Int -> SignalGen (Signal (Int, Int))
hat j i = effectful $ SDL.update >> hat' <$> SDL.getHat j (fromIntegral i)
hat' :: [SDL.Hat] -> (Int, Int)
hat' hats = if l > 0 then (round $ fromIntegral hx / l, round $ fromIntegral hy / l) else (0, 0)
where
l = realToFrac $ length hats :: Double
(hx, hy) = foldl hat'' (0, 0) hats
hat'' :: (Int, Int) -> SDL.Hat -> (Int, Int)
hat'' (x, y) h =
case h of
SDL.HatCentered -> (x, y)
SDL.HatUp -> (x, y 1)
SDL.HatRight -> (x + 1, y)
SDL.HatDown -> (x, y + 1)
SDL.HatLeft -> (x 1, y)
SDL.HatRightUp -> (x + 1, y 1)
SDL.HatRightDown -> (x + 1, y + 1)
SDL.HatLeftUp -> (x 1, x 1)
SDL.HatLeftDown -> (x 1, y + 1)
button :: Joystick -> Int -> SignalGen (Signal Bool)
button j i = effectful $ SDL.update >> SDL.getButton j (fromIntegral i)
ball :: Joystick -> Int -> SignalGen (Signal (Int, Int))
ball j i = effectful $ SDL.update >> ball' <$> SDL.getBall j (fromIntegral i)
ball' :: Maybe (Int16, Int16) -> (Int, Int)
ball' mayhaps =
case mayhaps of
Just (x, y) -> (fromIntegral x, fromIntegral y)
Nothing -> (0, 0)