module QueryPointer(queryPointerK) where
import Command
import Event
--import Font(FontStruct)
--import Fudget
--import Geometry(Line, Point, Rect, Size(..))
--import LayoutRequest(LayoutRequest)
import Xrequest
--import Xtypes

queryPointerK :: Cont (K b c) (Bool, Point, Point, ModState)
queryPointerK =
    let f :: XResponse -> Maybe (Bool, Point, Point, ModState)
f (PointerQueried Bool
s Point
r Point
w ModState
m) = (Bool, Point, Point, ModState)
-> Maybe (Bool, Point, Point, ModState)
forall a. a -> Maybe a
Just (Bool
s, Point
r, Point
w, ModState
m)
        f XResponse
_ = Maybe (Bool, Point, Point, ModState)
forall a. Maybe a
Nothing
    in  XRequest
-> (XResponse -> Maybe (Bool, Point, Point, ModState))
-> Cont (K b c) (Bool, Point, Point, ModState)
forall a b c. XRequest -> (XResponse -> Maybe a) -> Cont (K b c) a
xrequestK XRequest
QueryPointer XResponse -> Maybe (Bool, Point, Point, ModState)
f