Capability.hs

{-# LANGUAGE DeriveDataTypeable #-}
{- |
Module      : Graphics.V4L2.Capability
Maintainer  : claudiusmaximus@goto10.org
Stability   : no
Portability : no
-}
module Graphics.V4L2.Capability
  ( DeviceInfo(..)
  , DeviceCapability(..)
  , deviceInfoCapabilities
  , deviceInfo
  , deviceCapabilities
  ) where

import Data.Bits ((.&.), shiftR)
import Data.Data (Data)
import Data.Set (Set)
import Data.Typeable (Typeable)
import Data.Version (Version(..))
import Data.Word (Word32)

import Bindings.Linux.VideoDev2

import Foreign.Extra.BitSet (fromBitSet)
import Foreign.Extra.String (fromString)
import Graphics.V4L2.Device (Device)
import Graphics.V4L2.IOCtl (ioctl')

{- |  Device information. -}
data DeviceInfo = DeviceInfo{ deviceDriver, deviceCard, deviceBus :: String, deviceVersion :: Version }
  deriving (Eq, Ord, Read, Show, Typeable)

{- |  Device capabilities. -}
data DeviceCapability
  = DeviceVideoCapture
  | DeviceVideoOutput
  | DeviceVideoOverlay
  | DeviceVbiCapture
  | DeviceVbiOutput
  | DeviceSlicedVbiCapture
  | DeviceSlicedVbiOutput
  | DeviceRdsCapture
  | DeviceVideoOutputOverlay
  | DeviceHwFreqSeek
  | DeviceRdsOutput
  | DeviceTuner
  | DeviceAudio
  | DeviceRadio
  | DeviceModulator
  | DeviceReadWrite
  | DeviceAsyncIO
  | DeviceStreaming
  | DeviceTimePerFrame
  | DeviceUnknown Word32
  deriving (Eq, Ord, Read, Show, Data, Typeable)

fromCapability :: Word32 -> Set DeviceCapability
fromCapability = fromBitSet
  [ ( DeviceVideoCapture       , c'V4L2_CAP_VIDEO_CAPTURE        )
  , ( DeviceVideoOutput        , c'V4L2_CAP_VIDEO_OUTPUT         )
  , ( DeviceVideoOverlay       , c'V4L2_CAP_VIDEO_OVERLAY        )
  , ( DeviceVbiCapture         , c'V4L2_CAP_VBI_CAPTURE          )
  , ( DeviceVbiOutput          , c'V4L2_CAP_VBI_OUTPUT           )
  , ( DeviceSlicedVbiCapture   , c'V4L2_CAP_SLICED_VBI_CAPTURE   )
  , ( DeviceSlicedVbiOutput    , c'V4L2_CAP_SLICED_VBI_OUTPUT    )
  , ( DeviceRdsCapture         , c'V4L2_CAP_RDS_CAPTURE          )
  , ( DeviceVideoOutputOverlay , c'V4L2_CAP_VIDEO_OUTPUT_OVERLAY )
  , ( DeviceHwFreqSeek         , c'V4L2_CAP_HW_FREQ_SEEK         )
  , ( DeviceRdsOutput          , c'V4L2_CAP_RDS_OUTPUT           )
  , ( DeviceTuner              , c'V4L2_CAP_TUNER                )
  , ( DeviceAudio              , c'V4L2_CAP_AUDIO                )
  , ( DeviceRadio              , c'V4L2_CAP_RADIO                )
  , ( DeviceModulator          , c'V4L2_CAP_MODULATOR            )
  , ( DeviceReadWrite          , c'V4L2_CAP_READWRITE            )
  , ( DeviceAsyncIO            , c'V4L2_CAP_ASYNCIO              )
  , ( DeviceStreaming          , c'V4L2_CAP_STREAMING            )
  , ( DeviceTimePerFrame       , c'V4L2_CAP_TIMEPERFRAME         )
  ]   DeviceUnknown

{- |  Get device information and capabilities. -}
deviceInfoCapabilities :: Device -> IO (DeviceInfo, Set DeviceCapability)
deviceInfoCapabilities d = do
  c <- ioctl' d C'VIDIOC_QUERYCAP
  return
    ( DeviceInfo
        { deviceDriver = fromString $ c'v4l2_capability'driver c
        , deviceCard = fromString $ c'v4l2_capability'card c
        , deviceBus = fromString $ c'v4l2_capability'bus_info c
        , deviceVersion = fromVersion $ c'v4l2_capability'version c
        }
    , fromCapability $ c'v4l2_capability'capabilities c
    )

{- |  Get device information. -}
deviceInfo :: Device -> IO DeviceInfo
deviceInfo d = fst `fmap` deviceInfoCapabilities d

{- |  Get device capabilities. -}
deviceCapabilities :: Device -> IO (Set DeviceCapability)
deviceCapabilities d = snd `fmap` deviceInfoCapabilities d

fromVersion :: Word32 -> Version
fromVersion v = Version
  { versionBranch =
      [ fromIntegral $ (v `shiftR` 16) .&. 0xFF
      , fromIntegral $ (v `shiftR`  8) .&. 0xFF
      , fromIntegral $ (v            ) .&. 0xFF
      ]
  , versionTags = []
  }