large portion
[hsv4l2:phischus-v4l2.git] / Graphics / V4L2 / Priority.hs
1 {-# LANGUAGE DeriveDataTypeable #-}
2 {- |
3 Module      : Graphics.V4L2.Priority
4 Maintainer  : claudiusmaximus@goto10.org
5 Stability   : no
6 Portability : no
7 -}
8 module Graphics.V4L2.Priority
9   ( Priority(..)
10   , getPriority
11   , setPriority
12   ) where
13
14 import Data.Data (Data)
15 import Data.Typeable (Typeable)
16 import Data.Word (Word32)
17
18 import Bindings.Linux.VideoDev2
19
20 import Foreign.Extra.CEnum (fromCEnum, toCEnum)
21 import Graphics.V4L2.Device (Device)
22 import Graphics.V4L2.IOCtl (ioctl', ioctl_)
23
24 {- |  Priorities. -}
25 data Priority
26   = PriorityUnset
27   | PriorityBackground
28   | PriorityInteractive
29   | PriorityDefault
30   | PriorityRecord
31   | PriorityUnknown Word32
32   deriving (Eq, Ord, Read, Show, Data, Typeable)
33
34 fromPriority :: C'v4l2_priority -> Priority
35 toPriority :: Priority -> C'v4l2_priority
36 (fromPriority, toPriority) = (fromCEnum spec (PriorityUnknown . fromIntegral), toCEnum spec isUnknown unUnknown) where
37   spec =
38     [ ( PriorityUnset       , c'V4L2_PRIORITY_UNSET       )
39     , ( PriorityBackground  , c'V4L2_PRIORITY_BACKGROUND  )
40     , ( PriorityInteractive , c'V4L2_PRIORITY_INTERACTIVE )
41     , ( PriorityDefault     , c'V4L2_PRIORITY_DEFAULT     )
42     , ( PriorityRecord      , c'V4L2_PRIORITY_RECORD      )
43     ]
44   isUnknown (PriorityUnknown _) = True
45   isUnknown _ = False
46   unUnknown (PriorityUnknown x) = fromIntegral x
47   unUnknown _ = error "Graphics.V4L2.Priority.toPriority.unUnknown"
48
49 {- |  Get priority. -}
50 getPriority :: Device -> IO Priority
51 getPriority d = fromPriority `fmap` ioctl' d C'VIDIOC_G_PRIORITY
52
53 {- |  Set priority. -}
54 setPriority :: Device -> Priority -> IO ()
55 setPriority d p = ioctl_ d C'VIDIOC_S_PRIORITY (toPriority p)