module Graphics.XHB.Gen.RandR.Types (deserializeError, deserializeEvent, MODE, CRTC, OUTPUT, Rotation(..), ScreenSize(..), RefreshRates(..), QueryVersion(..), QueryVersionReply(..), SetScreenConfig(..), SetScreenConfigReply(..), SetConfig(..), SelectInput(..), GetScreenInfo(..), GetScreenInfoReply(..), GetScreenSizeRange(..), GetScreenSizeRangeReply(..), SetScreenSize(..), ModeFlag(..), ModeInfo(..), GetScreenResources(..), GetScreenResourcesReply(..), Connection(..), GetOutputInfo(..), GetOutputInfoReply(..), ListOutputProperties(..), ListOutputPropertiesReply(..), QueryOutputProperty(..), QueryOutputPropertyReply(..), ConfigureOutputProperty(..), ChangeOutputProperty(..), DeleteOutputProperty(..), GetOutputProperty(..), GetOutputPropertyReply(..), CreateMode(..), CreateModeReply(..), DestroyMode(..), AddOutputMode(..), DeleteOutputMode(..), GetCrtcInfo(..), GetCrtcInfoReply(..), SetCrtcConfig(..), SetCrtcConfigReply(..), GetCrtcGammaSize(..), GetCrtcGammaSizeReply(..), GetCrtcGamma(..), GetCrtcGammaReply(..), SetCrtcGamma(..), NotifyMask(..), ScreenChangeNotify(..), NotifyEnum(..), CrtcChange(..), OutputChange(..), OutputProperty(..), Notify(..),NotifyData(..)) where 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 (deserializeError, deserializeEvent) import qualified Graphics.XHB.Gen.Xproto.Types deserializeError :: Word8 -> Maybe (Get SomeError) deserializeError _ = Nothing deserializeEvent :: Word8 -> Maybe (Get SomeEvent) deserializeEvent 0 = return (liftM toEvent (deserialize :: Get ScreenChangeNotify)) deserializeEvent 1 = return (liftM toEvent (deserialize :: Get Notify)) deserializeEvent _ = Nothing newtype MODE = MkMODE Xid deriving (Eq, Ord, Show, Serialize, Deserialize, XidLike) newtype CRTC = MkCRTC Xid deriving (Eq, Ord, Show, Serialize, Deserialize, XidLike) newtype OUTPUT = MkOUTPUT Xid deriving (Eq, Ord, Show, Serialize, Deserialize, XidLike) data Rotation = RotationRotate_0 | RotationRotate_90 | RotationRotate_180 | RotationRotate_270 | RotationReflect_X | RotationReflect_Y deriving Show instance BitEnum Rotation where toBit RotationRotate_0{} = 0 toBit RotationRotate_90{} = 1 toBit RotationRotate_180{} = 2 toBit RotationRotate_270{} = 3 toBit RotationReflect_X{} = 4 toBit RotationReflect_Y{} = 5 fromBit 0 = RotationRotate_0 fromBit 1 = RotationRotate_90 fromBit 2 = RotationRotate_180 fromBit 3 = RotationRotate_270 fromBit 4 = RotationReflect_X fromBit 5 = RotationReflect_Y data ScreenSize = MkScreenSize{width_ScreenSize :: Word16, height_ScreenSize :: Word16, mwidth_ScreenSize :: Word16, mheight_ScreenSize :: Word16} deriving (Show, Typeable) instance Serialize ScreenSize where serialize x = do serialize (width_ScreenSize x) serialize (height_ScreenSize x) serialize (mwidth_ScreenSize x) serialize (mheight_ScreenSize x) size x = size (width_ScreenSize x) + size (height_ScreenSize x) + size (mwidth_ScreenSize x) + size (mheight_ScreenSize x) instance Deserialize ScreenSize where deserialize = do width <- deserialize height <- deserialize mwidth <- deserialize mheight <- deserialize return (MkScreenSize width height mwidth mheight) data RefreshRates = MkRefreshRates{nRates_RefreshRates :: Word16, rates_RefreshRates :: [Word16]} deriving (Show, Typeable) instance Serialize RefreshRates where serialize x = do serialize (nRates_RefreshRates x) serializeList (rates_RefreshRates x) size x = size (nRates_RefreshRates x) + sum (map size (rates_RefreshRates x)) instance Deserialize RefreshRates where deserialize = do nRates <- deserialize rates <- deserializeList (fromIntegral nRates) return (MkRefreshRates nRates rates) data QueryVersion = MkQueryVersion{major_version_QueryVersion :: Word32, minor_version_QueryVersion :: Word32} deriving (Show, Typeable) instance ExtensionRequest QueryVersion where extensionId _ = "RANDR" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 0 let size__ = 4 + size (major_version_QueryVersion x) + size (minor_version_QueryVersion x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (major_version_QueryVersion x) serialize (minor_version_QueryVersion x) putSkip (requiredPadding size__) data QueryVersionReply = MkQueryVersionReply{major_version_QueryVersionReply :: Word32, minor_version_QueryVersionReply :: Word32} deriving (Show, Typeable) instance Deserialize QueryVersionReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize major_version <- deserialize minor_version <- deserialize skip 16 let _ = isCard32 length return (MkQueryVersionReply major_version minor_version) data SetScreenConfig = MkSetScreenConfig{window_SetScreenConfig :: WINDOW, timestamp_SetScreenConfig :: TIMESTAMP, config_timestamp_SetScreenConfig :: TIMESTAMP, sizeID_SetScreenConfig :: Word16, rotation_SetScreenConfig :: Word16, rate_SetScreenConfig :: Word16} deriving (Show, Typeable) instance ExtensionRequest SetScreenConfig where extensionId _ = "RANDR" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 2 let size__ = 4 + size (window_SetScreenConfig x) + size (timestamp_SetScreenConfig x) + size (config_timestamp_SetScreenConfig x) + size (sizeID_SetScreenConfig x) + size (rotation_SetScreenConfig x) + size (rate_SetScreenConfig x) + 2 serialize (convertBytesToRequestSize size__ :: Int16) serialize (window_SetScreenConfig x) serialize (timestamp_SetScreenConfig x) serialize (config_timestamp_SetScreenConfig x) serialize (sizeID_SetScreenConfig x) serialize (rotation_SetScreenConfig x) serialize (rate_SetScreenConfig x) putSkip 2 putSkip (requiredPadding size__) data SetScreenConfigReply = MkSetScreenConfigReply{status_SetScreenConfigReply :: Word8, new_timestamp_SetScreenConfigReply :: TIMESTAMP, config_timestamp_SetScreenConfigReply :: TIMESTAMP, root_SetScreenConfigReply :: WINDOW, subpixel_order_SetScreenConfigReply :: Word16} deriving (Show, Typeable) instance Deserialize SetScreenConfigReply where deserialize = do skip 1 status <- deserialize skip 2 length <- deserialize new_timestamp <- deserialize config_timestamp <- deserialize root <- deserialize subpixel_order <- deserialize skip 10 let _ = isCard32 length return (MkSetScreenConfigReply status new_timestamp config_timestamp root subpixel_order) data SetConfig = SetConfigSuccess | SetConfigInvalidConfigTime | SetConfigInvalidTime | SetConfigFailed deriving Show instance SimpleEnum SetConfig where toValue SetConfigSuccess{} = 0 toValue SetConfigInvalidConfigTime{} = 1 toValue SetConfigInvalidTime{} = 2 toValue SetConfigFailed{} = 3 fromValue 0 = SetConfigSuccess fromValue 1 = SetConfigInvalidConfigTime fromValue 2 = SetConfigInvalidTime fromValue 3 = SetConfigFailed data SelectInput = MkSelectInput{window_SelectInput :: WINDOW, enable_SelectInput :: Word16} deriving (Show, Typeable) instance ExtensionRequest SelectInput where extensionId _ = "RANDR" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 4 let size__ = 4 + size (window_SelectInput x) + size (enable_SelectInput x) + 2 serialize (convertBytesToRequestSize size__ :: Int16) serialize (window_SelectInput x) serialize (enable_SelectInput x) putSkip 2 putSkip (requiredPadding size__) data GetScreenInfo = MkGetScreenInfo{window_GetScreenInfo :: WINDOW} deriving (Show, Typeable) instance ExtensionRequest GetScreenInfo where extensionId _ = "RANDR" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 5 let size__ = 4 + size (window_GetScreenInfo x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (window_GetScreenInfo x) putSkip (requiredPadding size__) data GetScreenInfoReply = MkGetScreenInfoReply{rotations_GetScreenInfoReply :: Word8, root_GetScreenInfoReply :: WINDOW, timestamp_GetScreenInfoReply :: TIMESTAMP, config_timestamp_GetScreenInfoReply :: TIMESTAMP, nSizes_GetScreenInfoReply :: Word16, sizeID_GetScreenInfoReply :: Word16, rotation_GetScreenInfoReply :: Word16, rate_GetScreenInfoReply :: Word16, nInfo_GetScreenInfoReply :: Word16, sizes_GetScreenInfoReply :: [ScreenSize], rates_GetScreenInfoReply :: [RefreshRates]} deriving (Show, Typeable) instance Deserialize GetScreenInfoReply where deserialize = do skip 1 rotations <- deserialize skip 2 length <- deserialize root <- deserialize timestamp <- deserialize config_timestamp <- deserialize nSizes <- deserialize sizeID <- deserialize rotation <- deserialize rate <- deserialize nInfo <- deserialize skip 2 sizes <- deserializeList (fromIntegral nSizes) rates <- deserializeList (fromIntegral (fromIntegral (nInfo - nSizes))) let _ = isCard32 length return (MkGetScreenInfoReply rotations root timestamp config_timestamp nSizes sizeID rotation rate nInfo sizes rates) data GetScreenSizeRange = MkGetScreenSizeRange{window_GetScreenSizeRange :: WINDOW} deriving (Show, Typeable) instance ExtensionRequest GetScreenSizeRange where extensionId _ = "RANDR" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 6 let size__ = 4 + size (window_GetScreenSizeRange x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (window_GetScreenSizeRange x) putSkip (requiredPadding size__) data GetScreenSizeRangeReply = MkGetScreenSizeRangeReply{min_width_GetScreenSizeRangeReply :: Word16, min_height_GetScreenSizeRangeReply :: Word16, max_width_GetScreenSizeRangeReply :: Word16, max_height_GetScreenSizeRangeReply :: Word16} deriving (Show, Typeable) instance Deserialize GetScreenSizeRangeReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize min_width <- deserialize min_height <- deserialize max_width <- deserialize max_height <- deserialize skip 16 let _ = isCard32 length return (MkGetScreenSizeRangeReply min_width min_height max_width max_height) data SetScreenSize = MkSetScreenSize{window_SetScreenSize :: WINDOW, width_SetScreenSize :: Word16, height_SetScreenSize :: Word16, mm_width_SetScreenSize :: Word32, mm_height_SetScreenSize :: Word32} deriving (Show, Typeable) instance ExtensionRequest SetScreenSize where extensionId _ = "RANDR" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 7 let size__ = 4 + size (window_SetScreenSize x) + size (width_SetScreenSize x) + size (height_SetScreenSize x) + size (mm_width_SetScreenSize x) + size (mm_height_SetScreenSize x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (window_SetScreenSize x) serialize (width_SetScreenSize x) serialize (height_SetScreenSize x) serialize (mm_width_SetScreenSize x) serialize (mm_height_SetScreenSize x) putSkip (requiredPadding size__) data ModeFlag = ModeFlagHsyncPositive | ModeFlagHsyncNegative | ModeFlagVsyncPositive | ModeFlagVsyncNegative | ModeFlagInterlace | ModeFlagDoubleScan | ModeFlagCsync | ModeFlagCsyncPositive | ModeFlagCsyncNegative | ModeFlagHskewPresent | ModeFlagBcast | ModeFlagPixelMultiplex | ModeFlagDoubleClock | ModeFlagHalveClock deriving Show instance BitEnum ModeFlag where toBit ModeFlagHsyncPositive{} = 0 toBit ModeFlagHsyncNegative{} = 1 toBit ModeFlagVsyncPositive{} = 2 toBit ModeFlagVsyncNegative{} = 3 toBit ModeFlagInterlace{} = 4 toBit ModeFlagDoubleScan{} = 5 toBit ModeFlagCsync{} = 6 toBit ModeFlagCsyncPositive{} = 7 toBit ModeFlagCsyncNegative{} = 8 toBit ModeFlagHskewPresent{} = 9 toBit ModeFlagBcast{} = 10 toBit ModeFlagPixelMultiplex{} = 11 toBit ModeFlagDoubleClock{} = 12 toBit ModeFlagHalveClock{} = 13 fromBit 0 = ModeFlagHsyncPositive fromBit 1 = ModeFlagHsyncNegative fromBit 2 = ModeFlagVsyncPositive fromBit 3 = ModeFlagVsyncNegative fromBit 4 = ModeFlagInterlace fromBit 5 = ModeFlagDoubleScan fromBit 6 = ModeFlagCsync fromBit 7 = ModeFlagCsyncPositive fromBit 8 = ModeFlagCsyncNegative fromBit 9 = ModeFlagHskewPresent fromBit 10 = ModeFlagBcast fromBit 11 = ModeFlagPixelMultiplex fromBit 12 = ModeFlagDoubleClock fromBit 13 = ModeFlagHalveClock data ModeInfo = MkModeInfo{id_ModeInfo :: Word32, width_ModeInfo :: Word16, height_ModeInfo :: Word16, dot_clock_ModeInfo :: Word32, hsync_start_ModeInfo :: Word16, hsync_end_ModeInfo :: Word16, htotal_ModeInfo :: Word16, hskew_ModeInfo :: Word16, vsync_start_ModeInfo :: Word16, vsync_end_ModeInfo :: Word16, vtotal_ModeInfo :: Word16, name_len_ModeInfo :: Word16, mode_flags_ModeInfo :: Word32} deriving (Show, Typeable) instance Serialize ModeInfo where serialize x = do serialize (id_ModeInfo x) serialize (width_ModeInfo x) serialize (height_ModeInfo x) serialize (dot_clock_ModeInfo x) serialize (hsync_start_ModeInfo x) serialize (hsync_end_ModeInfo x) serialize (htotal_ModeInfo x) serialize (hskew_ModeInfo x) serialize (vsync_start_ModeInfo x) serialize (vsync_end_ModeInfo x) serialize (vtotal_ModeInfo x) serialize (name_len_ModeInfo x) serialize (mode_flags_ModeInfo x) size x = size (id_ModeInfo x) + size (width_ModeInfo x) + size (height_ModeInfo x) + size (dot_clock_ModeInfo x) + size (hsync_start_ModeInfo x) + size (hsync_end_ModeInfo x) + size (htotal_ModeInfo x) + size (hskew_ModeInfo x) + size (vsync_start_ModeInfo x) + size (vsync_end_ModeInfo x) + size (vtotal_ModeInfo x) + size (name_len_ModeInfo x) + size (mode_flags_ModeInfo x) instance Deserialize ModeInfo where deserialize = do id <- deserialize width <- deserialize height <- deserialize dot_clock <- deserialize hsync_start <- deserialize hsync_end <- deserialize htotal <- deserialize hskew <- deserialize vsync_start <- deserialize vsync_end <- deserialize vtotal <- deserialize name_len <- deserialize mode_flags <- deserialize return (MkModeInfo id width height dot_clock hsync_start hsync_end htotal hskew vsync_start vsync_end vtotal name_len mode_flags) data GetScreenResources = MkGetScreenResources{window_GetScreenResources :: WINDOW} deriving (Show, Typeable) instance ExtensionRequest GetScreenResources where extensionId _ = "RANDR" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 8 let size__ = 4 + size (window_GetScreenResources x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (window_GetScreenResources x) putSkip (requiredPadding size__) data GetScreenResourcesReply = MkGetScreenResourcesReply{timestamp_GetScreenResourcesReply :: TIMESTAMP, config_timestamp_GetScreenResourcesReply :: TIMESTAMP, num_crtcs_GetScreenResourcesReply :: Word16, num_outputs_GetScreenResourcesReply :: Word16, num_modes_GetScreenResourcesReply :: Word16, names_len_GetScreenResourcesReply :: Word16, crtcs_GetScreenResourcesReply :: [CRTC], outputs_GetScreenResourcesReply :: [OUTPUT], modes_GetScreenResourcesReply :: [ModeInfo], names_GetScreenResourcesReply :: [Word8]} deriving (Show, Typeable) instance Deserialize GetScreenResourcesReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize timestamp <- deserialize config_timestamp <- deserialize num_crtcs <- deserialize num_outputs <- deserialize num_modes <- deserialize names_len <- deserialize skip 8 crtcs <- deserializeList (fromIntegral num_crtcs) outputs <- deserializeList (fromIntegral num_outputs) modes <- deserializeList (fromIntegral num_modes) names <- deserializeList (fromIntegral names_len) let _ = isCard32 length return (MkGetScreenResourcesReply timestamp config_timestamp num_crtcs num_outputs num_modes names_len crtcs outputs modes names) data Connection = ConnectionConnected | ConnectionDisconnected | ConnectionUnknown deriving Show instance SimpleEnum Connection where toValue ConnectionConnected{} = 0 toValue ConnectionDisconnected{} = 1 toValue ConnectionUnknown{} = 2 fromValue 0 = ConnectionConnected fromValue 1 = ConnectionDisconnected fromValue 2 = ConnectionUnknown data GetOutputInfo = MkGetOutputInfo{output_GetOutputInfo :: OUTPUT, config_timestamp_GetOutputInfo :: TIMESTAMP} deriving (Show, Typeable) instance ExtensionRequest GetOutputInfo where extensionId _ = "RANDR" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 9 let size__ = 4 + size (output_GetOutputInfo x) + size (config_timestamp_GetOutputInfo x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (output_GetOutputInfo x) serialize (config_timestamp_GetOutputInfo x) putSkip (requiredPadding size__) data GetOutputInfoReply = MkGetOutputInfoReply{status_GetOutputInfoReply :: Word8, timestamp_GetOutputInfoReply :: TIMESTAMP, crtc_GetOutputInfoReply :: CRTC, mm_width_GetOutputInfoReply :: Word32, mm_height_GetOutputInfoReply :: Word32, connection_GetOutputInfoReply :: Word8, subpixel_order_GetOutputInfoReply :: Word8, num_crtcs_GetOutputInfoReply :: Word16, num_modes_GetOutputInfoReply :: Word16, num_preferred_GetOutputInfoReply :: Word16, num_clones_GetOutputInfoReply :: Word16, name_len_GetOutputInfoReply :: Word16, crtcs_GetOutputInfoReply :: [CRTC], modes_GetOutputInfoReply :: [MODE], clones_GetOutputInfoReply :: [OUTPUT], name_GetOutputInfoReply :: [Word8]} deriving (Show, Typeable) instance Deserialize GetOutputInfoReply where deserialize = do skip 1 status <- deserialize skip 2 length <- deserialize timestamp <- deserialize crtc <- deserialize mm_width <- deserialize mm_height <- deserialize connection <- deserialize subpixel_order <- deserialize num_crtcs <- deserialize num_modes <- deserialize num_preferred <- deserialize num_clones <- deserialize name_len <- deserialize crtcs <- deserializeList (fromIntegral num_crtcs) modes <- deserializeList (fromIntegral num_modes) clones <- deserializeList (fromIntegral num_clones) name <- deserializeList (fromIntegral name_len) let _ = isCard32 length return (MkGetOutputInfoReply status timestamp crtc mm_width mm_height connection subpixel_order num_crtcs num_modes num_preferred num_clones name_len crtcs modes clones name) data ListOutputProperties = MkListOutputProperties{output_ListOutputProperties :: OUTPUT} deriving (Show, Typeable) instance ExtensionRequest ListOutputProperties where extensionId _ = "RANDR" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 10 let size__ = 4 + size (output_ListOutputProperties x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (output_ListOutputProperties x) putSkip (requiredPadding size__) data ListOutputPropertiesReply = MkListOutputPropertiesReply{num_atoms_ListOutputPropertiesReply :: Word16, atoms_ListOutputPropertiesReply :: [ATOM]} deriving (Show, Typeable) instance Deserialize ListOutputPropertiesReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize num_atoms <- deserialize skip 22 atoms <- deserializeList (fromIntegral num_atoms) let _ = isCard32 length return (MkListOutputPropertiesReply num_atoms atoms) data QueryOutputProperty = MkQueryOutputProperty{output_QueryOutputProperty :: OUTPUT, property_QueryOutputProperty :: ATOM} deriving (Show, Typeable) instance ExtensionRequest QueryOutputProperty where extensionId _ = "RANDR" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 11 let size__ = 4 + size (output_QueryOutputProperty x) + size (property_QueryOutputProperty x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (output_QueryOutputProperty x) serialize (property_QueryOutputProperty x) putSkip (requiredPadding size__) data QueryOutputPropertyReply = MkQueryOutputPropertyReply{pending_QueryOutputPropertyReply :: Bool, range_QueryOutputPropertyReply :: Bool, immutable_QueryOutputPropertyReply :: Bool, validValues_QueryOutputPropertyReply :: [Int32]} deriving (Show, Typeable) instance Deserialize QueryOutputPropertyReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize pending <- deserialize range <- deserialize immutable <- deserialize skip 21 validValues <- deserializeList (fromIntegral length) let _ = isCard32 length return (MkQueryOutputPropertyReply pending range immutable validValues) data ConfigureOutputProperty = MkConfigureOutputProperty{output_ConfigureOutputProperty :: OUTPUT, property_ConfigureOutputProperty :: ATOM, pending_ConfigureOutputProperty :: Bool, range_ConfigureOutputProperty :: Bool, values_ConfigureOutputProperty :: [Int32]} deriving (Show, Typeable) instance ExtensionRequest ConfigureOutputProperty where extensionId _ = "RANDR" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 12 let size__ = 4 + size (output_ConfigureOutputProperty x) + size (property_ConfigureOutputProperty x) + size (pending_ConfigureOutputProperty x) + size (range_ConfigureOutputProperty x) + 2 + sum (map size (values_ConfigureOutputProperty x)) serialize (convertBytesToRequestSize size__ :: Int16) serialize (output_ConfigureOutputProperty x) serialize (property_ConfigureOutputProperty x) serialize (pending_ConfigureOutputProperty x) serialize (range_ConfigureOutputProperty x) putSkip 2 serializeList (values_ConfigureOutputProperty x) putSkip (requiredPadding size__) data ChangeOutputProperty = MkChangeOutputProperty{output_ChangeOutputProperty :: OUTPUT, property_ChangeOutputProperty :: ATOM, type_ChangeOutputProperty :: ATOM, format_ChangeOutputProperty :: Word8, mode_ChangeOutputProperty :: Word8, num_units_ChangeOutputProperty :: Word32, data_ChangeOutputProperty :: [Word8]} deriving (Show, Typeable) instance ExtensionRequest ChangeOutputProperty where extensionId _ = "RANDR" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 13 let size__ = 4 + size (output_ChangeOutputProperty x) + size (property_ChangeOutputProperty x) + size (type_ChangeOutputProperty x) + size (format_ChangeOutputProperty x) + size (mode_ChangeOutputProperty x) + 2 + size (num_units_ChangeOutputProperty x) + sum (map size (data_ChangeOutputProperty x)) serialize (convertBytesToRequestSize size__ :: Int16) serialize (output_ChangeOutputProperty x) serialize (property_ChangeOutputProperty x) serialize (type_ChangeOutputProperty x) serialize (format_ChangeOutputProperty x) serialize (mode_ChangeOutputProperty x) putSkip 2 serialize (num_units_ChangeOutputProperty x) serializeList (data_ChangeOutputProperty x) putSkip (requiredPadding size__) data DeleteOutputProperty = MkDeleteOutputProperty{output_DeleteOutputProperty :: OUTPUT, property_DeleteOutputProperty :: ATOM} deriving (Show, Typeable) instance ExtensionRequest DeleteOutputProperty where extensionId _ = "RANDR" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 14 let size__ = 4 + size (output_DeleteOutputProperty x) + size (property_DeleteOutputProperty x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (output_DeleteOutputProperty x) serialize (property_DeleteOutputProperty x) putSkip (requiredPadding size__) data GetOutputProperty = MkGetOutputProperty{output_GetOutputProperty :: OUTPUT, property_GetOutputProperty :: ATOM, type_GetOutputProperty :: ATOM, long_offset_GetOutputProperty :: Word32, long_length_GetOutputProperty :: Word32, delete_GetOutputProperty :: Bool, pending_GetOutputProperty :: Bool} deriving (Show, Typeable) instance ExtensionRequest GetOutputProperty where extensionId _ = "RANDR" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 15 let size__ = 4 + size (output_GetOutputProperty x) + size (property_GetOutputProperty x) + size (type_GetOutputProperty x) + size (long_offset_GetOutputProperty x) + size (long_length_GetOutputProperty x) + size (delete_GetOutputProperty x) + size (pending_GetOutputProperty x) + 2 serialize (convertBytesToRequestSize size__ :: Int16) serialize (output_GetOutputProperty x) serialize (property_GetOutputProperty x) serialize (type_GetOutputProperty x) serialize (long_offset_GetOutputProperty x) serialize (long_length_GetOutputProperty x) serialize (delete_GetOutputProperty x) serialize (pending_GetOutputProperty x) putSkip 2 putSkip (requiredPadding size__) data GetOutputPropertyReply = MkGetOutputPropertyReply{format_GetOutputPropertyReply :: Word8, type_GetOutputPropertyReply :: ATOM, bytes_after_GetOutputPropertyReply :: Word32, num_items_GetOutputPropertyReply :: Word32, data_GetOutputPropertyReply :: [Word8]} deriving (Show, Typeable) instance Deserialize GetOutputPropertyReply where deserialize = do skip 1 format <- deserialize skip 2 length <- deserialize type_ <- deserialize bytes_after <- deserialize num_items <- deserialize skip 12 data_ <- deserializeList (fromIntegral (fromIntegral (num_items * (fromIntegral (format `div` 8))))) let _ = isCard32 length return (MkGetOutputPropertyReply format type_ bytes_after num_items data_) data CreateMode = MkCreateMode{window_CreateMode :: WINDOW, mode_info_CreateMode :: ModeInfo, name_CreateMode :: [CChar]} deriving (Show, Typeable) instance ExtensionRequest CreateMode where extensionId _ = "RANDR" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 16 let size__ = 4 + size (window_CreateMode x) + size (mode_info_CreateMode x) + sum (map size (name_CreateMode x)) serialize (convertBytesToRequestSize size__ :: Int16) serialize (window_CreateMode x) serialize (mode_info_CreateMode x) serializeList (name_CreateMode x) putSkip (requiredPadding size__) data CreateModeReply = MkCreateModeReply{mode_CreateModeReply :: MODE} deriving (Show, Typeable) instance Deserialize CreateModeReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize mode <- deserialize skip 20 let _ = isCard32 length return (MkCreateModeReply mode) data DestroyMode = MkDestroyMode{mode_DestroyMode :: MODE} deriving (Show, Typeable) instance ExtensionRequest DestroyMode where extensionId _ = "RANDR" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 17 let size__ = 4 + size (mode_DestroyMode x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (mode_DestroyMode x) putSkip (requiredPadding size__) data AddOutputMode = MkAddOutputMode{output_AddOutputMode :: OUTPUT, mode_AddOutputMode :: MODE} deriving (Show, Typeable) instance ExtensionRequest AddOutputMode where extensionId _ = "RANDR" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 18 let size__ = 4 + size (output_AddOutputMode x) + size (mode_AddOutputMode x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (output_AddOutputMode x) serialize (mode_AddOutputMode x) putSkip (requiredPadding size__) data DeleteOutputMode = MkDeleteOutputMode{output_DeleteOutputMode :: OUTPUT, mode_DeleteOutputMode :: MODE} deriving (Show, Typeable) instance ExtensionRequest DeleteOutputMode where extensionId _ = "RANDR" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 19 let size__ = 4 + size (output_DeleteOutputMode x) + size (mode_DeleteOutputMode x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (output_DeleteOutputMode x) serialize (mode_DeleteOutputMode x) putSkip (requiredPadding size__) data GetCrtcInfo = MkGetCrtcInfo{crtc_GetCrtcInfo :: CRTC, config_timestamp_GetCrtcInfo :: TIMESTAMP} deriving (Show, Typeable) instance ExtensionRequest GetCrtcInfo where extensionId _ = "RANDR" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 20 let size__ = 4 + size (crtc_GetCrtcInfo x) + size (config_timestamp_GetCrtcInfo x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (crtc_GetCrtcInfo x) serialize (config_timestamp_GetCrtcInfo x) putSkip (requiredPadding size__) data GetCrtcInfoReply = MkGetCrtcInfoReply{status_GetCrtcInfoReply :: Word8, timestamp_GetCrtcInfoReply :: TIMESTAMP, x_GetCrtcInfoReply :: Int16, y_GetCrtcInfoReply :: Int16, width_GetCrtcInfoReply :: Word16, height_GetCrtcInfoReply :: Word16, mode_GetCrtcInfoReply :: MODE, rotation_GetCrtcInfoReply :: Word16, rotations_GetCrtcInfoReply :: Word16, num_outputs_GetCrtcInfoReply :: Word16, num_possible_outputs_GetCrtcInfoReply :: Word16, outputs_GetCrtcInfoReply :: [OUTPUT], possible_GetCrtcInfoReply :: [OUTPUT]} deriving (Show, Typeable) instance Deserialize GetCrtcInfoReply where deserialize = do skip 1 status <- deserialize skip 2 length <- deserialize timestamp <- deserialize x <- deserialize y <- deserialize width <- deserialize height <- deserialize mode <- deserialize rotation <- deserialize rotations <- deserialize num_outputs <- deserialize num_possible_outputs <- deserialize outputs <- deserializeList (fromIntegral num_outputs) possible <- deserializeList (fromIntegral num_possible_outputs) let _ = isCard32 length return (MkGetCrtcInfoReply status timestamp x y width height mode rotation rotations num_outputs num_possible_outputs outputs possible) data SetCrtcConfig = MkSetCrtcConfig{crtc_SetCrtcConfig :: CRTC, timestamp_SetCrtcConfig :: TIMESTAMP, config_timestamp_SetCrtcConfig :: TIMESTAMP, x_SetCrtcConfig :: Int16, y_SetCrtcConfig :: Int16, mode_SetCrtcConfig :: MODE, rotation_SetCrtcConfig :: Word16, outputs_SetCrtcConfig :: [OUTPUT]} deriving (Show, Typeable) instance ExtensionRequest SetCrtcConfig where extensionId _ = "RANDR" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 21 let size__ = 4 + size (crtc_SetCrtcConfig x) + size (timestamp_SetCrtcConfig x) + size (config_timestamp_SetCrtcConfig x) + size (x_SetCrtcConfig x) + size (y_SetCrtcConfig x) + size (mode_SetCrtcConfig x) + size (rotation_SetCrtcConfig x) + 2 + sum (map size (outputs_SetCrtcConfig x)) serialize (convertBytesToRequestSize size__ :: Int16) serialize (crtc_SetCrtcConfig x) serialize (timestamp_SetCrtcConfig x) serialize (config_timestamp_SetCrtcConfig x) serialize (x_SetCrtcConfig x) serialize (y_SetCrtcConfig x) serialize (mode_SetCrtcConfig x) serialize (rotation_SetCrtcConfig x) putSkip 2 serializeList (outputs_SetCrtcConfig x) putSkip (requiredPadding size__) data SetCrtcConfigReply = MkSetCrtcConfigReply{status_SetCrtcConfigReply :: Word8, timestamp_SetCrtcConfigReply :: TIMESTAMP} deriving (Show, Typeable) instance Deserialize SetCrtcConfigReply where deserialize = do skip 1 status <- deserialize skip 2 length <- deserialize timestamp <- deserialize skip 20 let _ = isCard32 length return (MkSetCrtcConfigReply status timestamp) data GetCrtcGammaSize = MkGetCrtcGammaSize{crtc_GetCrtcGammaSize :: CRTC} deriving (Show, Typeable) instance ExtensionRequest GetCrtcGammaSize where extensionId _ = "RANDR" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 22 let size__ = 4 + size (crtc_GetCrtcGammaSize x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (crtc_GetCrtcGammaSize x) putSkip (requiredPadding size__) data GetCrtcGammaSizeReply = MkGetCrtcGammaSizeReply{size_GetCrtcGammaSizeReply :: Word16} deriving (Show, Typeable) instance Deserialize GetCrtcGammaSizeReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize size <- deserialize skip 22 let _ = isCard32 length return (MkGetCrtcGammaSizeReply size) data GetCrtcGamma = MkGetCrtcGamma{crtc_GetCrtcGamma :: CRTC} deriving (Show, Typeable) instance ExtensionRequest GetCrtcGamma where extensionId _ = "RANDR" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 23 let size__ = 4 + size (crtc_GetCrtcGamma x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (crtc_GetCrtcGamma x) putSkip (requiredPadding size__) data GetCrtcGammaReply = MkGetCrtcGammaReply{size_GetCrtcGammaReply :: Word16, red_GetCrtcGammaReply :: [Word16], green_GetCrtcGammaReply :: [Word16], blue_GetCrtcGammaReply :: [Word16]} deriving (Show, Typeable) instance Deserialize GetCrtcGammaReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize size <- deserialize skip 22 red <- deserializeList (fromIntegral size) green <- deserializeList (fromIntegral size) blue <- deserializeList (fromIntegral size) let _ = isCard32 length return (MkGetCrtcGammaReply size red green blue) data SetCrtcGamma = MkSetCrtcGamma{crtc_SetCrtcGamma :: CRTC, size_SetCrtcGamma :: Word16, red_SetCrtcGamma :: [Word16], green_SetCrtcGamma :: [Word16], blue_SetCrtcGamma :: [Word16]} deriving (Show, Typeable) instance ExtensionRequest SetCrtcGamma where extensionId _ = "RANDR" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 24 let size__ = 4 + size (crtc_SetCrtcGamma x) + size (size_SetCrtcGamma x) + 2 + sum (map size (red_SetCrtcGamma x)) + sum (map size (green_SetCrtcGamma x)) + sum (map size (blue_SetCrtcGamma x)) serialize (convertBytesToRequestSize size__ :: Int16) serialize (crtc_SetCrtcGamma x) serialize (size_SetCrtcGamma x) putSkip 2 serializeList (red_SetCrtcGamma x) serializeList (green_SetCrtcGamma x) serializeList (blue_SetCrtcGamma x) putSkip (requiredPadding size__) data NotifyMask = NotifyMaskScreenChange | NotifyMaskCrtcChange | NotifyMaskOutputChange | NotifyMaskOutputProperty deriving Show instance BitEnum NotifyMask where toBit NotifyMaskScreenChange{} = 0 toBit NotifyMaskCrtcChange{} = 1 toBit NotifyMaskOutputChange{} = 2 toBit NotifyMaskOutputProperty{} = 3 fromBit 0 = NotifyMaskScreenChange fromBit 1 = NotifyMaskCrtcChange fromBit 2 = NotifyMaskOutputChange fromBit 3 = NotifyMaskOutputProperty data ScreenChangeNotify = MkScreenChangeNotify{rotation_ScreenChangeNotify :: Word8, timestamp_ScreenChangeNotify :: TIMESTAMP, config_timestamp_ScreenChangeNotify :: TIMESTAMP, root_ScreenChangeNotify :: WINDOW, request_window_ScreenChangeNotify :: WINDOW, sizeID_ScreenChangeNotify :: Word16, subpixel_order_ScreenChangeNotify :: Word16, width_ScreenChangeNotify :: Word16, height_ScreenChangeNotify :: Word16, mwidth_ScreenChangeNotify :: Word16, mheight_ScreenChangeNotify :: Word16} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event ScreenChangeNotify instance Deserialize ScreenChangeNotify where deserialize = do skip 1 rotation <- deserialize skip 2 timestamp <- deserialize config_timestamp <- deserialize root <- deserialize request_window <- deserialize sizeID <- deserialize subpixel_order <- deserialize width <- deserialize height <- deserialize mwidth <- deserialize mheight <- deserialize return (MkScreenChangeNotify rotation timestamp config_timestamp root request_window sizeID subpixel_order width height mwidth mheight) data NotifyEnum = NotifyCrtcChange | NotifyOutputChange | NotifyOutputProperty deriving Show instance SimpleEnum NotifyEnum where toValue NotifyCrtcChange{} = 0 toValue NotifyOutputChange{} = 1 toValue NotifyOutputProperty{} = 2 fromValue 0 = NotifyCrtcChange fromValue 1 = NotifyOutputChange fromValue 2 = NotifyOutputProperty data CrtcChange = MkCrtcChange{timestamp_CrtcChange :: TIMESTAMP, window_CrtcChange :: WINDOW, crtc_CrtcChange :: CRTC, mode_CrtcChange :: MODE, rotation_CrtcChange :: Word16, x_CrtcChange :: Int16, y_CrtcChange :: Int16, width_CrtcChange :: Word16, height_CrtcChange :: Word16} deriving (Show, Typeable) instance Serialize CrtcChange where serialize x = do serialize (timestamp_CrtcChange x) serialize (window_CrtcChange x) serialize (crtc_CrtcChange x) serialize (mode_CrtcChange x) serialize (rotation_CrtcChange x) putSkip 2 serialize (x_CrtcChange x) serialize (y_CrtcChange x) serialize (width_CrtcChange x) serialize (height_CrtcChange x) size x = size (timestamp_CrtcChange x) + size (window_CrtcChange x) + size (crtc_CrtcChange x) + size (mode_CrtcChange x) + size (rotation_CrtcChange x) + 2 + size (x_CrtcChange x) + size (y_CrtcChange x) + size (width_CrtcChange x) + size (height_CrtcChange x) instance Deserialize CrtcChange where deserialize = do timestamp <- deserialize window <- deserialize crtc <- deserialize mode <- deserialize rotation <- deserialize skip 2 x <- deserialize y <- deserialize width <- deserialize height <- deserialize return (MkCrtcChange timestamp window crtc mode rotation x y width height) data OutputChange = MkOutputChange{timestamp_OutputChange :: TIMESTAMP, config_timestamp_OutputChange :: TIMESTAMP, window_OutputChange :: WINDOW, output_OutputChange :: OUTPUT, crtc_OutputChange :: CRTC, mode_OutputChange :: MODE, rotation_OutputChange :: Word16, connection_OutputChange :: Word8, subpixel_order_OutputChange :: Word8} deriving (Show, Typeable) instance Serialize OutputChange where serialize x = do serialize (timestamp_OutputChange x) serialize (config_timestamp_OutputChange x) serialize (window_OutputChange x) serialize (output_OutputChange x) serialize (crtc_OutputChange x) serialize (mode_OutputChange x) serialize (rotation_OutputChange x) serialize (connection_OutputChange x) serialize (subpixel_order_OutputChange x) size x = size (timestamp_OutputChange x) + size (config_timestamp_OutputChange x) + size (window_OutputChange x) + size (output_OutputChange x) + size (crtc_OutputChange x) + size (mode_OutputChange x) + size (rotation_OutputChange x) + size (connection_OutputChange x) + size (subpixel_order_OutputChange x) instance Deserialize OutputChange where deserialize = do timestamp <- deserialize config_timestamp <- deserialize window <- deserialize output <- deserialize crtc <- deserialize mode <- deserialize rotation <- deserialize connection <- deserialize subpixel_order <- deserialize return (MkOutputChange timestamp config_timestamp window output crtc mode rotation connection subpixel_order) data OutputProperty = MkOutputProperty{window_OutputProperty :: WINDOW, output_OutputProperty :: OUTPUT, atom_OutputProperty :: ATOM, timestamp_OutputProperty :: TIMESTAMP, status_OutputProperty :: Word8} deriving (Show, Typeable) instance Serialize OutputProperty where serialize x = do serialize (window_OutputProperty x) serialize (output_OutputProperty x) serialize (atom_OutputProperty x) serialize (timestamp_OutputProperty x) serialize (status_OutputProperty x) putSkip 11 size x = size (window_OutputProperty x) + size (output_OutputProperty x) + size (atom_OutputProperty x) + size (timestamp_OutputProperty x) + size (status_OutputProperty x) + 11 instance Deserialize OutputProperty where deserialize = do window <- deserialize output <- deserialize atom <- deserialize timestamp <- deserialize status <- deserialize skip 11 return (MkOutputProperty window output atom timestamp status) data NotifyData = NotifyDataCrtcChange CrtcChange | NotifyDataOutputChange OutputChange | NotifyDataOutputProperty OutputProperty deriving (Show, Typeable) instance Serialize NotifyData where serialize (NotifyDataCrtcChange x) = serialize x serialize (NotifyDataOutputChange x) = serialize x serialize (NotifyDataOutputProperty x) = serialize x size (NotifyDataCrtcChange x) = size x size (NotifyDataOutputChange x) = size x size (NotifyDataOutputProperty x) = size x deserializeNotifyData :: NotifyEnum -> Get NotifyData deserializeNotifyData NotifyCrtcChange = NotifyDataCrtcChange `liftM` deserialize deserializeNotifyData NotifyOutputChange = NotifyDataOutputChange `liftM` deserialize deserializeNotifyData NotifyOutputProperty = NotifyDataOutputProperty `liftM` deserialize subCodeToNotifyEnum :: Word8 -> NotifyEnum subCodeToNotifyEnum 0 = NotifyCrtcChange subCodeToNotifyEnum 1 = NotifyOutputChange subCodeToNotifyEnum 2 = NotifyOutputProperty data Notify = MkNotify{subCode_Notify :: Word8, u_Notify :: NotifyData} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event Notify instance Deserialize Notify where deserialize = do skip 1 subCode <- deserialize skip 2 u <- deserializeNotifyData (subCodeToNotifyEnum subCode) return (MkNotify subCode u)