module Graphics.XHB.Gen.Record.Types (deserializeError, deserializeEvent, CONTEXT, Range8(..), Range16(..), ExtRange(..), Range(..), ElementHeader, HType(..), ClientSpec, CS(..), ClientInfo(..), BadContext(..), QueryVersion(..), QueryVersionReply(..), CreateContext(..), RegisterClients(..), UnregisterClients(..), GetContext(..), GetContextReply(..), EnableContext(..), EnableContextReply(..), DisableContext(..), FreeContext(..)) 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 deserializeError :: Word8 -> Maybe (Get SomeError) deserializeError 0 = return (liftM toError (deserialize :: Get BadContext)) deserializeError _ = Nothing deserializeEvent :: Word8 -> Maybe (Get SomeEvent) deserializeEvent _ = Nothing newtype CONTEXT = MkCONTEXT Xid deriving (Eq, Ord, Show, Serialize, Deserialize, XidLike) data Range8 = MkRange8{first_Range8 :: Word8, last_Range8 :: Word8} deriving (Show, Typeable) instance Serialize Range8 where serialize x = do serialize (first_Range8 x) serialize (last_Range8 x) size x = size (first_Range8 x) + size (last_Range8 x) instance Deserialize Range8 where deserialize = do first <- deserialize last <- deserialize return (MkRange8 first last) data Range16 = MkRange16{first_Range16 :: Word16, last_Range16 :: Word16} deriving (Show, Typeable) instance Serialize Range16 where serialize x = do serialize (first_Range16 x) serialize (last_Range16 x) size x = size (first_Range16 x) + size (last_Range16 x) instance Deserialize Range16 where deserialize = do first <- deserialize last <- deserialize return (MkRange16 first last) data ExtRange = MkExtRange{major_ExtRange :: Range8, minor_ExtRange :: Range16} deriving (Show, Typeable) instance Serialize ExtRange where serialize x = do serialize (major_ExtRange x) serialize (minor_ExtRange x) size x = size (major_ExtRange x) + size (minor_ExtRange x) instance Deserialize ExtRange where deserialize = do major <- deserialize minor <- deserialize return (MkExtRange major minor) data Range = MkRange{core_requests_Range :: Range8, core_replies_Range :: Range8, ext_requests_Range :: ExtRange, ext_replies_Range :: ExtRange, delivered_events_Range :: Range8, device_events_Range :: Range8, errors_Range :: Range8, client_started_Range :: Bool, client_died_Range :: Bool} deriving (Show, Typeable) instance Serialize Range where serialize x = do serialize (core_requests_Range x) serialize (core_replies_Range x) serialize (ext_requests_Range x) serialize (ext_replies_Range x) serialize (delivered_events_Range x) serialize (device_events_Range x) serialize (errors_Range x) serialize (client_started_Range x) serialize (client_died_Range x) size x = size (core_requests_Range x) + size (core_replies_Range x) + size (ext_requests_Range x) + size (ext_replies_Range x) + size (delivered_events_Range x) + size (device_events_Range x) + size (errors_Range x) + size (client_started_Range x) + size (client_died_Range x) instance Deserialize Range where deserialize = do core_requests <- deserialize core_replies <- deserialize ext_requests <- deserialize ext_replies <- deserialize delivered_events <- deserialize device_events <- deserialize errors <- deserialize client_started <- deserialize client_died <- deserialize return (MkRange core_requests core_replies ext_requests ext_replies delivered_events device_events errors client_started client_died) type ElementHeader = Word8 data HType = HTypeFromServerTime | HTypeFromClientTime | HTypeFromClientSequence deriving Show instance BitEnum HType where toBit HTypeFromServerTime{} = 0 toBit HTypeFromClientTime{} = 1 toBit HTypeFromClientSequence{} = 2 fromBit 0 = HTypeFromServerTime fromBit 1 = HTypeFromClientTime fromBit 2 = HTypeFromClientSequence type ClientSpec = Word32 data CS = CSCurrentClients | CSFutureClients | CSAllClients deriving Show instance SimpleEnum CS where toValue CSCurrentClients{} = 1 toValue CSFutureClients{} = 2 toValue CSAllClients{} = 3 fromValue 1 = CSCurrentClients fromValue 2 = CSFutureClients fromValue 3 = CSAllClients data ClientInfo = MkClientInfo{client_resource_ClientInfo :: ClientSpec, num_ranges_ClientInfo :: Word32, ranges_ClientInfo :: [Range]} deriving (Show, Typeable) instance Serialize ClientInfo where serialize x = do serialize (client_resource_ClientInfo x) serialize (num_ranges_ClientInfo x) serializeList (ranges_ClientInfo x) size x = size (client_resource_ClientInfo x) + size (num_ranges_ClientInfo x) + sum (map size (ranges_ClientInfo x)) instance Deserialize ClientInfo where deserialize = do client_resource <- deserialize num_ranges <- deserialize ranges <- deserializeList (fromIntegral num_ranges) return (MkClientInfo client_resource num_ranges ranges) data BadContext = MkBadContext{invalid_record_BadContext :: Word32} deriving (Show, Typeable) instance Graphics.XHB.Shared.Error BadContext instance Deserialize BadContext where deserialize = do skip 4 invalid_record <- deserialize return (MkBadContext invalid_record) data QueryVersion = MkQueryVersion{major_version_QueryVersion :: Word16, minor_version_QueryVersion :: Word16} deriving (Show, Typeable) instance ExtensionRequest QueryVersion where extensionId _ = "RECORD" 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 :: Word16, minor_version_QueryVersionReply :: Word16} deriving (Show, Typeable) instance Deserialize QueryVersionReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize major_version <- deserialize minor_version <- deserialize let _ = isCard32 length return (MkQueryVersionReply major_version minor_version) data CreateContext = MkCreateContext{context_CreateContext :: Graphics.XHB.Gen.Record.Types.CONTEXT, element_header_CreateContext :: ElementHeader, num_client_specs_CreateContext :: Word32, num_ranges_CreateContext :: Word32, client_specs_CreateContext :: [ClientSpec], ranges_CreateContext :: [Range]} deriving (Show, Typeable) instance ExtensionRequest CreateContext where extensionId _ = "RECORD" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 1 let size__ = 4 + size (context_CreateContext x) + size (element_header_CreateContext x) + 3 + size (num_client_specs_CreateContext x) + size (num_ranges_CreateContext x) + sum (map size (client_specs_CreateContext x)) + sum (map size (ranges_CreateContext x)) serialize (convertBytesToRequestSize size__ :: Int16) serialize (context_CreateContext x) serialize (element_header_CreateContext x) putSkip 3 serialize (num_client_specs_CreateContext x) serialize (num_ranges_CreateContext x) serializeList (client_specs_CreateContext x) serializeList (ranges_CreateContext x) putSkip (requiredPadding size__) data RegisterClients = MkRegisterClients{context_RegisterClients :: Graphics.XHB.Gen.Record.Types.CONTEXT, element_header_RegisterClients :: ElementHeader, num_client_specs_RegisterClients :: Word32, num_ranges_RegisterClients :: Word32, client_specs_RegisterClients :: [ClientSpec], ranges_RegisterClients :: [Range]} deriving (Show, Typeable) instance ExtensionRequest RegisterClients where extensionId _ = "RECORD" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 2 let size__ = 4 + size (context_RegisterClients x) + size (element_header_RegisterClients x) + 3 + size (num_client_specs_RegisterClients x) + size (num_ranges_RegisterClients x) + sum (map size (client_specs_RegisterClients x)) + sum (map size (ranges_RegisterClients x)) serialize (convertBytesToRequestSize size__ :: Int16) serialize (context_RegisterClients x) serialize (element_header_RegisterClients x) putSkip 3 serialize (num_client_specs_RegisterClients x) serialize (num_ranges_RegisterClients x) serializeList (client_specs_RegisterClients x) serializeList (ranges_RegisterClients x) putSkip (requiredPadding size__) data UnregisterClients = MkUnregisterClients{context_UnregisterClients :: Graphics.XHB.Gen.Record.Types.CONTEXT, num_client_specs_UnregisterClients :: Word32, client_specs_UnregisterClients :: [ClientSpec]} deriving (Show, Typeable) instance ExtensionRequest UnregisterClients where extensionId _ = "RECORD" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 3 let size__ = 4 + size (context_UnregisterClients x) + size (num_client_specs_UnregisterClients x) + sum (map size (client_specs_UnregisterClients x)) serialize (convertBytesToRequestSize size__ :: Int16) serialize (context_UnregisterClients x) serialize (num_client_specs_UnregisterClients x) serializeList (client_specs_UnregisterClients x) putSkip (requiredPadding size__) data GetContext = MkGetContext{context_GetContext :: Graphics.XHB.Gen.Record.Types.CONTEXT} deriving (Show, Typeable) instance ExtensionRequest GetContext where extensionId _ = "RECORD" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 4 let size__ = 4 + size (context_GetContext x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (context_GetContext x) putSkip (requiredPadding size__) data GetContextReply = MkGetContextReply{enabled_GetContextReply :: Bool, element_header_GetContextReply :: ElementHeader, num_intercepted_clients_GetContextReply :: Word32, intercepted_clients_GetContextReply :: [ClientInfo]} deriving (Show, Typeable) instance Deserialize GetContextReply where deserialize = do skip 1 enabled <- deserialize skip 2 length <- deserialize element_header <- deserialize skip 3 num_intercepted_clients <- deserialize skip 16 intercepted_clients <- deserializeList (fromIntegral num_intercepted_clients) let _ = isCard32 length return (MkGetContextReply enabled element_header num_intercepted_clients intercepted_clients) data EnableContext = MkEnableContext{context_EnableContext :: Graphics.XHB.Gen.Record.Types.CONTEXT} deriving (Show, Typeable) instance ExtensionRequest EnableContext where extensionId _ = "RECORD" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 5 let size__ = 4 + size (context_EnableContext x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (context_EnableContext x) putSkip (requiredPadding size__) data EnableContextReply = MkEnableContextReply{category_EnableContextReply :: Word8, element_header_EnableContextReply :: ElementHeader, client_swapped_EnableContextReply :: Bool, xid_base_EnableContextReply :: Word32, server_time_EnableContextReply :: Word32, rec_sequence_num_EnableContextReply :: Word32, data_EnableContextReply :: [Word8]} deriving (Show, Typeable) instance Deserialize EnableContextReply where deserialize = do skip 1 category <- deserialize skip 2 length <- deserialize element_header <- deserialize client_swapped <- deserialize skip 2 xid_base <- deserialize server_time <- deserialize rec_sequence_num <- deserialize skip 8 data_ <- deserializeList (fromIntegral (fromIntegral (length * 4))) let _ = isCard32 length return (MkEnableContextReply category element_header client_swapped xid_base server_time rec_sequence_num data_) data DisableContext = MkDisableContext{context_DisableContext :: Graphics.XHB.Gen.Record.Types.CONTEXT} deriving (Show, Typeable) instance ExtensionRequest DisableContext where extensionId _ = "RECORD" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 6 let size__ = 4 + size (context_DisableContext x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (context_DisableContext x) putSkip (requiredPadding size__) data FreeContext = MkFreeContext{context_FreeContext :: Graphics.XHB.Gen.Record.Types.CONTEXT} deriving (Show, Typeable) instance ExtensionRequest FreeContext where extensionId _ = "RECORD" serializeRequest x extOpCode = do putWord8 extOpCode putWord8 7 let size__ = 4 + size (context_FreeContext x) serialize (convertBytesToRequestSize size__ :: Int16) serialize (context_FreeContext x) putSkip (requiredPadding size__)