module TransCoord where
import Command
import Event
import Fudget
import FRequest
import Geometry(Point)
import Xrequest
import Cont(cmdContK)
import Xtypes

getWindowRootPoint :: Cont (K a b) Point
getWindowRootPoint :: Cont (K a b) Point
getWindowRootPoint =
    let cmd :: XRequest
cmd = XRequest
TranslateCoordinates
        expected :: XResponse -> Maybe Point
expected (CoordinatesTranslated Point
p) = Point -> Maybe Point
forall a. a -> Maybe a
Just Point
p
        expected XResponse
_ = Maybe Point
forall a. Maybe a
Nothing
    in  XRequest -> (XResponse -> Maybe Point) -> Cont (K a b) Point
forall a b c. XRequest -> (XResponse -> Maybe a) -> Cont (K b c) a
xrequestK XRequest
cmd XResponse -> Maybe Point
expected


getWindowId :: Cont (K a b) Window
getWindowId :: Cont (K a b) Window
getWindowId = FRequest -> (FResponse -> Maybe Window) -> Cont (K a b) Window
forall a b c. FRequest -> (FResponse -> Maybe a) -> Cont (K b c) a
cmdContK (XCommand -> FRequest
XCmd XCommand
GetWindowId)
	      (\FResponse
r->case FResponse
r of XEvt (YourWindowId Window
w) -> Window -> Maybe Window
forall a. a -> Maybe a
Just Window
w; FResponse
_ -> Maybe Window
forall a. Maybe a
Nothing)

-- Why is GetWindowId an XCommand?