module Graphics.XHB.Gen.Xproto.Types (deserializeError, deserializeEvent, CHAR2B(..), WINDOW, PIXMAP, CURSOR, FONT, GCONTEXT, COLORMAP, ATOM, DRAWABLE, FONTABLE, VISUALID, TIMESTAMP, KEYSYM, KEYCODE, BUTTON, POINT(..), RECTANGLE(..), ARC(..), FORMAT(..), VisualClass(..), VISUALTYPE(..), DEPTH(..), SCREEN(..), SetupRequest(..), SetupFailed(..), SetupAuthenticate(..), ImageOrder(..), Setup(..), ModMask(..), KeyPress(..), KeyRelease(..), ButtonMask(..), ButtonPress(..), ButtonRelease(..), Motion(..), MotionNotify(..), NotifyDetail(..), NotifyMode(..), EnterNotify(..), LeaveNotify(..), FocusIn(..), FocusOut(..), KeymapNotify(..), Expose(..), GraphicsExposure(..), NoExposure(..), Visibility(..), VisibilityNotify(..), CreateNotify(..), DestroyNotify(..), UnmapNotify(..), MapNotify(..), MapRequest(..), ReparentNotify(..), ConfigureNotify(..), ConfigureRequest(..), GravityNotify(..), ResizeRequest(..), Place(..), CirculateNotify(..), CirculateRequest(..), Property(..), PropertyNotify(..), SelectionClear(..), SelectionRequest(..), SelectionNotify(..), ColormapState(..), ColormapNotify(..), ClientMessage(..),ClientMessageData(..), Mapping(..), MappingNotify(..), Request(..), Value(..), Window(..), Pixmap(..), Atom(..), Cursor(..), Font(..), Match(..), Drawable(..), Access(..), Alloc(..), Colormap(..), GContext(..), IDChoice(..), Name(..), Length(..), Implementation(..), WindowClass(..), CW(..), BackPixmap(..), Gravity(..), BackingStore(..), EventMask(..), CreateWindow(..), ChangeWindowAttributes(..), MapState(..), GetWindowAttributes(..), GetWindowAttributesReply(..), DestroyWindow(..), DestroySubwindows(..), SetMode(..), ChangeSaveSet(..), ReparentWindow(..), MapWindow(..), MapSubwindows(..), UnmapWindow(..), UnmapSubwindows(..), ConfigWindow(..), StackMode(..), ConfigureWindow(..), Circulate(..), CirculateWindow(..), GetGeometry(..), GetGeometryReply(..), QueryTree(..), QueryTreeReply(..), InternAtom(..), InternAtomReply(..), GetAtomName(..), GetAtomNameReply(..), PropMode(..), ChangeProperty(..), DeleteProperty(..), GetPropertyType(..), GetProperty(..), GetPropertyReply(..), ListProperties(..), ListPropertiesReply(..), SetSelectionOwner(..), GetSelectionOwner(..), GetSelectionOwnerReply(..), ConvertSelection(..), SendEventDest(..), SendEvent(..), GrabMode(..), GrabStatus(..), GrabPointer(..), GrabPointerReply(..), UngrabPointer(..), ButtonIndex(..), GrabButton(..), UngrabButton(..), ChangeActivePointerGrab(..), GrabKeyboard(..), GrabKeyboardReply(..), UngrabKeyboard(..), Grab(..), GrabKey(..), UngrabKey(..), Allow(..), AllowEvents(..), QueryPointer(..), QueryPointerReply(..), TIMECOORD(..), GetMotionEvents(..), GetMotionEventsReply(..), TranslateCoordinates(..), TranslateCoordinatesReply(..), WarpPointer(..), InputFocus(..), SetInputFocus(..), GetInputFocus(..), GetInputFocusReply(..), QueryKeymap(..), QueryKeymapReply(..), OpenFont(..), CloseFont(..), FontDraw(..), FONTPROP(..), CHARINFO(..), QueryFont(..), QueryFontReply(..), odd_length_QueryTextExtents, QueryTextExtents(..), QueryTextExtentsReply(..), STR(..), ListFonts(..), ListFontsReply(..), ListFontsWithInfo(..), ListFontsWithInfoReply(..), SetFontPath(..), GetFontPath(..), GetFontPathReply(..), CreatePixmap(..), FreePixmap(..), GC(..), GX(..), LineStyle(..), CapStyle(..), JoinStyle(..), FillStyle(..), FillRule(..), SubwindowMode(..), ArcMode(..), CreateGC(..), ChangeGC(..), CopyGC(..), SetDashes(..), ClipOrdering(..), SetClipRectangles(..), FreeGC(..), ClearArea(..), CopyArea(..), CopyPlane(..), CoordMode(..), PolyPoint(..), PolyLine(..), SEGMENT(..), PolySegment(..), PolyRectangle(..), PolyArc(..), PolyShape(..), FillPoly(..), PolyFillRectangle(..), PolyFillArc(..), ImageFormat(..), PutImage(..), GetImage(..), GetImageReply(..), PolyText8(..), PolyText16(..), ImageText8(..), ImageText16(..), ColormapAlloc(..), CreateColormap(..), FreeColormap(..), CopyColormapAndFree(..), InstallColormap(..), UninstallColormap(..), ListInstalledColormaps(..), ListInstalledColormapsReply(..), AllocColor(..), AllocColorReply(..), AllocNamedColor(..), AllocNamedColorReply(..), AllocColorCells(..), AllocColorCellsReply(..), AllocColorPlanes(..), AllocColorPlanesReply(..), FreeColors(..), ColorFlag(..), COLORITEM(..), StoreColors(..), StoreNamedColor(..), RGB(..), QueryColors(..), QueryColorsReply(..), LookupColor(..), LookupColorReply(..), CreateCursor(..), CreateGlyphCursor(..), FreeCursor(..), RecolorCursor(..), QueryShapeOf(..), QueryBestSize(..), QueryBestSizeReply(..), QueryExtension(..), QueryExtensionReply(..), ListExtensions(..), ListExtensionsReply(..), ChangeKeyboardMapping(..), GetKeyboardMapping(..), GetKeyboardMappingReply(..), KB(..), LedMode(..), AutoRepeatMode(..), ChangeKeyboardControl(..), GetKeyboardControl(..), GetKeyboardControlReply(..), Bell(..), ChangePointerControl(..), GetPointerControl(..), GetPointerControlReply(..), Blanking(..), Exposures(..), SetScreenSaver(..), GetScreenSaver(..), GetScreenSaverReply(..), HostMode(..), Family(..), ChangeHosts(..), HOST(..), ListHosts(..), ListHostsReply(..), AccessControl(..), SetAccessControl(..), CloseDown(..), SetCloseDownMode(..), Kill(..), KillClient(..), RotateProperties(..), ScreenSaver(..), ForceScreenSaver(..), MappingStatus(..), SetPointerMapping(..), SetPointerMappingReply(..), GetPointerMapping(..), GetPointerMappingReply(..), MapIndex(..), SetModifierMapping(..), SetModifierMappingReply(..), GetModifierMapping(..), GetModifierMappingReply(..)) 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 1 = return (liftM toError (deserialize :: Get Request)) deserializeError 2 = return (liftM toError (deserialize :: Get Value)) deserializeError 3 = return (liftM toError (deserialize :: Get Window)) deserializeError 4 = return (liftM toError (deserialize :: Get Pixmap)) deserializeError 5 = return (liftM toError (deserialize :: Get Atom)) deserializeError 6 = return (liftM toError (deserialize :: Get Cursor)) deserializeError 7 = return (liftM toError (deserialize :: Get Font)) deserializeError 8 = return (liftM toError (deserialize :: Get Match)) deserializeError 9 = return (liftM toError (deserialize :: Get Drawable)) deserializeError 10 = return (liftM toError (deserialize :: Get Access)) deserializeError 11 = return (liftM toError (deserialize :: Get Alloc)) deserializeError 12 = return (liftM toError (deserialize :: Get Colormap)) deserializeError 13 = return (liftM toError (deserialize :: Get GContext)) deserializeError 14 = return (liftM toError (deserialize :: Get IDChoice)) deserializeError 15 = return (liftM toError (deserialize :: Get Name)) deserializeError 16 = return (liftM toError (deserialize :: Get Length)) deserializeError 17 = return (liftM toError (deserialize :: Get Implementation)) deserializeError _ = Nothing deserializeEvent :: Word8 -> Maybe (Get SomeEvent) deserializeEvent 2 = return (liftM toEvent (deserialize :: Get KeyPress)) deserializeEvent 3 = return (liftM toEvent (deserialize :: Get KeyRelease)) deserializeEvent 4 = return (liftM toEvent (deserialize :: Get ButtonPress)) deserializeEvent 5 = return (liftM toEvent (deserialize :: Get ButtonRelease)) deserializeEvent 6 = return (liftM toEvent (deserialize :: Get MotionNotify)) deserializeEvent 7 = return (liftM toEvent (deserialize :: Get EnterNotify)) deserializeEvent 8 = return (liftM toEvent (deserialize :: Get LeaveNotify)) deserializeEvent 9 = return (liftM toEvent (deserialize :: Get FocusIn)) deserializeEvent 10 = return (liftM toEvent (deserialize :: Get FocusOut)) deserializeEvent 11 = return (liftM toEvent (deserialize :: Get KeymapNotify)) deserializeEvent 12 = return (liftM toEvent (deserialize :: Get Expose)) deserializeEvent 13 = return (liftM toEvent (deserialize :: Get GraphicsExposure)) deserializeEvent 14 = return (liftM toEvent (deserialize :: Get NoExposure)) deserializeEvent 15 = return (liftM toEvent (deserialize :: Get VisibilityNotify)) deserializeEvent 16 = return (liftM toEvent (deserialize :: Get CreateNotify)) deserializeEvent 17 = return (liftM toEvent (deserialize :: Get DestroyNotify)) deserializeEvent 18 = return (liftM toEvent (deserialize :: Get UnmapNotify)) deserializeEvent 19 = return (liftM toEvent (deserialize :: Get MapNotify)) deserializeEvent 20 = return (liftM toEvent (deserialize :: Get MapRequest)) deserializeEvent 21 = return (liftM toEvent (deserialize :: Get ReparentNotify)) deserializeEvent 22 = return (liftM toEvent (deserialize :: Get ConfigureNotify)) deserializeEvent 23 = return (liftM toEvent (deserialize :: Get ConfigureRequest)) deserializeEvent 24 = return (liftM toEvent (deserialize :: Get GravityNotify)) deserializeEvent 25 = return (liftM toEvent (deserialize :: Get ResizeRequest)) deserializeEvent 26 = return (liftM toEvent (deserialize :: Get CirculateNotify)) deserializeEvent 27 = return (liftM toEvent (deserialize :: Get CirculateRequest)) deserializeEvent 28 = return (liftM toEvent (deserialize :: Get PropertyNotify)) deserializeEvent 29 = return (liftM toEvent (deserialize :: Get SelectionClear)) deserializeEvent 30 = return (liftM toEvent (deserialize :: Get SelectionRequest)) deserializeEvent 31 = return (liftM toEvent (deserialize :: Get SelectionNotify)) deserializeEvent 32 = return (liftM toEvent (deserialize :: Get ColormapNotify)) deserializeEvent 33 = return (liftM toEvent (deserialize :: Get ClientMessage)) deserializeEvent 34 = return (liftM toEvent (deserialize :: Get MappingNotify)) deserializeEvent _ = Nothing data CHAR2B = MkCHAR2B{byte1_CHAR2B :: Word8, byte2_CHAR2B :: Word8} deriving (Show, Typeable) instance Serialize CHAR2B where serialize x = do serialize (byte1_CHAR2B x) serialize (byte2_CHAR2B x) size x = size (byte1_CHAR2B x) + size (byte2_CHAR2B x) instance Deserialize CHAR2B where deserialize = do byte1 <- deserialize byte2 <- deserialize return (MkCHAR2B byte1 byte2) newtype WINDOW = MkWINDOW Xid deriving (Eq, Ord, Show, Serialize, Deserialize, XidLike) newtype PIXMAP = MkPIXMAP Xid deriving (Eq, Ord, Show, Serialize, Deserialize, XidLike) newtype CURSOR = MkCURSOR Xid deriving (Eq, Ord, Show, Serialize, Deserialize, XidLike) newtype FONT = MkFONT Xid deriving (Eq, Ord, Show, Serialize, Deserialize, XidLike) newtype GCONTEXT = MkGCONTEXT Xid deriving (Eq, Ord, Show, Serialize, Deserialize, XidLike) newtype COLORMAP = MkCOLORMAP Xid deriving (Eq, Ord, Show, Serialize, Deserialize, XidLike) newtype ATOM = MkATOM Xid deriving (Eq, Ord, Show, Serialize, Deserialize, XidLike) newtype DRAWABLE = MkDRAWABLE Xid deriving (Eq, Ord, Show, Serialize, Deserialize, XidLike) newtype FONTABLE = MkFONTABLE Xid deriving (Eq, Ord, Show, Serialize, Deserialize, XidLike) type VISUALID = Word32 type TIMESTAMP = Word32 type KEYSYM = Word32 type KEYCODE = Word8 type BUTTON = Word8 data POINT = MkPOINT{x_POINT :: Int16, y_POINT :: Int16} deriving (Show, Typeable) instance Serialize POINT where serialize x = do serialize (x_POINT x) serialize (y_POINT x) size x = size (x_POINT x) + size (y_POINT x) instance Deserialize POINT where deserialize = do x <- deserialize y <- deserialize return (MkPOINT x y) data RECTANGLE = MkRECTANGLE{x_RECTANGLE :: Int16, y_RECTANGLE :: Int16, width_RECTANGLE :: Word16, height_RECTANGLE :: Word16} deriving (Show, Typeable) instance Serialize RECTANGLE where serialize x = do serialize (x_RECTANGLE x) serialize (y_RECTANGLE x) serialize (width_RECTANGLE x) serialize (height_RECTANGLE x) size x = size (x_RECTANGLE x) + size (y_RECTANGLE x) + size (width_RECTANGLE x) + size (height_RECTANGLE x) instance Deserialize RECTANGLE where deserialize = do x <- deserialize y <- deserialize width <- deserialize height <- deserialize return (MkRECTANGLE x y width height) data ARC = MkARC{x_ARC :: Int16, y_ARC :: Int16, width_ARC :: Word16, height_ARC :: Word16, angle1_ARC :: Int16, angle2_ARC :: Int16} deriving (Show, Typeable) instance Serialize ARC where serialize x = do serialize (x_ARC x) serialize (y_ARC x) serialize (width_ARC x) serialize (height_ARC x) serialize (angle1_ARC x) serialize (angle2_ARC x) size x = size (x_ARC x) + size (y_ARC x) + size (width_ARC x) + size (height_ARC x) + size (angle1_ARC x) + size (angle2_ARC x) instance Deserialize ARC where deserialize = do x <- deserialize y <- deserialize width <- deserialize height <- deserialize angle1 <- deserialize angle2 <- deserialize return (MkARC x y width height angle1 angle2) data FORMAT = MkFORMAT{depth_FORMAT :: Word8, bits_per_pixel_FORMAT :: Word8, scanline_pad_FORMAT :: Word8} deriving (Show, Typeable) instance Serialize FORMAT where serialize x = do serialize (depth_FORMAT x) serialize (bits_per_pixel_FORMAT x) serialize (scanline_pad_FORMAT x) putSkip 5 size x = size (depth_FORMAT x) + size (bits_per_pixel_FORMAT x) + size (scanline_pad_FORMAT x) + 5 instance Deserialize FORMAT where deserialize = do depth <- deserialize bits_per_pixel <- deserialize scanline_pad <- deserialize skip 5 return (MkFORMAT depth bits_per_pixel scanline_pad) data VisualClass = VisualClassStaticGray | VisualClassGrayScale | VisualClassStaticColor | VisualClassPseudoColor | VisualClassTrueColor | VisualClassDirectColor instance SimpleEnum VisualClass where toValue VisualClassStaticGray{} = 0 toValue VisualClassGrayScale{} = 1 toValue VisualClassStaticColor{} = 2 toValue VisualClassPseudoColor{} = 3 toValue VisualClassTrueColor{} = 4 toValue VisualClassDirectColor{} = 5 fromValue 0 = VisualClassStaticGray fromValue 1 = VisualClassGrayScale fromValue 2 = VisualClassStaticColor fromValue 3 = VisualClassPseudoColor fromValue 4 = VisualClassTrueColor fromValue 5 = VisualClassDirectColor data VISUALTYPE = MkVISUALTYPE{visual_id_VISUALTYPE :: VISUALID, class_VISUALTYPE :: Word8, bits_per_rgb_value_VISUALTYPE :: Word8, colormap_entries_VISUALTYPE :: Word16, red_mask_VISUALTYPE :: Word32, green_mask_VISUALTYPE :: Word32, blue_mask_VISUALTYPE :: Word32} deriving (Show, Typeable) instance Serialize VISUALTYPE where serialize x = do serialize (visual_id_VISUALTYPE x) serialize (class_VISUALTYPE x) serialize (bits_per_rgb_value_VISUALTYPE x) serialize (colormap_entries_VISUALTYPE x) serialize (red_mask_VISUALTYPE x) serialize (green_mask_VISUALTYPE x) serialize (blue_mask_VISUALTYPE x) putSkip 4 size x = size (visual_id_VISUALTYPE x) + size (class_VISUALTYPE x) + size (bits_per_rgb_value_VISUALTYPE x) + size (colormap_entries_VISUALTYPE x) + size (red_mask_VISUALTYPE x) + size (green_mask_VISUALTYPE x) + size (blue_mask_VISUALTYPE x) + 4 instance Deserialize VISUALTYPE where deserialize = do visual_id <- deserialize class_ <- deserialize bits_per_rgb_value <- deserialize colormap_entries <- deserialize red_mask <- deserialize green_mask <- deserialize blue_mask <- deserialize skip 4 return (MkVISUALTYPE visual_id class_ bits_per_rgb_value colormap_entries red_mask green_mask blue_mask) data DEPTH = MkDEPTH{depth_DEPTH :: Word8, visuals_len_DEPTH :: Word16, visuals_DEPTH :: [VISUALTYPE]} deriving (Show, Typeable) instance Serialize DEPTH where serialize x = do serialize (depth_DEPTH x) putSkip 1 serialize (visuals_len_DEPTH x) putSkip 4 serializeList (visuals_DEPTH x) size x = size (depth_DEPTH x) + 1 + size (visuals_len_DEPTH x) + 4 + sum (map size (visuals_DEPTH x)) instance Deserialize DEPTH where deserialize = do depth <- deserialize skip 1 visuals_len <- deserialize skip 4 visuals <- deserializeList (fromIntegral visuals_len) return (MkDEPTH depth visuals_len visuals) data SCREEN = MkSCREEN{root_SCREEN :: WINDOW, default_colormap_SCREEN :: COLORMAP, white_pixel_SCREEN :: Word32, black_pixel_SCREEN :: Word32, current_input_masks_SCREEN :: Word32, width_in_pixels_SCREEN :: Word16, height_in_pixels_SCREEN :: Word16, width_in_millimeters_SCREEN :: Word16, height_in_millimeters_SCREEN :: Word16, min_installed_maps_SCREEN :: Word16, max_installed_maps_SCREEN :: Word16, root_visual_SCREEN :: VISUALID, backing_stores_SCREEN :: Word8, save_unders_SCREEN :: Bool, root_depth_SCREEN :: Word8, allowed_depths_len_SCREEN :: Word8, allowed_depths_SCREEN :: [DEPTH]} deriving (Show, Typeable) instance Serialize SCREEN where serialize x = do serialize (root_SCREEN x) serialize (default_colormap_SCREEN x) serialize (white_pixel_SCREEN x) serialize (black_pixel_SCREEN x) serialize (current_input_masks_SCREEN x) serialize (width_in_pixels_SCREEN x) serialize (height_in_pixels_SCREEN x) serialize (width_in_millimeters_SCREEN x) serialize (height_in_millimeters_SCREEN x) serialize (min_installed_maps_SCREEN x) serialize (max_installed_maps_SCREEN x) serialize (root_visual_SCREEN x) serialize (backing_stores_SCREEN x) serialize (save_unders_SCREEN x) serialize (root_depth_SCREEN x) serialize (allowed_depths_len_SCREEN x) serializeList (allowed_depths_SCREEN x) size x = size (root_SCREEN x) + size (default_colormap_SCREEN x) + size (white_pixel_SCREEN x) + size (black_pixel_SCREEN x) + size (current_input_masks_SCREEN x) + size (width_in_pixels_SCREEN x) + size (height_in_pixels_SCREEN x) + size (width_in_millimeters_SCREEN x) + size (height_in_millimeters_SCREEN x) + size (min_installed_maps_SCREEN x) + size (max_installed_maps_SCREEN x) + size (root_visual_SCREEN x) + size (backing_stores_SCREEN x) + size (save_unders_SCREEN x) + size (root_depth_SCREEN x) + size (allowed_depths_len_SCREEN x) + sum (map size (allowed_depths_SCREEN x)) instance Deserialize SCREEN where deserialize = do root <- deserialize default_colormap <- deserialize white_pixel <- deserialize black_pixel <- deserialize current_input_masks <- deserialize width_in_pixels <- deserialize height_in_pixels <- deserialize width_in_millimeters <- deserialize height_in_millimeters <- deserialize min_installed_maps <- deserialize max_installed_maps <- deserialize root_visual <- deserialize backing_stores <- deserialize save_unders <- deserialize root_depth <- deserialize allowed_depths_len <- deserialize allowed_depths <- deserializeList (fromIntegral allowed_depths_len) return (MkSCREEN root default_colormap white_pixel black_pixel current_input_masks width_in_pixels height_in_pixels width_in_millimeters height_in_millimeters min_installed_maps max_installed_maps root_visual backing_stores save_unders root_depth allowed_depths_len allowed_depths) data SetupRequest = MkSetupRequest{byte_order_SetupRequest :: Word8, protocol_major_version_SetupRequest :: Word16, protocol_minor_version_SetupRequest :: Word16, authorization_protocol_name_len_SetupRequest :: Word16, authorization_protocol_data_len_SetupRequest :: Word16, authorization_protocol_name_SetupRequest :: [CChar], authorization_protocol_data_SetupRequest :: [CChar]} deriving (Show, Typeable) instance Serialize SetupRequest where serialize x = do serialize (byte_order_SetupRequest x) putSkip 1 serialize (protocol_major_version_SetupRequest x) serialize (protocol_minor_version_SetupRequest x) serialize (authorization_protocol_name_len_SetupRequest x) serialize (authorization_protocol_data_len_SetupRequest x) putSkip 2 serializeList (authorization_protocol_name_SetupRequest x) serializeList (authorization_protocol_data_SetupRequest x) size x = size (byte_order_SetupRequest x) + 1 + size (protocol_major_version_SetupRequest x) + size (protocol_minor_version_SetupRequest x) + size (authorization_protocol_name_len_SetupRequest x) + size (authorization_protocol_data_len_SetupRequest x) + 2 + sum (map size (authorization_protocol_name_SetupRequest x)) + sum (map size (authorization_protocol_data_SetupRequest x)) instance Deserialize SetupRequest where deserialize = do byte_order <- deserialize skip 1 protocol_major_version <- deserialize protocol_minor_version <- deserialize authorization_protocol_name_len <- deserialize authorization_protocol_data_len <- deserialize skip 2 authorization_protocol_name <- deserializeList (fromIntegral authorization_protocol_name_len) authorization_protocol_data <- deserializeList (fromIntegral authorization_protocol_data_len) return (MkSetupRequest byte_order protocol_major_version protocol_minor_version authorization_protocol_name_len authorization_protocol_data_len authorization_protocol_name authorization_protocol_data) data SetupFailed = MkSetupFailed{status_SetupFailed :: Word8, reason_len_SetupFailed :: Word8, protocol_major_version_SetupFailed :: Word16, protocol_minor_version_SetupFailed :: Word16, length_SetupFailed :: Word16, reason_SetupFailed :: [CChar]} deriving (Show, Typeable) instance Serialize SetupFailed where serialize x = do serialize (status_SetupFailed x) serialize (reason_len_SetupFailed x) serialize (protocol_major_version_SetupFailed x) serialize (protocol_minor_version_SetupFailed x) serialize (length_SetupFailed x) serializeList (reason_SetupFailed x) size x = size (status_SetupFailed x) + size (reason_len_SetupFailed x) + size (protocol_major_version_SetupFailed x) + size (protocol_minor_version_SetupFailed x) + size (length_SetupFailed x) + sum (map size (reason_SetupFailed x)) instance Deserialize SetupFailed where deserialize = do status <- deserialize reason_len <- deserialize protocol_major_version <- deserialize protocol_minor_version <- deserialize length <- deserialize reason <- deserializeList (fromIntegral reason_len) return (MkSetupFailed status reason_len protocol_major_version protocol_minor_version length reason) data SetupAuthenticate = MkSetupAuthenticate{status_SetupAuthenticate :: Word8, length_SetupAuthenticate :: Word16, reason_SetupAuthenticate :: [CChar]} deriving (Show, Typeable) instance Serialize SetupAuthenticate where serialize x = do serialize (status_SetupAuthenticate x) putSkip 5 serialize (length_SetupAuthenticate x) serializeList (reason_SetupAuthenticate x) size x = size (status_SetupAuthenticate x) + 5 + size (length_SetupAuthenticate x) + sum (map size (reason_SetupAuthenticate x)) instance Deserialize SetupAuthenticate where deserialize = do status <- deserialize skip 5 length <- deserialize reason <- deserializeList (fromIntegral (fromIntegral (length * 4))) return (MkSetupAuthenticate status length reason) data ImageOrder = ImageOrderLSBFirst | ImageOrderMSBFirst instance SimpleEnum ImageOrder where toValue ImageOrderLSBFirst{} = 0 toValue ImageOrderMSBFirst{} = 1 fromValue 0 = ImageOrderLSBFirst fromValue 1 = ImageOrderMSBFirst data Setup = MkSetup{status_Setup :: Word8, protocol_major_version_Setup :: Word16, protocol_minor_version_Setup :: Word16, length_Setup :: Word16, release_number_Setup :: Word32, resource_id_base_Setup :: Word32, resource_id_mask_Setup :: Word32, motion_buffer_size_Setup :: Word32, vendor_len_Setup :: Word16, maximum_request_length_Setup :: Word16, roots_len_Setup :: Word8, pixmap_formats_len_Setup :: Word8, image_byte_order_Setup :: Word8, bitmap_format_bit_order_Setup :: Word8, bitmap_format_scanline_unit_Setup :: Word8, bitmap_format_scanline_pad_Setup :: Word8, min_keycode_Setup :: KEYCODE, max_keycode_Setup :: KEYCODE, vendor_Setup :: [CChar], pixmap_formats_Setup :: [FORMAT], roots_Setup :: [SCREEN]} deriving (Show, Typeable) instance Serialize Setup where serialize x = do serialize (status_Setup x) putSkip 1 serialize (protocol_major_version_Setup x) serialize (protocol_minor_version_Setup x) serialize (length_Setup x) serialize (release_number_Setup x) serialize (resource_id_base_Setup x) serialize (resource_id_mask_Setup x) serialize (motion_buffer_size_Setup x) serialize (vendor_len_Setup x) serialize (maximum_request_length_Setup x) serialize (roots_len_Setup x) serialize (pixmap_formats_len_Setup x) serialize (image_byte_order_Setup x) serialize (bitmap_format_bit_order_Setup x) serialize (bitmap_format_scanline_unit_Setup x) serialize (bitmap_format_scanline_pad_Setup x) serialize (min_keycode_Setup x) serialize (max_keycode_Setup x) putSkip 4 serializeList (vendor_Setup x) serializeList (pixmap_formats_Setup x) serializeList (roots_Setup x) size x = size (status_Setup x) + 1 + size (protocol_major_version_Setup x) + size (protocol_minor_version_Setup x) + size (length_Setup x) + size (release_number_Setup x) + size (resource_id_base_Setup x) + size (resource_id_mask_Setup x) + size (motion_buffer_size_Setup x) + size (vendor_len_Setup x) + size (maximum_request_length_Setup x) + size (roots_len_Setup x) + size (pixmap_formats_len_Setup x) + size (image_byte_order_Setup x) + size (bitmap_format_bit_order_Setup x) + size (bitmap_format_scanline_unit_Setup x) + size (bitmap_format_scanline_pad_Setup x) + size (min_keycode_Setup x) + size (max_keycode_Setup x) + 4 + sum (map size (vendor_Setup x)) + sum (map size (pixmap_formats_Setup x)) + sum (map size (roots_Setup x)) instance Deserialize Setup where deserialize = do status <- deserialize skip 1 protocol_major_version <- deserialize protocol_minor_version <- deserialize length <- deserialize release_number <- deserialize resource_id_base <- deserialize resource_id_mask <- deserialize motion_buffer_size <- deserialize vendor_len <- deserialize maximum_request_length <- deserialize roots_len <- deserialize pixmap_formats_len <- deserialize image_byte_order <- deserialize bitmap_format_bit_order <- deserialize bitmap_format_scanline_unit <- deserialize bitmap_format_scanline_pad <- deserialize min_keycode <- deserialize max_keycode <- deserialize skip 4 vendor <- deserializeList (fromIntegral vendor_len) pixmap_formats <- deserializeList (fromIntegral pixmap_formats_len) roots <- deserializeList (fromIntegral roots_len) return (MkSetup status protocol_major_version protocol_minor_version length release_number resource_id_base resource_id_mask motion_buffer_size vendor_len maximum_request_length roots_len pixmap_formats_len image_byte_order bitmap_format_bit_order bitmap_format_scanline_unit bitmap_format_scanline_pad min_keycode max_keycode vendor pixmap_formats roots) data ModMask = ModMaskShift | ModMaskLock | ModMaskControl | ModMask1 | ModMask2 | ModMask3 | ModMask4 | ModMask5 instance BitEnum ModMask where toBit ModMaskShift{} = 0 toBit ModMaskLock{} = 1 toBit ModMaskControl{} = 2 toBit ModMask1{} = 3 toBit ModMask2{} = 4 toBit ModMask3{} = 5 toBit ModMask4{} = 6 toBit ModMask5{} = 7 fromBit 0 = ModMaskShift fromBit 1 = ModMaskLock fromBit 2 = ModMaskControl fromBit 3 = ModMask1 fromBit 4 = ModMask2 fromBit 5 = ModMask3 fromBit 6 = ModMask4 fromBit 7 = ModMask5 data KeyPress = MkKeyPress{detail_KeyPress :: KEYCODE, time_KeyPress :: TIMESTAMP, root_KeyPress :: WINDOW, event_KeyPress :: WINDOW, child_KeyPress :: WINDOW, root_x_KeyPress :: Int16, root_y_KeyPress :: Int16, event_x_KeyPress :: Int16, event_y_KeyPress :: Int16, state_KeyPress :: Word16, same_screen_KeyPress :: Bool} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event KeyPress instance Deserialize KeyPress where deserialize = do skip 1 detail <- deserialize skip 2 time <- deserialize root <- deserialize event <- deserialize child <- deserialize root_x <- deserialize root_y <- deserialize event_x <- deserialize event_y <- deserialize state <- deserialize same_screen <- deserialize skip 1 return (MkKeyPress detail time root event child root_x root_y event_x event_y state same_screen) data KeyRelease = MkKeyRelease{detail_KeyRelease :: KEYCODE, time_KeyRelease :: TIMESTAMP, root_KeyRelease :: WINDOW, event_KeyRelease :: WINDOW, child_KeyRelease :: WINDOW, root_x_KeyRelease :: Int16, root_y_KeyRelease :: Int16, event_x_KeyRelease :: Int16, event_y_KeyRelease :: Int16, state_KeyRelease :: Word16, same_screen_KeyRelease :: Bool} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event KeyRelease instance Deserialize KeyRelease where deserialize = do skip 1 detail <- deserialize skip 2 time <- deserialize root <- deserialize event <- deserialize child <- deserialize root_x <- deserialize root_y <- deserialize event_x <- deserialize event_y <- deserialize state <- deserialize same_screen <- deserialize skip 1 return (MkKeyRelease detail time root event child root_x root_y event_x event_y state same_screen) data ButtonMask = ButtonMask1 | ButtonMask2 | ButtonMask3 | ButtonMask4 | ButtonMask5 | ButtonMaskAny instance BitEnum ButtonMask where toBit ButtonMask1{} = 8 toBit ButtonMask2{} = 9 toBit ButtonMask3{} = 10 toBit ButtonMask4{} = 11 toBit ButtonMask5{} = 12 toBit ButtonMaskAny{} = 15 fromBit 8 = ButtonMask1 fromBit 9 = ButtonMask2 fromBit 10 = ButtonMask3 fromBit 11 = ButtonMask4 fromBit 12 = ButtonMask5 fromBit 15 = ButtonMaskAny data ButtonPress = MkButtonPress{detail_ButtonPress :: BUTTON, time_ButtonPress :: TIMESTAMP, root_ButtonPress :: WINDOW, event_ButtonPress :: WINDOW, child_ButtonPress :: WINDOW, root_x_ButtonPress :: Int16, root_y_ButtonPress :: Int16, event_x_ButtonPress :: Int16, event_y_ButtonPress :: Int16, state_ButtonPress :: Word16, same_screen_ButtonPress :: Bool} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event ButtonPress instance Deserialize ButtonPress where deserialize = do skip 1 detail <- deserialize skip 2 time <- deserialize root <- deserialize event <- deserialize child <- deserialize root_x <- deserialize root_y <- deserialize event_x <- deserialize event_y <- deserialize state <- deserialize same_screen <- deserialize skip 1 return (MkButtonPress detail time root event child root_x root_y event_x event_y state same_screen) data ButtonRelease = MkButtonRelease{detail_ButtonRelease :: BUTTON, time_ButtonRelease :: TIMESTAMP, root_ButtonRelease :: WINDOW, event_ButtonRelease :: WINDOW, child_ButtonRelease :: WINDOW, root_x_ButtonRelease :: Int16, root_y_ButtonRelease :: Int16, event_x_ButtonRelease :: Int16, event_y_ButtonRelease :: Int16, state_ButtonRelease :: Word16, same_screen_ButtonRelease :: Bool} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event ButtonRelease instance Deserialize ButtonRelease where deserialize = do skip 1 detail <- deserialize skip 2 time <- deserialize root <- deserialize event <- deserialize child <- deserialize root_x <- deserialize root_y <- deserialize event_x <- deserialize event_y <- deserialize state <- deserialize same_screen <- deserialize skip 1 return (MkButtonRelease detail time root event child root_x root_y event_x event_y state same_screen) data Motion = MotionNormal | MotionHint instance SimpleEnum Motion where toValue MotionNormal{} = 0 toValue MotionHint{} = 1 fromValue 0 = MotionNormal fromValue 1 = MotionHint data MotionNotify = MkMotionNotify{detail_MotionNotify :: Word8, time_MotionNotify :: TIMESTAMP, root_MotionNotify :: WINDOW, event_MotionNotify :: WINDOW, child_MotionNotify :: WINDOW, root_x_MotionNotify :: Int16, root_y_MotionNotify :: Int16, event_x_MotionNotify :: Int16, event_y_MotionNotify :: Int16, state_MotionNotify :: Word16, same_screen_MotionNotify :: Bool} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event MotionNotify instance Deserialize MotionNotify where deserialize = do skip 1 detail <- deserialize skip 2 time <- deserialize root <- deserialize event <- deserialize child <- deserialize root_x <- deserialize root_y <- deserialize event_x <- deserialize event_y <- deserialize state <- deserialize same_screen <- deserialize skip 1 return (MkMotionNotify detail time root event child root_x root_y event_x event_y state same_screen) data NotifyDetail = NotifyDetailAncestor | NotifyDetailVirtual | NotifyDetailInferior | NotifyDetailNonlinear | NotifyDetailNonlinearVirtual | NotifyDetailPointer | NotifyDetailPointerRoot | NotifyDetailNone instance SimpleEnum NotifyDetail where toValue NotifyDetailAncestor{} = 0 toValue NotifyDetailVirtual{} = 1 toValue NotifyDetailInferior{} = 2 toValue NotifyDetailNonlinear{} = 3 toValue NotifyDetailNonlinearVirtual{} = 4 toValue NotifyDetailPointer{} = 5 toValue NotifyDetailPointerRoot{} = 6 toValue NotifyDetailNone{} = 7 fromValue 0 = NotifyDetailAncestor fromValue 1 = NotifyDetailVirtual fromValue 2 = NotifyDetailInferior fromValue 3 = NotifyDetailNonlinear fromValue 4 = NotifyDetailNonlinearVirtual fromValue 5 = NotifyDetailPointer fromValue 6 = NotifyDetailPointerRoot fromValue 7 = NotifyDetailNone data NotifyMode = NotifyModeNormal | NotifyModeGrab | NotifyModeUngrab | NotifyModeWhileGrabbed instance SimpleEnum NotifyMode where toValue NotifyModeNormal{} = 0 toValue NotifyModeGrab{} = 1 toValue NotifyModeUngrab{} = 2 toValue NotifyModeWhileGrabbed{} = 3 fromValue 0 = NotifyModeNormal fromValue 1 = NotifyModeGrab fromValue 2 = NotifyModeUngrab fromValue 3 = NotifyModeWhileGrabbed data EnterNotify = MkEnterNotify{detail_EnterNotify :: Word8, time_EnterNotify :: TIMESTAMP, root_EnterNotify :: WINDOW, event_EnterNotify :: WINDOW, child_EnterNotify :: WINDOW, root_x_EnterNotify :: Int16, root_y_EnterNotify :: Int16, event_x_EnterNotify :: Int16, event_y_EnterNotify :: Int16, state_EnterNotify :: Word16, mode_EnterNotify :: Word8, same_screen_focus_EnterNotify :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event EnterNotify instance Deserialize EnterNotify where deserialize = do skip 1 detail <- deserialize skip 2 time <- deserialize root <- deserialize event <- deserialize child <- deserialize root_x <- deserialize root_y <- deserialize event_x <- deserialize event_y <- deserialize state <- deserialize mode <- deserialize same_screen_focus <- deserialize return (MkEnterNotify detail time root event child root_x root_y event_x event_y state mode same_screen_focus) data LeaveNotify = MkLeaveNotify{detail_LeaveNotify :: Word8, time_LeaveNotify :: TIMESTAMP, root_LeaveNotify :: WINDOW, event_LeaveNotify :: WINDOW, child_LeaveNotify :: WINDOW, root_x_LeaveNotify :: Int16, root_y_LeaveNotify :: Int16, event_x_LeaveNotify :: Int16, event_y_LeaveNotify :: Int16, state_LeaveNotify :: Word16, mode_LeaveNotify :: Word8, same_screen_focus_LeaveNotify :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event LeaveNotify instance Deserialize LeaveNotify where deserialize = do skip 1 detail <- deserialize skip 2 time <- deserialize root <- deserialize event <- deserialize child <- deserialize root_x <- deserialize root_y <- deserialize event_x <- deserialize event_y <- deserialize state <- deserialize mode <- deserialize same_screen_focus <- deserialize return (MkLeaveNotify detail time root event child root_x root_y event_x event_y state mode same_screen_focus) data FocusIn = MkFocusIn{detail_FocusIn :: Word8, event_FocusIn :: WINDOW, mode_FocusIn :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event FocusIn instance Deserialize FocusIn where deserialize = do skip 1 detail <- deserialize skip 2 event <- deserialize mode <- deserialize skip 3 return (MkFocusIn detail event mode) data FocusOut = MkFocusOut{detail_FocusOut :: Word8, event_FocusOut :: WINDOW, mode_FocusOut :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event FocusOut instance Deserialize FocusOut where deserialize = do skip 1 detail <- deserialize skip 2 event <- deserialize mode <- deserialize skip 3 return (MkFocusOut detail event mode) data KeymapNotify = MkKeymapNotify{keys_KeymapNotify :: [Word8]} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event KeymapNotify instance Deserialize KeymapNotify where deserialize = do skip 1 keys <- deserializeList (fromIntegral 31) return (MkKeymapNotify keys) data Expose = MkExpose{window_Expose :: WINDOW, x_Expose :: Word16, y_Expose :: Word16, width_Expose :: Word16, height_Expose :: Word16, count_Expose :: Word16} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event Expose instance Deserialize Expose where deserialize = do skip 1 skip 1 skip 2 window <- deserialize x <- deserialize y <- deserialize width <- deserialize height <- deserialize count <- deserialize skip 2 return (MkExpose window x y width height count) data GraphicsExposure = MkGraphicsExposure{drawable_GraphicsExposure :: DRAWABLE, x_GraphicsExposure :: Word16, y_GraphicsExposure :: Word16, width_GraphicsExposure :: Word16, height_GraphicsExposure :: Word16, minor_opcode_GraphicsExposure :: Word16, count_GraphicsExposure :: Word16, major_opcode_GraphicsExposure :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event GraphicsExposure instance Deserialize GraphicsExposure where deserialize = do skip 1 skip 1 skip 2 drawable <- deserialize x <- deserialize y <- deserialize width <- deserialize height <- deserialize minor_opcode <- deserialize count <- deserialize major_opcode <- deserialize skip 3 return (MkGraphicsExposure drawable x y width height minor_opcode count major_opcode) data NoExposure = MkNoExposure{drawable_NoExposure :: DRAWABLE, minor_opcode_NoExposure :: Word16, major_opcode_NoExposure :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event NoExposure instance Deserialize NoExposure where deserialize = do skip 1 skip 1 skip 2 drawable <- deserialize minor_opcode <- deserialize major_opcode <- deserialize skip 1 return (MkNoExposure drawable minor_opcode major_opcode) data Visibility = VisibilityUnobscured | VisibilityPartiallyObscured | VisibilityFullyObscured instance SimpleEnum Visibility where toValue VisibilityUnobscured{} = 0 toValue VisibilityPartiallyObscured{} = 1 toValue VisibilityFullyObscured{} = 2 fromValue 0 = VisibilityUnobscured fromValue 1 = VisibilityPartiallyObscured fromValue 2 = VisibilityFullyObscured data VisibilityNotify = MkVisibilityNotify{window_VisibilityNotify :: WINDOW, state_VisibilityNotify :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event VisibilityNotify instance Deserialize VisibilityNotify where deserialize = do skip 1 skip 1 skip 2 window <- deserialize state <- deserialize skip 3 return (MkVisibilityNotify window state) data CreateNotify = MkCreateNotify{parent_CreateNotify :: WINDOW, window_CreateNotify :: WINDOW, x_CreateNotify :: Int16, y_CreateNotify :: Int16, width_CreateNotify :: Word16, height_CreateNotify :: Word16, border_width_CreateNotify :: Word16, override_redirect_CreateNotify :: Bool} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event CreateNotify instance Deserialize CreateNotify where deserialize = do skip 1 skip 1 skip 2 parent <- deserialize window <- deserialize x <- deserialize y <- deserialize width <- deserialize height <- deserialize border_width <- deserialize override_redirect <- deserialize skip 1 return (MkCreateNotify parent window x y width height border_width override_redirect) data DestroyNotify = MkDestroyNotify{event_DestroyNotify :: WINDOW, window_DestroyNotify :: WINDOW} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event DestroyNotify instance Deserialize DestroyNotify where deserialize = do skip 1 skip 1 skip 2 event <- deserialize window <- deserialize return (MkDestroyNotify event window) data UnmapNotify = MkUnmapNotify{event_UnmapNotify :: WINDOW, window_UnmapNotify :: WINDOW, from_configure_UnmapNotify :: Bool} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event UnmapNotify instance Deserialize UnmapNotify where deserialize = do skip 1 skip 1 skip 2 event <- deserialize window <- deserialize from_configure <- deserialize skip 3 return (MkUnmapNotify event window from_configure) data MapNotify = MkMapNotify{event_MapNotify :: WINDOW, window_MapNotify :: WINDOW, override_redirect_MapNotify :: Bool} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event MapNotify instance Deserialize MapNotify where deserialize = do skip 1 skip 1 skip 2 event <- deserialize window <- deserialize override_redirect <- deserialize skip 3 return (MkMapNotify event window override_redirect) data MapRequest = MkMapRequest{parent_MapRequest :: WINDOW, window_MapRequest :: WINDOW} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event MapRequest instance Deserialize MapRequest where deserialize = do skip 1 skip 1 skip 2 parent <- deserialize window <- deserialize return (MkMapRequest parent window) data ReparentNotify = MkReparentNotify{event_ReparentNotify :: WINDOW, window_ReparentNotify :: WINDOW, parent_ReparentNotify :: WINDOW, x_ReparentNotify :: Int16, y_ReparentNotify :: Int16, override_redirect_ReparentNotify :: Bool} deriving (Show, Typeable) data ClientMessageData = ClientData8 [Word8] -- ^length 20 | ClientData16 [Word16] -- ^length 10 | ClientData32 [Word32] -- ^length 5 deriving (Show, Typeable) data ClientMessageDataType = CDType8 | CDType16 | CDType32 clientMessageDataType :: ClientMessageData -> ClientMessageDataType clientMessageDataType ClientData8{} = CDType8 clientMessageDataType ClientData16{} = CDType16 clientMessageDataType ClientData32{} = CDType32 instance Serialize ClientMessageData where serialize (ClientData8 xs) = assert (length xs == 20) $ serializeList xs serialize (ClientData16 xs) = assert (length xs == 10) $ serializeList xs serialize (ClientData32 xs) = assert (length xs == 5) $ serializeList xs size cd = assert (case cd of ClientData8 xs -> length xs == 20 ClientData16 xs -> length xs == 10 ClientData32 xs -> length xs == 5) 20 deserializeClientData :: ClientMessageDataType -> Get ClientMessageData deserializeClientData CDType8 = ClientData8 `liftM` deserializeList 20 deserializeClientData CDType16 = ClientData16 `liftM` deserializeList 10 deserializeClientData CDType32 = ClientData32 `liftM` deserializeList 5 clientDataFormatToType :: Word8 -> ClientMessageDataType clientDataFormatToType 8 = CDType8 clientDataFormatToType 16 = CDType16 clientDataFormatToType 32 = CDType32 clientDataFormatToType _ = CDType8 -- should we throw an error here? instance Graphics.XHB.Shared.Event ReparentNotify instance Deserialize ReparentNotify where deserialize = do skip 1 skip 1 skip 2 event <- deserialize window <- deserialize parent <- deserialize x <- deserialize y <- deserialize override_redirect <- deserialize skip 3 return (MkReparentNotify event window parent x y override_redirect) data ConfigureNotify = MkConfigureNotify{event_ConfigureNotify :: WINDOW, window_ConfigureNotify :: WINDOW, above_sibling_ConfigureNotify :: WINDOW, x_ConfigureNotify :: Int16, y_ConfigureNotify :: Int16, width_ConfigureNotify :: Word16, height_ConfigureNotify :: Word16, border_width_ConfigureNotify :: Word16, override_redirect_ConfigureNotify :: Bool} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event ConfigureNotify instance Deserialize ConfigureNotify where deserialize = do skip 1 skip 1 skip 2 event <- deserialize window <- deserialize above_sibling <- deserialize x <- deserialize y <- deserialize width <- deserialize height <- deserialize border_width <- deserialize override_redirect <- deserialize skip 1 return (MkConfigureNotify event window above_sibling x y width height border_width override_redirect) data ConfigureRequest = MkConfigureRequest{stack_mode_ConfigureRequest :: Word8, parent_ConfigureRequest :: WINDOW, window_ConfigureRequest :: WINDOW, sibling_ConfigureRequest :: WINDOW, x_ConfigureRequest :: Int16, y_ConfigureRequest :: Int16, width_ConfigureRequest :: Word16, height_ConfigureRequest :: Word16, border_width_ConfigureRequest :: Word16, value_mask_ConfigureRequest :: Word16} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event ConfigureRequest instance Deserialize ConfigureRequest where deserialize = do skip 1 stack_mode <- deserialize skip 2 parent <- deserialize window <- deserialize sibling <- deserialize x <- deserialize y <- deserialize width <- deserialize height <- deserialize border_width <- deserialize value_mask <- deserialize return (MkConfigureRequest stack_mode parent window sibling x y width height border_width value_mask) data GravityNotify = MkGravityNotify{event_GravityNotify :: WINDOW, window_GravityNotify :: WINDOW, x_GravityNotify :: Int16, y_GravityNotify :: Int16} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event GravityNotify instance Deserialize GravityNotify where deserialize = do skip 1 skip 1 skip 2 event <- deserialize window <- deserialize x <- deserialize y <- deserialize return (MkGravityNotify event window x y) data ResizeRequest = MkResizeRequest{window_ResizeRequest :: WINDOW, width_ResizeRequest :: Word16, height_ResizeRequest :: Word16} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event ResizeRequest instance Deserialize ResizeRequest where deserialize = do skip 1 skip 1 skip 2 window <- deserialize width <- deserialize height <- deserialize return (MkResizeRequest window width height) data Place = PlaceOnTop | PlaceOnBottom instance SimpleEnum Place where toValue PlaceOnTop{} = 0 toValue PlaceOnBottom{} = 1 fromValue 0 = PlaceOnTop fromValue 1 = PlaceOnBottom data CirculateNotify = MkCirculateNotify{event_CirculateNotify :: WINDOW, window_CirculateNotify :: WINDOW, place_CirculateNotify :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event CirculateNotify instance Deserialize CirculateNotify where deserialize = do skip 1 skip 1 skip 2 event <- deserialize window <- deserialize skip 4 place <- deserialize skip 3 return (MkCirculateNotify event window place) data CirculateRequest = MkCirculateRequest{event_CirculateRequest :: WINDOW, window_CirculateRequest :: WINDOW, place_CirculateRequest :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event CirculateRequest instance Deserialize CirculateRequest where deserialize = do skip 1 skip 1 skip 2 event <- deserialize window <- deserialize skip 4 place <- deserialize skip 3 return (MkCirculateRequest event window place) data Property = PropertyNewValue | PropertyDelete instance SimpleEnum Property where toValue PropertyNewValue{} = 0 toValue PropertyDelete{} = 1 fromValue 0 = PropertyNewValue fromValue 1 = PropertyDelete data PropertyNotify = MkPropertyNotify{window_PropertyNotify :: WINDOW, atom_PropertyNotify :: ATOM, time_PropertyNotify :: TIMESTAMP, state_PropertyNotify :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event PropertyNotify instance Deserialize PropertyNotify where deserialize = do skip 1 skip 1 skip 2 window <- deserialize atom <- deserialize time <- deserialize state <- deserialize skip 3 return (MkPropertyNotify window atom time state) data SelectionClear = MkSelectionClear{time_SelectionClear :: TIMESTAMP, owner_SelectionClear :: WINDOW, selection_SelectionClear :: ATOM} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event SelectionClear instance Deserialize SelectionClear where deserialize = do skip 1 skip 1 skip 2 time <- deserialize owner <- deserialize selection <- deserialize return (MkSelectionClear time owner selection) data SelectionRequest = MkSelectionRequest{time_SelectionRequest :: TIMESTAMP, owner_SelectionRequest :: WINDOW, requestor_SelectionRequest :: WINDOW, selection_SelectionRequest :: ATOM, target_SelectionRequest :: ATOM, property_SelectionRequest :: ATOM} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event SelectionRequest instance Deserialize SelectionRequest where deserialize = do skip 1 skip 1 skip 2 time <- deserialize owner <- deserialize requestor <- deserialize selection <- deserialize target <- deserialize property <- deserialize return (MkSelectionRequest time owner requestor selection target property) data SelectionNotify = MkSelectionNotify{time_SelectionNotify :: TIMESTAMP, requestor_SelectionNotify :: WINDOW, selection_SelectionNotify :: ATOM, target_SelectionNotify :: ATOM, property_SelectionNotify :: ATOM} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event SelectionNotify instance Deserialize SelectionNotify where deserialize = do skip 1 skip 1 skip 2 time <- deserialize requestor <- deserialize selection <- deserialize target <- deserialize property <- deserialize return (MkSelectionNotify time requestor selection target property) data ColormapState = ColormapStateUninstalled | ColormapStateInstalled instance SimpleEnum ColormapState where toValue ColormapStateUninstalled{} = 0 toValue ColormapStateInstalled{} = 1 fromValue 0 = ColormapStateUninstalled fromValue 1 = ColormapStateInstalled data ColormapNotify = MkColormapNotify{window_ColormapNotify :: WINDOW, colormap_ColormapNotify :: COLORMAP, new_ColormapNotify :: Bool, state_ColormapNotify :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event ColormapNotify instance Deserialize ColormapNotify where deserialize = do skip 1 skip 1 skip 2 window <- deserialize colormap <- deserialize new <- deserialize state <- deserialize skip 2 return (MkColormapNotify window colormap new state) data ClientMessage = MkClientMessage{format_ClientMessage :: Word8, window_ClientMessage :: WINDOW, type_ClientMessage :: ATOM, data_ClientMessage :: ClientMessageData} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event ClientMessage instance Deserialize ClientMessage where deserialize = do skip 1 format <- deserialize skip 2 window <- deserialize type_ <- deserialize data_ <- deserializeClientData (clientDataFormatToType format) return (MkClientMessage format window type_ data_) data Mapping = MappingModifier | MappingKeyboard | MappingPointer instance SimpleEnum Mapping where toValue MappingModifier{} = 0 toValue MappingKeyboard{} = 1 toValue MappingPointer{} = 2 fromValue 0 = MappingModifier fromValue 1 = MappingKeyboard fromValue 2 = MappingPointer data MappingNotify = MkMappingNotify{request_MappingNotify :: Word8, first_keycode_MappingNotify :: KEYCODE, count_MappingNotify :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Event MappingNotify instance Deserialize MappingNotify where deserialize = do skip 1 skip 1 skip 2 request <- deserialize first_keycode <- deserialize count <- deserialize skip 1 return (MkMappingNotify request first_keycode count) data Request = MkRequest{bad_value_Request :: Word32, minor_opcode_Request :: Word16, major_opcode_Request :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Error Request instance Deserialize Request where deserialize = do skip 4 bad_value <- deserialize minor_opcode <- deserialize major_opcode <- deserialize skip 1 return (MkRequest bad_value minor_opcode major_opcode) data Value = MkValue{bad_value_Value :: Word32, minor_opcode_Value :: Word16, major_opcode_Value :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Error Value instance Deserialize Value where deserialize = do skip 4 bad_value <- deserialize minor_opcode <- deserialize major_opcode <- deserialize skip 1 return (MkValue bad_value minor_opcode major_opcode) data Window = MkWindow{bad_value_Window :: Word32, minor_opcode_Window :: Word16, major_opcode_Window :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Error Window instance Deserialize Window where deserialize = do skip 4 bad_value <- deserialize minor_opcode <- deserialize major_opcode <- deserialize skip 1 return (MkWindow bad_value minor_opcode major_opcode) data Pixmap = MkPixmap{bad_value_Pixmap :: Word32, minor_opcode_Pixmap :: Word16, major_opcode_Pixmap :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Error Pixmap instance Deserialize Pixmap where deserialize = do skip 4 bad_value <- deserialize minor_opcode <- deserialize major_opcode <- deserialize skip 1 return (MkPixmap bad_value minor_opcode major_opcode) data Atom = MkAtom{bad_value_Atom :: Word32, minor_opcode_Atom :: Word16, major_opcode_Atom :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Error Atom instance Deserialize Atom where deserialize = do skip 4 bad_value <- deserialize minor_opcode <- deserialize major_opcode <- deserialize skip 1 return (MkAtom bad_value minor_opcode major_opcode) data Cursor = MkCursor{bad_value_Cursor :: Word32, minor_opcode_Cursor :: Word16, major_opcode_Cursor :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Error Cursor instance Deserialize Cursor where deserialize = do skip 4 bad_value <- deserialize minor_opcode <- deserialize major_opcode <- deserialize skip 1 return (MkCursor bad_value minor_opcode major_opcode) data Font = MkFont{bad_value_Font :: Word32, minor_opcode_Font :: Word16, major_opcode_Font :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Error Font instance Deserialize Font where deserialize = do skip 4 bad_value <- deserialize minor_opcode <- deserialize major_opcode <- deserialize skip 1 return (MkFont bad_value minor_opcode major_opcode) data Match = MkMatch{bad_value_Match :: Word32, minor_opcode_Match :: Word16, major_opcode_Match :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Error Match instance Deserialize Match where deserialize = do skip 4 bad_value <- deserialize minor_opcode <- deserialize major_opcode <- deserialize skip 1 return (MkMatch bad_value minor_opcode major_opcode) data Drawable = MkDrawable{bad_value_Drawable :: Word32, minor_opcode_Drawable :: Word16, major_opcode_Drawable :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Error Drawable instance Deserialize Drawable where deserialize = do skip 4 bad_value <- deserialize minor_opcode <- deserialize major_opcode <- deserialize skip 1 return (MkDrawable bad_value minor_opcode major_opcode) data Access = MkAccess{bad_value_Access :: Word32, minor_opcode_Access :: Word16, major_opcode_Access :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Error Access instance Deserialize Access where deserialize = do skip 4 bad_value <- deserialize minor_opcode <- deserialize major_opcode <- deserialize skip 1 return (MkAccess bad_value minor_opcode major_opcode) data Alloc = MkAlloc{bad_value_Alloc :: Word32, minor_opcode_Alloc :: Word16, major_opcode_Alloc :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Error Alloc instance Deserialize Alloc where deserialize = do skip 4 bad_value <- deserialize minor_opcode <- deserialize major_opcode <- deserialize skip 1 return (MkAlloc bad_value minor_opcode major_opcode) data Colormap = MkColormap{bad_value_Colormap :: Word32, minor_opcode_Colormap :: Word16, major_opcode_Colormap :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Error Colormap instance Deserialize Colormap where deserialize = do skip 4 bad_value <- deserialize minor_opcode <- deserialize major_opcode <- deserialize skip 1 return (MkColormap bad_value minor_opcode major_opcode) data GContext = MkGContext{bad_value_GContext :: Word32, minor_opcode_GContext :: Word16, major_opcode_GContext :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Error GContext instance Deserialize GContext where deserialize = do skip 4 bad_value <- deserialize minor_opcode <- deserialize major_opcode <- deserialize skip 1 return (MkGContext bad_value minor_opcode major_opcode) data IDChoice = MkIDChoice{bad_value_IDChoice :: Word32, minor_opcode_IDChoice :: Word16, major_opcode_IDChoice :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Error IDChoice instance Deserialize IDChoice where deserialize = do skip 4 bad_value <- deserialize minor_opcode <- deserialize major_opcode <- deserialize skip 1 return (MkIDChoice bad_value minor_opcode major_opcode) data Name = MkName{bad_value_Name :: Word32, minor_opcode_Name :: Word16, major_opcode_Name :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Error Name instance Deserialize Name where deserialize = do skip 4 bad_value <- deserialize minor_opcode <- deserialize major_opcode <- deserialize skip 1 return (MkName bad_value minor_opcode major_opcode) data Length = MkLength{bad_value_Length :: Word32, minor_opcode_Length :: Word16, major_opcode_Length :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Error Length instance Deserialize Length where deserialize = do skip 4 bad_value <- deserialize minor_opcode <- deserialize major_opcode <- deserialize skip 1 return (MkLength bad_value minor_opcode major_opcode) data Implementation = MkImplementation{bad_value_Implementation :: Word32, minor_opcode_Implementation :: Word16, major_opcode_Implementation :: Word8} deriving (Show, Typeable) instance Graphics.XHB.Shared.Error Implementation instance Deserialize Implementation where deserialize = do skip 4 bad_value <- deserialize minor_opcode <- deserialize major_opcode <- deserialize skip 1 return (MkImplementation bad_value minor_opcode major_opcode) data WindowClass = WindowClassCopyFromParent | WindowClassInputOutput | WindowClassInputOnly instance SimpleEnum WindowClass where toValue WindowClassCopyFromParent{} = 0 toValue WindowClassInputOutput{} = 1 toValue WindowClassInputOnly{} = 2 fromValue 0 = WindowClassCopyFromParent fromValue 1 = WindowClassInputOutput fromValue 2 = WindowClassInputOnly data CW = CWBackPixmap | CWBackPixel | CWBorderPixmap | CWBorderPixel | CWBitGravity | CWWinGravity | CWBackingStore | CWBackingPlanes | CWBackingPixel | CWOverrideRedirect | CWSaveUnder | CWEventMask | CWDontPropagate | CWColormap | CWCursor instance BitEnum CW where toBit CWBackPixmap{} = 0 toBit CWBackPixel{} = 1 toBit CWBorderPixmap{} = 2 toBit CWBorderPixel{} = 3 toBit CWBitGravity{} = 4 toBit CWWinGravity{} = 5 toBit CWBackingStore{} = 6 toBit CWBackingPlanes{} = 7 toBit CWBackingPixel{} = 8 toBit CWOverrideRedirect{} = 9 toBit CWSaveUnder{} = 10 toBit CWEventMask{} = 11 toBit CWDontPropagate{} = 12 toBit CWColormap{} = 13 toBit CWCursor{} = 14 fromBit 0 = CWBackPixmap fromBit 1 = CWBackPixel fromBit 2 = CWBorderPixmap fromBit 3 = CWBorderPixel fromBit 4 = CWBitGravity fromBit 5 = CWWinGravity fromBit 6 = CWBackingStore fromBit 7 = CWBackingPlanes fromBit 8 = CWBackingPixel fromBit 9 = CWOverrideRedirect fromBit 10 = CWSaveUnder fromBit 11 = CWEventMask fromBit 12 = CWDontPropagate fromBit 13 = CWColormap fromBit 14 = CWCursor data BackPixmap = BackPixmapNone | BackPixmapParentRelative instance SimpleEnum BackPixmap where toValue BackPixmapNone{} = 0 toValue BackPixmapParentRelative{} = 1 fromValue 0 = BackPixmapNone fromValue 1 = BackPixmapParentRelative data Gravity = GravityBitForget | GravityWinUnmap | GravityNorthWest | GravityNorth | GravityNorthEast | GravityWest | GravityCenter | GravityEast | GravitySouthWest | GravitySouth | GravitySouthEast | GravityStatic instance SimpleEnum Gravity where toValue GravityBitForget{} = 0 toValue GravityWinUnmap{} = 0 toValue GravityNorthWest{} = 1 toValue GravityNorth{} = 2 toValue GravityNorthEast{} = 3 toValue GravityWest{} = 4 toValue GravityCenter{} = 5 toValue GravityEast{} = 6 toValue GravitySouthWest{} = 7 toValue GravitySouth{} = 8 toValue GravitySouthEast{} = 9 toValue GravityStatic{} = 10 fromValue 0 = GravityBitForget fromValue 0 = GravityWinUnmap fromValue 1 = GravityNorthWest fromValue 2 = GravityNorth fromValue 3 = GravityNorthEast fromValue 4 = GravityWest fromValue 5 = GravityCenter fromValue 6 = GravityEast fromValue 7 = GravitySouthWest fromValue 8 = GravitySouth fromValue 9 = GravitySouthEast fromValue 10 = GravityStatic data BackingStore = BackingStoreNotUseful | BackingStoreWhenMapped | BackingStoreAlways instance SimpleEnum BackingStore where toValue BackingStoreNotUseful{} = 0 toValue BackingStoreWhenMapped{} = 1 toValue BackingStoreAlways{} = 2 fromValue 0 = BackingStoreNotUseful fromValue 1 = BackingStoreWhenMapped fromValue 2 = BackingStoreAlways data EventMask = EventMaskKeyPress | EventMaskKeyRelease | EventMaskButtonPress | EventMaskButtonRelease | EventMaskEnterWindow | EventMaskLeaveWindow | EventMaskPointerMotion | EventMaskPointerMotionHint | EventMaskButton1Motion | EventMaskButton2Motion | EventMaskButton3Motion | EventMaskButton4Motion | EventMaskButton5Motion | EventMaskButtonMotion | EventMaskKeymapState | EventMaskExposure | EventMaskVisibilityChange | EventMaskStructureNotify | EventMaskResizeRedirect | EventMaskSubstructureNotify | EventMaskSubstructureRedirect | EventMaskFocusChange | EventMaskPropertyChange | EventMaskColorMapChange | EventMaskOwnerGrabButton instance BitEnum EventMask where toBit EventMaskKeyPress{} = 0 toBit EventMaskKeyRelease{} = 1 toBit EventMaskButtonPress{} = 2 toBit EventMaskButtonRelease{} = 3 toBit EventMaskEnterWindow{} = 4 toBit EventMaskLeaveWindow{} = 5 toBit EventMaskPointerMotion{} = 6 toBit EventMaskPointerMotionHint{} = 7 toBit EventMaskButton1Motion{} = 8 toBit EventMaskButton2Motion{} = 9 toBit EventMaskButton3Motion{} = 10 toBit EventMaskButton4Motion{} = 11 toBit EventMaskButton5Motion{} = 12 toBit EventMaskButtonMotion{} = 13 toBit EventMaskKeymapState{} = 14 toBit EventMaskExposure{} = 15 toBit EventMaskVisibilityChange{} = 16 toBit EventMaskStructureNotify{} = 17 toBit EventMaskResizeRedirect{} = 18 toBit EventMaskSubstructureNotify{} = 19 toBit EventMaskSubstructureRedirect{} = 20 toBit EventMaskFocusChange{} = 21 toBit EventMaskPropertyChange{} = 22 toBit EventMaskColorMapChange{} = 23 toBit EventMaskOwnerGrabButton{} = 24 fromBit 0 = EventMaskKeyPress fromBit 1 = EventMaskKeyRelease fromBit 2 = EventMaskButtonPress fromBit 3 = EventMaskButtonRelease fromBit 4 = EventMaskEnterWindow fromBit 5 = EventMaskLeaveWindow fromBit 6 = EventMaskPointerMotion fromBit 7 = EventMaskPointerMotionHint fromBit 8 = EventMaskButton1Motion fromBit 9 = EventMaskButton2Motion fromBit 10 = EventMaskButton3Motion fromBit 11 = EventMaskButton4Motion fromBit 12 = EventMaskButton5Motion fromBit 13 = EventMaskButtonMotion fromBit 14 = EventMaskKeymapState fromBit 15 = EventMaskExposure fromBit 16 = EventMaskVisibilityChange fromBit 17 = EventMaskStructureNotify fromBit 18 = EventMaskResizeRedirect fromBit 19 = EventMaskSubstructureNotify fromBit 20 = EventMaskSubstructureRedirect fromBit 21 = EventMaskFocusChange fromBit 22 = EventMaskPropertyChange fromBit 23 = EventMaskColorMapChange fromBit 24 = EventMaskOwnerGrabButton data CreateWindow = MkCreateWindow{depth_CreateWindow :: Word8, wid_CreateWindow :: WINDOW, parent_CreateWindow :: WINDOW, x_CreateWindow :: Int16, y_CreateWindow :: Int16, width_CreateWindow :: Word16, height_CreateWindow :: Word16, border_width_CreateWindow :: Word16, class_CreateWindow :: Word16, visual_CreateWindow :: VISUALID, value_CreateWindow :: ValueParam Word32} deriving (Show, Typeable) instance Serialize CreateWindow where serialize x = do putWord8 1 serialize (depth_CreateWindow x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (wid_CreateWindow x) serialize (parent_CreateWindow x) serialize (x_CreateWindow x) serialize (y_CreateWindow x) serialize (width_CreateWindow x) serialize (height_CreateWindow x) serialize (border_width_CreateWindow x) serialize (class_CreateWindow x) serialize (visual_CreateWindow x) serialize (value_CreateWindow x) putSkip (requiredPadding (size x)) size x = 3 + size (depth_CreateWindow x) + size (wid_CreateWindow x) + size (parent_CreateWindow x) + size (x_CreateWindow x) + size (y_CreateWindow x) + size (width_CreateWindow x) + size (height_CreateWindow x) + size (border_width_CreateWindow x) + size (class_CreateWindow x) + size (visual_CreateWindow x) + size (value_CreateWindow x) data ChangeWindowAttributes = MkChangeWindowAttributes{window_ChangeWindowAttributes :: WINDOW, value_ChangeWindowAttributes :: ValueParam Word32} deriving (Show, Typeable) instance Serialize ChangeWindowAttributes where serialize x = do putWord8 2 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (window_ChangeWindowAttributes x) serialize (value_ChangeWindowAttributes x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (window_ChangeWindowAttributes x) + size (value_ChangeWindowAttributes x) data MapState = MapStateUnmapped | MapStateUnviewable | MapStateViewable instance SimpleEnum MapState where toValue MapStateUnmapped{} = 0 toValue MapStateUnviewable{} = 1 toValue MapStateViewable{} = 2 fromValue 0 = MapStateUnmapped fromValue 1 = MapStateUnviewable fromValue 2 = MapStateViewable data GetWindowAttributes = MkGetWindowAttributes{window_GetWindowAttributes :: WINDOW} deriving (Show, Typeable) instance Serialize GetWindowAttributes where serialize x = do putWord8 3 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (window_GetWindowAttributes x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (window_GetWindowAttributes x) data GetWindowAttributesReply = MkGetWindowAttributesReply{backing_store_GetWindowAttributesReply :: Word8, visual_GetWindowAttributesReply :: VISUALID, class_GetWindowAttributesReply :: Word16, bit_gravity_GetWindowAttributesReply :: Word8, win_gravity_GetWindowAttributesReply :: Word8, backing_planes_GetWindowAttributesReply :: Word32, backing_pixel_GetWindowAttributesReply :: Word32, save_under_GetWindowAttributesReply :: Bool, map_is_installed_GetWindowAttributesReply :: Bool, map_state_GetWindowAttributesReply :: Word8, override_redirect_GetWindowAttributesReply :: Bool, colormap_GetWindowAttributesReply :: COLORMAP, all_event_masks_GetWindowAttributesReply :: Word32, your_event_mask_GetWindowAttributesReply :: Word32, do_not_propagate_mask_GetWindowAttributesReply :: Word16} deriving (Show, Typeable) instance Deserialize GetWindowAttributesReply where deserialize = do skip 1 backing_store <- deserialize skip 2 length <- deserialize visual <- deserialize class_ <- deserialize bit_gravity <- deserialize win_gravity <- deserialize backing_planes <- deserialize backing_pixel <- deserialize save_under <- deserialize map_is_installed <- deserialize map_state <- deserialize override_redirect <- deserialize colormap <- deserialize all_event_masks <- deserialize your_event_mask <- deserialize do_not_propagate_mask <- deserialize skip 2 let _ = isCard32 length return (MkGetWindowAttributesReply backing_store visual class_ bit_gravity win_gravity backing_planes backing_pixel save_under map_is_installed map_state override_redirect colormap all_event_masks your_event_mask do_not_propagate_mask) data DestroyWindow = MkDestroyWindow{window_DestroyWindow :: WINDOW} deriving (Show, Typeable) instance Serialize DestroyWindow where serialize x = do putWord8 4 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (window_DestroyWindow x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (window_DestroyWindow x) data DestroySubwindows = MkDestroySubwindows{window_DestroySubwindows :: WINDOW} deriving (Show, Typeable) instance Serialize DestroySubwindows where serialize x = do putWord8 5 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (window_DestroySubwindows x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (window_DestroySubwindows x) data SetMode = SetModeInsert | SetModeDelete instance SimpleEnum SetMode where toValue SetModeInsert{} = 0 toValue SetModeDelete{} = 1 fromValue 0 = SetModeInsert fromValue 1 = SetModeDelete data ChangeSaveSet = MkChangeSaveSet{mode_ChangeSaveSet :: Word8, window_ChangeSaveSet :: WINDOW} deriving (Show, Typeable) instance Serialize ChangeSaveSet where serialize x = do putWord8 6 serialize (mode_ChangeSaveSet x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (window_ChangeSaveSet x) putSkip (requiredPadding (size x)) size x = 3 + size (mode_ChangeSaveSet x) + size (window_ChangeSaveSet x) data ReparentWindow = MkReparentWindow{window_ReparentWindow :: WINDOW, parent_ReparentWindow :: WINDOW, x_ReparentWindow :: Int16, y_ReparentWindow :: Int16} deriving (Show, Typeable) instance Serialize ReparentWindow where serialize x = do putWord8 7 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (window_ReparentWindow x) serialize (parent_ReparentWindow x) serialize (x_ReparentWindow x) serialize (y_ReparentWindow x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (window_ReparentWindow x) + size (parent_ReparentWindow x) + size (x_ReparentWindow x) + size (y_ReparentWindow x) data MapWindow = MkMapWindow{window_MapWindow :: WINDOW} deriving (Show, Typeable) instance Serialize MapWindow where serialize x = do putWord8 8 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (window_MapWindow x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (window_MapWindow x) data MapSubwindows = MkMapSubwindows{window_MapSubwindows :: WINDOW} deriving (Show, Typeable) instance Serialize MapSubwindows where serialize x = do putWord8 9 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (window_MapSubwindows x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (window_MapSubwindows x) data UnmapWindow = MkUnmapWindow{window_UnmapWindow :: WINDOW} deriving (Show, Typeable) instance Serialize UnmapWindow where serialize x = do putWord8 10 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (window_UnmapWindow x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (window_UnmapWindow x) data UnmapSubwindows = MkUnmapSubwindows{window_UnmapSubwindows :: WINDOW} deriving (Show, Typeable) instance Serialize UnmapSubwindows where serialize x = do putWord8 11 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (window_UnmapSubwindows x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (window_UnmapSubwindows x) data ConfigWindow = ConfigWindowX | ConfigWindowY | ConfigWindowWidth | ConfigWindowHeight | ConfigWindowBorderWidth | ConfigWindowSibling | ConfigWindowStackMode instance BitEnum ConfigWindow where toBit ConfigWindowX{} = 0 toBit ConfigWindowY{} = 1 toBit ConfigWindowWidth{} = 2 toBit ConfigWindowHeight{} = 3 toBit ConfigWindowBorderWidth{} = 4 toBit ConfigWindowSibling{} = 5 toBit ConfigWindowStackMode{} = 6 fromBit 0 = ConfigWindowX fromBit 1 = ConfigWindowY fromBit 2 = ConfigWindowWidth fromBit 3 = ConfigWindowHeight fromBit 4 = ConfigWindowBorderWidth fromBit 5 = ConfigWindowSibling fromBit 6 = ConfigWindowStackMode data StackMode = StackModeAbove | StackModeBelow | StackModeTopIf | StackModeBottomIf | StackModeOpposite instance SimpleEnum StackMode where toValue StackModeAbove{} = 0 toValue StackModeBelow{} = 1 toValue StackModeTopIf{} = 2 toValue StackModeBottomIf{} = 3 toValue StackModeOpposite{} = 4 fromValue 0 = StackModeAbove fromValue 1 = StackModeBelow fromValue 2 = StackModeTopIf fromValue 3 = StackModeBottomIf fromValue 4 = StackModeOpposite data ConfigureWindow = MkConfigureWindow{window_ConfigureWindow :: WINDOW, value_ConfigureWindow :: ValueParam Word16} deriving (Show, Typeable) instance Serialize ConfigureWindow where serialize x = do putWord8 12 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (window_ConfigureWindow x) serializeValueParam 2 (value_ConfigureWindow x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (window_ConfigureWindow x) + size (value_ConfigureWindow x) + 2 data Circulate = CirculateRaiseLowest | CirculateLowerHighest instance SimpleEnum Circulate where toValue CirculateRaiseLowest{} = 0 toValue CirculateLowerHighest{} = 1 fromValue 0 = CirculateRaiseLowest fromValue 1 = CirculateLowerHighest data CirculateWindow = MkCirculateWindow{direction_CirculateWindow :: Word8, window_CirculateWindow :: WINDOW} deriving (Show, Typeable) instance Serialize CirculateWindow where serialize x = do putWord8 13 serialize (direction_CirculateWindow x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (window_CirculateWindow x) putSkip (requiredPadding (size x)) size x = 3 + size (direction_CirculateWindow x) + size (window_CirculateWindow x) data GetGeometry = MkGetGeometry{drawable_GetGeometry :: DRAWABLE} deriving (Show, Typeable) instance Serialize GetGeometry where serialize x = do putWord8 14 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (drawable_GetGeometry x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (drawable_GetGeometry x) data GetGeometryReply = MkGetGeometryReply{depth_GetGeometryReply :: Word8, root_GetGeometryReply :: WINDOW, x_GetGeometryReply :: Int16, y_GetGeometryReply :: Int16, width_GetGeometryReply :: Word16, height_GetGeometryReply :: Word16, border_width_GetGeometryReply :: Word16} deriving (Show, Typeable) instance Deserialize GetGeometryReply where deserialize = do skip 1 depth <- deserialize skip 2 length <- deserialize root <- deserialize x <- deserialize y <- deserialize width <- deserialize height <- deserialize border_width <- deserialize skip 2 let _ = isCard32 length return (MkGetGeometryReply depth root x y width height border_width) data QueryTree = MkQueryTree{window_QueryTree :: WINDOW} deriving (Show, Typeable) instance Serialize QueryTree where serialize x = do putWord8 15 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (window_QueryTree x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (window_QueryTree x) data QueryTreeReply = MkQueryTreeReply{root_QueryTreeReply :: WINDOW, parent_QueryTreeReply :: WINDOW, children_len_QueryTreeReply :: Word16, children_QueryTreeReply :: [WINDOW]} deriving (Show, Typeable) instance Deserialize QueryTreeReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize root <- deserialize parent <- deserialize children_len <- deserialize skip 14 children <- deserializeList (fromIntegral children_len) let _ = isCard32 length return (MkQueryTreeReply root parent children_len children) data InternAtom = MkInternAtom{only_if_exists_InternAtom :: Bool, name_len_InternAtom :: Word16, name_InternAtom :: [CChar]} deriving (Show, Typeable) instance Serialize InternAtom where serialize x = do putWord8 16 serialize (only_if_exists_InternAtom x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (name_len_InternAtom x) putSkip 2 serializeList (name_InternAtom x) putSkip (requiredPadding (size x)) size x = 3 + size (only_if_exists_InternAtom x) + size (name_len_InternAtom x) + 2 + sum (map size (name_InternAtom x)) data InternAtomReply = MkInternAtomReply{atom_InternAtomReply :: ATOM} deriving (Show, Typeable) instance Deserialize InternAtomReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize atom <- deserialize let _ = isCard32 length return (MkInternAtomReply atom) data GetAtomName = MkGetAtomName{atom_GetAtomName :: ATOM} deriving (Show, Typeable) instance Serialize GetAtomName where serialize x = do putWord8 17 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (atom_GetAtomName x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (atom_GetAtomName x) data GetAtomNameReply = MkGetAtomNameReply{name_len_GetAtomNameReply :: Word16, name_GetAtomNameReply :: [CChar]} deriving (Show, Typeable) instance Deserialize GetAtomNameReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize name_len <- deserialize skip 22 name <- deserializeList (fromIntegral name_len) let _ = isCard32 length return (MkGetAtomNameReply name_len name) data PropMode = PropModeReplace | PropModePrepend | PropModeAppend instance SimpleEnum PropMode where toValue PropModeReplace{} = 0 toValue PropModePrepend{} = 1 toValue PropModeAppend{} = 2 fromValue 0 = PropModeReplace fromValue 1 = PropModePrepend fromValue 2 = PropModeAppend data ChangeProperty = MkChangeProperty{mode_ChangeProperty :: Word8, window_ChangeProperty :: WINDOW, property_ChangeProperty :: ATOM, type_ChangeProperty :: ATOM, format_ChangeProperty :: Word8, data_len_ChangeProperty :: Word32, data_ChangeProperty :: [Word8]} deriving (Show, Typeable) instance Serialize ChangeProperty where serialize x = do putWord8 18 serialize (mode_ChangeProperty x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (window_ChangeProperty x) serialize (property_ChangeProperty x) serialize (type_ChangeProperty x) serialize (format_ChangeProperty x) putSkip 3 serialize (data_len_ChangeProperty x) serializeList (data_ChangeProperty x) putSkip (requiredPadding (size x)) size x = 3 + size (mode_ChangeProperty x) + size (window_ChangeProperty x) + size (property_ChangeProperty x) + size (type_ChangeProperty x) + size (format_ChangeProperty x) + 3 + size (data_len_ChangeProperty x) + sum (map size (data_ChangeProperty x)) data DeleteProperty = MkDeleteProperty{window_DeleteProperty :: WINDOW, property_DeleteProperty :: ATOM} deriving (Show, Typeable) instance Serialize DeleteProperty where serialize x = do putWord8 19 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (window_DeleteProperty x) serialize (property_DeleteProperty x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (window_DeleteProperty x) + size (property_DeleteProperty x) data GetPropertyType = GetPropertyTypeAny instance SimpleEnum GetPropertyType where toValue GetPropertyTypeAny{} = 0 fromValue 0 = GetPropertyTypeAny data GetProperty = MkGetProperty{delete_GetProperty :: Bool, window_GetProperty :: WINDOW, property_GetProperty :: ATOM, type_GetProperty :: ATOM, long_offset_GetProperty :: Word32, long_length_GetProperty :: Word32} deriving (Show, Typeable) instance Serialize GetProperty where serialize x = do putWord8 20 serialize (delete_GetProperty x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (window_GetProperty x) serialize (property_GetProperty x) serialize (type_GetProperty x) serialize (long_offset_GetProperty x) serialize (long_length_GetProperty x) putSkip (requiredPadding (size x)) size x = 3 + size (delete_GetProperty x) + size (window_GetProperty x) + size (property_GetProperty x) + size (type_GetProperty x) + size (long_offset_GetProperty x) + size (long_length_GetProperty x) data GetPropertyReply = MkGetPropertyReply{format_GetPropertyReply :: Word8, type_GetPropertyReply :: ATOM, bytes_after_GetPropertyReply :: Word32, value_len_GetPropertyReply :: Word32, value_GetPropertyReply :: [Word8]} deriving (Show, Typeable) instance Deserialize GetPropertyReply where deserialize = do skip 1 format <- deserialize skip 2 length <- deserialize type_ <- deserialize bytes_after <- deserialize value_len <- deserialize skip 12 value <- deserializeList (fromIntegral value_len) let _ = isCard32 length return (MkGetPropertyReply format type_ bytes_after value_len value) data ListProperties = MkListProperties{window_ListProperties :: WINDOW} deriving (Show, Typeable) instance Serialize ListProperties where serialize x = do putWord8 21 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (window_ListProperties x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (window_ListProperties x) data ListPropertiesReply = MkListPropertiesReply{atoms_len_ListPropertiesReply :: Word16, atoms_ListPropertiesReply :: [ATOM]} deriving (Show, Typeable) instance Deserialize ListPropertiesReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize atoms_len <- deserialize skip 22 atoms <- deserializeList (fromIntegral atoms_len) let _ = isCard32 length return (MkListPropertiesReply atoms_len atoms) data SetSelectionOwner = MkSetSelectionOwner{owner_SetSelectionOwner :: WINDOW, selection_SetSelectionOwner :: ATOM, time_SetSelectionOwner :: TIMESTAMP} deriving (Show, Typeable) instance Serialize SetSelectionOwner where serialize x = do putWord8 22 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (owner_SetSelectionOwner x) serialize (selection_SetSelectionOwner x) serialize (time_SetSelectionOwner x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (owner_SetSelectionOwner x) + size (selection_SetSelectionOwner x) + size (time_SetSelectionOwner x) data GetSelectionOwner = MkGetSelectionOwner{selection_GetSelectionOwner :: ATOM} deriving (Show, Typeable) instance Serialize GetSelectionOwner where serialize x = do putWord8 23 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (selection_GetSelectionOwner x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (selection_GetSelectionOwner x) data GetSelectionOwnerReply = MkGetSelectionOwnerReply{owner_GetSelectionOwnerReply :: WINDOW} deriving (Show, Typeable) instance Deserialize GetSelectionOwnerReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize owner <- deserialize let _ = isCard32 length return (MkGetSelectionOwnerReply owner) data ConvertSelection = MkConvertSelection{requestor_ConvertSelection :: WINDOW, selection_ConvertSelection :: ATOM, target_ConvertSelection :: ATOM, property_ConvertSelection :: ATOM, time_ConvertSelection :: TIMESTAMP} deriving (Show, Typeable) instance Serialize ConvertSelection where serialize x = do putWord8 24 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (requestor_ConvertSelection x) serialize (selection_ConvertSelection x) serialize (target_ConvertSelection x) serialize (property_ConvertSelection x) serialize (time_ConvertSelection x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (requestor_ConvertSelection x) + size (selection_ConvertSelection x) + size (target_ConvertSelection x) + size (property_ConvertSelection x) + size (time_ConvertSelection x) data SendEventDest = SendEventDestPointerWindow | SendEventDestItemFocus instance SimpleEnum SendEventDest where toValue SendEventDestPointerWindow{} = 0 toValue SendEventDestItemFocus{} = 1 fromValue 0 = SendEventDestPointerWindow fromValue 1 = SendEventDestItemFocus data SendEvent = MkSendEvent{propagate_SendEvent :: Bool, destination_SendEvent :: WINDOW, event_mask_SendEvent :: Word32, event_SendEvent :: [CChar]} deriving (Show, Typeable) instance Serialize SendEvent where serialize x = do putWord8 25 serialize (propagate_SendEvent x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (destination_SendEvent x) serialize (event_mask_SendEvent x) serializeList (event_SendEvent x) putSkip (requiredPadding (size x)) size x = 3 + size (propagate_SendEvent x) + size (destination_SendEvent x) + size (event_mask_SendEvent x) + sum (map size (event_SendEvent x)) data GrabMode = GrabModeSync | GrabModeAsync instance SimpleEnum GrabMode where toValue GrabModeSync{} = 0 toValue GrabModeAsync{} = 1 fromValue 0 = GrabModeSync fromValue 1 = GrabModeAsync data GrabStatus = GrabStatusSuccess | GrabStatusAlreadyGrabbed | GrabStatusInvalidTime | GrabStatusNotViewable | GrabStatusFrozen instance SimpleEnum GrabStatus where toValue GrabStatusSuccess{} = 0 toValue GrabStatusAlreadyGrabbed{} = 1 toValue GrabStatusInvalidTime{} = 2 toValue GrabStatusNotViewable{} = 3 toValue GrabStatusFrozen{} = 4 fromValue 0 = GrabStatusSuccess fromValue 1 = GrabStatusAlreadyGrabbed fromValue 2 = GrabStatusInvalidTime fromValue 3 = GrabStatusNotViewable fromValue 4 = GrabStatusFrozen data GrabPointer = MkGrabPointer{owner_events_GrabPointer :: Bool, grab_window_GrabPointer :: WINDOW, event_mask_GrabPointer :: Word16, pointer_mode_GrabPointer :: Word8, keyboard_mode_GrabPointer :: Word8, confine_to_GrabPointer :: WINDOW, cursor_GrabPointer :: CURSOR, time_GrabPointer :: TIMESTAMP} deriving (Show, Typeable) instance Serialize GrabPointer where serialize x = do putWord8 26 serialize (owner_events_GrabPointer x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (grab_window_GrabPointer x) serialize (event_mask_GrabPointer x) serialize (pointer_mode_GrabPointer x) serialize (keyboard_mode_GrabPointer x) serialize (confine_to_GrabPointer x) serialize (cursor_GrabPointer x) serialize (time_GrabPointer x) putSkip (requiredPadding (size x)) size x = 3 + size (owner_events_GrabPointer x) + size (grab_window_GrabPointer x) + size (event_mask_GrabPointer x) + size (pointer_mode_GrabPointer x) + size (keyboard_mode_GrabPointer x) + size (confine_to_GrabPointer x) + size (cursor_GrabPointer x) + size (time_GrabPointer x) data GrabPointerReply = MkGrabPointerReply{status_GrabPointerReply :: Word8} deriving (Show, Typeable) instance Deserialize GrabPointerReply where deserialize = do skip 1 status <- deserialize skip 2 length <- deserialize let _ = isCard32 length return (MkGrabPointerReply status) data UngrabPointer = MkUngrabPointer{time_UngrabPointer :: TIMESTAMP} deriving (Show, Typeable) instance Serialize UngrabPointer where serialize x = do putWord8 27 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (time_UngrabPointer x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (time_UngrabPointer x) data ButtonIndex = ButtonIndexAny | ButtonIndex1 | ButtonIndex2 | ButtonIndex3 | ButtonIndex4 | ButtonIndex5 instance SimpleEnum ButtonIndex where toValue ButtonIndexAny{} = 0 toValue ButtonIndex1{} = 1 toValue ButtonIndex2{} = 2 toValue ButtonIndex3{} = 3 toValue ButtonIndex4{} = 4 toValue ButtonIndex5{} = 5 fromValue 0 = ButtonIndexAny fromValue 1 = ButtonIndex1 fromValue 2 = ButtonIndex2 fromValue 3 = ButtonIndex3 fromValue 4 = ButtonIndex4 fromValue 5 = ButtonIndex5 data GrabButton = MkGrabButton{owner_events_GrabButton :: Bool, grab_window_GrabButton :: WINDOW, event_mask_GrabButton :: Word16, pointer_mode_GrabButton :: Word8, keyboard_mode_GrabButton :: Word8, confine_to_GrabButton :: WINDOW, cursor_GrabButton :: CURSOR, button_GrabButton :: Word8, modifiers_GrabButton :: Word16} deriving (Show, Typeable) instance Serialize GrabButton where serialize x = do putWord8 28 serialize (owner_events_GrabButton x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (grab_window_GrabButton x) serialize (event_mask_GrabButton x) serialize (pointer_mode_GrabButton x) serialize (keyboard_mode_GrabButton x) serialize (confine_to_GrabButton x) serialize (cursor_GrabButton x) serialize (button_GrabButton x) putSkip 1 serialize (modifiers_GrabButton x) putSkip (requiredPadding (size x)) size x = 3 + size (owner_events_GrabButton x) + size (grab_window_GrabButton x) + size (event_mask_GrabButton x) + size (pointer_mode_GrabButton x) + size (keyboard_mode_GrabButton x) + size (confine_to_GrabButton x) + size (cursor_GrabButton x) + size (button_GrabButton x) + 1 + size (modifiers_GrabButton x) data UngrabButton = MkUngrabButton{button_UngrabButton :: Word8, grab_window_UngrabButton :: WINDOW, modifiers_UngrabButton :: Word16} deriving (Show, Typeable) instance Serialize UngrabButton where serialize x = do putWord8 29 serialize (button_UngrabButton x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (grab_window_UngrabButton x) serialize (modifiers_UngrabButton x) putSkip 2 putSkip (requiredPadding (size x)) size x = 3 + size (button_UngrabButton x) + size (grab_window_UngrabButton x) + size (modifiers_UngrabButton x) + 2 data ChangeActivePointerGrab = MkChangeActivePointerGrab{cursor_ChangeActivePointerGrab :: CURSOR, time_ChangeActivePointerGrab :: TIMESTAMP, event_mask_ChangeActivePointerGrab :: Word16} deriving (Show, Typeable) instance Serialize ChangeActivePointerGrab where serialize x = do putWord8 30 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (cursor_ChangeActivePointerGrab x) serialize (time_ChangeActivePointerGrab x) serialize (event_mask_ChangeActivePointerGrab x) putSkip 2 putSkip (requiredPadding (size x)) size x = 3 + 1 + size (cursor_ChangeActivePointerGrab x) + size (time_ChangeActivePointerGrab x) + size (event_mask_ChangeActivePointerGrab x) + 2 data GrabKeyboard = MkGrabKeyboard{owner_events_GrabKeyboard :: Bool, grab_window_GrabKeyboard :: WINDOW, time_GrabKeyboard :: TIMESTAMP, pointer_mode_GrabKeyboard :: Word8, keyboard_mode_GrabKeyboard :: Word8} deriving (Show, Typeable) instance Serialize GrabKeyboard where serialize x = do putWord8 31 serialize (owner_events_GrabKeyboard x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (grab_window_GrabKeyboard x) serialize (time_GrabKeyboard x) serialize (pointer_mode_GrabKeyboard x) serialize (keyboard_mode_GrabKeyboard x) putSkip 2 putSkip (requiredPadding (size x)) size x = 3 + size (owner_events_GrabKeyboard x) + size (grab_window_GrabKeyboard x) + size (time_GrabKeyboard x) + size (pointer_mode_GrabKeyboard x) + size (keyboard_mode_GrabKeyboard x) + 2 data GrabKeyboardReply = MkGrabKeyboardReply{status_GrabKeyboardReply :: Word8} deriving (Show, Typeable) instance Deserialize GrabKeyboardReply where deserialize = do skip 1 status <- deserialize skip 2 length <- deserialize let _ = isCard32 length return (MkGrabKeyboardReply status) data UngrabKeyboard = MkUngrabKeyboard{time_UngrabKeyboard :: TIMESTAMP} deriving (Show, Typeable) instance Serialize UngrabKeyboard where serialize x = do putWord8 32 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (time_UngrabKeyboard x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (time_UngrabKeyboard x) data Grab = GrabAny instance SimpleEnum Grab where toValue GrabAny{} = 0 fromValue 0 = GrabAny data GrabKey = MkGrabKey{owner_events_GrabKey :: Bool, grab_window_GrabKey :: WINDOW, modifiers_GrabKey :: Word16, key_GrabKey :: KEYCODE, pointer_mode_GrabKey :: Word8, keyboard_mode_GrabKey :: Word8} deriving (Show, Typeable) instance Serialize GrabKey where serialize x = do putWord8 33 serialize (owner_events_GrabKey x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (grab_window_GrabKey x) serialize (modifiers_GrabKey x) serialize (key_GrabKey x) serialize (pointer_mode_GrabKey x) serialize (keyboard_mode_GrabKey x) putSkip 3 putSkip (requiredPadding (size x)) size x = 3 + size (owner_events_GrabKey x) + size (grab_window_GrabKey x) + size (modifiers_GrabKey x) + size (key_GrabKey x) + size (pointer_mode_GrabKey x) + size (keyboard_mode_GrabKey x) + 3 data UngrabKey = MkUngrabKey{key_UngrabKey :: KEYCODE, grab_window_UngrabKey :: WINDOW, modifiers_UngrabKey :: Word16} deriving (Show, Typeable) instance Serialize UngrabKey where serialize x = do putWord8 34 serialize (key_UngrabKey x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (grab_window_UngrabKey x) serialize (modifiers_UngrabKey x) putSkip 2 putSkip (requiredPadding (size x)) size x = 3 + size (key_UngrabKey x) + size (grab_window_UngrabKey x) + size (modifiers_UngrabKey x) + 2 data Allow = AllowAsyncPointer | AllowSyncPointer | AllowReplayPointer | AllowAsyncKeyboard | AllowSyncKeyboard | AllowReplayKeyboard | AllowAsyncBoth | AllowSyncBoth instance SimpleEnum Allow where toValue AllowAsyncPointer{} = 0 toValue AllowSyncPointer{} = 1 toValue AllowReplayPointer{} = 2 toValue AllowAsyncKeyboard{} = 3 toValue AllowSyncKeyboard{} = 4 toValue AllowReplayKeyboard{} = 5 toValue AllowAsyncBoth{} = 6 toValue AllowSyncBoth{} = 7 fromValue 0 = AllowAsyncPointer fromValue 1 = AllowSyncPointer fromValue 2 = AllowReplayPointer fromValue 3 = AllowAsyncKeyboard fromValue 4 = AllowSyncKeyboard fromValue 5 = AllowReplayKeyboard fromValue 6 = AllowAsyncBoth fromValue 7 = AllowSyncBoth data AllowEvents = MkAllowEvents{mode_AllowEvents :: Word8, time_AllowEvents :: TIMESTAMP} deriving (Show, Typeable) instance Serialize AllowEvents where serialize x = do putWord8 35 serialize (mode_AllowEvents x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (time_AllowEvents x) putSkip (requiredPadding (size x)) size x = 3 + size (mode_AllowEvents x) + size (time_AllowEvents x) data QueryPointer = MkQueryPointer{window_QueryPointer :: WINDOW} deriving (Show, Typeable) instance Serialize QueryPointer where serialize x = do putWord8 38 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (window_QueryPointer x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (window_QueryPointer x) data QueryPointerReply = MkQueryPointerReply{same_screen_QueryPointerReply :: Bool, root_QueryPointerReply :: WINDOW, child_QueryPointerReply :: WINDOW, root_x_QueryPointerReply :: Int16, root_y_QueryPointerReply :: Int16, win_x_QueryPointerReply :: Int16, win_y_QueryPointerReply :: Int16, mask_QueryPointerReply :: Word16} deriving (Show, Typeable) instance Deserialize QueryPointerReply where deserialize = do skip 1 same_screen <- deserialize skip 2 length <- deserialize root <- deserialize child <- deserialize root_x <- deserialize root_y <- deserialize win_x <- deserialize win_y <- deserialize mask <- deserialize skip 2 let _ = isCard32 length return (MkQueryPointerReply same_screen root child root_x root_y win_x win_y mask) data TIMECOORD = MkTIMECOORD{time_TIMECOORD :: TIMESTAMP, x_TIMECOORD :: Int16, y_TIMECOORD :: Int16} deriving (Show, Typeable) instance Serialize TIMECOORD where serialize x = do serialize (time_TIMECOORD x) serialize (x_TIMECOORD x) serialize (y_TIMECOORD x) size x = size (time_TIMECOORD x) + size (x_TIMECOORD x) + size (y_TIMECOORD x) instance Deserialize TIMECOORD where deserialize = do time <- deserialize x <- deserialize y <- deserialize return (MkTIMECOORD time x y) data GetMotionEvents = MkGetMotionEvents{window_GetMotionEvents :: WINDOW, start_GetMotionEvents :: TIMESTAMP, stop_GetMotionEvents :: TIMESTAMP} deriving (Show, Typeable) instance Serialize GetMotionEvents where serialize x = do putWord8 39 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (window_GetMotionEvents x) serialize (start_GetMotionEvents x) serialize (stop_GetMotionEvents x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (window_GetMotionEvents x) + size (start_GetMotionEvents x) + size (stop_GetMotionEvents x) data GetMotionEventsReply = MkGetMotionEventsReply{events_len_GetMotionEventsReply :: Word32, events_GetMotionEventsReply :: [TIMECOORD]} deriving (Show, Typeable) instance Deserialize GetMotionEventsReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize events_len <- deserialize skip 20 events <- deserializeList (fromIntegral events_len) let _ = isCard32 length return (MkGetMotionEventsReply events_len events) data TranslateCoordinates = MkTranslateCoordinates{src_window_TranslateCoordinates :: WINDOW, dst_window_TranslateCoordinates :: WINDOW, src_x_TranslateCoordinates :: Int16, src_y_TranslateCoordinates :: Int16} deriving (Show, Typeable) instance Serialize TranslateCoordinates where serialize x = do putWord8 40 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (src_window_TranslateCoordinates x) serialize (dst_window_TranslateCoordinates x) serialize (src_x_TranslateCoordinates x) serialize (src_y_TranslateCoordinates x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (src_window_TranslateCoordinates x) + size (dst_window_TranslateCoordinates x) + size (src_x_TranslateCoordinates x) + size (src_y_TranslateCoordinates x) data TranslateCoordinatesReply = MkTranslateCoordinatesReply{same_screen_TranslateCoordinatesReply :: Bool, child_TranslateCoordinatesReply :: WINDOW, dst_x_TranslateCoordinatesReply :: Word16, dst_y_TranslateCoordinatesReply :: Word16} deriving (Show, Typeable) instance Deserialize TranslateCoordinatesReply where deserialize = do skip 1 same_screen <- deserialize skip 2 length <- deserialize child <- deserialize dst_x <- deserialize dst_y <- deserialize let _ = isCard32 length return (MkTranslateCoordinatesReply same_screen child dst_x dst_y) data WarpPointer = MkWarpPointer{src_window_WarpPointer :: WINDOW, dst_window_WarpPointer :: WINDOW, src_x_WarpPointer :: Int16, src_y_WarpPointer :: Int16, src_width_WarpPointer :: Word16, src_height_WarpPointer :: Word16, dst_x_WarpPointer :: Int16, dst_y_WarpPointer :: Int16} deriving (Show, Typeable) instance Serialize WarpPointer where serialize x = do putWord8 41 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (src_window_WarpPointer x) serialize (dst_window_WarpPointer x) serialize (src_x_WarpPointer x) serialize (src_y_WarpPointer x) serialize (src_width_WarpPointer x) serialize (src_height_WarpPointer x) serialize (dst_x_WarpPointer x) serialize (dst_y_WarpPointer x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (src_window_WarpPointer x) + size (dst_window_WarpPointer x) + size (src_x_WarpPointer x) + size (src_y_WarpPointer x) + size (src_width_WarpPointer x) + size (src_height_WarpPointer x) + size (dst_x_WarpPointer x) + size (dst_y_WarpPointer x) data InputFocus = InputFocusNone | InputFocusPointerRoot | InputFocusParent instance SimpleEnum InputFocus where toValue InputFocusNone{} = 0 toValue InputFocusPointerRoot{} = 1 toValue InputFocusParent{} = 2 fromValue 0 = InputFocusNone fromValue 1 = InputFocusPointerRoot fromValue 2 = InputFocusParent data SetInputFocus = MkSetInputFocus{revert_to_SetInputFocus :: Word8, focus_SetInputFocus :: WINDOW, time_SetInputFocus :: TIMESTAMP} deriving (Show, Typeable) instance Serialize SetInputFocus where serialize x = do putWord8 42 serialize (revert_to_SetInputFocus x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (focus_SetInputFocus x) serialize (time_SetInputFocus x) putSkip (requiredPadding (size x)) size x = 3 + size (revert_to_SetInputFocus x) + size (focus_SetInputFocus x) + size (time_SetInputFocus x) data GetInputFocus = MkGetInputFocus{} deriving (Show, Typeable) instance Serialize GetInputFocus where serialize x = do putWord8 43 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) putSkip (requiredPadding (size x)) size x = 4 data GetInputFocusReply = MkGetInputFocusReply{revert_to_GetInputFocusReply :: Word8, focus_GetInputFocusReply :: WINDOW} deriving (Show, Typeable) instance Deserialize GetInputFocusReply where deserialize = do skip 1 revert_to <- deserialize skip 2 length <- deserialize focus <- deserialize let _ = isCard32 length return (MkGetInputFocusReply revert_to focus) data QueryKeymap = MkQueryKeymap{} deriving (Show, Typeable) instance Serialize QueryKeymap where serialize x = do putWord8 44 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) putSkip (requiredPadding (size x)) size x = 4 data QueryKeymapReply = MkQueryKeymapReply{keys_QueryKeymapReply :: [Word8]} deriving (Show, Typeable) instance Deserialize QueryKeymapReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize keys <- deserializeList (fromIntegral 32) let _ = isCard32 length return (MkQueryKeymapReply keys) data OpenFont = MkOpenFont{fid_OpenFont :: FONT, name_len_OpenFont :: Word16, name_OpenFont :: [CChar]} deriving (Show, Typeable) instance Serialize OpenFont where serialize x = do putWord8 45 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (fid_OpenFont x) serialize (name_len_OpenFont x) putSkip 2 serializeList (name_OpenFont x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (fid_OpenFont x) + size (name_len_OpenFont x) + 2 + sum (map size (name_OpenFont x)) data CloseFont = MkCloseFont{font_CloseFont :: FONT} deriving (Show, Typeable) instance Serialize CloseFont where serialize x = do putWord8 46 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (font_CloseFont x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (font_CloseFont x) data FontDraw = FontDrawLeftToRight | FontDrawRightToLeft instance SimpleEnum FontDraw where toValue FontDrawLeftToRight{} = 0 toValue FontDrawRightToLeft{} = 1 fromValue 0 = FontDrawLeftToRight fromValue 1 = FontDrawRightToLeft data FONTPROP = MkFONTPROP{name_FONTPROP :: ATOM, value_FONTPROP :: Word32} deriving (Show, Typeable) instance Serialize FONTPROP where serialize x = do serialize (name_FONTPROP x) serialize (value_FONTPROP x) size x = size (name_FONTPROP x) + size (value_FONTPROP x) instance Deserialize FONTPROP where deserialize = do name <- deserialize value <- deserialize return (MkFONTPROP name value) data CHARINFO = MkCHARINFO{left_side_bearing_CHARINFO :: Int16, right_side_bearing_CHARINFO :: Int16, character_width_CHARINFO :: Int16, ascent_CHARINFO :: Int16, descent_CHARINFO :: Int16, attributes_CHARINFO :: Word16} deriving (Show, Typeable) instance Serialize CHARINFO where serialize x = do serialize (left_side_bearing_CHARINFO x) serialize (right_side_bearing_CHARINFO x) serialize (character_width_CHARINFO x) serialize (ascent_CHARINFO x) serialize (descent_CHARINFO x) serialize (attributes_CHARINFO x) size x = size (left_side_bearing_CHARINFO x) + size (right_side_bearing_CHARINFO x) + size (character_width_CHARINFO x) + size (ascent_CHARINFO x) + size (descent_CHARINFO x) + size (attributes_CHARINFO x) instance Deserialize CHARINFO where deserialize = do left_side_bearing <- deserialize right_side_bearing <- deserialize character_width <- deserialize ascent <- deserialize descent <- deserialize attributes <- deserialize return (MkCHARINFO left_side_bearing right_side_bearing character_width ascent descent attributes) data QueryFont = MkQueryFont{font_QueryFont :: FONTABLE} deriving (Show, Typeable) instance Serialize QueryFont where serialize x = do putWord8 47 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (font_QueryFont x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (font_QueryFont x) data QueryFontReply = MkQueryFontReply{min_bounds_QueryFontReply :: CHARINFO, max_bounds_QueryFontReply :: CHARINFO, min_char_or_byte2_QueryFontReply :: Word16, max_char_or_byte2_QueryFontReply :: Word16, default_char_QueryFontReply :: Word16, properties_len_QueryFontReply :: Word16, draw_direction_QueryFontReply :: Word8, min_byte1_QueryFontReply :: Word8, max_byte1_QueryFontReply :: Word8, all_chars_exist_QueryFontReply :: Bool, font_ascent_QueryFontReply :: Int16, font_descent_QueryFontReply :: Int16, char_infos_len_QueryFontReply :: Word32, properties_QueryFontReply :: [FONTPROP], char_infos_QueryFontReply :: [CHARINFO]} deriving (Show, Typeable) instance Deserialize QueryFontReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize min_bounds <- deserialize skip 4 max_bounds <- deserialize skip 4 min_char_or_byte2 <- deserialize max_char_or_byte2 <- deserialize default_char <- deserialize properties_len <- deserialize draw_direction <- deserialize min_byte1 <- deserialize max_byte1 <- deserialize all_chars_exist <- deserialize font_ascent <- deserialize font_descent <- deserialize char_infos_len <- deserialize properties <- deserializeList (fromIntegral properties_len) char_infos <- deserializeList (fromIntegral char_infos_len) let _ = isCard32 length return (MkQueryFontReply min_bounds max_bounds min_char_or_byte2 max_char_or_byte2 default_char properties_len draw_direction min_byte1 max_byte1 all_chars_exist font_ascent font_descent char_infos_len properties char_infos) data QueryTextExtents = MkQueryTextExtents{font_QueryTextExtents :: FONTABLE, string_QueryTextExtents :: [CHAR2B]} deriving (Show, Typeable) odd_length_QueryTextExtents :: QueryTextExtents -> Bool odd_length_QueryTextExtents x = wordToBool (string_len_QueryTextExtents x .&. 1) string_len_QueryTextExtents :: QueryTextExtents -> Word8 string_len_QueryTextExtents x = genericLength $ string_QueryTextExtents x instance Serialize QueryTextExtents where serialize x = do putWord8 48 serialize (odd_length_QueryTextExtents x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (font_QueryTextExtents x) serializeList (string_QueryTextExtents x) putSkip (requiredPadding (size x)) size x = 3 + size (odd_length_QueryTextExtents x) + size (font_QueryTextExtents x) + sum (map size (string_QueryTextExtents x)) data QueryTextExtentsReply = MkQueryTextExtentsReply{draw_direction_QueryTextExtentsReply :: Word8, font_ascent_QueryTextExtentsReply :: Int16, font_descent_QueryTextExtentsReply :: Int16, overall_ascent_QueryTextExtentsReply :: Int16, overall_descent_QueryTextExtentsReply :: Int16, overall_width_QueryTextExtentsReply :: Int32, overall_left_QueryTextExtentsReply :: Int32, overall_right_QueryTextExtentsReply :: Int32} deriving (Show, Typeable) instance Deserialize QueryTextExtentsReply where deserialize = do skip 1 draw_direction <- deserialize skip 2 length <- deserialize font_ascent <- deserialize font_descent <- deserialize overall_ascent <- deserialize overall_descent <- deserialize overall_width <- deserialize overall_left <- deserialize overall_right <- deserialize let _ = isCard32 length return (MkQueryTextExtentsReply draw_direction font_ascent font_descent overall_ascent overall_descent overall_width overall_left overall_right) data STR = MkSTR{name_len_STR :: Word8, name_STR :: [CChar]} deriving (Show, Typeable) instance Serialize STR where serialize x = do serialize (name_len_STR x) serializeList (name_STR x) size x = size (name_len_STR x) + sum (map size (name_STR x)) instance Deserialize STR where deserialize = do name_len <- deserialize name <- deserializeList (fromIntegral name_len) return (MkSTR name_len name) data ListFonts = MkListFonts{max_names_ListFonts :: Word16, pattern_len_ListFonts :: Word16, pattern_ListFonts :: [CChar]} deriving (Show, Typeable) instance Serialize ListFonts where serialize x = do putWord8 49 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (max_names_ListFonts x) serialize (pattern_len_ListFonts x) serializeList (pattern_ListFonts x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (max_names_ListFonts x) + size (pattern_len_ListFonts x) + sum (map size (pattern_ListFonts x)) data ListFontsReply = MkListFontsReply{names_len_ListFontsReply :: Word16, names_ListFontsReply :: [STR]} deriving (Show, Typeable) instance Deserialize ListFontsReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize names_len <- deserialize skip 22 names <- deserializeList (fromIntegral names_len) let _ = isCard32 length return (MkListFontsReply names_len names) data ListFontsWithInfo = MkListFontsWithInfo{max_names_ListFontsWithInfo :: Word16, pattern_len_ListFontsWithInfo :: Word16, pattern_ListFontsWithInfo :: [CChar]} deriving (Show, Typeable) instance Serialize ListFontsWithInfo where serialize x = do putWord8 50 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (max_names_ListFontsWithInfo x) serialize (pattern_len_ListFontsWithInfo x) serializeList (pattern_ListFontsWithInfo x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (max_names_ListFontsWithInfo x) + size (pattern_len_ListFontsWithInfo x) + sum (map size (pattern_ListFontsWithInfo x)) data ListFontsWithInfoReply = MkListFontsWithInfoReply{name_len_ListFontsWithInfoReply :: Word8, min_bounds_ListFontsWithInfoReply :: CHARINFO, max_bounds_ListFontsWithInfoReply :: CHARINFO, min_char_or_byte2_ListFontsWithInfoReply :: Word16, max_char_or_byte2_ListFontsWithInfoReply :: Word16, default_char_ListFontsWithInfoReply :: Word16, properties_len_ListFontsWithInfoReply :: Word16, draw_direction_ListFontsWithInfoReply :: Word8, min_byte1_ListFontsWithInfoReply :: Word8, max_byte1_ListFontsWithInfoReply :: Word8, all_chars_exist_ListFontsWithInfoReply :: Bool, font_ascent_ListFontsWithInfoReply :: Int16, font_descent_ListFontsWithInfoReply :: Int16, replies_hint_ListFontsWithInfoReply :: Word32, properties_ListFontsWithInfoReply :: [FONTPROP], name_ListFontsWithInfoReply :: [CChar]} deriving (Show, Typeable) instance Deserialize ListFontsWithInfoReply where deserialize = do skip 1 name_len <- deserialize skip 2 length <- deserialize min_bounds <- deserialize skip 4 max_bounds <- deserialize skip 4 min_char_or_byte2 <- deserialize max_char_or_byte2 <- deserialize default_char <- deserialize properties_len <- deserialize draw_direction <- deserialize min_byte1 <- deserialize max_byte1 <- deserialize all_chars_exist <- deserialize font_ascent <- deserialize font_descent <- deserialize replies_hint <- deserialize properties <- deserializeList (fromIntegral properties_len) name <- deserializeList (fromIntegral name_len) let _ = isCard32 length return (MkListFontsWithInfoReply name_len min_bounds max_bounds min_char_or_byte2 max_char_or_byte2 default_char properties_len draw_direction min_byte1 max_byte1 all_chars_exist font_ascent font_descent replies_hint properties name) data SetFontPath = MkSetFontPath{font_qty_SetFontPath :: Word16, path_SetFontPath :: [CChar]} deriving (Show, Typeable) instance Serialize SetFontPath where serialize x = do putWord8 51 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (font_qty_SetFontPath x) serializeList (path_SetFontPath x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (font_qty_SetFontPath x) + sum (map size (path_SetFontPath x)) data GetFontPath = MkGetFontPath{} deriving (Show, Typeable) instance Serialize GetFontPath where serialize x = do putWord8 52 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) putSkip (requiredPadding (size x)) size x = 4 data GetFontPathReply = MkGetFontPathReply{path_len_GetFontPathReply :: Word16, path_GetFontPathReply :: [STR]} deriving (Show, Typeable) instance Deserialize GetFontPathReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize path_len <- deserialize skip 22 path <- deserializeList (fromIntegral path_len) let _ = isCard32 length return (MkGetFontPathReply path_len path) data CreatePixmap = MkCreatePixmap{depth_CreatePixmap :: Word8, pid_CreatePixmap :: PIXMAP, drawable_CreatePixmap :: DRAWABLE, width_CreatePixmap :: Word16, height_CreatePixmap :: Word16} deriving (Show, Typeable) instance Serialize CreatePixmap where serialize x = do putWord8 53 serialize (depth_CreatePixmap x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (pid_CreatePixmap x) serialize (drawable_CreatePixmap x) serialize (width_CreatePixmap x) serialize (height_CreatePixmap x) putSkip (requiredPadding (size x)) size x = 3 + size (depth_CreatePixmap x) + size (pid_CreatePixmap x) + size (drawable_CreatePixmap x) + size (width_CreatePixmap x) + size (height_CreatePixmap x) data FreePixmap = MkFreePixmap{pixmap_FreePixmap :: PIXMAP} deriving (Show, Typeable) instance Serialize FreePixmap where serialize x = do putWord8 54 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (pixmap_FreePixmap x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (pixmap_FreePixmap x) data GC = GCFunction | GCPlaneMask | GCForeground | GCBackground | GCLineWidth | GCLineStyle | GCCapStyle | GCJoinStyle | GCFillStyle | GCFillRule | GCTile | GCStipple | GCTileStippleOriginX | GCTileStippleOriginY | GCFont | GCSubwindowMode | GCGraphicsExposures | GCClipOriginX | GCClipOriginY | GCClipMask | GCDashOffset | GCDashList | GCArcMode instance BitEnum GC where toBit GCFunction{} = 0 toBit GCPlaneMask{} = 1 toBit GCForeground{} = 2 toBit GCBackground{} = 3 toBit GCLineWidth{} = 4 toBit GCLineStyle{} = 5 toBit GCCapStyle{} = 6 toBit GCJoinStyle{} = 7 toBit GCFillStyle{} = 8 toBit GCFillRule{} = 9 toBit GCTile{} = 10 toBit GCStipple{} = 11 toBit GCTileStippleOriginX{} = 12 toBit GCTileStippleOriginY{} = 13 toBit GCFont{} = 14 toBit GCSubwindowMode{} = 15 toBit GCGraphicsExposures{} = 16 toBit GCClipOriginX{} = 17 toBit GCClipOriginY{} = 18 toBit GCClipMask{} = 19 toBit GCDashOffset{} = 20 toBit GCDashList{} = 21 toBit GCArcMode{} = 22 fromBit 0 = GCFunction fromBit 1 = GCPlaneMask fromBit 2 = GCForeground fromBit 3 = GCBackground fromBit 4 = GCLineWidth fromBit 5 = GCLineStyle fromBit 6 = GCCapStyle fromBit 7 = GCJoinStyle fromBit 8 = GCFillStyle fromBit 9 = GCFillRule fromBit 10 = GCTile fromBit 11 = GCStipple fromBit 12 = GCTileStippleOriginX fromBit 13 = GCTileStippleOriginY fromBit 14 = GCFont fromBit 15 = GCSubwindowMode fromBit 16 = GCGraphicsExposures fromBit 17 = GCClipOriginX fromBit 18 = GCClipOriginY fromBit 19 = GCClipMask fromBit 20 = GCDashOffset fromBit 21 = GCDashList fromBit 22 = GCArcMode data GX = GXclear | GXand | GXandReverse | GXcopy | GXandInverted | GXnoop | GXxor | GXor | GXnor | GXequiv | GXinvert | GXorReverse | GXcopyInverted | GXorInverted | GXnand | GXset instance SimpleEnum GX where toValue GXclear{} = 0 toValue GXand{} = 1 toValue GXandReverse{} = 2 toValue GXcopy{} = 3 toValue GXandInverted{} = 4 toValue GXnoop{} = 5 toValue GXxor{} = 6 toValue GXor{} = 7 toValue GXnor{} = 8 toValue GXequiv{} = 9 toValue GXinvert{} = 10 toValue GXorReverse{} = 11 toValue GXcopyInverted{} = 12 toValue GXorInverted{} = 13 toValue GXnand{} = 14 toValue GXset{} = 15 fromValue 0 = GXclear fromValue 1 = GXand fromValue 2 = GXandReverse fromValue 3 = GXcopy fromValue 4 = GXandInverted fromValue 5 = GXnoop fromValue 6 = GXxor fromValue 7 = GXor fromValue 8 = GXnor fromValue 9 = GXequiv fromValue 10 = GXinvert fromValue 11 = GXorReverse fromValue 12 = GXcopyInverted fromValue 13 = GXorInverted fromValue 14 = GXnand fromValue 15 = GXset data LineStyle = LineStyleSolid | LineStyleOnOffDash | LineStyleDoubleDash instance SimpleEnum LineStyle where toValue LineStyleSolid{} = 0 toValue LineStyleOnOffDash{} = 1 toValue LineStyleDoubleDash{} = 2 fromValue 0 = LineStyleSolid fromValue 1 = LineStyleOnOffDash fromValue 2 = LineStyleDoubleDash data CapStyle = CapStyleNotLast | CapStyleButt | CapStyleRound | CapStyleProjecting instance SimpleEnum CapStyle where toValue CapStyleNotLast{} = 0 toValue CapStyleButt{} = 1 toValue CapStyleRound{} = 2 toValue CapStyleProjecting{} = 3 fromValue 0 = CapStyleNotLast fromValue 1 = CapStyleButt fromValue 2 = CapStyleRound fromValue 3 = CapStyleProjecting data JoinStyle = JoinStyleMitre | JoinStyleRound | JoinStyleBevel instance SimpleEnum JoinStyle where toValue JoinStyleMitre{} = 0 toValue JoinStyleRound{} = 1 toValue JoinStyleBevel{} = 2 fromValue 0 = JoinStyleMitre fromValue 1 = JoinStyleRound fromValue 2 = JoinStyleBevel data FillStyle = FillStyleSolid | FillStyleTiled | FillStyleStippled | FillStyleOpaqueStippled instance SimpleEnum FillStyle where toValue FillStyleSolid{} = 0 toValue FillStyleTiled{} = 1 toValue FillStyleStippled{} = 2 toValue FillStyleOpaqueStippled{} = 3 fromValue 0 = FillStyleSolid fromValue 1 = FillStyleTiled fromValue 2 = FillStyleStippled fromValue 3 = FillStyleOpaqueStippled data FillRule = FillRuleEvenOdd | FillRuleWinding instance SimpleEnum FillRule where toValue FillRuleEvenOdd{} = 0 toValue FillRuleWinding{} = 1 fromValue 0 = FillRuleEvenOdd fromValue 1 = FillRuleWinding data SubwindowMode = SubwindowModeClipByChildren | SubwindowModeIncludeInferiors instance SimpleEnum SubwindowMode where toValue SubwindowModeClipByChildren{} = 0 toValue SubwindowModeIncludeInferiors{} = 1 fromValue 0 = SubwindowModeClipByChildren fromValue 1 = SubwindowModeIncludeInferiors data ArcMode = ArcModeChord | ArcModePieSlice instance SimpleEnum ArcMode where toValue ArcModeChord{} = 0 toValue ArcModePieSlice{} = 1 fromValue 0 = ArcModeChord fromValue 1 = ArcModePieSlice data CreateGC = MkCreateGC{cid_CreateGC :: GCONTEXT, drawable_CreateGC :: DRAWABLE, value_CreateGC :: ValueParam Word32} deriving (Show, Typeable) instance Serialize CreateGC where serialize x = do putWord8 55 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (cid_CreateGC x) serialize (drawable_CreateGC x) serialize (value_CreateGC x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (cid_CreateGC x) + size (drawable_CreateGC x) + size (value_CreateGC x) data ChangeGC = MkChangeGC{gc_ChangeGC :: GCONTEXT, value_ChangeGC :: ValueParam Word32} deriving (Show, Typeable) instance Serialize ChangeGC where serialize x = do putWord8 56 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (gc_ChangeGC x) serialize (value_ChangeGC x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (gc_ChangeGC x) + size (value_ChangeGC x) data CopyGC = MkCopyGC{src_gc_CopyGC :: GCONTEXT, dst_gc_CopyGC :: GCONTEXT, value_mask_CopyGC :: Word32} deriving (Show, Typeable) instance Serialize CopyGC where serialize x = do putWord8 57 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (src_gc_CopyGC x) serialize (dst_gc_CopyGC x) serialize (value_mask_CopyGC x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (src_gc_CopyGC x) + size (dst_gc_CopyGC x) + size (value_mask_CopyGC x) data SetDashes = MkSetDashes{gc_SetDashes :: GCONTEXT, dash_offset_SetDashes :: Word16, dashes_len_SetDashes :: Word16, dashes_SetDashes :: [Word8]} deriving (Show, Typeable) instance Serialize SetDashes where serialize x = do putWord8 58 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (gc_SetDashes x) serialize (dash_offset_SetDashes x) serialize (dashes_len_SetDashes x) serializeList (dashes_SetDashes x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (gc_SetDashes x) + size (dash_offset_SetDashes x) + size (dashes_len_SetDashes x) + sum (map size (dashes_SetDashes x)) data ClipOrdering = ClipOrderingUnsorted | ClipOrderingYSorted | ClipOrderingYXSorted | ClipOrderingYXBanded instance SimpleEnum ClipOrdering where toValue ClipOrderingUnsorted{} = 0 toValue ClipOrderingYSorted{} = 1 toValue ClipOrderingYXSorted{} = 2 toValue ClipOrderingYXBanded{} = 3 fromValue 0 = ClipOrderingUnsorted fromValue 1 = ClipOrderingYSorted fromValue 2 = ClipOrderingYXSorted fromValue 3 = ClipOrderingYXBanded data SetClipRectangles = MkSetClipRectangles{ordering_SetClipRectangles :: Word8, gc_SetClipRectangles :: GCONTEXT, clip_x_origin_SetClipRectangles :: Int16, clip_y_origin_SetClipRectangles :: Int16, rectangles_SetClipRectangles :: [RECTANGLE]} deriving (Show, Typeable) instance Serialize SetClipRectangles where serialize x = do putWord8 59 serialize (ordering_SetClipRectangles x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (gc_SetClipRectangles x) serialize (clip_x_origin_SetClipRectangles x) serialize (clip_y_origin_SetClipRectangles x) serializeList (rectangles_SetClipRectangles x) putSkip (requiredPadding (size x)) size x = 3 + size (ordering_SetClipRectangles x) + size (gc_SetClipRectangles x) + size (clip_x_origin_SetClipRectangles x) + size (clip_y_origin_SetClipRectangles x) + sum (map size (rectangles_SetClipRectangles x)) data FreeGC = MkFreeGC{gc_FreeGC :: GCONTEXT} deriving (Show, Typeable) instance Serialize FreeGC where serialize x = do putWord8 60 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (gc_FreeGC x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (gc_FreeGC x) data ClearArea = MkClearArea{exposures_ClearArea :: Bool, window_ClearArea :: WINDOW, x_ClearArea :: Int16, y_ClearArea :: Int16, width_ClearArea :: Word16, height_ClearArea :: Word16} deriving (Show, Typeable) instance Serialize ClearArea where serialize x = do putWord8 61 serialize (exposures_ClearArea x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (window_ClearArea x) serialize (x_ClearArea x) serialize (y_ClearArea x) serialize (width_ClearArea x) serialize (height_ClearArea x) putSkip (requiredPadding (size x)) size x = 3 + size (exposures_ClearArea x) + size (window_ClearArea x) + size (x_ClearArea x) + size (y_ClearArea x) + size (width_ClearArea x) + size (height_ClearArea x) data CopyArea = MkCopyArea{src_drawable_CopyArea :: DRAWABLE, dst_drawable_CopyArea :: DRAWABLE, gc_CopyArea :: GCONTEXT, src_x_CopyArea :: Int16, src_y_CopyArea :: Int16, dst_x_CopyArea :: Int16, dst_y_CopyArea :: Int16, width_CopyArea :: Word16, height_CopyArea :: Word16} deriving (Show, Typeable) instance Serialize CopyArea where serialize x = do putWord8 62 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (src_drawable_CopyArea x) serialize (dst_drawable_CopyArea x) serialize (gc_CopyArea x) serialize (src_x_CopyArea x) serialize (src_y_CopyArea x) serialize (dst_x_CopyArea x) serialize (dst_y_CopyArea x) serialize (width_CopyArea x) serialize (height_CopyArea x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (src_drawable_CopyArea x) + size (dst_drawable_CopyArea x) + size (gc_CopyArea x) + size (src_x_CopyArea x) + size (src_y_CopyArea x) + size (dst_x_CopyArea x) + size (dst_y_CopyArea x) + size (width_CopyArea x) + size (height_CopyArea x) data CopyPlane = MkCopyPlane{src_drawable_CopyPlane :: DRAWABLE, dst_drawable_CopyPlane :: DRAWABLE, gc_CopyPlane :: GCONTEXT, src_x_CopyPlane :: Int16, src_y_CopyPlane :: Int16, dst_x_CopyPlane :: Int16, dst_y_CopyPlane :: Int16, width_CopyPlane :: Word16, height_CopyPlane :: Word16, bit_plane_CopyPlane :: Word32} deriving (Show, Typeable) instance Serialize CopyPlane where serialize x = do putWord8 63 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (src_drawable_CopyPlane x) serialize (dst_drawable_CopyPlane x) serialize (gc_CopyPlane x) serialize (src_x_CopyPlane x) serialize (src_y_CopyPlane x) serialize (dst_x_CopyPlane x) serialize (dst_y_CopyPlane x) serialize (width_CopyPlane x) serialize (height_CopyPlane x) serialize (bit_plane_CopyPlane x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (src_drawable_CopyPlane x) + size (dst_drawable_CopyPlane x) + size (gc_CopyPlane x) + size (src_x_CopyPlane x) + size (src_y_CopyPlane x) + size (dst_x_CopyPlane x) + size (dst_y_CopyPlane x) + size (width_CopyPlane x) + size (height_CopyPlane x) + size (bit_plane_CopyPlane x) data CoordMode = CoordModeOrigin | CoordModePrevious instance SimpleEnum CoordMode where toValue CoordModeOrigin{} = 0 toValue CoordModePrevious{} = 1 fromValue 0 = CoordModeOrigin fromValue 1 = CoordModePrevious data PolyPoint = MkPolyPoint{coordinate_mode_PolyPoint :: Word8, drawable_PolyPoint :: DRAWABLE, gc_PolyPoint :: GCONTEXT, points_PolyPoint :: [POINT]} deriving (Show, Typeable) instance Serialize PolyPoint where serialize x = do putWord8 64 serialize (coordinate_mode_PolyPoint x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (drawable_PolyPoint x) serialize (gc_PolyPoint x) serializeList (points_PolyPoint x) putSkip (requiredPadding (size x)) size x = 3 + size (coordinate_mode_PolyPoint x) + size (drawable_PolyPoint x) + size (gc_PolyPoint x) + sum (map size (points_PolyPoint x)) data PolyLine = MkPolyLine{coordinate_mode_PolyLine :: Word8, drawable_PolyLine :: DRAWABLE, gc_PolyLine :: GCONTEXT, points_PolyLine :: [POINT]} deriving (Show, Typeable) instance Serialize PolyLine where serialize x = do putWord8 65 serialize (coordinate_mode_PolyLine x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (drawable_PolyLine x) serialize (gc_PolyLine x) serializeList (points_PolyLine x) putSkip (requiredPadding (size x)) size x = 3 + size (coordinate_mode_PolyLine x) + size (drawable_PolyLine x) + size (gc_PolyLine x) + sum (map size (points_PolyLine x)) data SEGMENT = MkSEGMENT{x1_SEGMENT :: Int16, y1_SEGMENT :: Int16, x2_SEGMENT :: Int16, y2_SEGMENT :: Int16} deriving (Show, Typeable) instance Serialize SEGMENT where serialize x = do serialize (x1_SEGMENT x) serialize (y1_SEGMENT x) serialize (x2_SEGMENT x) serialize (y2_SEGMENT x) size x = size (x1_SEGMENT x) + size (y1_SEGMENT x) + size (x2_SEGMENT x) + size (y2_SEGMENT x) instance Deserialize SEGMENT where deserialize = do x1 <- deserialize y1 <- deserialize x2 <- deserialize y2 <- deserialize return (MkSEGMENT x1 y1 x2 y2) data PolySegment = MkPolySegment{drawable_PolySegment :: DRAWABLE, gc_PolySegment :: GCONTEXT, segments_PolySegment :: [SEGMENT]} deriving (Show, Typeable) instance Serialize PolySegment where serialize x = do putWord8 66 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (drawable_PolySegment x) serialize (gc_PolySegment x) serializeList (segments_PolySegment x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (drawable_PolySegment x) + size (gc_PolySegment x) + sum (map size (segments_PolySegment x)) data PolyRectangle = MkPolyRectangle{drawable_PolyRectangle :: DRAWABLE, gc_PolyRectangle :: GCONTEXT, rectangles_PolyRectangle :: [RECTANGLE]} deriving (Show, Typeable) instance Serialize PolyRectangle where serialize x = do putWord8 67 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (drawable_PolyRectangle x) serialize (gc_PolyRectangle x) serializeList (rectangles_PolyRectangle x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (drawable_PolyRectangle x) + size (gc_PolyRectangle x) + sum (map size (rectangles_PolyRectangle x)) data PolyArc = MkPolyArc{drawable_PolyArc :: DRAWABLE, gc_PolyArc :: GCONTEXT, arcs_PolyArc :: [ARC]} deriving (Show, Typeable) instance Serialize PolyArc where serialize x = do putWord8 68 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (drawable_PolyArc x) serialize (gc_PolyArc x) serializeList (arcs_PolyArc x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (drawable_PolyArc x) + size (gc_PolyArc x) + sum (map size (arcs_PolyArc x)) data PolyShape = PolyShapeComplex | PolyShapeNonconvex | PolyShapeConvex instance SimpleEnum PolyShape where toValue PolyShapeComplex{} = 0 toValue PolyShapeNonconvex{} = 1 toValue PolyShapeConvex{} = 2 fromValue 0 = PolyShapeComplex fromValue 1 = PolyShapeNonconvex fromValue 2 = PolyShapeConvex data FillPoly = MkFillPoly{drawable_FillPoly :: DRAWABLE, gc_FillPoly :: GCONTEXT, shape_FillPoly :: Word8, coordinate_mode_FillPoly :: Word8, points_FillPoly :: [POINT]} deriving (Show, Typeable) instance Serialize FillPoly where serialize x = do putWord8 69 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (drawable_FillPoly x) serialize (gc_FillPoly x) serialize (shape_FillPoly x) serialize (coordinate_mode_FillPoly x) putSkip 2 serializeList (points_FillPoly x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (drawable_FillPoly x) + size (gc_FillPoly x) + size (shape_FillPoly x) + size (coordinate_mode_FillPoly x) + 2 + sum (map size (points_FillPoly x)) data PolyFillRectangle = MkPolyFillRectangle{drawable_PolyFillRectangle :: DRAWABLE, gc_PolyFillRectangle :: GCONTEXT, rectangles_PolyFillRectangle :: [RECTANGLE]} deriving (Show, Typeable) instance Serialize PolyFillRectangle where serialize x = do putWord8 70 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (drawable_PolyFillRectangle x) serialize (gc_PolyFillRectangle x) serializeList (rectangles_PolyFillRectangle x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (drawable_PolyFillRectangle x) + size (gc_PolyFillRectangle x) + sum (map size (rectangles_PolyFillRectangle x)) data PolyFillArc = MkPolyFillArc{drawable_PolyFillArc :: DRAWABLE, gc_PolyFillArc :: GCONTEXT, arcs_PolyFillArc :: [ARC]} deriving (Show, Typeable) instance Serialize PolyFillArc where serialize x = do putWord8 71 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (drawable_PolyFillArc x) serialize (gc_PolyFillArc x) serializeList (arcs_PolyFillArc x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (drawable_PolyFillArc x) + size (gc_PolyFillArc x) + sum (map size (arcs_PolyFillArc x)) data ImageFormat = ImageFormatXYBitmap | ImageFormatXYPixmap | ImageFormatZPixmap instance SimpleEnum ImageFormat where toValue ImageFormatXYBitmap{} = 0 toValue ImageFormatXYPixmap{} = 1 toValue ImageFormatZPixmap{} = 2 fromValue 0 = ImageFormatXYBitmap fromValue 1 = ImageFormatXYPixmap fromValue 2 = ImageFormatZPixmap data PutImage = MkPutImage{format_PutImage :: Word8, drawable_PutImage :: DRAWABLE, gc_PutImage :: GCONTEXT, width_PutImage :: Word16, height_PutImage :: Word16, dst_x_PutImage :: Int16, dst_y_PutImage :: Int16, left_pad_PutImage :: Word8, depth_PutImage :: Word8, data_PutImage :: [Word8]} deriving (Show, Typeable) instance Serialize PutImage where serialize x = do putWord8 72 serialize (format_PutImage x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (drawable_PutImage x) serialize (gc_PutImage x) serialize (width_PutImage x) serialize (height_PutImage x) serialize (dst_x_PutImage x) serialize (dst_y_PutImage x) serialize (left_pad_PutImage x) serialize (depth_PutImage x) putSkip 2 serializeList (data_PutImage x) putSkip (requiredPadding (size x)) size x = 3 + size (format_PutImage x) + size (drawable_PutImage x) + size (gc_PutImage x) + size (width_PutImage x) + size (height_PutImage x) + size (dst_x_PutImage x) + size (dst_y_PutImage x) + size (left_pad_PutImage x) + size (depth_PutImage x) + 2 + sum (map size (data_PutImage x)) data GetImage = MkGetImage{format_GetImage :: Word8, drawable_GetImage :: DRAWABLE, x_GetImage :: Int16, y_GetImage :: Int16, width_GetImage :: Word16, height_GetImage :: Word16, plane_mask_GetImage :: Word32} deriving (Show, Typeable) instance Serialize GetImage where serialize x = do putWord8 73 serialize (format_GetImage x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (drawable_GetImage x) serialize (x_GetImage x) serialize (y_GetImage x) serialize (width_GetImage x) serialize (height_GetImage x) serialize (plane_mask_GetImage x) putSkip (requiredPadding (size x)) size x = 3 + size (format_GetImage x) + size (drawable_GetImage x) + size (x_GetImage x) + size (y_GetImage x) + size (width_GetImage x) + size (height_GetImage x) + size (plane_mask_GetImage x) data GetImageReply = MkGetImageReply{depth_GetImageReply :: Word8, visual_GetImageReply :: VISUALID, data_GetImageReply :: [Word8]} deriving (Show, Typeable) instance Deserialize GetImageReply where deserialize = do skip 1 depth <- deserialize skip 2 length <- deserialize visual <- deserialize skip 20 data_ <- deserializeList (fromIntegral (fromIntegral (length * 4))) let _ = isCard32 length return (MkGetImageReply depth visual data_) data PolyText8 = MkPolyText8{drawable_PolyText8 :: DRAWABLE, gc_PolyText8 :: GCONTEXT, x_PolyText8 :: Int16, y_PolyText8 :: Int16, items_PolyText8 :: [Word8]} deriving (Show, Typeable) instance Serialize PolyText8 where serialize x = do putWord8 74 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (drawable_PolyText8 x) serialize (gc_PolyText8 x) serialize (x_PolyText8 x) serialize (y_PolyText8 x) serializeList (items_PolyText8 x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (drawable_PolyText8 x) + size (gc_PolyText8 x) + size (x_PolyText8 x) + size (y_PolyText8 x) + sum (map size (items_PolyText8 x)) data PolyText16 = MkPolyText16{drawable_PolyText16 :: DRAWABLE, gc_PolyText16 :: GCONTEXT, x_PolyText16 :: Int16, y_PolyText16 :: Int16, items_PolyText16 :: [Word8]} deriving (Show, Typeable) instance Serialize PolyText16 where serialize x = do putWord8 75 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (drawable_PolyText16 x) serialize (gc_PolyText16 x) serialize (x_PolyText16 x) serialize (y_PolyText16 x) serializeList (items_PolyText16 x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (drawable_PolyText16 x) + size (gc_PolyText16 x) + size (x_PolyText16 x) + size (y_PolyText16 x) + sum (map size (items_PolyText16 x)) data ImageText8 = MkImageText8{string_len_ImageText8 :: Word8, drawable_ImageText8 :: DRAWABLE, gc_ImageText8 :: GCONTEXT, x_ImageText8 :: Int16, y_ImageText8 :: Int16, string_ImageText8 :: [CChar]} deriving (Show, Typeable) instance Serialize ImageText8 where serialize x = do putWord8 76 serialize (string_len_ImageText8 x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (drawable_ImageText8 x) serialize (gc_ImageText8 x) serialize (x_ImageText8 x) serialize (y_ImageText8 x) serializeList (string_ImageText8 x) putSkip (requiredPadding (size x)) size x = 3 + size (string_len_ImageText8 x) + size (drawable_ImageText8 x) + size (gc_ImageText8 x) + size (x_ImageText8 x) + size (y_ImageText8 x) + sum (map size (string_ImageText8 x)) data ImageText16 = MkImageText16{string_len_ImageText16 :: Word8, drawable_ImageText16 :: DRAWABLE, gc_ImageText16 :: GCONTEXT, x_ImageText16 :: Int16, y_ImageText16 :: Int16, string_ImageText16 :: [CHAR2B]} deriving (Show, Typeable) instance Serialize ImageText16 where serialize x = do putWord8 77 serialize (string_len_ImageText16 x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (drawable_ImageText16 x) serialize (gc_ImageText16 x) serialize (x_ImageText16 x) serialize (y_ImageText16 x) serializeList (string_ImageText16 x) putSkip (requiredPadding (size x)) size x = 3 + size (string_len_ImageText16 x) + size (drawable_ImageText16 x) + size (gc_ImageText16 x) + size (x_ImageText16 x) + size (y_ImageText16 x) + sum (map size (string_ImageText16 x)) data ColormapAlloc = ColormapAllocNone | ColormapAllocAll instance SimpleEnum ColormapAlloc where toValue ColormapAllocNone{} = 0 toValue ColormapAllocAll{} = 1 fromValue 0 = ColormapAllocNone fromValue 1 = ColormapAllocAll data CreateColormap = MkCreateColormap{alloc_CreateColormap :: Word8, mid_CreateColormap :: COLORMAP, window_CreateColormap :: WINDOW, visual_CreateColormap :: VISUALID} deriving (Show, Typeable) instance Serialize CreateColormap where serialize x = do putWord8 78 serialize (alloc_CreateColormap x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (mid_CreateColormap x) serialize (window_CreateColormap x) serialize (visual_CreateColormap x) putSkip (requiredPadding (size x)) size x = 3 + size (alloc_CreateColormap x) + size (mid_CreateColormap x) + size (window_CreateColormap x) + size (visual_CreateColormap x) data FreeColormap = MkFreeColormap{cmap_FreeColormap :: COLORMAP} deriving (Show, Typeable) instance Serialize FreeColormap where serialize x = do putWord8 79 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (cmap_FreeColormap x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (cmap_FreeColormap x) data CopyColormapAndFree = MkCopyColormapAndFree{mid_CopyColormapAndFree :: COLORMAP, src_cmap_CopyColormapAndFree :: COLORMAP} deriving (Show, Typeable) instance Serialize CopyColormapAndFree where serialize x = do putWord8 80 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (mid_CopyColormapAndFree x) serialize (src_cmap_CopyColormapAndFree x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (mid_CopyColormapAndFree x) + size (src_cmap_CopyColormapAndFree x) data InstallColormap = MkInstallColormap{cmap_InstallColormap :: COLORMAP} deriving (Show, Typeable) instance Serialize InstallColormap where serialize x = do putWord8 81 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (cmap_InstallColormap x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (cmap_InstallColormap x) data UninstallColormap = MkUninstallColormap{cmap_UninstallColormap :: COLORMAP} deriving (Show, Typeable) instance Serialize UninstallColormap where serialize x = do putWord8 82 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (cmap_UninstallColormap x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (cmap_UninstallColormap x) data ListInstalledColormaps = MkListInstalledColormaps{window_ListInstalledColormaps :: WINDOW} deriving (Show, Typeable) instance Serialize ListInstalledColormaps where serialize x = do putWord8 83 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (window_ListInstalledColormaps x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (window_ListInstalledColormaps x) data ListInstalledColormapsReply = MkListInstalledColormapsReply{cmaps_len_ListInstalledColormapsReply :: Word16, cmaps_ListInstalledColormapsReply :: [COLORMAP]} deriving (Show, Typeable) instance Deserialize ListInstalledColormapsReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize cmaps_len <- deserialize skip 22 cmaps <- deserializeList (fromIntegral cmaps_len) let _ = isCard32 length return (MkListInstalledColormapsReply cmaps_len cmaps) data AllocColor = MkAllocColor{cmap_AllocColor :: COLORMAP, red_AllocColor :: Word16, green_AllocColor :: Word16, blue_AllocColor :: Word16} deriving (Show, Typeable) instance Serialize AllocColor where serialize x = do putWord8 84 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (cmap_AllocColor x) serialize (red_AllocColor x) serialize (green_AllocColor x) serialize (blue_AllocColor x) putSkip 2 putSkip (requiredPadding (size x)) size x = 3 + 1 + size (cmap_AllocColor x) + size (red_AllocColor x) + size (green_AllocColor x) + size (blue_AllocColor x) + 2 data AllocColorReply = MkAllocColorReply{red_AllocColorReply :: Word16, green_AllocColorReply :: Word16, blue_AllocColorReply :: Word16, pixel_AllocColorReply :: Word32} deriving (Show, Typeable) instance Deserialize AllocColorReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize red <- deserialize green <- deserialize blue <- deserialize skip 2 pixel <- deserialize let _ = isCard32 length return (MkAllocColorReply red green blue pixel) data AllocNamedColor = MkAllocNamedColor{cmap_AllocNamedColor :: COLORMAP, name_len_AllocNamedColor :: Word16, name_AllocNamedColor :: [CChar]} deriving (Show, Typeable) instance Serialize AllocNamedColor where serialize x = do putWord8 85 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (cmap_AllocNamedColor x) serialize (name_len_AllocNamedColor x) putSkip 2 serializeList (name_AllocNamedColor x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (cmap_AllocNamedColor x) + size (name_len_AllocNamedColor x) + 2 + sum (map size (name_AllocNamedColor x)) data AllocNamedColorReply = MkAllocNamedColorReply{pixel_AllocNamedColorReply :: Word32, exact_red_AllocNamedColorReply :: Word16, exact_green_AllocNamedColorReply :: Word16, exact_blue_AllocNamedColorReply :: Word16, visual_red_AllocNamedColorReply :: Word16, visual_green_AllocNamedColorReply :: Word16, visual_blue_AllocNamedColorReply :: Word16} deriving (Show, Typeable) instance Deserialize AllocNamedColorReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize pixel <- deserialize exact_red <- deserialize exact_green <- deserialize exact_blue <- deserialize visual_red <- deserialize visual_green <- deserialize visual_blue <- deserialize let _ = isCard32 length return (MkAllocNamedColorReply pixel exact_red exact_green exact_blue visual_red visual_green visual_blue) data AllocColorCells = MkAllocColorCells{contiguous_AllocColorCells :: Bool, cmap_AllocColorCells :: COLORMAP, colors_AllocColorCells :: Word16, planes_AllocColorCells :: Word16} deriving (Show, Typeable) instance Serialize AllocColorCells where serialize x = do putWord8 86 serialize (contiguous_AllocColorCells x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (cmap_AllocColorCells x) serialize (colors_AllocColorCells x) serialize (planes_AllocColorCells x) putSkip (requiredPadding (size x)) size x = 3 + size (contiguous_AllocColorCells x) + size (cmap_AllocColorCells x) + size (colors_AllocColorCells x) + size (planes_AllocColorCells x) data AllocColorCellsReply = MkAllocColorCellsReply{pixels_len_AllocColorCellsReply :: Word16, masks_len_AllocColorCellsReply :: Word16, pixels_AllocColorCellsReply :: [Word32], masks_AllocColorCellsReply :: [Word32]} deriving (Show, Typeable) instance Deserialize AllocColorCellsReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize pixels_len <- deserialize masks_len <- deserialize skip 20 pixels <- deserializeList (fromIntegral pixels_len) masks <- deserializeList (fromIntegral masks_len) let _ = isCard32 length return (MkAllocColorCellsReply pixels_len masks_len pixels masks) data AllocColorPlanes = MkAllocColorPlanes{contiguous_AllocColorPlanes :: Bool, cmap_AllocColorPlanes :: COLORMAP, colors_AllocColorPlanes :: Word16, reds_AllocColorPlanes :: Word16, greens_AllocColorPlanes :: Word16, blues_AllocColorPlanes :: Word16} deriving (Show, Typeable) instance Serialize AllocColorPlanes where serialize x = do putWord8 87 serialize (contiguous_AllocColorPlanes x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (cmap_AllocColorPlanes x) serialize (colors_AllocColorPlanes x) serialize (reds_AllocColorPlanes x) serialize (greens_AllocColorPlanes x) serialize (blues_AllocColorPlanes x) putSkip (requiredPadding (size x)) size x = 3 + size (contiguous_AllocColorPlanes x) + size (cmap_AllocColorPlanes x) + size (colors_AllocColorPlanes x) + size (reds_AllocColorPlanes x) + size (greens_AllocColorPlanes x) + size (blues_AllocColorPlanes x) data AllocColorPlanesReply = MkAllocColorPlanesReply{pixels_len_AllocColorPlanesReply :: Word16, red_mask_AllocColorPlanesReply :: Word32, green_mask_AllocColorPlanesReply :: Word32, blue_mask_AllocColorPlanesReply :: Word32, pixels_AllocColorPlanesReply :: [Word32]} deriving (Show, Typeable) instance Deserialize AllocColorPlanesReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize pixels_len <- deserialize skip 2 red_mask <- deserialize green_mask <- deserialize blue_mask <- deserialize skip 8 pixels <- deserializeList (fromIntegral pixels_len) let _ = isCard32 length return (MkAllocColorPlanesReply pixels_len red_mask green_mask blue_mask pixels) data FreeColors = MkFreeColors{cmap_FreeColors :: COLORMAP, plane_mask_FreeColors :: Word32, pixels_FreeColors :: [Word32]} deriving (Show, Typeable) instance Serialize FreeColors where serialize x = do putWord8 88 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (cmap_FreeColors x) serialize (plane_mask_FreeColors x) serializeList (pixels_FreeColors x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (cmap_FreeColors x) + size (plane_mask_FreeColors x) + sum (map size (pixels_FreeColors x)) data ColorFlag = ColorFlagRed | ColorFlagGreen | ColorFlagBlue instance BitEnum ColorFlag where toBit ColorFlagRed{} = 0 toBit ColorFlagGreen{} = 1 toBit ColorFlagBlue{} = 2 fromBit 0 = ColorFlagRed fromBit 1 = ColorFlagGreen fromBit 2 = ColorFlagBlue data COLORITEM = MkCOLORITEM{pixel_COLORITEM :: Word32, red_COLORITEM :: Word16, green_COLORITEM :: Word16, blue_COLORITEM :: Word16, flags_COLORITEM :: Word8} deriving (Show, Typeable) instance Serialize COLORITEM where serialize x = do serialize (pixel_COLORITEM x) serialize (red_COLORITEM x) serialize (green_COLORITEM x) serialize (blue_COLORITEM x) serialize (flags_COLORITEM x) putSkip 1 size x = size (pixel_COLORITEM x) + size (red_COLORITEM x) + size (green_COLORITEM x) + size (blue_COLORITEM x) + size (flags_COLORITEM x) + 1 instance Deserialize COLORITEM where deserialize = do pixel <- deserialize red <- deserialize green <- deserialize blue <- deserialize flags <- deserialize skip 1 return (MkCOLORITEM pixel red green blue flags) data StoreColors = MkStoreColors{cmap_StoreColors :: COLORMAP, items_StoreColors :: [COLORITEM]} deriving (Show, Typeable) instance Serialize StoreColors where serialize x = do putWord8 89 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (cmap_StoreColors x) serializeList (items_StoreColors x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (cmap_StoreColors x) + sum (map size (items_StoreColors x)) data StoreNamedColor = MkStoreNamedColor{flags_StoreNamedColor :: Word8, cmap_StoreNamedColor :: COLORMAP, pixel_StoreNamedColor :: Word32, name_len_StoreNamedColor :: Word16, name_StoreNamedColor :: [CChar]} deriving (Show, Typeable) instance Serialize StoreNamedColor where serialize x = do putWord8 90 serialize (flags_StoreNamedColor x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (cmap_StoreNamedColor x) serialize (pixel_StoreNamedColor x) serialize (name_len_StoreNamedColor x) putSkip 2 serializeList (name_StoreNamedColor x) putSkip (requiredPadding (size x)) size x = 3 + size (flags_StoreNamedColor x) + size (cmap_StoreNamedColor x) + size (pixel_StoreNamedColor x) + size (name_len_StoreNamedColor x) + 2 + sum (map size (name_StoreNamedColor x)) data RGB = MkRGB{red_RGB :: Word16, green_RGB :: Word16, blue_RGB :: Word16} deriving (Show, Typeable) instance Serialize RGB where serialize x = do serialize (red_RGB x) serialize (green_RGB x) serialize (blue_RGB x) putSkip 2 size x = size (red_RGB x) + size (green_RGB x) + size (blue_RGB x) + 2 instance Deserialize RGB where deserialize = do red <- deserialize green <- deserialize blue <- deserialize skip 2 return (MkRGB red green blue) data QueryColors = MkQueryColors{cmap_QueryColors :: COLORMAP, pixels_QueryColors :: [Word32]} deriving (Show, Typeable) instance Serialize QueryColors where serialize x = do putWord8 91 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (cmap_QueryColors x) serializeList (pixels_QueryColors x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (cmap_QueryColors x) + sum (map size (pixels_QueryColors x)) data QueryColorsReply = MkQueryColorsReply{colors_len_QueryColorsReply :: Word16, colors_QueryColorsReply :: [RGB]} deriving (Show, Typeable) instance Deserialize QueryColorsReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize colors_len <- deserialize skip 22 colors <- deserializeList (fromIntegral colors_len) let _ = isCard32 length return (MkQueryColorsReply colors_len colors) data LookupColor = MkLookupColor{cmap_LookupColor :: COLORMAP, name_len_LookupColor :: Word16, name_LookupColor :: [CChar]} deriving (Show, Typeable) instance Serialize LookupColor where serialize x = do putWord8 92 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (cmap_LookupColor x) serialize (name_len_LookupColor x) putSkip 2 serializeList (name_LookupColor x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (cmap_LookupColor x) + size (name_len_LookupColor x) + 2 + sum (map size (name_LookupColor x)) data LookupColorReply = MkLookupColorReply{exact_red_LookupColorReply :: Word16, exact_green_LookupColorReply :: Word16, exact_blue_LookupColorReply :: Word16, visual_red_LookupColorReply :: Word16, visual_green_LookupColorReply :: Word16, visual_blue_LookupColorReply :: Word16} deriving (Show, Typeable) instance Deserialize LookupColorReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize exact_red <- deserialize exact_green <- deserialize exact_blue <- deserialize visual_red <- deserialize visual_green <- deserialize visual_blue <- deserialize let _ = isCard32 length return (MkLookupColorReply exact_red exact_green exact_blue visual_red visual_green visual_blue) data CreateCursor = MkCreateCursor{cid_CreateCursor :: CURSOR, source_CreateCursor :: PIXMAP, mask_CreateCursor :: PIXMAP, fore_red_CreateCursor :: Word16, fore_green_CreateCursor :: Word16, fore_blue_CreateCursor :: Word16, back_red_CreateCursor :: Word16, back_green_CreateCursor :: Word16, back_blue_CreateCursor :: Word16, x_CreateCursor :: Word16, y_CreateCursor :: Word16} deriving (Show, Typeable) instance Serialize CreateCursor where serialize x = do putWord8 93 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (cid_CreateCursor x) serialize (source_CreateCursor x) serialize (mask_CreateCursor x) serialize (fore_red_CreateCursor x) serialize (fore_green_CreateCursor x) serialize (fore_blue_CreateCursor x) serialize (back_red_CreateCursor x) serialize (back_green_CreateCursor x) serialize (back_blue_CreateCursor x) serialize (x_CreateCursor x) serialize (y_CreateCursor x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (cid_CreateCursor x) + size (source_CreateCursor x) + size (mask_CreateCursor x) + size (fore_red_CreateCursor x) + size (fore_green_CreateCursor x) + size (fore_blue_CreateCursor x) + size (back_red_CreateCursor x) + size (back_green_CreateCursor x) + size (back_blue_CreateCursor x) + size (x_CreateCursor x) + size (y_CreateCursor x) data CreateGlyphCursor = MkCreateGlyphCursor{cid_CreateGlyphCursor :: CURSOR, source_font_CreateGlyphCursor :: FONT, mask_font_CreateGlyphCursor :: FONT, source_char_CreateGlyphCursor :: Word16, mask_char_CreateGlyphCursor :: Word16, fore_red_CreateGlyphCursor :: Word16, fore_green_CreateGlyphCursor :: Word16, fore_blue_CreateGlyphCursor :: Word16, back_red_CreateGlyphCursor :: Word16, back_green_CreateGlyphCursor :: Word16, back_blue_CreateGlyphCursor :: Word16} deriving (Show, Typeable) instance Serialize CreateGlyphCursor where serialize x = do putWord8 94 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (cid_CreateGlyphCursor x) serialize (source_font_CreateGlyphCursor x) serialize (mask_font_CreateGlyphCursor x) serialize (source_char_CreateGlyphCursor x) serialize (mask_char_CreateGlyphCursor x) serialize (fore_red_CreateGlyphCursor x) serialize (fore_green_CreateGlyphCursor x) serialize (fore_blue_CreateGlyphCursor x) serialize (back_red_CreateGlyphCursor x) serialize (back_green_CreateGlyphCursor x) serialize (back_blue_CreateGlyphCursor x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (cid_CreateGlyphCursor x) + size (source_font_CreateGlyphCursor x) + size (mask_font_CreateGlyphCursor x) + size (source_char_CreateGlyphCursor x) + size (mask_char_CreateGlyphCursor x) + size (fore_red_CreateGlyphCursor x) + size (fore_green_CreateGlyphCursor x) + size (fore_blue_CreateGlyphCursor x) + size (back_red_CreateGlyphCursor x) + size (back_green_CreateGlyphCursor x) + size (back_blue_CreateGlyphCursor x) data FreeCursor = MkFreeCursor{cursor_FreeCursor :: CURSOR} deriving (Show, Typeable) instance Serialize FreeCursor where serialize x = do putWord8 95 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (cursor_FreeCursor x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (cursor_FreeCursor x) data RecolorCursor = MkRecolorCursor{cursor_RecolorCursor :: CURSOR, fore_red_RecolorCursor :: Word16, fore_green_RecolorCursor :: Word16, fore_blue_RecolorCursor :: Word16, back_red_RecolorCursor :: Word16, back_green_RecolorCursor :: Word16, back_blue_RecolorCursor :: Word16} deriving (Show, Typeable) instance Serialize RecolorCursor where serialize x = do putWord8 96 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (cursor_RecolorCursor x) serialize (fore_red_RecolorCursor x) serialize (fore_green_RecolorCursor x) serialize (fore_blue_RecolorCursor x) serialize (back_red_RecolorCursor x) serialize (back_green_RecolorCursor x) serialize (back_blue_RecolorCursor x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (cursor_RecolorCursor x) + size (fore_red_RecolorCursor x) + size (fore_green_RecolorCursor x) + size (fore_blue_RecolorCursor x) + size (back_red_RecolorCursor x) + size (back_green_RecolorCursor x) + size (back_blue_RecolorCursor x) data QueryShapeOf = QueryShapeOfLargestCursor | QueryShapeOfFastestTile | QueryShapeOfFastestStipple instance SimpleEnum QueryShapeOf where toValue QueryShapeOfLargestCursor{} = 0 toValue QueryShapeOfFastestTile{} = 1 toValue QueryShapeOfFastestStipple{} = 2 fromValue 0 = QueryShapeOfLargestCursor fromValue 1 = QueryShapeOfFastestTile fromValue 2 = QueryShapeOfFastestStipple data QueryBestSize = MkQueryBestSize{class_QueryBestSize :: Word8, drawable_QueryBestSize :: DRAWABLE, width_QueryBestSize :: Word16, height_QueryBestSize :: Word16} deriving (Show, Typeable) instance Serialize QueryBestSize where serialize x = do putWord8 97 serialize (class_QueryBestSize x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (drawable_QueryBestSize x) serialize (width_QueryBestSize x) serialize (height_QueryBestSize x) putSkip (requiredPadding (size x)) size x = 3 + size (class_QueryBestSize x) + size (drawable_QueryBestSize x) + size (width_QueryBestSize x) + size (height_QueryBestSize x) data QueryBestSizeReply = MkQueryBestSizeReply{width_QueryBestSizeReply :: Word16, height_QueryBestSizeReply :: Word16} deriving (Show, Typeable) instance Deserialize QueryBestSizeReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize width <- deserialize height <- deserialize let _ = isCard32 length return (MkQueryBestSizeReply width height) data QueryExtension = MkQueryExtension{name_len_QueryExtension :: Word16, name_QueryExtension :: [CChar]} deriving (Show, Typeable) instance Serialize QueryExtension where serialize x = do putWord8 98 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (name_len_QueryExtension x) putSkip 2 serializeList (name_QueryExtension x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (name_len_QueryExtension x) + 2 + sum (map size (name_QueryExtension x)) data QueryExtensionReply = MkQueryExtensionReply{present_QueryExtensionReply :: Bool, major_opcode_QueryExtensionReply :: Word8, first_event_QueryExtensionReply :: Word8, first_error_QueryExtensionReply :: Word8} deriving (Show, Typeable) instance Deserialize QueryExtensionReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize present <- deserialize major_opcode <- deserialize first_event <- deserialize first_error <- deserialize let _ = isCard32 length return (MkQueryExtensionReply present major_opcode first_event first_error) data ListExtensions = MkListExtensions{} deriving (Show, Typeable) instance Serialize ListExtensions where serialize x = do putWord8 99 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) putSkip (requiredPadding (size x)) size x = 4 data ListExtensionsReply = MkListExtensionsReply{names_len_ListExtensionsReply :: Word8, names_ListExtensionsReply :: [STR]} deriving (Show, Typeable) instance Deserialize ListExtensionsReply where deserialize = do skip 1 names_len <- deserialize skip 2 length <- deserialize skip 24 names <- deserializeList (fromIntegral names_len) let _ = isCard32 length return (MkListExtensionsReply names_len names) data ChangeKeyboardMapping = MkChangeKeyboardMapping{keycode_count_ChangeKeyboardMapping :: Word8, first_keycode_ChangeKeyboardMapping :: KEYCODE, keysyms_per_keycode_ChangeKeyboardMapping :: Word8, keysyms_ChangeKeyboardMapping :: [KEYSYM]} deriving (Show, Typeable) instance Serialize ChangeKeyboardMapping where serialize x = do putWord8 100 serialize (keycode_count_ChangeKeyboardMapping x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (first_keycode_ChangeKeyboardMapping x) serialize (keysyms_per_keycode_ChangeKeyboardMapping x) serializeList (keysyms_ChangeKeyboardMapping x) putSkip (requiredPadding (size x)) size x = 3 + size (keycode_count_ChangeKeyboardMapping x) + size (first_keycode_ChangeKeyboardMapping x) + size (keysyms_per_keycode_ChangeKeyboardMapping x) + sum (map size (keysyms_ChangeKeyboardMapping x)) data GetKeyboardMapping = MkGetKeyboardMapping{first_keycode_GetKeyboardMapping :: KEYCODE, count_GetKeyboardMapping :: Word8} deriving (Show, Typeable) instance Serialize GetKeyboardMapping where serialize x = do putWord8 101 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (first_keycode_GetKeyboardMapping x) serialize (count_GetKeyboardMapping x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (first_keycode_GetKeyboardMapping x) + size (count_GetKeyboardMapping x) data GetKeyboardMappingReply = MkGetKeyboardMappingReply{keysyms_per_keycode_GetKeyboardMappingReply :: Word8, keysyms_GetKeyboardMappingReply :: [KEYSYM]} deriving (Show, Typeable) instance Deserialize GetKeyboardMappingReply where deserialize = do skip 1 keysyms_per_keycode <- deserialize skip 2 length <- deserialize skip 24 keysyms <- deserializeList (fromIntegral length) let _ = isCard32 length return (MkGetKeyboardMappingReply keysyms_per_keycode keysyms) data KB = KBKeyClickPercent | KBBellPercent | KBBellPitch | KBBellDuration | KBLed | KBLedMode | KBKey | KBAutoRepeatMode instance BitEnum KB where toBit KBKeyClickPercent{} = 0 toBit KBBellPercent{} = 1 toBit KBBellPitch{} = 2 toBit KBBellDuration{} = 3 toBit KBLed{} = 4 toBit KBLedMode{} = 5 toBit KBKey{} = 6 toBit KBAutoRepeatMode{} = 7 fromBit 0 = KBKeyClickPercent fromBit 1 = KBBellPercent fromBit 2 = KBBellPitch fromBit 3 = KBBellDuration fromBit 4 = KBLed fromBit 5 = KBLedMode fromBit 6 = KBKey fromBit 7 = KBAutoRepeatMode data LedMode = LedModeOff | LedModeOn instance SimpleEnum LedMode where toValue LedModeOff{} = 0 toValue LedModeOn{} = 1 fromValue 0 = LedModeOff fromValue 1 = LedModeOn data AutoRepeatMode = AutoRepeatModeOff | AutoRepeatModeOn | AutoRepeatModeDefault instance SimpleEnum AutoRepeatMode where toValue AutoRepeatModeOff{} = 0 toValue AutoRepeatModeOn{} = 1 toValue AutoRepeatModeDefault{} = 2 fromValue 0 = AutoRepeatModeOff fromValue 1 = AutoRepeatModeOn fromValue 2 = AutoRepeatModeDefault data ChangeKeyboardControl = MkChangeKeyboardControl{value_ChangeKeyboardControl :: ValueParam Word32} deriving (Show, Typeable) instance Serialize ChangeKeyboardControl where serialize x = do putWord8 102 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (value_ChangeKeyboardControl x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (value_ChangeKeyboardControl x) data GetKeyboardControl = MkGetKeyboardControl{} deriving (Show, Typeable) instance Serialize GetKeyboardControl where serialize x = do putWord8 103 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) putSkip (requiredPadding (size x)) size x = 4 data GetKeyboardControlReply = MkGetKeyboardControlReply{global_auto_repeat_GetKeyboardControlReply :: Word8, led_mask_GetKeyboardControlReply :: Word32, key_click_percent_GetKeyboardControlReply :: Word8, bell_percent_GetKeyboardControlReply :: Word8, bell_pitch_GetKeyboardControlReply :: Word16, bell_duration_GetKeyboardControlReply :: Word16, auto_repeats_GetKeyboardControlReply :: [Word8]} deriving (Show, Typeable) instance Deserialize GetKeyboardControlReply where deserialize = do skip 1 global_auto_repeat <- deserialize skip 2 length <- deserialize led_mask <- deserialize key_click_percent <- deserialize bell_percent <- deserialize bell_pitch <- deserialize bell_duration <- deserialize skip 2 auto_repeats <- deserializeList (fromIntegral 32) let _ = isCard32 length return (MkGetKeyboardControlReply global_auto_repeat led_mask key_click_percent bell_percent bell_pitch bell_duration auto_repeats) data Bell = MkBell{percent_Bell :: Int8} deriving (Show, Typeable) instance Serialize Bell where serialize x = do putWord8 104 serialize (percent_Bell x) serialize (convertBytesToRequestSize (size x) :: Int16) putSkip (requiredPadding (size x)) size x = 3 + size (percent_Bell x) data ChangePointerControl = MkChangePointerControl{acceleration_numerator_ChangePointerControl :: Int16, acceleration_denominator_ChangePointerControl :: Int16, threshold_ChangePointerControl :: Int16, do_acceleration_ChangePointerControl :: Bool, do_threshold_ChangePointerControl :: Bool} deriving (Show, Typeable) instance Serialize ChangePointerControl where serialize x = do putWord8 105 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (acceleration_numerator_ChangePointerControl x) serialize (acceleration_denominator_ChangePointerControl x) serialize (threshold_ChangePointerControl x) serialize (do_acceleration_ChangePointerControl x) serialize (do_threshold_ChangePointerControl x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (acceleration_numerator_ChangePointerControl x) + size (acceleration_denominator_ChangePointerControl x) + size (threshold_ChangePointerControl x) + size (do_acceleration_ChangePointerControl x) + size (do_threshold_ChangePointerControl x) data GetPointerControl = MkGetPointerControl{} deriving (Show, Typeable) instance Serialize GetPointerControl where serialize x = do putWord8 106 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) putSkip (requiredPadding (size x)) size x = 4 data GetPointerControlReply = MkGetPointerControlReply{acceleration_numerator_GetPointerControlReply :: Word16, acceleration_denominator_GetPointerControlReply :: Word16, threshold_GetPointerControlReply :: Word16} deriving (Show, Typeable) instance Deserialize GetPointerControlReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize acceleration_numerator <- deserialize acceleration_denominator <- deserialize threshold <- deserialize skip 18 let _ = isCard32 length return (MkGetPointerControlReply acceleration_numerator acceleration_denominator threshold) data Blanking = BlankingNotPreferred | BlankingPreferred | BlankingDefault instance SimpleEnum Blanking where toValue BlankingNotPreferred{} = 0 toValue BlankingPreferred{} = 1 toValue BlankingDefault{} = 2 fromValue 0 = BlankingNotPreferred fromValue 1 = BlankingPreferred fromValue 2 = BlankingDefault data Exposures = ExposuresNotAllowed | ExposuresAllowed | ExposuresDefault instance SimpleEnum Exposures where toValue ExposuresNotAllowed{} = 0 toValue ExposuresAllowed{} = 1 toValue ExposuresDefault{} = 2 fromValue 0 = ExposuresNotAllowed fromValue 1 = ExposuresAllowed fromValue 2 = ExposuresDefault data SetScreenSaver = MkSetScreenSaver{timeout_SetScreenSaver :: Int16, interval_SetScreenSaver :: Int16, prefer_blanking_SetScreenSaver :: Word8, allow_exposures_SetScreenSaver :: Word8} deriving (Show, Typeable) instance Serialize SetScreenSaver where serialize x = do putWord8 107 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (timeout_SetScreenSaver x) serialize (interval_SetScreenSaver x) serialize (prefer_blanking_SetScreenSaver x) serialize (allow_exposures_SetScreenSaver x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (timeout_SetScreenSaver x) + size (interval_SetScreenSaver x) + size (prefer_blanking_SetScreenSaver x) + size (allow_exposures_SetScreenSaver x) data GetScreenSaver = MkGetScreenSaver{} deriving (Show, Typeable) instance Serialize GetScreenSaver where serialize x = do putWord8 108 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) putSkip (requiredPadding (size x)) size x = 4 data GetScreenSaverReply = MkGetScreenSaverReply{timeout_GetScreenSaverReply :: Word16, interval_GetScreenSaverReply :: Word16, prefer_blanking_GetScreenSaverReply :: Word8, allow_exposures_GetScreenSaverReply :: Word8} deriving (Show, Typeable) instance Deserialize GetScreenSaverReply where deserialize = do skip 1 skip 1 skip 2 length <- deserialize timeout <- deserialize interval <- deserialize prefer_blanking <- deserialize allow_exposures <- deserialize skip 18 let _ = isCard32 length return (MkGetScreenSaverReply timeout interval prefer_blanking allow_exposures) data HostMode = HostModeInsert | HostModeDelete instance SimpleEnum HostMode where toValue HostModeInsert{} = 0 toValue HostModeDelete{} = 1 fromValue 0 = HostModeInsert fromValue 1 = HostModeDelete data Family = FamilyInternet | FamilyDECnet | FamilyChaos | FamilyServerInterpreted | FamilyInternet6 instance SimpleEnum Family where toValue FamilyInternet{} = 0 toValue FamilyDECnet{} = 1 toValue FamilyChaos{} = 2 toValue FamilyServerInterpreted{} = 5 toValue FamilyInternet6{} = 6 fromValue 0 = FamilyInternet fromValue 1 = FamilyDECnet fromValue 2 = FamilyChaos fromValue 5 = FamilyServerInterpreted fromValue 6 = FamilyInternet6 data ChangeHosts = MkChangeHosts{mode_ChangeHosts :: Word8, family_ChangeHosts :: Word8, address_len_ChangeHosts :: Word16, address_ChangeHosts :: [CChar]} deriving (Show, Typeable) instance Serialize ChangeHosts where serialize x = do putWord8 109 serialize (mode_ChangeHosts x) serialize (convertBytesToRequestSize (size x) :: Int16) serialize (family_ChangeHosts x) putSkip 1 serialize (address_len_ChangeHosts x) serializeList (address_ChangeHosts x) putSkip (requiredPadding (size x)) size x = 3 + size (mode_ChangeHosts x) + size (family_ChangeHosts x) + 1 + size (address_len_ChangeHosts x) + sum (map size (address_ChangeHosts x)) data HOST = MkHOST{family_HOST :: Word8, address_len_HOST :: Word16, address_HOST :: [Word8]} deriving (Show, Typeable) instance Serialize HOST where serialize x = do serialize (family_HOST x) putSkip 1 serialize (address_len_HOST x) serializeList (address_HOST x) size x = size (family_HOST x) + 1 + size (address_len_HOST x) + sum (map size (address_HOST x)) instance Deserialize HOST where deserialize = do family <- deserialize skip 1 address_len <- deserialize address <- deserializeList (fromIntegral address_len) return (MkHOST family address_len address) data ListHosts = MkListHosts{} deriving (Show, Typeable) instance Serialize ListHosts where serialize x = do putWord8 110 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) putSkip (requiredPadding (size x)) size x = 4 data ListHostsReply = MkListHostsReply{mode_ListHostsReply :: Word8, hosts_len_ListHostsReply :: Word16, hosts_ListHostsReply :: [HOST]} deriving (Show, Typeable) instance Deserialize ListHostsReply where deserialize = do skip 1 mode <- deserialize skip 2 length <- deserialize hosts_len <- deserialize skip 22 hosts <- deserializeList (fromIntegral hosts_len) let _ = isCard32 length return (MkListHostsReply mode hosts_len hosts) data AccessControl = AccessControlDisable | AccessControlEnable instance SimpleEnum AccessControl where toValue AccessControlDisable{} = 0 toValue AccessControlEnable{} = 1 fromValue 0 = AccessControlDisable fromValue 1 = AccessControlEnable data SetAccessControl = MkSetAccessControl{mode_SetAccessControl :: Word8} deriving (Show, Typeable) instance Serialize SetAccessControl where serialize x = do putWord8 111 serialize (mode_SetAccessControl x) serialize (convertBytesToRequestSize (size x) :: Int16) putSkip (requiredPadding (size x)) size x = 3 + size (mode_SetAccessControl x) data CloseDown = CloseDownDestroyAll | CloseDownRetainPermanent | CloseDownRetainTemporary instance SimpleEnum CloseDown where toValue CloseDownDestroyAll{} = 0 toValue CloseDownRetainPermanent{} = 1 toValue CloseDownRetainTemporary{} = 2 fromValue 0 = CloseDownDestroyAll fromValue 1 = CloseDownRetainPermanent fromValue 2 = CloseDownRetainTemporary data SetCloseDownMode = MkSetCloseDownMode{mode_SetCloseDownMode :: Word8} deriving (Show, Typeable) instance Serialize SetCloseDownMode where serialize x = do putWord8 112 serialize (mode_SetCloseDownMode x) serialize (convertBytesToRequestSize (size x) :: Int16) putSkip (requiredPadding (size x)) size x = 3 + size (mode_SetCloseDownMode x) data Kill = KillAllTemporary instance SimpleEnum Kill where toValue KillAllTemporary{} = 0 fromValue 0 = KillAllTemporary data KillClient = MkKillClient{resource_KillClient :: Word32} deriving (Show, Typeable) instance Serialize KillClient where serialize x = do putWord8 113 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (resource_KillClient x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (resource_KillClient x) data RotateProperties = MkRotateProperties{window_RotateProperties :: WINDOW, atoms_len_RotateProperties :: Word16, delta_RotateProperties :: Int16, atoms_RotateProperties :: [ATOM]} deriving (Show, Typeable) instance Serialize RotateProperties where serialize x = do putWord8 114 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) serialize (window_RotateProperties x) serialize (atoms_len_RotateProperties x) serialize (delta_RotateProperties x) serializeList (atoms_RotateProperties x) putSkip (requiredPadding (size x)) size x = 3 + 1 + size (window_RotateProperties x) + size (atoms_len_RotateProperties x) + size (delta_RotateProperties x) + sum (map size (atoms_RotateProperties x)) data ScreenSaver = ScreenSaverReset | ScreenSaverActive instance SimpleEnum ScreenSaver where toValue ScreenSaverReset{} = 0 toValue ScreenSaverActive{} = 1 fromValue 0 = ScreenSaverReset fromValue 1 = ScreenSaverActive data ForceScreenSaver = MkForceScreenSaver{mode_ForceScreenSaver :: Word8} deriving (Show, Typeable) instance Serialize ForceScreenSaver where serialize x = do putWord8 115 serialize (mode_ForceScreenSaver x) serialize (convertBytesToRequestSize (size x) :: Int16) putSkip (requiredPadding (size x)) size x = 3 + size (mode_ForceScreenSaver x) data MappingStatus = MappingStatusSuccess | MappingStatusBusy | MappingStatusFailure instance SimpleEnum MappingStatus where toValue MappingStatusSuccess{} = 0 toValue MappingStatusBusy{} = 1 toValue MappingStatusFailure{} = 2 fromValue 0 = MappingStatusSuccess fromValue 1 = MappingStatusBusy fromValue 2 = MappingStatusFailure data SetPointerMapping = MkSetPointerMapping{map_len_SetPointerMapping :: Word8, map_SetPointerMapping :: [Word8]} deriving (Show, Typeable) instance Serialize SetPointerMapping where serialize x = do putWord8 116 serialize (map_len_SetPointerMapping x) serialize (convertBytesToRequestSize (size x) :: Int16) serializeList (map_SetPointerMapping x) putSkip (requiredPadding (size x)) size x = 3 + size (map_len_SetPointerMapping x) + sum (map size (map_SetPointerMapping x)) data SetPointerMappingReply = MkSetPointerMappingReply{status_SetPointerMappingReply :: Word8} deriving (Show, Typeable) instance Deserialize SetPointerMappingReply where deserialize = do skip 1 status <- deserialize skip 2 length <- deserialize let _ = isCard32 length return (MkSetPointerMappingReply status) data GetPointerMapping = MkGetPointerMapping{} deriving (Show, Typeable) instance Serialize GetPointerMapping where serialize x = do putWord8 117 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) putSkip (requiredPadding (size x)) size x = 4 data GetPointerMappingReply = MkGetPointerMappingReply{map_len_GetPointerMappingReply :: Word8, map_GetPointerMappingReply :: [Word8]} deriving (Show, Typeable) instance Deserialize GetPointerMappingReply where deserialize = do skip 1 map_len <- deserialize skip 2 length <- deserialize skip 24 map <- deserializeList (fromIntegral map_len) let _ = isCard32 length return (MkGetPointerMappingReply map_len map) data MapIndex = MapIndexShift | MapIndexLock | MapIndexControl | MapIndex1 | MapIndex2 | MapIndex3 | MapIndex4 | MapIndex5 instance SimpleEnum MapIndex where toValue MapIndexShift{} = 0 toValue MapIndexLock{} = 1 toValue MapIndexControl{} = 2 toValue MapIndex1{} = 3 toValue MapIndex2{} = 4 toValue MapIndex3{} = 5 toValue MapIndex4{} = 6 toValue MapIndex5{} = 7 fromValue 0 = MapIndexShift fromValue 1 = MapIndexLock fromValue 2 = MapIndexControl fromValue 3 = MapIndex1 fromValue 4 = MapIndex2 fromValue 5 = MapIndex3 fromValue 6 = MapIndex4 fromValue 7 = MapIndex5 data SetModifierMapping = MkSetModifierMapping{keycodes_per_modifier_SetModifierMapping :: Word8, keycodes_SetModifierMapping :: [KEYCODE]} deriving (Show, Typeable) instance Serialize SetModifierMapping where serialize x = do putWord8 118 serialize (keycodes_per_modifier_SetModifierMapping x) serialize (convertBytesToRequestSize (size x) :: Int16) serializeList (keycodes_SetModifierMapping x) putSkip (requiredPadding (size x)) size x = 3 + size (keycodes_per_modifier_SetModifierMapping x) + sum (map size (keycodes_SetModifierMapping x)) data SetModifierMappingReply = MkSetModifierMappingReply{status_SetModifierMappingReply :: Word8} deriving (Show, Typeable) instance Deserialize SetModifierMappingReply where deserialize = do skip 1 status <- deserialize skip 2 length <- deserialize let _ = isCard32 length return (MkSetModifierMappingReply status) data GetModifierMapping = MkGetModifierMapping{} deriving (Show, Typeable) instance Serialize GetModifierMapping where serialize x = do putWord8 119 putSkip 1 serialize (convertBytesToRequestSize (size x) :: Int16) putSkip (requiredPadding (size x)) size x = 4 data GetModifierMappingReply = MkGetModifierMappingReply{keycodes_per_modifier_GetModifierMappingReply :: Word8, keycodes_GetModifierMappingReply :: [KEYCODE]} deriving (Show, Typeable) instance Deserialize GetModifierMappingReply where deserialize = do skip 1 keycodes_per_modifier <- deserialize skip 2 length <- deserialize skip 24 keycodes <- deserializeList (fromIntegral (fromIntegral (keycodes_per_modifier * 8))) let _ = isCard32 length return (MkGetModifierMappingReply keycodes_per_modifier keycodes)