neocturne/phi
Archived
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Use XCB backend

Browse source
This commit is contained in:
Matthias Schiffer 2011-10-10 23:22:59 +02:00
parent 456f9fb6e6
commit 33cd402ae9
10 changed files with 80 additions and 131 deletions
Download patch file Download diff file Expand all files Collapse all files

7
lib/Phi/X11/AtomList.hs
View file

@ -6,8 +6,7 @@ module Phi.X11.AtomList ( atoms
import Language.Haskell.TH
import Graphics.XHB.Connection
import Graphics.XHB.Connection.Open
import Graphics.XHB
atoms :: [String]
atoms = [ "ATOM"
@ -51,7 +50,7 @@ atoms = [ "ATOM"
, "_XROOTMAP_ID"
]
-- the expression must have the type (Connection -> String)
-- the expression must have the type (ConnectionClass c => c -> String)
specialAtoms :: [(String, Q Exp)]
specialAtoms = [ ("_NET_SYSTEM_TRAY_SCREEN", [|("_NET_SYSTEM_TRAY_S" ++) . show . screen . displayInfo|])
specialAtoms = [ ("_NET_SYSTEM_TRAY_SCREEN", [|("_NET_SYSTEM_TRAY_S" ++) . show . connectionScreen|])
]

3
lib/Phi/X11/Atoms.hs
View file

@ -10,7 +10,6 @@ import Data.List
import Language.Haskell.TH
import Graphics.XHB
import Graphics.XHB.Connection
import Graphics.XHB.Gen.Xproto
import Phi.X11.AtomList
@ -22,7 +21,7 @@ $(let atomsName = mkName "Atoms"
in return [DataD [] atomsName [] [RecC atomsName fields] []]
)
initAtoms :: Connection -> IO Atoms
initAtoms :: ConnectionClass c => c -> IO Atoms
initAtoms conn =
$(do
normalAtomNames <- mapM (\atom -> do

16
lib/Phi/X11/Util.hs
View file

@ -29,7 +29,7 @@ import Graphics.XHB.Gen.Xproto
import System.IO.Unsafe
getReply' :: ConnectionClass c r => String -> r a -> IO a
getReply' :: String -> Receipt a -> IO a
getReply' m = getReply >=> return . fromRight
where
fromRight (Left _) = error m
@ -60,17 +60,17 @@ castToCChar input = unsafePerformIO $
with input $ \ptr ->
peekArray (sizeOf input) (castPtr ptr)
changeProperty8 :: ConnectionClass c r => c -> PropMode -> WINDOW -> ATOM -> ATOM -> [Word8] -> IO ()
changeProperty8 :: ConnectionClass c => c -> PropMode -> WINDOW -> ATOM -> ATOM -> [Word8] -> IO ()
changeProperty8 conn mode win prop proptype propdata = changeProperty conn $ MkChangeProperty mode win prop proptype 8 (genericLength propdata) propdata
changeProperty16 :: ConnectionClass c r => c -> PropMode -> WINDOW -> ATOM -> ATOM -> [Word16] -> IO ()
changeProperty16 :: ConnectionClass c => c -> PropMode -> WINDOW -> ATOM -> ATOM -> [Word16] -> IO ()
changeProperty16 conn mode win prop proptype propdata = changeProperty conn $ MkChangeProperty mode win prop proptype 16 (genericLength propdata) (castWord16to8 propdata)
changeProperty32 :: ConnectionClass c r => c -> PropMode -> WINDOW -> ATOM -> ATOM -> [Word32] -> IO ()
changeProperty32 :: ConnectionClass c => c -> PropMode -> WINDOW -> ATOM -> ATOM -> [Word32] -> IO ()
changeProperty32 conn mode win prop proptype propdata = changeProperty conn $ MkChangeProperty mode win prop proptype 32 (genericLength propdata) (castWord32to8 propdata)
getProperty' :: ConnectionClass c r => Word8 -> c -> WINDOW -> ATOM -> IO (Maybe [Word8])
getProperty' :: ConnectionClass c => Word8 -> c -> WINDOW -> ATOM -> IO (Maybe [Word8])
getProperty' format conn win prop = do
reply <- getProperty conn (MkGetProperty False win prop (fromXid xidNone) 0 4) >>= getReply
case reply of
@ -84,13 +84,13 @@ getProperty' format conn win prop = do
Right (MkGetPropertyReply {format_GetPropertyReply = format'}) | format' /= format -> return Nothing
Right (MkGetPropertyReply {value_GetPropertyReply = value}) -> return $ Just value
getProperty8 :: ConnectionClass c r => c -> WINDOW -> ATOM -> IO (Maybe [Word8])
getProperty8 :: ConnectionClass c => c -> WINDOW -> ATOM -> IO (Maybe [Word8])
getProperty8 = getProperty' 8
getProperty16 :: ConnectionClass c r => c -> WINDOW -> ATOM -> IO (Maybe [Word16])
getProperty16 :: ConnectionClass c => c -> WINDOW -> ATOM -> IO (Maybe [Word16])
getProperty16 conn win prop = getProperty' 16 conn win prop >>= return . fmap castWord8to16
getProperty32 :: ConnectionClass c r => c -> WINDOW -> ATOM -> IO (Maybe [Word32])
getProperty32 :: ConnectionClass c => c -> WINDOW -> ATOM -> IO (Maybe [Word32])
getProperty32 conn win prop = getProperty' 32 conn win prop >>= return . fmap castWord8to32