module Graphics.V4L2.VideoStandard.Internal
( VideoStandardID()
, VideoStandardInfo(..)
, videoStandards
, getVideoStandard
, setVideoStandard
, detectVideoStandard
, VideoStandard
, VideoStandardType(..)
, videoStandardPalB
, videoStandardPalB1
, videoStandardPalG
, videoStandardPalH
, videoStandardPalI
, videoStandardPalD
, videoStandardPalD1
, videoStandardPalK
, videoStandardPalM
, videoStandardPalN
, videoStandardPalNc
, videoStandardPal60
, videoStandardNtscM
, videoStandardNtscM_JP
, videoStandardNtsc443
, videoStandardNtscM_KR
, videoStandardSecamB
, videoStandardSecamD
, videoStandardSecamG
, videoStandardSecamH
, videoStandardSecamK
, videoStandardSecamK1
, videoStandardSecamL
, videoStandardSecamLC
, videoStandardAtsc8Vsb
, videoStandardAtsc16Vsb
, videoStandardMn
, videoStandardB
, videoStandardGh
, videoStandardDk
, videoStandardPalBg
, videoStandardPalDk
, videoStandardPal
, videoStandardNtsc
, videoStandardSecamDk
, videoStandardSecam
, videoStandard525_60
, videoStandard625_50
, videoStandardAtsc
, videoStandardUnknown
, videoStandardAll
, fromVideoStandard
) where
import Control.Exception as E (catch, throwIO)
import Data.Data (Data)
import Data.Set (Set)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Typeable (Typeable)
import Data.Word (Word64)
import GHC.IO.Exception (IOErrorType(InvalidArgument), ioe_type)
import Bindings.Linux.VideoDev2
import Foreign.Extra.BitSet (fromBitSet, toBitSet)
import Foreign.Extra.String (fromString)
import Graphics.V4L2.Device (Device)
import Graphics.V4L2.IOCtl (ioctl, ioctl_, ioctl', zero)
import Graphics.V4L2.Types (Fraction)
import Graphics.V4L2.Types.Internal (fromFraction)
type VideoStandard = Set VideoStandardType
data VideoStandardType
= StdPalB
| StdPalB1
| StdPalG
| StdPalH
| StdPalI
| StdPalD
| StdPalD1
| StdPalK
| StdPalM
| StdPalN
| StdPalNc
| StdPal60
| StdNtscM
| StdNtscMJp
| StdNtsc443
| StdNtscMKr
| StdSecamB
| StdSecamD
| StdSecamG
| StdSecamH
| StdSecamK
| StdSecamK1
| StdSecamL
| StdSecamLC
| StdAtsc8Vsb
| StdAtsc16Vsb
| StdUnknown Word64
deriving (Eq, Ord, Read, Show, Data, Typeable)
fromVideoStandard :: Word64 -> VideoStandard
toVideoStandard :: VideoStandard -> Word64
(fromVideoStandard, toVideoStandard) = (fromBitSet spec StdUnknown, toBitSet spec isStdUnknown unStdUnknown) where
spec =
[ ( StdPalB , c'V4L2_STD_PAL_B )
, ( StdPalB1 , c'V4L2_STD_PAL_B1 )
, ( StdPalG , c'V4L2_STD_PAL_G )
, ( StdPalH , c'V4L2_STD_PAL_H )
, ( StdPalI , c'V4L2_STD_PAL_I )
, ( StdPalD , c'V4L2_STD_PAL_D )
, ( StdPalD1 , c'V4L2_STD_PAL_D1 )
, ( StdPalK , c'V4L2_STD_PAL_K )
, ( StdPalM , c'V4L2_STD_PAL_M )
, ( StdPalN , c'V4L2_STD_PAL_N )
, ( StdPalNc , c'V4L2_STD_PAL_Nc )
, ( StdPal60 , c'V4L2_STD_PAL_60 )
, ( StdNtscM , c'V4L2_STD_NTSC_M )
, ( StdNtscMJp , c'V4L2_STD_NTSC_M_JP )
, ( StdNtsc443 , c'V4L2_STD_NTSC_443 )
, ( StdNtscMKr , c'V4L2_STD_NTSC_M_KR )
, ( StdSecamB , c'V4L2_STD_SECAM_B )
, ( StdSecamD , c'V4L2_STD_SECAM_D )
, ( StdSecamG , c'V4L2_STD_SECAM_G )
, ( StdSecamH , c'V4L2_STD_SECAM_H )
, ( StdSecamK , c'V4L2_STD_SECAM_K )
, ( StdSecamK1 , c'V4L2_STD_SECAM_K1 )
, ( StdSecamL , c'V4L2_STD_SECAM_L )
, ( StdSecamLC , c'V4L2_STD_SECAM_LC )
, ( StdAtsc8Vsb , c'V4L2_STD_ATSC_8_VSB )
, ( StdAtsc16Vsb , c'V4L2_STD_ATSC_16_VSB )
]
isStdUnknown (StdUnknown _) = True
isStdUnknown _ = False
unStdUnknown (StdUnknown x) = x
unStdUnknown _ = error "Graphics.V4L2.Video.Standard.Internal.toVideoStandard.unUnknown"
newtype VideoStandardID = VideoStandardID Int
deriving (Eq, Ord, Enum, Bounded, Read, Show, Data, Typeable, Num, Integral, Real)
data VideoStandardInfo = VideoStandardInfo
{ videoStandardStandard :: VideoStandard
, videoStandardName :: String
, videoStandardFramePeriod :: Fraction
, videoStandardFrameLines :: Int
}
deriving (Eq, Ord, Read, Show, Data, Typeable)
videoStandards :: Device -> IO (Map VideoStandardID VideoStandardInfo)
videoStandards = enumstds' 0
enumstds' :: VideoStandardID -> Device -> IO (Map VideoStandardID VideoStandardInfo)
enumstds' n h = do
mi <- (Just `fmap` enumstd 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` enumstds' (n + 1) h
Nothing -> return M.empty
enumstd :: Device -> VideoStandardID -> IO VideoStandardInfo
enumstd h n = do
i' <- ioctl h C'VIDIOC_ENUMSTD =<< return . (\s->s{ c'v4l2_standard'index = fromIntegral n }) =<< zero
return (decodeStandard i')
decodeStandard :: C'v4l2_standard -> VideoStandardInfo
decodeStandard i = VideoStandardInfo
{ videoStandardStandard = fromVideoStandard $ c'v4l2_standard'id i
, videoStandardName = fromString $ c'v4l2_standard'name i
, videoStandardFramePeriod = fromFraction $ c'v4l2_standard'frameperiod i
, videoStandardFrameLines = fromIntegral $ c'v4l2_standard'framelines i
}
getVideoStandard :: Device -> IO VideoStandard
getVideoStandard d = do
s <- ioctl' d C'VIDIOC_G_STD
return (fromVideoStandard s)
setVideoStandard :: Device -> VideoStandard -> IO ()
setVideoStandard d s = do
ioctl_ d C'VIDIOC_S_STD (toVideoStandard s)
detectVideoStandard :: Device -> IO VideoStandard
detectVideoStandard d = do
s <- ioctl' d C'VIDIOC_QUERYSTD
return (fromVideoStandard s)
videoStandardPalB :: VideoStandard
videoStandardPalB1 :: VideoStandard
videoStandardPalG :: VideoStandard
videoStandardPalH :: VideoStandard
videoStandardPalI :: VideoStandard
videoStandardPalD :: VideoStandard
videoStandardPalD1 :: VideoStandard
videoStandardPalK :: VideoStandard
videoStandardPalM :: VideoStandard
videoStandardPalN :: VideoStandard
videoStandardPalNc :: VideoStandard
videoStandardPal60 :: VideoStandard
videoStandardNtscM :: VideoStandard
videoStandardNtscM_JP :: VideoStandard
videoStandardNtsc443 :: VideoStandard
videoStandardNtscM_KR :: VideoStandard
videoStandardSecamB :: VideoStandard
videoStandardSecamD :: VideoStandard
videoStandardSecamG :: VideoStandard
videoStandardSecamH :: VideoStandard
videoStandardSecamK :: VideoStandard
videoStandardSecamK1 :: VideoStandard
videoStandardSecamL :: VideoStandard
videoStandardSecamLC :: VideoStandard
videoStandardAtsc8Vsb :: VideoStandard
videoStandardAtsc16Vsb :: VideoStandard
videoStandardMn :: VideoStandard
videoStandardB :: VideoStandard
videoStandardGh :: VideoStandard
videoStandardDk :: VideoStandard
videoStandardPalBg :: VideoStandard
videoStandardPalDk :: VideoStandard
videoStandardPal :: VideoStandard
videoStandardNtsc :: VideoStandard
videoStandardSecamDk :: VideoStandard
videoStandardSecam :: VideoStandard
videoStandard525_60 :: VideoStandard
videoStandard625_50 :: VideoStandard
videoStandardAtsc :: VideoStandard
videoStandardUnknown :: VideoStandard
videoStandardAll :: VideoStandard
videoStandardPalB = fromVideoStandard c'V4L2_STD_PAL_B
videoStandardPalB1 = fromVideoStandard c'V4L2_STD_PAL_B1
videoStandardPalG = fromVideoStandard c'V4L2_STD_PAL_G
videoStandardPalH = fromVideoStandard c'V4L2_STD_PAL_H
videoStandardPalI = fromVideoStandard c'V4L2_STD_PAL_I
videoStandardPalD = fromVideoStandard c'V4L2_STD_PAL_D
videoStandardPalD1 = fromVideoStandard c'V4L2_STD_PAL_D1
videoStandardPalK = fromVideoStandard c'V4L2_STD_PAL_K
videoStandardPalM = fromVideoStandard c'V4L2_STD_PAL_M
videoStandardPalN = fromVideoStandard c'V4L2_STD_PAL_N
videoStandardPalNc = fromVideoStandard c'V4L2_STD_PAL_Nc
videoStandardPal60 = fromVideoStandard c'V4L2_STD_PAL_60
videoStandardNtscM = fromVideoStandard c'V4L2_STD_NTSC_M
videoStandardNtscM_JP = fromVideoStandard c'V4L2_STD_NTSC_M_JP
videoStandardNtsc443 = fromVideoStandard c'V4L2_STD_NTSC_443
videoStandardNtscM_KR = fromVideoStandard c'V4L2_STD_NTSC_M_KR
videoStandardSecamB = fromVideoStandard c'V4L2_STD_SECAM_B
videoStandardSecamD = fromVideoStandard c'V4L2_STD_SECAM_D
videoStandardSecamG = fromVideoStandard c'V4L2_STD_SECAM_G
videoStandardSecamH = fromVideoStandard c'V4L2_STD_SECAM_H
videoStandardSecamK = fromVideoStandard c'V4L2_STD_SECAM_K
videoStandardSecamK1 = fromVideoStandard c'V4L2_STD_SECAM_K1
videoStandardSecamL = fromVideoStandard c'V4L2_STD_SECAM_L
videoStandardSecamLC = fromVideoStandard c'V4L2_STD_SECAM_LC
videoStandardAtsc8Vsb = fromVideoStandard c'V4L2_STD_ATSC_8_VSB
videoStandardAtsc16Vsb = fromVideoStandard c'V4L2_STD_ATSC_16_VSB
videoStandardMn = fromVideoStandard c'V4L2_STD_MN
videoStandardB = fromVideoStandard c'V4L2_STD_B
videoStandardGh = fromVideoStandard c'V4L2_STD_GH
videoStandardDk = fromVideoStandard c'V4L2_STD_DK
videoStandardPalBg = fromVideoStandard c'V4L2_STD_PAL_BG
videoStandardPalDk = fromVideoStandard c'V4L2_STD_PAL_DK
videoStandardPal = fromVideoStandard c'V4L2_STD_PAL
videoStandardNtsc = fromVideoStandard c'V4L2_STD_NTSC
videoStandardSecamDk = fromVideoStandard c'V4L2_STD_SECAM_DK
videoStandardSecam = fromVideoStandard c'V4L2_STD_SECAM
videoStandard525_60 = fromVideoStandard c'V4L2_STD_525_60
videoStandard625_50 = fromVideoStandard c'V4L2_STD_625_50
videoStandardAtsc = fromVideoStandard c'V4L2_STD_ATSC
videoStandardUnknown = fromVideoStandard c'V4L2_STD_UNKNOWN
videoStandardAll = fromVideoStandard c'V4L2_STD_ALL