module Cursor where
import Command
import Event
import Fudget
import Xrequest
import Xcommand
import Xtypes

createFontCursor :: Int -> Cont (K b c) CursorId
createFontCursor Int
shape =
    let cmd :: XRequest
cmd = Int -> XRequest
CreateFontCursor Int
shape
        expected :: XResponse -> Maybe CursorId
expected (CursorCreated CursorId
cursor) = forall a. a -> Maybe a
Just CursorId
cursor
        expected XResponse
_ = forall a. Maybe a
Nothing
    in  forall {a} {b} {c}.
XRequest -> (XResponse -> Maybe a) -> Cont (K b c) a
xrequestK XRequest
cmd XResponse -> Maybe CursorId
expected

setFontCursor :: Int -> K a b -> K a b
setFontCursor :: forall a b. Int -> K a b -> K a b
setFontCursor Int
shape K a b
process =
    forall {b} {c}. Int -> Cont (K b c) CursorId
createFontCursor Int
shape forall a b. (a -> b) -> a -> b
$ \ CursorId
cursor ->
    forall {i} {o}. XCommand -> K i o -> K i o
xcommandK ([WindowAttributes] -> XCommand
ChangeWindowAttributes [CursorId -> WindowAttributes
CWCursor CursorId
cursor]) forall a b. (a -> b) -> a -> b
$
    K a b
process

defineCursor :: CursorId -> K i o -> K i o
defineCursor CursorId
cursor = forall {i} {o}. XCommand -> K i o -> K i o
xcommandK ([WindowAttributes] -> XCommand
ChangeWindowAttributes [CursorId -> WindowAttributes
CWCursor CursorId
cursor])
undefineCusror :: K i o -> K i o
undefineCusror = forall {i} {o}. XCommand -> K i o -> K i o
xcommandK ([WindowAttributes] -> XCommand
ChangeWindowAttributes [CursorId -> WindowAttributes
CWCursor CursorId
cursorNone])