packages feed

v4l2 0.1 → 0.1.0.2

raw patch · 22 files changed

+146/−106 lines, 22 files

Files

Foreign/Extra/BitSet.hs view
@@ -6,7 +6,7 @@ import Data.Bits (Bits, (.&.), (.|.), complement) import Data.Set (Set, empty, insert, toList) -fromBitSet :: (Ord h, Bits c) => [(h, c)] -> (c -> h) -> c -> Set h+fromBitSet :: (Ord h, Bits c, Num c) => [(h, c)] -> (c -> h) -> c -> Set h fromBitSet spec unknown bits   | unmatched == 0 = matched   | otherwise = insert (unknown unmatched) matched@@ -16,7 +16,7 @@       | v == v .&. um = (insert h m, um .&. complement v)       | otherwise     = (m, um) -toBitSet ::(Eq h, Bits c) => [(h, c)] -> (h -> Bool) -> (h -> c) -> Set h -> c+toBitSet ::(Eq h, Bits c, Num c) => [(h, c)] -> (h -> Bool) -> (h -> c) -> Set h -> c toBitSet spec isUnknown unUnknown = foldr (.|.) 0 . map f . toList   where     f h
Graphics/V4L2.hs view
@@ -1,6 +1,6 @@ {- | Module      : Graphics.V4L2-Maintainer  : claudiusmaximus@goto10.org+Maintainer  : claude@mathr.co.uk Stability   : no Portability : no -}
Graphics/V4L2/Capability.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {- | Module      : Graphics.V4L2.Capability-Maintainer  : claudiusmaximus@goto10.org+Maintainer  : claude@mathr.co.uk Stability   : no Portability : no -}
Graphics/V4L2/ColorSpace.hs view
@@ -1,6 +1,6 @@ {- | Module      : Graphics.V4L2.ColorSpace-Maintainer  : claudiusmaximus@goto10.org+Maintainer  : claude@mathr.co.uk Stability   : no Portability : no -}
Graphics/V4L2/ColorSpace/Internal.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {- | Module      : Graphics.V4L2.ColorSpace.Internal-Maintainer  : claudiusmaximus@goto10.org+Maintainer  : claude@mathr.co.uk Stability   : no Portability : no -}
Graphics/V4L2/Control.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-} {- | Module      : Graphics.V4L2.Control-Maintainer  : claudiusmaximus@goto10.org+Maintainer  : claude@mathr.co.uk Stability   : no Portability : no -}@@ -17,9 +17,7 @@   , setControl   ) where -import Prelude hiding (catch)--import Control.Exception (catch, throwIO)+import Control.Exception as E (catch, throwIO) import Control.Monad (liftM) import Data.Data (Data) import Data.Int (Int32)@@ -92,7 +90,7 @@ queryctrl :: Device -> ControlID -> IO (Maybe (ControlID, ControlInfo)) queryctrl d n = do   mq <- (return . Just =<< ioctl d C'VIDIOC_QUERYCTRL . (\s->s{ c'v4l2_queryctrl'id = fromIntegral n }) =<< zero-          ) `catch` (\e -> case ioe_type e of+          ) `E.catch` (\e -> case ioe_type e of     InvalidArgument -> return Nothing     _ -> throwIO e)   case mq of@@ -135,7 +133,7 @@ querymenu :: Device -> ControlID -> MenuID -> IO (Maybe (MenuID, String)) querymenu d c m = do   i <- (return . Just =<< ioctl d C'VIDIOC_QUERYMENU . (\s->s{ c'v4l2_querymenu'id = fromIntegral c, c'v4l2_querymenu'index = fromIntegral m }) =<< zero-         ) `catch` (\e -> case ioe_type e of+         ) `E.catch` (\e -> case ioe_type e of     InvalidArgument -> return Nothing     _ -> throwIO e)   return $ case i of@@ -159,7 +157,7 @@   toControlData = id   fromControlData = id   -{- | Button control data. -}+{- |  Button control data. -} data Activate = Activate   deriving (Eq, Ord, Enum, Bounded, Read, Show, Data, Typeable) @@ -167,9 +165,11 @@   toControlData Activate = 0   fromControlData _ = Activate +{- |  Get a control. -} getControl :: ControlData d => Device -> ControlID -> IO d getControl d c = return . fromControlData . c'v4l2_control'value =<< ioctl d C'VIDIOC_G_CTRL . (\s->s{ c'v4l2_control'id = fromIntegral c }) =<< zero +{- |  Set a control. -} setControl :: ControlData d => Device -> ControlID -> d -> IO () setControl d c x = ioctl_ d C'VIDIOC_S_CTRL . (\s->s{ c'v4l2_control'id = fromIntegral c, c'v4l2_control'value = toControlData x }) =<< zero
Graphics/V4L2/Device.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-} {- | Module      : Graphics.V4L2.Device-Maintainer  : claudiusmaximus@goto10.org+Maintainer  : claude@mathr.co.uk Stability   : no Portability : no -}
Graphics/V4L2/Field.hs view
@@ -1,6 +1,6 @@ {- | Module      : Graphics.V4L2.Field-Maintainer  : claudiusmaximus@goto10.org+Maintainer  : claude@mathr.co.uk Stability   : no Portability : no -}
Graphics/V4L2/Field/Internal.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {- | Module      : Graphics.V4L2.Field.Internal-Maintainer  : claudiusmaximus@goto10.org+Maintainer  : claude@mathr.co.uk Stability   : no Portability : no -}@@ -17,7 +17,7 @@ import Data.Data (Data) import Data.Typeable (Typeable) import Data.Word (Word32)-import Foreign (unsafePerformIO)+import System.IO.Unsafe (unsafePerformIO) import Foreign.Marshal.Utils (toBool)  import Bindings.Linux.VideoDev2
Graphics/V4L2/Format.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-} {- | Module      : Graphics.V4L2.Format-Maintainer  : claudiusmaximus@goto10.org+Maintainer  : claude@mathr.co.uk Stability   : no Portability : no -}@@ -21,9 +21,7 @@   , ImageFormat(..)   ) where -import Prelude hiding (catch)--import Control.Exception (catch, throwIO)+import Control.Exception as E (catch, throwIO) import Control.Monad (when) import Data.Data (Data) import Data.Map (Map)@@ -64,6 +62,7 @@ -} -- FIXME } +{- |  Buffer types. -} data BufferType = BufferVideoCapture | BufferVideoOutput | BufferUnknown Word32   deriving (Eq, Ord, Read, Show, Data, Typeable) @@ -78,15 +77,22 @@     unU (BufferUnknown b) = fromIntegral b     unU _ = error "err" +{- |  Transfer types. -} data Direction = Capture | Output   deriving (Eq, Ord, Enum, Bounded, Read, Show, Data, Typeable) +{- |  Buffer formats. -} class Format f where+  {- |  Corresponding buffer type. -}   formatBufferType :: f -> Direction -> BufferType+  {- |  Query the format. -}   getFormat :: Device -> Direction -> IO f+  {- |  Select the format. -}   setFormat :: Device -> Direction -> f -> IO f+  {- |  Test the format. -}   tryFormat :: Device -> Direction -> f -> IO f +{- |  Image format. -} data ImageFormat = ImageFormat   { imageWidth, imageHeight :: Int   , imagePixelFormat :: PixelFormat@@ -181,7 +187,7 @@  enumfmts' :: FormatID -> Device -> BufferType -> IO (Map FormatID FormatDescription) enumfmts' n h t = do-  mi <- (Just `fmap` enumfmt h t n) `catch` (\e -> case ioe_type e of+  mi <- (Just `fmap` enumfmt h t n) `E.catch` (\e -> case ioe_type e of     InvalidArgument -> return Nothing     _ -> throwIO e)   case mi of@@ -191,7 +197,7 @@ {- |  Enumerate supported frame sizes. -} queryFrameSizes :: Device -> PixelFormat -> IO FrameSizes queryFrameSizes h p = do-  fs <- enumframesizes0 h p `catch` (\e -> case ioe_type e of+  fs <- enumframesizes0 h p `E.catch` (\e -> case ioe_type e of     InvalidArgument -> return (DiscreteSizes S.empty)     _ -> throwIO e)   case fs of@@ -223,7 +229,7 @@   f <- (do     f' <- ioctl h C'VIDIOC_ENUM_FRAMESIZES . (\s->s{ c'v4l2_frmsizeenum'index = n, c'v4l2_frmsizeenum'pixel_format = toPixelFormat p }) =<< zero     when (c'v4l2_frmsizeenum'type f' /= c'V4L2_FRMSIZE_TYPE_DISCRETE) $ error "err"-    return (Just f')) `catch` (\e -> case ioe_type e of+    return (Just f')) `E.catch` (\e -> case ioe_type e of     InvalidArgument -> return Nothing     _ -> throwIO e)   case f of@@ -260,7 +266,7 @@ {- |  Enumerate frame intervals. -} queryFrameIntervals :: Device -> PixelFormat -> FrameSize -> IO FrameIntervals queryFrameIntervals h p f = do-  fi <- enumframeintervals0 h p f `catch` (\e -> case ioe_type e of+  fi <- enumframeintervals0 h p f `E.catch` (\e -> case ioe_type e of     InvalidArgument -> return (DiscreteIntervals S.empty)     _ -> throwIO e)   case fi of@@ -289,14 +295,14 @@   i <- (do     f' <- ioctl h C'VIDIOC_ENUM_FRAMEINTERVALS . (\s->s{ c'v4l2_frmivalenum'index = n, c'v4l2_frmivalenum'pixel_format = toPixelFormat p, c'v4l2_frmivalenum'width = fromIntegral (frameWidth f), c'v4l2_frmivalenum'height = fromIntegral (frameHeight f) }) =<< zero     when (c'v4l2_frmivalenum'type f' /= c'V4L2_FRMIVAL_TYPE_DISCRETE) $ error "err"-    return (Just f')) `catch` (\e -> case ioe_type e of+    return (Just f')) `E.catch` (\e -> case ioe_type e of     InvalidArgument -> return Nothing     _ -> throwIO e)   case i of     Nothing -> return S.empty     Just fs -> S.insert (fromFraction . c'v4l2_frmivalenum_u'discrete . c'v4l2_frmivalenum'u $ fs) `fmap` enumframeintervalsD (n + 1) h p f -{- | Discrete and continuous frame intervals. -}+{- |  Discrete and continuous frame intervals. -} data FrameIntervals   = DiscreteIntervals       { discreteIntervals :: Set Fraction }
Graphics/V4L2/IOCtl.hs view
@@ -1,4 +1,13 @@ {-# LANGUAGE ForeignFunctionInterface #-}+{- |+Module      : Graphics.V4L2.IOCtl+Maintainer  : claude@mathr.co.uk+Stability   : no+Portability : no++Heavily based on the 'ioctl' package (c) Maciej Piechotka.++-} module Graphics.V4L2.IOCtl   ( ioctl   , ioctl_@@ -6,9 +15,10 @@   , zero   ) where -import Foreign (Ptr, Storable, alloca, castPtr, peek, sizeOf, unsafePerformIO, with)-import Foreign.C (CInt, CSize, throwErrnoIfMinus1_)+import Foreign (Ptr, Storable, alloca, castPtr, peek, sizeOf, with)+import Foreign.C (CInt(..), CSize(..), throwErrnoIfMinus1_) import System.Posix.IOCtl (IOControl(ioctlReq))+import System.IO.Unsafe (unsafePerformIO)  import Bindings.LibV4L2 (c'v4l2_ioctl) @@ -42,7 +52,7 @@        -> IO d -- ^ The data ioctl' f req = alloca $ \p -> c_ioctl' f req p >> peek p -+{- |  A value obtained by peeking cleared memory. -} zero :: Storable a => IO a zero = alloca $ \p -> c'memset p 0 (fromIntegral $ sizeOf (undefined `asTypeOf` unsafePerformIO (peek p))) >> peek p
Graphics/V4L2/PixelFormat.hs view
@@ -1,6 +1,6 @@ {- | Module      : Graphics.V4L2.PixelFormat-Maintainer  : claudiusmaximus@goto10.org+Maintainer  : claude@mathr.co.uk Stability   : no Portability : no -}
Graphics/V4L2/PixelFormat/Internal.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {- | Module      : Graphics.V4L2.PixelFormat.Internal-Maintainer  : claudiusmaximus@goto10.org+Maintainer  : claude@mathr.co.uk Stability   : no Portability : no -}
Graphics/V4L2/Priority.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {- | Module      : Graphics.V4L2.Priority-Maintainer  : claudiusmaximus@goto10.org+Maintainer  : claude@mathr.co.uk Stability   : no Portability : no -}
Graphics/V4L2/Types.hs view
@@ -1,3 +1,9 @@+{- |+Module      : Graphics.V4L2.Types+Maintainer  : claude@mathr.co.uk+Stability   : no+Portability : no+-} module Graphics.V4L2.Types   ( module Graphics.V4L2.Types.Internal   ) where
Graphics/V4L2/Types/Internal.hs view
@@ -1,4 +1,10 @@ {-# LANGUAGE DeriveDataTypeable #-}+{- |+Module      : Graphics.V4L2.Types.Internal+Maintainer  : claude@mathr.co.uk+Stability   : no+Portability : no+-} module Graphics.V4L2.Types.Internal   ( Fraction(..)   , fromFraction@@ -10,9 +16,11 @@  import Bindings.Linux.VideoDev2 +{- |  Fraction type. -} data Fraction = Fraction{ fractionNumerator, fractionDenominator:: Word32 }   deriving (Eq, Ord, Read, Show, Data, Typeable) +{- |  Unmarshal fraction. -} fromFraction :: C'v4l2_fract -> Fraction fromFraction f = Fraction   { fractionNumerator = c'v4l2_fract'numerator f
Graphics/V4L2/VideoCapture.hs view
@@ -1,6 +1,6 @@ {- | Module      : Graphics.V4L2.VideoCapture-Maintainer  : claudiusmaximus@goto10.org+Maintainer  : claude@mathr.co.uk Stability   : no Portability : no -}
Graphics/V4L2/VideoCapture/Read.hs view
@@ -1,3 +1,11 @@+{- |+Module      : Graphics.V4L2.VideoCapture.Read+Maintainer  : claude@mathr.co.uk+Stability   : no+Portability : no++Video capture using Read I/O.+-} module Graphics.V4L2.VideoCapture.Read   ( withFrame   ) where@@ -9,6 +17,7 @@ import Graphics.V4L2.Device (Device) import Graphics.V4L2.Format (ImageFormat, imageSize) +{- |  Capture a video frame. -} withFrame :: Device -> ImageFormat -> (Ptr a -> Int -> IO b) -> IO b withFrame d f a = do   allocaBytes (imageSize f) $ \p -> do
Graphics/V4L2/VideoInput.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-} {- | Module      : Graphics.V4L2.VideoInput-Maintainer  : claudiusmaximus@goto10.org+Maintainer  : claude@mathr.co.uk Stability   : no Portability : no -}@@ -16,9 +16,7 @@   , setVideoInput   ) where -import Prelude hiding (catch)--import Control.Exception (catch, throwIO)+import Control.Exception as E (catch, throwIO) import Data.Bits (testBit) import Data.Data (Data) import Data.Map (Map)@@ -136,7 +134,7 @@  enuminputs' :: VideoInputID -> Device -> IO (Map VideoInputID VideoInputInfo) enuminputs' n h = do-  mi <- (Just `fmap` enuminput h n) `catch` (\e -> case ioe_type e of+  mi <- (Just `fmap` enuminput h n) `E.catch` (\e -> case ioe_type e of     InvalidArgument -> return Nothing     _ -> throwIO e)   case mi of
Graphics/V4L2/VideoStandard.hs view
@@ -1,6 +1,6 @@ {- | Module      : Graphics.V4L2.VideoStandard-Maintainer  : claudiusmaximus@goto10.org+Maintainer  : claude@mathr.co.uk Stability   : no Portability : no -}
Graphics/V4L2/VideoStandard/Internal.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-} {- | Module      : Graphics.V4L2.VideoStandard.Internal-Maintainer  : claudiusmaximus@goto10.org+Maintainer  : claude@mathr.co.uk Stability   : no Portability : no -}@@ -60,9 +60,7 @@   , fromVideoStandard   ) where -import Prelude hiding (catch)--import Control.Exception (catch, throwIO)+import Control.Exception as E (catch, throwIO) import Data.Data (Data) import Data.Set (Set) import Data.Map (Map)@@ -80,6 +78,7 @@ import Graphics.V4L2.Types (Fraction) import Graphics.V4L2.Types.Internal (fromFraction) +{- |  Video standard. -} type VideoStandard = Set VideoStandardType  {- |  Elementary video standard flags. -}@@ -115,6 +114,7 @@  {- |  internal -} fromVideoStandard :: Word64 -> VideoStandard+{- |  internal -} toVideoStandard :: VideoStandard -> Word64 (fromVideoStandard, toVideoStandard) = (fromBitSet spec StdUnknown, toBitSet spec isStdUnknown unStdUnknown) where   spec =@@ -150,6 +150,68 @@   unStdUnknown (StdUnknown x) = x   unStdUnknown _ = error "Graphics.V4L2.Video.Standard.Internal.toVideoStandard.unUnknown" +{- |  Video standard identifier. -}+newtype VideoStandardID = VideoStandardID Int+  deriving (Eq, Ord, Enum, Bounded, Read, Show, Data, Typeable, Num, Integral, Real)++{- |  Video standard information. -}+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) `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+  }++{- |  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)++-- Known standards.+ videoStandardPalB  :: VideoStandard videoStandardPalB1 :: VideoStandard videoStandardPalG  :: VideoStandard@@ -242,62 +304,3 @@ 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)
v4l2.cabal view
@@ -1,5 +1,5 @@ Name:                v4l2-Version:             0.1+Version:             0.1.0.2 Synopsis:            interface to Video For Linux Two (V4L2) Description:   Higher-level interface to V4L2.@@ -9,7 +9,7 @@ License:             BSD3 License-file:        LICENSE Author:              Claude Heiland-Allen-Maintainer:          claudiusmaximus@goto10.org+Maintainer:          claude@mathr.co.uk Category:            Graphics  Build-type:          Simple@@ -61,4 +61,4 @@ source-repository this   type:     git   location: git://gitorious.org/hsv4l2/v4l2.git-  tag:      v0.1+  tag:      v0.1.0.2