diff options
Diffstat (limited to 'lib/Phi/X11/Util.hs')
| -rw-r--r-- | lib/Phi/X11/Util.hs | 39 |
1 files changed, 38 insertions, 1 deletions
diff --git a/lib/Phi/X11/Util.hs b/lib/Phi/X11/Util.hs index cadceeb..a86cafd 100644 --- a/lib/Phi/X11/Util.hs +++ b/lib/Phi/X11/Util.hs @@ -6,8 +6,10 @@ module Phi.X11.Util ( getReply' , getProperty16 , getProperty32 , findVisualtype + , serializeClientMessage ) where +import Control.Exception (assert) import Control.Monad import Data.Int @@ -15,8 +17,11 @@ import Data.List import Data.Maybe import Data.Word +import Foreign.C.Types import Foreign.Marshal.Array +import Foreign.Marshal.Utils import Foreign.Ptr +import Foreign.Storable import Graphics.XHB import Graphics.XHB.Gen.Xproto @@ -50,6 +55,10 @@ castWord8to32 input = unsafePerformIO $ withArray input $ \ptr -> peekArray (length input `div` 4) (castPtr ptr) +castToCChar :: Storable s => s -> [CChar] +castToCChar input = unsafePerformIO $ + with input $ \ptr -> + peekArray (sizeOf input) (castPtr ptr) changeProperty8 :: Connection -> PropMode -> WINDOW -> ATOM -> ATOM -> [Word8] -> IO () changeProperty8 conn mode win prop proptype propdata = changeProperty conn $ MkChangeProperty mode win prop proptype 8 (genericLength propdata) propdata @@ -86,4 +95,32 @@ getProperty32 conn win prop = getProperty' 32 conn win prop >>= return . fmap ca findVisualtype :: SCREEN -> VISUALID -> Maybe VISUALTYPE -findVisualtype screen id = listToMaybe . filter ((== id) . visual_id_VISUALTYPE) . join . map visuals_DEPTH . allowed_depths_SCREEN $ screen
\ No newline at end of file +findVisualtype screen id = listToMaybe . filter ((== id) . visual_id_VISUALTYPE) . join . map visuals_DEPTH . allowed_depths_SCREEN $ screen + + +instance Storable ClientMessageData where + sizeOf _ = 20 + alignment _ = 1 + peek _ = error "ClientMessageData: peek not implemented" + poke ptr (ClientData8 d) = assert (length d == 20) $ pokeArray (castPtr ptr) d + poke ptr (ClientData16 d) = assert (length d == 10) $ pokeArray (castPtr ptr) d + poke ptr (ClientData32 d) = assert (length d == 5) $ pokeArray (castPtr ptr) d + +instance Storable ClientMessageEvent where + sizeOf _ = 32 + alignment _ = 1 + peek _ = error "ClientMessageEvent: peek not implemented" + poke ptr ev = do + poke' 0 (33 :: Word8) -- ClientMessage == 33 -- response_type + poke' 1 (format_ClientMessageEvent ev) -- format + poke' 2 (0 :: Word16) -- sequence + poke' 4 (fromXid . toXid . window_ClientMessageEvent $ ev :: Word32) -- window + poke' 8 (fromXid . toXid . type_ClientMessageEvent $ ev :: Word32) -- type + poke' 12 (data_ClientMessageEvent ev) -- data + where + poke' :: Storable s => Int -> s -> IO () + poke' = poke . plusPtr ptr + + +serializeClientMessage :: ClientMessageEvent -> [CChar] +serializeClientMessage = castToCChar |