SystrayHelper: initialization

This commit is contained in:
Matthias Schiffer 2011-09-09 03:20:16 +02:00
parent 4d519acbd4
commit 2ae89a5e33
7 changed files with 123 additions and 17 deletions

View file

@ -13,6 +13,7 @@ atoms :: [String]
atoms = [ "ATOM"
, "CARDINAL"
, "STRING"
, "VISUALID"
, "UTF8_STRING"
, "WM_NAME"
, "WM_CLASS"

View file

@ -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
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