module Graphics.XHB.Gen.Xv.Types (deserializeError, deserializeEvent, PORT, ENCODING, Type(..), ImageFormatInfoType(..), ImageFormatInfoFormat(..), AttributeFlag(..), VideoNotifyReason(..), ScanlineOrder(..), GrabPortStatus(..), Rational(..), Format(..), AdaptorInfo(..), EncodingInfo(..), Image(..), AttributeInfo(..), ImageFormatInfo(..), VideoNotifyEvent(..), PortNotifyEvent(..), QueryExtension(..), QueryExtensionReply(..), QueryAdaptors(..), QueryAdaptorsReply(..), QueryEncodings(..), QueryEncodingsReply(..), GrabPort(..), GrabPortReply(..), UngrabPort(..), PutVideo(..), PutStill(..), GetVideo(..), GetStill(..), StopVideo(..), SelectVideoNotify(..), SelectPortNotify(..), QueryBestSize(..), QueryBestSizeReply(..), SetPortAttribute(..), GetPortAttribute(..), GetPortAttributeReply(..), QueryPortAttributes(..), QueryPortAttributesReply(..), ListImageFormats(..), ListImageFormatsReply(..), QueryImageAttributes(..), QueryImageAttributesReply(..), PutImage(..), ShmPutImage(..)) where import Prelude hiding (Rational) import Data.Word import Data.Int import Foreign.C.Types import Data.Bits import Data.Binary.Put import Data.Binary.Get import Data.Typeable import Control.Monad import Control.Exception import Data.List import Graphics.XHB.Shared hiding (Event, Error) import qualified Graphics.XHB.Shared import Graphics.XHB.Gen.Xproto.Types hiding (QueryExtension(..), QueryExtensionReply(..), QueryBestSize(..), QueryBestSizeReply(..), PutImage(..), deserializeError, deserializeEvent) import qualified Graphics.XHB.Gen.Xproto.Types import Graphics.XHB.Gen.Shm.Types hiding (PutImage(..), deserializeError, deserializeEvent) import qualified Graphics.XHB.Gen.Shm.Types deserializeError :: Word8 -> Maybe (Get SomeError) deserializeError _ = Nothing deserializeEvent :: Word8 -> Maybe (Get SomeEvent) deserializeEvent 0 = return (liftM toEvent (deserialize :: Get VideoNotifyEvent)) deserializeEvent 1 = return (liftM toEvent (deserialize :: Get PortNotifyEvent)) deserializeEvent _ = Nothing newtype PORT = MkPORT Xid deriving (Eq, Ord, Show, Serialize, Deserialize, XidLike) newtype ENCODING = MkENCODING Xid deriving (Eq, Ord, Show, Serialize, Deserialize, XidLike) data Type = TypeInputMask | TypeOutputMask | TypeVideoMask | TypeStillMask | TypeImageMask deriving Show instance BitEnum Type where toBit TypeInputMask{} = 0 toBit TypeOutputMask{} = 1 toBit TypeVideoMask{} = 2 toBit TypeStillMask{} = 3 toBit TypeImageMask{} = 4 fromBit 0 = TypeInputMask fromBit 1 = TypeOutputMask fromBit 2 = TypeVideoMask fromBit 3 = TypeStillMask fromBit 4 = TypeImageMask data ImageFormatInfoType = ImageFormatInfoTypeRGB | ImageFormatInfoTypeYUV deriving Show instance SimpleEnum ImageFormatInfoType where toValue ImageFormatInfoTypeRGB{} = 0 toValue ImageFormatInfoTypeYUV{} = 1 fromValue 0 = ImageFormatInfoTypeRGB fromValue 1 = ImageFormatInfoTypeYUV data ImageFormatInfoFormat = ImageFormatInfoFormatPacked | ImageFormatInfoFormatPlanar deriving Show instance SimpleEnum ImageFormatInfoFormat where toValue ImageFormatInfoFormatPacked{} = 0 toValue ImageFormatInfoFormatPlanar{} = 1 fromValue 0 = ImageFormatInfoFormatPacked fromValue 1 = ImageFormatInfoFormatPlanar data AttributeFlag = AttributeFlagGettable | AttributeFlagSettable deriving Show instance BitEnum AttributeFlag where toBit AttributeFlagGettable{} = 0 toBit AttributeFlagSettable{} = 1 fromBit 0 = AttributeFlagGettable fromBit 1 = AttributeFlagSettable data VideoNotifyReason = VideoNotifyReasonStarted | VideoNotifyReasonStopped | VideoNotifyReasonBusy | VideoNotifyReasonPreempted | VideoNotifyReasonHardError deriving Show instance SimpleEnum VideoNotifyReason where toValue VideoNotifyReasonStarted{} = 0 toValue VideoNotifyReasonStopped{} = 1 toValue VideoNotifyReasonBusy{} = 2 toValue VideoNotifyReasonPreempted{} = 3 toValue VideoNotifyReasonHardError{} = 4 fromValue 0 = VideoNotifyReasonStarted fromValue 1 = VideoNotifyReasonStopped fromValue 2 = VideoNotifyReasonBusy fromValue 3 = VideoNotifyReasonPreempted fromValue 4 = VideoNotifyReasonHardError data ScanlineOrder = ScanlineOrderTopToBottom | ScanlineOrderBottomToTop deriving Show instance SimpleEnum ScanlineOrder where toValue ScanlineOrderTopToBottom{} = 0 toValue ScanlineOrderBottomToTop{} = 1 fromValue 0 = ScanlineOrderTopToBottom fromValue 1 = ScanlineOrderBottomToTop data GrabPortStatus = GrabPortStatusSuccess | GrabPortStatusBadExtension | GrabPortStatusAlreadyGrabbed | GrabPortStatusInvalidTime | GrabPortStatusBadReply | GrabPortStatusBadAlloc deriving Show instance SimpleEnum GrabPortStatus where toValue GrabPortStatusSuccess{} = 0 toValue GrabPortStatusBadExtension{} = 1 toValue GrabPortStatusAlreadyGrabbed{} = 2 toValue GrabPortStatusInvalidTime{} = 3 toValue GrabPortStatusBadReply{} = 4 toValue GrabPortStatusBadAlloc{} = 5 fromValue 0 = GrabPortStatusSuccess fromValue 1 = GrabPortStatusBadExtension fromValue 2 = GrabPortStatusAlreadyGrabbed fromValue 3 = GrabPortStatusInvalidTime fromValue 4 = GrabPortStatusBadReply fromValue 5 = GrabPortStatusBadAlloc data Rational = MkRational{numerator_Rational :: Int32, denominator_Rational :: Int32} deriving (Show, Typeable) instance Serialize Rational where serialize x = do serialize (numerator_Rational x) serialize (denominator_Rational x) size x = size (numerator_Rational x) + size (denominator_Rational x) instance Deserialize Rational where deserialize = do numerator <- deserialize denominator <- deserialize return (MkRational numerator denominator) data Format = MkFormat{visual_Format :: VISUALID, depth_Format :: Word8} deriving (Show, Typeable) instance Serialize Format where serialize x = do serialize (visual_Format x) serialize (depth_Format x) putSkip 3 size x = size (visual_Format x) + size (depth_Format x) + 3 instance Deserialize Format where deserialize = do visual <- deserialize depth <- deserialize skip 3 return (MkFormat visual depth) data AdaptorInfo = MkAdaptorInfo{base_id_AdaptorInfo :: PORT, name_size_AdaptorInfo :: Word16, num_ports_AdaptorInfo :: Word16, num_formats_AdaptorInfo :: Word16, type_AdaptorInfo :: [Type], name_AdaptorInfo :: [CChar], formats_AdaptorInfo :: [Format]} deriving (Show, Typeable) instance Serialize AdaptorInfo where serialize x = do serialize (base_id_AdaptorInfo x) serialize (name_size_AdaptorInfo x) serialize (num_ports_AdaptorInfo x) serialize (num_formats_AdaptorInfo x) serialize (toMask (type_AdaptorInfo x) :: Word8) putSkip 1 serializeList (name_AdaptorInfo x) serializeList (formats_AdaptorInfo x) size x = size (base_id_AdaptorInfo x) + size (name_size_AdaptorInfo x) + size (num_ports_AdaptorInfo x) + size (num_formats_AdaptorInfo x) + size (undefined :: Word8) + 1 + sum (map size (name_AdaptorInfo x)) + sum (map size (formats_AdaptorInfo x)) instance Deserialize AdaptorInfo where deserialize = do base_id <- deserialize name_size <- deserialize num_ports <- deserialize num_formats <- deserialize type_ <- liftM fromMask (deserialize :: Get Word8) skip 1 name <- deserializeList (fromIntegral name_size) formats <- deserializeList (fromIntegral num_formats) return (MkAdaptorInfo base_id name_size num_ports num_formats type_ name formats) data EncodingInfo = MkEncodingInfo{encoding_EncodingInfo :: ENCODING, name_size_EncodingInfo :: Word16, width_EncodingInfo :: Word16, height_EncodingInfo :: Word16, rate_EncodingInfo :: Rational, name_EncodingInfo :: [CChar]} deriving (Show, Typeable) instance Serialize EncodingInfo where serialize x = do serialize (encoding_EncodingInfo x) serialize (name_size_EncodingInfo x) serialize (width_EncodingInfo x) serialize (height_EncodingInfo x) putSkip 2 serialize (rate_EncodingInfo x) serializeList (name_EncodingInfo x) size x = size (encoding_EncodingInfo x) + size (name_size_EncodingInfo x) + size (width_EncodingInfo x) + size (height_EncodingInfo x) + 2 + size (rate_EncodingInfo x) + sum (map size (name_EncodingInfo x)) instance Deserialize EncodingInfo where deserialize = do encoding <- deserialize name_size <- deserialize width <- deserialize height <- deserialize skip 2 rate <- deserialize name <- deserializeList (fromIntegral name_size) return (MkEncodingInfo encoding name_size width height rate name) data Image = MkImage{id_Image :: Word32, width_Image :: Word16, height_Image :: Word16, data_size_Image :: Word32, num_planes_Image :: Word32, pitches_Image :: [Word32], offsets_Image :: [Word32], data_Image :: [Word8]} deriving (Show, Typeable) instance Serialize Image where serialize x = do serialize (id_Image x) serialize (width_Image x) serialize (height_Image x) serialize (data_size_Image x) serialize (num_planes_Image x) serializeList (pitches_Image x) serializeList (offsets_Image x) serializeList (data_Image x) size x = size (id_Image x) + size (width_Image x) + size (height_Image x) + size (data_size_Image x) + size (num_planes_Image x) + sum (map size (pitches_Image x)) + sum (map size (offsets_Image x)) + sum (map size (data_Image x)) instance Deserialize Image where deserialize = do id <- deserialize width <- deserialize height <- deserialize data_size <- deserialize num_planes <- deserialize pitches <- deserializeList (fromIntegral num_planes) offsets <- deserializeList (fromIntegral num_planes) data_ <- deserializeList (fromIntegral data_size) return (MkImage id width height data_size num_planes pitches offsets data_) data AttributeInfo = MkAttributeInfo{flags_AttributeInfo :: [AttributeFlag], min_AttributeInfo :: Int32, max_AttributeInfo :: Int32, size_AttributeInfo :: Word32, name_AttributeInfo :: [CChar]} deriving (Show, Typeable) instance Serialize AttributeInfo where serialize x = do serialize (toMask (flags_AttributeInfo x) :: Word32) serialize (min_AttributeInfo x) serialize (max_AttributeInfo x) serialize (size_AttributeInfo x) serializeList (name_AttributeInfo x) size x = size (undefined :: Word32) + size (min_AttributeInfo x) + size (max_AttributeInfo x) + size (size_AttributeInfo x) + sum (map size (name_AttributeInfo x)) instance Deserialize AttributeInfo where deserialize = do flags <- liftM fromMask (deserialize :: Get Word32) min <- deserialize max <- deserialize size <- deserialize name <- deserializeList (fromIntegral size) return (MkAttributeInfo flags min max size name) data ImageFormatInfo = MkImageFormatInfo{id_ImageFormatInfo :: Word32, type_ImageFormatInfo :: ImageFormatInfoType, byte_order_ImageFormatInfo :: ImageOrder, guid_ImageFormatInfo :: [Word8], bpp_ImageFormatInfo :: Word8, num_planes_ImageFormatInfo :: Word8, depth_ImageFormatInfo :: Word8, red_mask_ImageFormatInfo :: Word32, green_mask_ImageFormatInfo :: Word32, blue_mask_ImageFormatInfo :: Word32, format_ImageFormatInfo :: ImageFormatInfoFormat, y_sample_bits_ImageFormatInfo :: Word32, u_sample_bits_ImageFormatInfo :: Word32, v_sample_bits_ImageFormatInfo :: Word32, vhorz_y_period_ImageFormatInfo :: Word32, vhorz_u_period_ImageFormatInfo :: Word32, vhorz_v_period_ImageFormatInfo :: Word32, vvert_y_period_ImageFormatInfo :: Word32, vvert_u_period_ImageFormatInfo :: Word32, vvert_v_period_ImageFormatInfo :: Word32, vcomp_order_ImageFormatInfo :: [Word8], vscanline_order_ImageFormatInfo :: ScanlineOrder} deriving (Show, Typeable) instance Serialize ImageFormatInfo where serialize x = do serialize (id_ImageFormatInfo x) serialize (toValue (type_ImageFormatInfo x) :: Word8) serialize (toValue (byte_order_ImageFormatInfo x) :: Word8) putSkip 2 serializeList (guid_ImageFormatInfo x) serialize (bpp_ImageFormatInfo x) serialize (num_planes_ImageFormatInfo x) putSkip 2 serialize (depth_ImageFormatInfo x) putSkip 3 serialize (red_mask_ImageFormatInfo x) serialize (green_mask_ImageFormatInfo x) serialize (blue_mask_ImageFormatInfo x) serialize (toValue (format_ImageFormatInfo x) :: Word8) putSkip 3 serialize (y_sample_bits_ImageFormatInfo x) serialize (u_sample_bits_ImageFormatInfo x) serialize (v_sample_bits_ImageFormatInfo x) serialize (vhorz_y_period_ImageFormatInfo x) serialize (vhorz_u_period_ImageFormatInfo x) serialize (vhorz_v_period_ImageFormatInfo x) serialize (vvert_y_period_ImageFormatInfo x) serialize (vvert_u_period_ImageFormatInfo x) serialize (vvert_v_period_ImageFormatInfo x) serializeList (vcomp_order_ImageFormatInfo x) serialize (toValue (vscanline_order_ImageFormatInfo x) :: Word8) putSkip 11 size x = size (id_ImageFormatInfo x) + size (undefined :: Word8) + size (undefined :: Word8) + 2 + sum (map size (guid_ImageFormatInfo x)) + size (bpp_ImageFormatInfo x) + size (num_planes_ImageFormatInfo x) + 2 + size (depth_ImageFormatInfo x) + 3 + size (red_mask_ImageFormatInfo x) + size (green_mask_ImageFormatInfo x) + size (blue_mask_ImageFormatInfo x) + size (undefined :: Word8) + 3 + size (y_sample_bits_ImageFormatInfo x) + size (u_sample_bits_ImageFormatInfo x) + size (v_sample_bits_ImageFormatInfo x) + size (vhorz_y_period_ImageFormatInfo x) + size (vhorz_u_period_ImageFormatInfo x) + size (vhorz_v_period_ImageFormatInfo x) + size (vvert_y_period_ImageFormatInfo x) + size (vvert_u_period_ImageFormatInfo x) + size (vvert_v_period_ImageFormatInfo x) + sum (map size (vcomp_order_ImageFormatInfo x)) + size (undefined :: Word8) + 11 instance Deserialize ImageFormatInfo where deserialize = do id <- deserialize type_ <- liftM fromValue (deserialize :: Get Word8) byte_order <- liftM fromValue (deserialize :: Get Word8) skip 2 guid <- deserializeList (fromIntegral 16) bpp <- deserialize num_planes <- deserialize skip 2 depth <- deserialize skip 3 red_mask <- deserialize green_mask <- deserialize blue_mask <- deserialize format <- liftM fromValue (deserialize :: Get Word8) skip 3 y_sample_bits <- deserialize u_sample_bits <- deserialize v_sample_bits <- deserialize vhorz_y_period <- deserialize vhorz_u_period <- deserialize vhorz_v_period <- deserialize vvert_y_period <- deserialize vvert_u_period <- deserialize vvert_v_period <- deserialize vcomp_order <- deserializeList (fromIntegral 32) vscanline_order <- liftM fromValue (deserialize :: Get Word8) skip 11 return (MkImageFormatInfo id type_ byte_order guid bpp num_planes depth red_mask green_mask blue_mask format y_sample_bits u_sample_bits v_sample_bits vhorz_y_period vhorz_u_period vhorz_v_period vvert_y_period vvert_u_period vvert_v_period vcomp_order vscanline_order) data VideoNotifyEvent = MkVideoNotifyEvent{reason_VideoNotifyEvent :: VideoNotifyReason, time_VideoNotifyEvent :: TIMESTAMP, drawable_VideoNotifyEvent :: DRAWABLE, port_VideoNotifyEvent :: PORT} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event VideoNotifyEvent instance Deserialize VideoNotifyEvent where deserialize = do skip 1 reason <- liftM fromValue (deserialize :: Get Word8) skip 2 time <- deserialize drawable <- deserialize port <- deserialize return (MkVideoNotifyEvent reason time drawable port) data PortNotifyEvent = MkPortNotifyEvent{time_PortNotifyEvent :: TIMESTAMP, port_PortNotifyEvent :: PORT, attribute_PortNotifyEvent :: ATOM, value_PortNotifyEvent :: Int32} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event PortNotifyEvent instance Deserialize PortNotifyEvent where deserialize = do skip 1 skip 1 skip 2 time <- deserialize port <- deserialize attribute <- deserialize value <- deserialize return (MkPortNotifyEvent time port attribute value) data QueryExtension = MkQueryExtension{} deriving (Show, Typeable) instance ExtensionRequest QueryExtension where extensionId _ = "XVideo" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 0 let size__ = 4 serialize (convertBytesToRequestSize size__ :: Int16) putSkip (requiredPadding size__) data QueryExtensionReply = MkQueryExtensionReply{major_QueryExtensionReply :: Word16, minor_QueryExtensionReply :: Word16} deriving (Show, Typeable) instance Deserialize QueryExtensionReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize major <- deserialize minor <- deserialize let _ = isCard32 length return (MkQueryExtensionReply major minor) data QueryAdaptors = MkQueryAdaptors{window_QueryAdaptors :: WINDOW} deriving (Show, Typeable) instance ExtensionRequest QueryAdaptors where extensionId _ = "XVideo" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 1 let size__ = 4 + size (window_QueryAdaptors x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (window_QueryAdaptors x) putSkip (requiredPadding size__) data QueryAdaptorsReply = MkQueryAdaptorsReply{num_adaptors_QueryAdaptorsReply :: Word16, info_QueryAdaptorsReply :: [AdaptorInfo]} deriving (Show, Typeable) instance Deserialize QueryAdaptorsReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize num_adaptors <- deserialize skip 22 info <- deserializeList (fromIntegral num_adaptors) let _ = isCard32 length return (MkQueryAdaptorsReply num_adaptors info) data QueryEncodings = MkQueryEncodings{port_QueryEncodings :: PORT} deriving (Show, Typeable) instance ExtensionRequest QueryEncodings where extensionId _ = "XVideo" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 2 let size__ = 4 + size (port_QueryEncodings x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (port_QueryEncodings x) putSkip (requiredPadding size__) data QueryEncodingsReply = MkQueryEncodingsReply{num_encodings_QueryEncodingsReply :: Word16, info_QueryEncodingsReply :: [EncodingInfo]} deriving (Show, Typeable) instance Deserialize QueryEncodingsReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize num_encodings <- deserialize skip 22 info <- deserializeList (fromIntegral num_encodings) let _ = isCard32 length return (MkQueryEncodingsReply num_encodings info) data GrabPort = MkGrabPort{port_GrabPort :: PORT, time_GrabPort :: TIMESTAMP} deriving (Show, Typeable) instance ExtensionRequest GrabPort where extensionId _ = "XVideo" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 3 let size__ = 4 + size (port_GrabPort x) + size (time_GrabPort x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (port_GrabPort x) serialize (time_GrabPort x) putSkip (requiredPadding size__) data GrabPortReply = MkGrabPortReply{result_GrabPortReply :: GrabPortStatus} deriving (Show, Typeable) instance Deserialize GrabPortReply where deserialize = do skip 1 result <- liftM fromValue (deserialize :: Get Word8) skip 2 length <- deserialize let _ = isCard32 length return (MkGrabPortReply result) data UngrabPort = MkUngrabPort{port_UngrabPort :: PORT, time_UngrabPort :: TIMESTAMP} deriving (Show, Typeable) instance ExtensionRequest UngrabPort where extensionId _ = "XVideo" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 4 let size__ = 4 + size (port_UngrabPort x) + size (time_UngrabPort x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (port_UngrabPort x) serialize (time_UngrabPort x) putSkip (requiredPadding size__) data PutVideo = MkPutVideo{port_PutVideo :: PORT, drawable_PutVideo :: DRAWABLE, gc_PutVideo :: GCONTEXT, vid_x_PutVideo :: Int16, vid_y_PutVideo :: Int16, vid_w_PutVideo :: Word16, vid_h_PutVideo :: Word16, drw_x_PutVideo :: Int16, drw_y_PutVideo :: Int16, drw_w_PutVideo :: Word16, drw_h_PutVideo :: Word16} deriving (Show, Typeable) instance ExtensionRequest PutVideo where extensionId _ = "XVideo" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 5 let size__ = 4 + size (port_PutVideo x) + size (drawable_PutVideo x) + size (gc_PutVideo x) + size (vid_x_PutVideo x) + size (vid_y_PutVideo x) + size (vid_w_PutVideo x) + size (vid_h_PutVideo x) + size (drw_x_PutVideo x) + size (drw_y_PutVideo x) + size (drw_w_PutVideo x) + size (drw_h_PutVideo x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (port_PutVideo x) serialize (drawable_PutVideo x) serialize (gc_PutVideo x) serialize (vid_x_PutVideo x) serialize (vid_y_PutVideo x) serialize (vid_w_PutVideo x) serialize (vid_h_PutVideo x) serialize (drw_x_PutVideo x) serialize (drw_y_PutVideo x) serialize (drw_w_PutVideo x) serialize (drw_h_PutVideo x) putSkip (requiredPadding size__) data PutStill = MkPutStill{port_PutStill :: PORT, drawable_PutStill :: DRAWABLE, gc_PutStill :: GCONTEXT, vid_x_PutStill :: Int16, vid_y_PutStill :: Int16, vid_w_PutStill :: Word16, vid_h_PutStill :: Word16, drw_x_PutStill :: Int16, drw_y_PutStill :: Int16, drw_w_PutStill :: Word16, drw_h_PutStill :: Word16} deriving (Show, Typeable) instance ExtensionRequest PutStill where extensionId _ = "XVideo" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 6 let size__ = 4 + size (port_PutStill x) + size (drawable_PutStill x) + size (gc_PutStill x) + size (vid_x_PutStill x) + size (vid_y_PutStill x) + size (vid_w_PutStill x) + size (vid_h_PutStill x) + size (drw_x_PutStill x) + size (drw_y_PutStill x) + size (drw_w_PutStill x) + size (drw_h_PutStill x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (port_PutStill x) serialize (drawable_PutStill x) serialize (gc_PutStill x) serialize (vid_x_PutStill x) serialize (vid_y_PutStill x) serialize (vid_w_PutStill x) serialize (vid_h_PutStill x) serialize (drw_x_PutStill x) serialize (drw_y_PutStill x) serialize (drw_w_PutStill x) serialize (drw_h_PutStill x) putSkip (requiredPadding size__) data GetVideo = MkGetVideo{port_GetVideo :: PORT, drawable_GetVideo :: DRAWABLE, gc_GetVideo :: GCONTEXT, vid_x_GetVideo :: Int16, vid_y_GetVideo :: Int16, vid_w_GetVideo :: Word16, vid_h_GetVideo :: Word16, drw_x_GetVideo :: Int16, drw_y_GetVideo :: Int16, drw_w_GetVideo :: Word16, drw_h_GetVideo :: Word16} deriving (Show, Typeable) instance ExtensionRequest GetVideo where extensionId _ = "XVideo" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 7 let size__ = 4 + size (port_GetVideo x) + size (drawable_GetVideo x) + size (gc_GetVideo x) + size (vid_x_GetVideo x) + size (vid_y_GetVideo x) + size (vid_w_GetVideo x) + size (vid_h_GetVideo x) + size (drw_x_GetVideo x) + size (drw_y_GetVideo x) + size (drw_w_GetVideo x) + size (drw_h_GetVideo x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (port_GetVideo x) serialize (drawable_GetVideo x) serialize (gc_GetVideo x) serialize (vid_x_GetVideo x) serialize (vid_y_GetVideo x) serialize (vid_w_GetVideo x) serialize (vid_h_GetVideo x) serialize (drw_x_GetVideo x) serialize (drw_y_GetVideo x) serialize (drw_w_GetVideo x) serialize (drw_h_GetVideo x) putSkip (requiredPadding size__) data GetStill = MkGetStill{port_GetStill :: PORT, drawable_GetStill :: DRAWABLE, gc_GetStill :: GCONTEXT, vid_x_GetStill :: Int16, vid_y_GetStill :: Int16, vid_w_GetStill :: Word16, vid_h_GetStill :: Word16, drw_x_GetStill :: Int16, drw_y_GetStill :: Int16, drw_w_GetStill :: Word16, drw_h_GetStill :: Word16} deriving (Show, Typeable) instance ExtensionRequest GetStill where extensionId _ = "XVideo" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 8 let size__ = 4 + size (port_GetStill x) + size (drawable_GetStill x) + size (gc_GetStill x) + size (vid_x_GetStill x) + size (vid_y_GetStill x) + size (vid_w_GetStill x) + size (vid_h_GetStill x) + size (drw_x_GetStill x) + size (drw_y_GetStill x) + size (drw_w_GetStill x) + size (drw_h_GetStill x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (port_GetStill x) serialize (drawable_GetStill x) serialize (gc_GetStill x) serialize (vid_x_GetStill x) serialize (vid_y_GetStill x) serialize (vid_w_GetStill x) serialize (vid_h_GetStill x) serialize (drw_x_GetStill x) serialize (drw_y_GetStill x) serialize (drw_w_GetStill x) serialize (drw_h_GetStill x) putSkip (requiredPadding size__) data StopVideo = MkStopVideo{port_StopVideo :: PORT, drawable_StopVideo :: DRAWABLE} deriving (Show, Typeable) instance ExtensionRequest StopVideo where extensionId _ = "XVideo" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 9 let size__ = 4 + size (port_StopVideo x) + size (drawable_StopVideo x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (port_StopVideo x) serialize (drawable_StopVideo x) putSkip (requiredPadding size__) data SelectVideoNotify = MkSelectVideoNotify{drawable_SelectVideoNotify :: DRAWABLE, onoff_SelectVideoNotify :: Bool} deriving (Show, Typeable) instance ExtensionRequest SelectVideoNotify where extensionId _ = "XVideo" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 10 let size__ = 4 + size (drawable_SelectVideoNotify x) + size (onoff_SelectVideoNotify x) + 3 serialize (convertBytesToRequestSize size__ :: Int16) serialize (drawable_SelectVideoNotify x) serialize (onoff_SelectVideoNotify x) putSkip 3 putSkip (requiredPadding size__) data SelectPortNotify = MkSelectPortNotify{port_SelectPortNotify :: PORT, onoff_SelectPortNotify :: Bool} deriving (Show, Typeable) instance ExtensionRequest SelectPortNotify where extensionId _ = "XVideo" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 11 let size__ = 4 + size (port_SelectPortNotify x) + size (onoff_SelectPortNotify x) + 3 serialize (convertBytesToRequestSize size__ :: Int16) serialize (port_SelectPortNotify x) serialize (onoff_SelectPortNotify x) putSkip 3 putSkip (requiredPadding size__) data QueryBestSize = MkQueryBestSize{port_QueryBestSize :: PORT, vid_w_QueryBestSize :: Word16, vid_h_QueryBestSize :: Word16, drw_w_QueryBestSize :: Word16, drw_h_QueryBestSize :: Word16, motion_QueryBestSize :: Bool} deriving (Show, Typeable) instance ExtensionRequest QueryBestSize where extensionId _ = "XVideo" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 12 let size__ = 4 + size (port_QueryBestSize x) + size (vid_w_QueryBestSize x) + size (vid_h_QueryBestSize x) + size (drw_w_QueryBestSize x) + size (drw_h_QueryBestSize x) + size (motion_QueryBestSize x) + 3 serialize (convertBytesToRequestSize size__ :: Int16) serialize (port_QueryBestSize x) serialize (vid_w_QueryBestSize x) serialize (vid_h_QueryBestSize x) serialize (drw_w_QueryBestSize x) serialize (drw_h_QueryBestSize x) serialize (motion_QueryBestSize x) putSkip 3 putSkip (requiredPadding size__) data QueryBestSizeReply = MkQueryBestSizeReply{actual_width_QueryBestSizeReply :: Word16, actual_height_QueryBestSizeReply :: Word16} deriving (Show, Typeable) instance Deserialize QueryBestSizeReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize actual_width <- deserialize actual_height <- deserialize let _ = isCard32 length return (MkQueryBestSizeReply actual_width actual_height) data SetPortAttribute = MkSetPortAttribute{port_SetPortAttribute :: PORT, attribute_SetPortAttribute :: ATOM, value_SetPortAttribute :: Int32} deriving (Show, Typeable) instance ExtensionRequest SetPortAttribute where extensionId _ = "XVideo" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 13 let size__ = 4 + size (port_SetPortAttribute x) + size (attribute_SetPortAttribute x) + size (value_SetPortAttribute x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (port_SetPortAttribute x) serialize (attribute_SetPortAttribute x) serialize (value_SetPortAttribute x) putSkip (requiredPadding size__) data GetPortAttribute = MkGetPortAttribute{port_GetPortAttribute :: PORT, attribute_GetPortAttribute :: ATOM} deriving (Show, Typeable) instance ExtensionRequest GetPortAttribute where extensionId _ = "XVideo" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 14 let size__ = 4 + size (port_GetPortAttribute x) + size (attribute_GetPortAttribute x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (port_GetPortAttribute x) serialize (attribute_GetPortAttribute x) putSkip (requiredPadding size__) data GetPortAttributeReply = MkGetPortAttributeReply{value_GetPortAttributeReply :: Int32} deriving (Show, Typeable) instance Deserialize GetPortAttributeReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize value <- deserialize let _ = isCard32 length return (MkGetPortAttributeReply value) data QueryPortAttributes = MkQueryPortAttributes{port_QueryPortAttributes :: PORT} deriving (Show, Typeable) instance ExtensionRequest QueryPortAttributes where extensionId _ = "XVideo" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 15 let size__ = 4 + size (port_QueryPortAttributes x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (port_QueryPortAttributes x) putSkip (requiredPadding size__) data QueryPortAttributesReply = MkQueryPortAttributesReply{num_attributes_QueryPortAttributesReply :: Word32, text_size_QueryPortAttributesReply :: Word32, attributes_QueryPortAttributesReply :: [AttributeInfo]} deriving (Show, Typeable) instance Deserialize QueryPortAttributesReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize num_attributes <- deserialize text_size <- deserialize skip 16 attributes <- deserializeList (fromIntegral num_attributes) let _ = isCard32 length return (MkQueryPortAttributesReply num_attributes text_size attributes) data ListImageFormats = MkListImageFormats{port_ListImageFormats :: PORT} deriving (Show, Typeable) instance ExtensionRequest ListImageFormats where extensionId _ = "XVideo" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 16 let size__ = 4 + size (port_ListImageFormats x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (port_ListImageFormats x) putSkip (requiredPadding size__) data ListImageFormatsReply = MkListImageFormatsReply{num_formats_ListImageFormatsReply :: Word32, format_ListImageFormatsReply :: [ImageFormatInfo]} deriving (Show, Typeable) instance Deserialize ListImageFormatsReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize num_formats <- deserialize skip 20 format <- deserializeList (fromIntegral num_formats) let _ = isCard32 length return (MkListImageFormatsReply num_formats format) data QueryImageAttributes = MkQueryImageAttributes{port_QueryImageAttributes :: PORT, id_QueryImageAttributes :: Word32, width_QueryImageAttributes :: Word16, height_QueryImageAttributes :: Word16} deriving (Show, Typeable) instance ExtensionRequest QueryImageAttributes where extensionId _ = "XVideo" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 17 let size__ = 4 + size (port_QueryImageAttributes x) + size (id_QueryImageAttributes x) + size (width_QueryImageAttributes x) + size (height_QueryImageAttributes x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (port_QueryImageAttributes x) serialize (id_QueryImageAttributes x) serialize (width_QueryImageAttributes x) serialize (height_QueryImageAttributes x) putSkip (requiredPadding size__) data QueryImageAttributesReply = MkQueryImageAttributesReply{num_planes_QueryImageAttributesReply :: Word32, data_size_QueryImageAttributesReply :: Word32, width_QueryImageAttributesReply :: Word16, height_QueryImageAttributesReply :: Word16, pitches_QueryImageAttributesReply :: [Word32], offsets_QueryImageAttributesReply :: [Word32]} deriving (Show, Typeable) instance Deserialize QueryImageAttributesReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize num_planes <- deserialize data_size <- deserialize width <- deserialize height <- deserialize skip 12 pitches <- deserializeList (fromIntegral num_planes) offsets <- deserializeList (fromIntegral num_planes) let _ = isCard32 length return (MkQueryImageAttributesReply num_planes data_size width height pitches offsets) data PutImage = MkPutImage{port_PutImage :: PORT, drawable_PutImage :: DRAWABLE, gc_PutImage :: GCONTEXT, id_PutImage :: Word32, src_x_PutImage :: Int16, src_y_PutImage :: Int16, src_w_PutImage :: Word16, src_h_PutImage :: Word16, drw_x_PutImage :: Int16, drw_y_PutImage :: Int16, drw_w_PutImage :: Word16, drw_h_PutImage :: Word16, width_PutImage :: Word16, height_PutImage :: Word16, data_PutImage :: [Word8]} deriving (Show, Typeable) instance ExtensionRequest PutImage where extensionId _ = "XVideo" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 18 let size__ = 4 + size (port_PutImage x) + size (drawable_PutImage x) + size (gc_PutImage x) + size (id_PutImage x) + size (src_x_PutImage x) + size (src_y_PutImage x) + size (src_w_PutImage x) + size (src_h_PutImage x) + size (drw_x_PutImage x) + size (drw_y_PutImage x) + size (drw_w_PutImage x) + size (drw_h_PutImage x) + size (width_PutImage x) + size (height_PutImage x) + sum (map size (data_PutImage x)) serialize (convertBytesToRequestSize size__ :: Int16) serialize (port_PutImage x) serialize (drawable_PutImage x) serialize (gc_PutImage x) serialize (id_PutImage x) serialize (src_x_PutImage x) serialize (src_y_PutImage x) serialize (src_w_PutImage x) serialize (src_h_PutImage x) serialize (drw_x_PutImage x) serialize (drw_y_PutImage x) serialize (drw_w_PutImage x) serialize (drw_h_PutImage x) serialize (width_PutImage x) serialize (height_PutImage x) serializeList (data_PutImage x) putSkip (requiredPadding size__) data ShmPutImage = MkShmPutImage{port_ShmPutImage :: PORT, drawable_ShmPutImage :: DRAWABLE, gc_ShmPutImage :: GCONTEXT, shmseg_ShmPutImage :: SEG, id_ShmPutImage :: Word32, offset_ShmPutImage :: Word32, src_x_ShmPutImage :: Int16, src_y_ShmPutImage :: Int16, src_w_ShmPutImage :: Word16, src_h_ShmPutImage :: Word16, drw_x_ShmPutImage :: Int16, drw_y_ShmPutImage :: Int16, drw_w_ShmPutImage :: Word16, drw_h_ShmPutImage :: Word16, width_ShmPutImage :: Word16, height_ShmPutImage :: Word16, send_event_ShmPutImage :: Word8} deriving (Show, Typeable) instance ExtensionRequest ShmPutImage where extensionId _ = "XVideo" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 19 let size__ = 4 + size (port_ShmPutImage x) + size (drawable_ShmPutImage x) + size (gc_ShmPutImage x) + size (shmseg_ShmPutImage x) + size (id_ShmPutImage x) + size (offset_ShmPutImage x) + size (src_x_ShmPutImage x) + size (src_y_ShmPutImage x) + size (src_w_ShmPutImage x) + size (src_h_ShmPutImage x) + size (drw_x_ShmPutImage x) + size (drw_y_ShmPutImage x) + size (drw_w_ShmPutImage x) + size (drw_h_ShmPutImage x) + size (width_ShmPutImage x) + size (height_ShmPutImage x) + size (send_event_ShmPutImage x) + 3 serialize (convertBytesToRequestSize size__ :: Int16) serialize (port_ShmPutImage x) serialize (drawable_ShmPutImage x) serialize (gc_ShmPutImage x) serialize (shmseg_ShmPutImage x) serialize (id_ShmPutImage x) serialize (offset_ShmPutImage x) serialize (src_x_ShmPutImage x) serialize (src_y_ShmPutImage x) serialize (src_w_ShmPutImage x) serialize (src_h_ShmPutImage x) serialize (drw_x_ShmPutImage x) serialize (drw_y_ShmPutImage x) serialize (drw_w_ShmPutImage x) serialize (drw_h_ShmPutImage x) serialize (width_ShmPutImage x) serialize (height_ShmPutImage x) serialize (send_event_ShmPutImage x) putSkip 3 putSkip (requiredPadding size__)