module Graphics.V4L2.VideoInput
( VideoInputID()
, VideoInputInfo(..)
, VideoInputType(..)
, VideoInputStatus(..)
, VideoInputCapability(..)
, videoInputs
, getVideoInput
, setVideoInput
) where
import Control.Exception as E (catch, throwIO)
import Data.Bits (testBit)
import Data.Data (Data)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Set (Set)
import qualified Data.Set as S
import Data.Typeable (Typeable)
import Data.Word (Word32)
import GHC.IO.Exception (IOErrorType(InvalidArgument), ioe_type)
import Bindings.Linux.VideoDev2
import Foreign.Extra.CEnum (fromCEnum)
import Foreign.Extra.BitSet (fromBitSet)
import Foreign.Extra.String (fromString)
import Graphics.V4L2.Device (Device)
import Graphics.V4L2.IOCtl (ioctl, ioctl_, ioctl', zero)
import Graphics.V4L2.VideoStandard (VideoStandard)
import Graphics.V4L2.VideoStandard.Internal (fromVideoStandard)
c'V4L2_IN_CAP_PRESETS :: Word32
c'V4L2_IN_CAP_PRESETS = 1
c'V4L2_IN_CAP_CUSTOM_TIMINGS :: Word32
c'V4L2_IN_CAP_CUSTOM_TIMINGS = 2
c'V4L2_IN_CAP_STD :: Word32
c'V4L2_IN_CAP_STD = 4
newtype AudioInputID = AudioInputID Int
deriving (Eq, Ord, Enum, Bounded, Read, Show, Data, Typeable, Num, Integral, Real)
newtype TunerID = TunerID Int
deriving (Eq, Ord, Enum, Bounded, Read, Show, Data, Typeable, Num, Integral, Real)
newtype VideoInputID = VideoInputID Int
deriving (Eq, Ord, Enum, Bounded, Read, Show, Data, Typeable, Num, Integral, Real)
data VideoInputInfo = VideoInputInfo
{ videoInputName :: String
, videoInputType :: VideoInputType
, videoInputAudio :: Set AudioInputID
, videoInputTuner :: Set TunerID
, videoInputStandard :: VideoStandard
, videoInputStatus :: Set VideoInputStatus
, videoInputCapability :: Set VideoInputCapability
}
deriving (Eq, Ord, Read, Show, Typeable)
data VideoInputType
= TunerInput
| CameraInput
| UnknownInput Word32
deriving (Eq, Ord, Read, Show, Data, Typeable)
fromVideoInputType :: Word32 -> VideoInputType
fromVideoInputType = fromCEnum
[ ( TunerInput , c'V4L2_INPUT_TYPE_TUNER )
, ( CameraInput , c'V4L2_INPUT_TYPE_CAMERA )
] UnknownInput
data VideoInputStatus
= NoPower
| NoSignal
| NoColor
| HFlip
| VFlip
| NoHLock
| ColorKill
| NoSync
| NoEqu
| NoCarrier
| Macrovision
| NoAccess
| Vtr
| UnknownStatus Word32
deriving (Eq, Ord, Read, Show, Data, Typeable)
fromVideoInputStatus :: Word32 -> Set VideoInputStatus
fromVideoInputStatus = fromBitSet
[ ( NoPower , c'V4L2_IN_ST_NO_POWER )
, ( NoSignal , c'V4L2_IN_ST_NO_SIGNAL )
, ( NoColor , c'V4L2_IN_ST_NO_COLOR )
, ( HFlip , c'V4L2_IN_ST_HFLIP )
, ( VFlip , c'V4L2_IN_ST_VFLIP )
, ( NoHLock , c'V4L2_IN_ST_NO_H_LOCK )
, ( ColorKill , c'V4L2_IN_ST_COLOR_KILL )
, ( NoSync , c'V4L2_IN_ST_NO_SYNC )
, ( NoEqu , c'V4L2_IN_ST_NO_EQU )
, ( NoCarrier , c'V4L2_IN_ST_NO_CARRIER )
, ( Macrovision , c'V4L2_IN_ST_MACROVISION )
, ( NoAccess , c'V4L2_IN_ST_NO_ACCESS )
, ( Vtr , c'V4L2_IN_ST_VTR )
] UnknownStatus
data VideoInputCapability
= Presets
| CustomTimings
| InputStd
| UnknownCapability Word32
deriving (Eq, Ord, Read, Show, Data, Typeable)
fromVideoInputCapability :: Word32 -> Set VideoInputCapability
fromVideoInputCapability = fromBitSet
[ ( Presets , c'V4L2_IN_CAP_PRESETS )
, ( CustomTimings , c'V4L2_IN_CAP_CUSTOM_TIMINGS )
, ( InputStd , c'V4L2_IN_CAP_STD )
] UnknownCapability
videoInputs :: Device -> IO (Map VideoInputID VideoInputInfo)
videoInputs = enuminputs' 0
enuminputs' :: VideoInputID -> Device -> IO (Map VideoInputID VideoInputInfo)
enuminputs' n h = do
mi <- (Just `fmap` enuminput h n) `E.catch` (\e -> case ioe_type e of
InvalidArgument -> return Nothing
_ -> throwIO e)
case mi of
Just i -> M.insert n i `fmap` enuminputs' (n + 1) h
Nothing -> return M.empty
enuminput :: Device -> VideoInputID -> IO VideoInputInfo
enuminput h n = do
i' <- ioctl h C'VIDIOC_ENUMINPUT =<< return . (\s->s{ c'v4l2_input'index = fromIntegral n }) =<< zero
return (decodeInput i')
decodeInput :: C'v4l2_input -> VideoInputInfo
decodeInput i = VideoInputInfo
{ videoInputName = fromString $ c'v4l2_input'name i
, videoInputType = fromVideoInputType $ c'v4l2_input'type i
, videoInputAudio = S.fromList [ fromIntegral ai | ai <- [0..31], c'v4l2_input'audioset i `testBit` ai ]
, videoInputTuner = S.fromList [ fromIntegral ti | ti <- [0..31], c'v4l2_input'tuner i `testBit` ti ]
, videoInputStandard = fromVideoStandard $ c'v4l2_input'std i
, videoInputStatus = fromVideoInputStatus $ c'v4l2_input'status i
, videoInputCapability = fromVideoInputCapability $ c'v4l2_input'reserved i !! 0
}
getVideoInput :: Device -> IO VideoInputID
getVideoInput h = fromIntegral `fmap` ioctl' h C'VIDIOC_G_INPUT
setVideoInput :: Device -> VideoInputID -> IO ()
setVideoInput h i = ioctl_ h C'VIDIOC_S_INPUT (fromIntegral i)