Test.hs

module Graphics.XHB.Gen.Test
       (extension, getVersion, compareCursor, fakeInput, grabControl,
        module Graphics.XHB.Gen.Test.Types)
       where
import Graphics.XHB.Gen.Test.Types
import Graphics.XHB.Connection.Internal
import Graphics.XHB.Connection.Extension
import Graphics.XHB.Connection.Types
import Control.Concurrent.STM
import Foreign.C.Types
import Data.Binary.Put (runPut)
import Graphics.XHB.Shared hiding (Event(..), Error(..))
import Graphics.XHB.Gen.Xproto.Types
       hiding (Cursor(..), deserializeError, deserializeEvent)
import qualified Graphics.XHB.Gen.Xproto.Types
 
extension :: ExtensionId
extension = "XTEST"
 
getVersion ::
             Graphics.XHB.Connection.Types.Connection ->
               CARD8 -> CARD16 -> IO (Receipt GetVersionReply)
getVersion c major_version minor_version
  = do receipt <- newEmptyReceiptIO
       let req = MkGetVersion major_version minor_version
       putAction <- serializeExtensionRequest c req
       let chunk = runPut putAction
       sendRequestWithReply c chunk receipt
       return receipt
 
compareCursor ::
                Graphics.XHB.Connection.Types.Connection ->
                  WINDOW -> CURSOR -> IO (Receipt CompareCursorReply)
compareCursor c window cursor
  = do receipt <- newEmptyReceiptIO
       let req = MkCompareCursor window cursor
       putAction <- serializeExtensionRequest c req
       let chunk = runPut putAction
       sendRequestWithReply c chunk receipt
       return receipt
 
fakeInput ::
            Graphics.XHB.Connection.Types.Connection -> FakeInput -> IO ()
fakeInput c req
  = do putAction <- serializeExtensionRequest c req
       let chunk = runPut putAction
       sendRequest c chunk
 
grabControl ::
              Graphics.XHB.Connection.Types.Connection -> BOOL -> IO ()
grabControl c impervious
  = do let req = MkGrabControl impervious
       putAction <- serializeExtensionRequest c req
       let chunk = runPut putAction
       sendRequest c chunk