From 2ae89a5e3348fbe94b50a985de9766689c22d011 Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <mschiffer@universe-factory.net>
Date: Fri, 9 Sep 2011 03:20:16 +0200
Subject: SystrayHelper: initialization

---
 lib/Phi/X11/Util.hs | 39 ++++++++++++++++++++++++++++++++++++++-
 1 file changed, 38 insertions(+), 1 deletion(-)

(limited to 'lib/Phi/X11/Util.hs')

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
-- 
cgit v1.2.3