{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-} {- | Module : Graphics.V4L2.VideoStandard.Internal Maintainer : claudiusmaximus@goto10.org Stability : no Portability : no -} module Graphics.V4L2.VideoStandard.Internal ( VideoStandardID() , VideoStandardInfo(..) , videoStandards , getVideoStandard , setVideoStandard , detectVideoStandard -- predefined standards , 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 Prelude hiding (catch) import Control.Exception (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 {- | Elementary video standard flags. -} 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) {- | internal -} 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" 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 -- derived standards 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 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) {- | Enumerate video standards. Drivers may enumerate a different set of standards after switching the video input or output. -} 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) `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 } {- | Get the current video standard. -} getVideoStandard :: Device -> IO VideoStandard getVideoStandard d = do s <- ioctl' d C'VIDIOC_G_STD return (fromVideoStandard s) {- | Set the current video standard. -} setVideoStandard :: Device -> VideoStandard -> IO () setVideoStandard d s = do ioctl_ d C'VIDIOC_S_STD (toVideoStandard s) {- | Detect the current video standard. -} detectVideoStandard :: Device -> IO VideoStandard detectVideoStandard d = do s <- ioctl' d C'VIDIOC_QUERYSTD return (fromVideoStandard s)