Compatibility with ghc-7.6
[hsv4l2:v4l2.git] / Graphics / V4L2 / Field / Internal.hs
1 {-# LANGUAGE DeriveDataTypeable #-}
2 {- |
3 Module      : Graphics.V4L2.Field.Internal
4 Maintainer  : claudiusmaximus@goto10.org
5 Stability   : no
6 Portability : no
7 -}
8 module Graphics.V4L2.Field.Internal
9   ( Field(..)
10   , fieldHasTop
11   , fieldHasBottom
12   , fieldHasBoth
13   , fromField
14   , toField
15   ) where
16
17 import Data.Data (Data)
18 import Data.Typeable (Typeable)
19 import Data.Word (Word32)
20 import System.IO.Unsafe (unsafePerformIO)
21 import Foreign.Marshal.Utils (toBool)
22
23 import Bindings.Linux.VideoDev2
24
25 import Foreign.Extra.CEnum (toCEnum, fromCEnum)
26
27 {- |  Interlacing modes. -}
28 data Field
29   = FieldAny
30   | FieldNone
31   | FieldTop
32   | FieldBottom
33   | FieldInterlaced
34   | FieldSeqTB
35   | FieldSeqBT
36   | FieldAlternate
37   | FieldInterlacedTB
38   | FieldInterlacedBT
39   | FieldUnknown Word32
40   deriving (Eq, Ord, Read, Show, Data, Typeable)
41
42 {- |  internal -}
43 fromField :: C'v4l2_field -> Field
44 {- |  internal -}
45 toField :: Field -> C'v4l2_field
46
47 (fromField, toField) = (fromCEnum spec (FieldUnknown . fromIntegral), toCEnum spec isUnknown unUnknown) where
48   spec =
49     [ ( FieldAny          , c'V4L2_FIELD_ANY           )
50     , ( FieldNone         , c'V4L2_FIELD_NONE          )
51     , ( FieldTop          , c'V4L2_FIELD_TOP           )
52     , ( FieldBottom       , c'V4L2_FIELD_BOTTOM        )
53     , ( FieldInterlaced   , c'V4L2_FIELD_INTERLACED    )
54     , ( FieldSeqTB        , c'V4L2_FIELD_SEQ_TB        )
55     , ( FieldSeqBT        , c'V4L2_FIELD_SEQ_BT        )
56     , ( FieldAlternate    , c'V4L2_FIELD_ALTERNATE     )
57     , ( FieldInterlacedTB , c'V4L2_FIELD_INTERLACED_TB )
58     , ( FieldInterlacedBT , c'V4L2_FIELD_INTERLACED_BT )
59     ]
60   isUnknown (FieldUnknown _) = True
61   isUnknown _ = False
62   unUnknown (FieldUnknown f) = fromIntegral f
63   unUnknown _ = error "Graphice.V4L2.Field.Internal.toField"
64
65 {- |  Inspect field interlacing. -}
66 fieldHasTop :: Field -> Bool
67 fieldHasTop    f = unsafePerformIO $ toBool `fmap` c'V4L2_FIELD_HAS_TOP    (toField f)
68
69 {- |  Inspect field interlacing. -}
70 fieldHasBottom :: Field -> Bool
71 fieldHasBottom f = unsafePerformIO $ toBool `fmap` c'V4L2_FIELD_HAS_BOTTOM (toField f)
72
73 {- |  Inspect field interlacing. -}
74 fieldHasBoth :: Field -> Bool
75 fieldHasBoth   f = unsafePerformIO $ toBool `fmap` c'V4L2_FIELD_HAS_BOTH   (toField f)