SystrayHelper: initialization
This commit is contained in:
parent
4d519acbd4
commit
2ae89a5e33
7 changed files with 123 additions and 17 deletions
|
@ -13,6 +13,7 @@ atoms :: [String]
|
|||
atoms = [ "ATOM"
|
||||
, "CARDINAL"
|
||||
, "STRING"
|
||||
, "VISUALID"
|
||||
, "UTF8_STRING"
|
||||
, "WM_NAME"
|
||||
, "WM_CLASS"
|
||||
|
|
|
@ -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
|
||||
|
|
Reference in a new issue