{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
module SDL.Event
(
pollEvent
, pollEvents
, mapEvents
, pumpEvents
, waitEvent
, waitEventTimeout
, RegisteredEventType(..)
, RegisteredEventData(..)
, EventPushResult(..)
, emptyRegisteredEvent
, registerEvent
, EventWatchCallback
, EventWatch
, addEventWatch
, delEventWatch
, Event(..)
, Timestamp
, EventPayload(..)
, WindowShownEventData(..)
, WindowHiddenEventData(..)
, WindowExposedEventData(..)
, WindowMovedEventData(..)
, WindowResizedEventData(..)
, WindowSizeChangedEventData(..)
, WindowMinimizedEventData(..)
, WindowMaximizedEventData(..)
, WindowRestoredEventData(..)
, WindowGainedMouseFocusEventData(..)
, WindowLostMouseFocusEventData(..)
, WindowGainedKeyboardFocusEventData(..)
, WindowLostKeyboardFocusEventData(..)
, WindowClosedEventData(..)
, SysWMEventData(..)
, KeyboardEventData(..)
, TextEditingEventData(..)
, TextInputEventData(..)
, MouseMotionEventData(..)
, MouseButtonEventData(..)
, MouseWheelEventData(..)
, JoyAxisEventData(..)
, JoyBallEventData(..)
, JoyHatEventData(..)
, JoyButtonEventData(..)
, JoyDeviceEventData(..)
, ControllerAxisEventData(..)
, ControllerButtonEventData(..)
, ControllerDeviceEventData(..)
, AudioDeviceEventData(..)
, UserEventData(..)
, TouchFingerEventData(..)
, TouchFingerMotionEventData(..)
, MultiGestureEventData(..)
, DollarGestureEventData(..)
, DropEventData(..)
, UnknownEventData(..)
, InputMotion(..)
, MouseButton(..)
) where
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Data (Data)
import Data.Maybe (catMaybes)
import Data.Text (Text)
import Data.Typeable
import Foreign hiding (throwIfNeg_)
import Foreign.C
import GHC.Generics (Generic)
import SDL.Vect
import SDL.Input.Joystick
import SDL.Input.GameController
import SDL.Input.Keyboard
import SDL.Input.Mouse
import SDL.Internal.Exception
import SDL.Internal.Numbered
import SDL.Internal.Types (Window(Window))
import qualified Data.ByteString.Char8 as BSC8
import qualified Data.Text.Encoding as Text
import qualified SDL.Raw as Raw
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
data Event = Event
{ Event -> Word32
eventTimestamp :: Timestamp
, Event -> EventPayload
eventPayload :: EventPayload
} deriving (Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
/= :: Event -> Event -> Bool
Eq, Eq Event
Eq Event =>
(Event -> Event -> Ordering)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Event)
-> (Event -> Event -> Event)
-> Ord Event
Event -> Event -> Bool
Event -> Event -> Ordering
Event -> Event -> Event
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Event -> Event -> Ordering
compare :: Event -> Event -> Ordering
$c< :: Event -> Event -> Bool
< :: Event -> Event -> Bool
$c<= :: Event -> Event -> Bool
<= :: Event -> Event -> Bool
$c> :: Event -> Event -> Bool
> :: Event -> Event -> Bool
$c>= :: Event -> Event -> Bool
>= :: Event -> Event -> Bool
$cmax :: Event -> Event -> Event
max :: Event -> Event -> Event
$cmin :: Event -> Event -> Event
min :: Event -> Event -> Event
Ord, (forall x. Event -> Rep Event x)
-> (forall x. Rep Event x -> Event) -> Generic Event
forall x. Rep Event x -> Event
forall x. Event -> Rep Event x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Event -> Rep Event x
from :: forall x. Event -> Rep Event x
$cto :: forall x. Rep Event x -> Event
to :: forall x. Rep Event x -> Event
Generic, Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Event -> ShowS
showsPrec :: Int -> Event -> ShowS
$cshow :: Event -> String
show :: Event -> String
$cshowList :: [Event] -> ShowS
showList :: [Event] -> ShowS
Show, Typeable)
type Timestamp = Word32
data EventPayload
= WindowShownEvent !WindowShownEventData
| WindowHiddenEvent !WindowHiddenEventData
| WindowExposedEvent !WindowExposedEventData
| WindowMovedEvent !WindowMovedEventData
| WindowResizedEvent !WindowResizedEventData
| WindowSizeChangedEvent !WindowSizeChangedEventData
| WindowMinimizedEvent !WindowMinimizedEventData
| WindowMaximizedEvent !WindowMaximizedEventData
| WindowRestoredEvent !WindowRestoredEventData
| WindowGainedMouseFocusEvent !WindowGainedMouseFocusEventData
| WindowLostMouseFocusEvent !WindowLostMouseFocusEventData
| WindowGainedKeyboardFocusEvent !WindowGainedKeyboardFocusEventData
| WindowLostKeyboardFocusEvent !WindowLostKeyboardFocusEventData
| WindowClosedEvent !WindowClosedEventData
| KeyboardEvent !KeyboardEventData
| TextEditingEvent !TextEditingEventData
| TextInputEvent !TextInputEventData
| KeymapChangedEvent
| MouseMotionEvent !MouseMotionEventData
| MouseButtonEvent !MouseButtonEventData
| MouseWheelEvent !MouseWheelEventData
| JoyAxisEvent !JoyAxisEventData
| JoyBallEvent !JoyBallEventData
| JoyHatEvent !JoyHatEventData
| JoyButtonEvent !JoyButtonEventData
| JoyDeviceEvent !JoyDeviceEventData
| ControllerAxisEvent !ControllerAxisEventData
| ControllerButtonEvent !ControllerButtonEventData
| ControllerDeviceEvent !ControllerDeviceEventData
| AudioDeviceEvent !AudioDeviceEventData
| QuitEvent
| UserEvent !UserEventData
| SysWMEvent !SysWMEventData
| TouchFingerEvent !TouchFingerEventData
| TouchFingerMotionEvent !TouchFingerMotionEventData
| MultiGestureEvent !MultiGestureEventData
| DollarGestureEvent !DollarGestureEventData
| DropEvent !DropEventData
| ClipboardUpdateEvent
| UnknownEvent !UnknownEventData
deriving (EventPayload -> EventPayload -> Bool
(EventPayload -> EventPayload -> Bool)
-> (EventPayload -> EventPayload -> Bool) -> Eq EventPayload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EventPayload -> EventPayload -> Bool
== :: EventPayload -> EventPayload -> Bool
$c/= :: EventPayload -> EventPayload -> Bool
/= :: EventPayload -> EventPayload -> Bool
Eq, Eq EventPayload
Eq EventPayload =>
(EventPayload -> EventPayload -> Ordering)
-> (EventPayload -> EventPayload -> Bool)
-> (EventPayload -> EventPayload -> Bool)
-> (EventPayload -> EventPayload -> Bool)
-> (EventPayload -> EventPayload -> Bool)
-> (EventPayload -> EventPayload -> EventPayload)
-> (EventPayload -> EventPayload -> EventPayload)
-> Ord EventPayload
EventPayload -> EventPayload -> Bool
EventPayload -> EventPayload -> Ordering
EventPayload -> EventPayload -> EventPayload
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EventPayload -> EventPayload -> Ordering
compare :: EventPayload -> EventPayload -> Ordering
$c< :: EventPayload -> EventPayload -> Bool
< :: EventPayload -> EventPayload -> Bool
$c<= :: EventPayload -> EventPayload -> Bool
<= :: EventPayload -> EventPayload -> Bool
$c> :: EventPayload -> EventPayload -> Bool
> :: EventPayload -> EventPayload -> Bool
$c>= :: EventPayload -> EventPayload -> Bool
>= :: EventPayload -> EventPayload -> Bool
$cmax :: EventPayload -> EventPayload -> EventPayload
max :: EventPayload -> EventPayload -> EventPayload
$cmin :: EventPayload -> EventPayload -> EventPayload
min :: EventPayload -> EventPayload -> EventPayload
Ord, (forall x. EventPayload -> Rep EventPayload x)
-> (forall x. Rep EventPayload x -> EventPayload)
-> Generic EventPayload
forall x. Rep EventPayload x -> EventPayload
forall x. EventPayload -> Rep EventPayload x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EventPayload -> Rep EventPayload x
from :: forall x. EventPayload -> Rep EventPayload x
$cto :: forall x. Rep EventPayload x -> EventPayload
to :: forall x. Rep EventPayload x -> EventPayload
Generic, Int -> EventPayload -> ShowS
[EventPayload] -> ShowS
EventPayload -> String
(Int -> EventPayload -> ShowS)
-> (EventPayload -> String)
-> ([EventPayload] -> ShowS)
-> Show EventPayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EventPayload -> ShowS
showsPrec :: Int -> EventPayload -> ShowS
$cshow :: EventPayload -> String
show :: EventPayload -> String
$cshowList :: [EventPayload] -> ShowS
showList :: [EventPayload] -> ShowS
Show, Typeable)
newtype WindowShownEventData =
WindowShownEventData {WindowShownEventData -> Window
windowShownEventWindow :: Window
}
deriving (WindowShownEventData -> WindowShownEventData -> Bool
(WindowShownEventData -> WindowShownEventData -> Bool)
-> (WindowShownEventData -> WindowShownEventData -> Bool)
-> Eq WindowShownEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WindowShownEventData -> WindowShownEventData -> Bool
== :: WindowShownEventData -> WindowShownEventData -> Bool
$c/= :: WindowShownEventData -> WindowShownEventData -> Bool
/= :: WindowShownEventData -> WindowShownEventData -> Bool
Eq,Eq WindowShownEventData
Eq WindowShownEventData =>
(WindowShownEventData -> WindowShownEventData -> Ordering)
-> (WindowShownEventData -> WindowShownEventData -> Bool)
-> (WindowShownEventData -> WindowShownEventData -> Bool)
-> (WindowShownEventData -> WindowShownEventData -> Bool)
-> (WindowShownEventData -> WindowShownEventData -> Bool)
-> (WindowShownEventData
-> WindowShownEventData -> WindowShownEventData)
-> (WindowShownEventData
-> WindowShownEventData -> WindowShownEventData)
-> Ord WindowShownEventData
WindowShownEventData -> WindowShownEventData -> Bool
WindowShownEventData -> WindowShownEventData -> Ordering
WindowShownEventData
-> WindowShownEventData -> WindowShownEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WindowShownEventData -> WindowShownEventData -> Ordering
compare :: WindowShownEventData -> WindowShownEventData -> Ordering
$c< :: WindowShownEventData -> WindowShownEventData -> Bool
< :: WindowShownEventData -> WindowShownEventData -> Bool
$c<= :: WindowShownEventData -> WindowShownEventData -> Bool
<= :: WindowShownEventData -> WindowShownEventData -> Bool
$c> :: WindowShownEventData -> WindowShownEventData -> Bool
> :: WindowShownEventData -> WindowShownEventData -> Bool
$c>= :: WindowShownEventData -> WindowShownEventData -> Bool
>= :: WindowShownEventData -> WindowShownEventData -> Bool
$cmax :: WindowShownEventData
-> WindowShownEventData -> WindowShownEventData
max :: WindowShownEventData
-> WindowShownEventData -> WindowShownEventData
$cmin :: WindowShownEventData
-> WindowShownEventData -> WindowShownEventData
min :: WindowShownEventData
-> WindowShownEventData -> WindowShownEventData
Ord,(forall x. WindowShownEventData -> Rep WindowShownEventData x)
-> (forall x. Rep WindowShownEventData x -> WindowShownEventData)
-> Generic WindowShownEventData
forall x. Rep WindowShownEventData x -> WindowShownEventData
forall x. WindowShownEventData -> Rep WindowShownEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WindowShownEventData -> Rep WindowShownEventData x
from :: forall x. WindowShownEventData -> Rep WindowShownEventData x
$cto :: forall x. Rep WindowShownEventData x -> WindowShownEventData
to :: forall x. Rep WindowShownEventData x -> WindowShownEventData
Generic,Int -> WindowShownEventData -> ShowS
[WindowShownEventData] -> ShowS
WindowShownEventData -> String
(Int -> WindowShownEventData -> ShowS)
-> (WindowShownEventData -> String)
-> ([WindowShownEventData] -> ShowS)
-> Show WindowShownEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindowShownEventData -> ShowS
showsPrec :: Int -> WindowShownEventData -> ShowS
$cshow :: WindowShownEventData -> String
show :: WindowShownEventData -> String
$cshowList :: [WindowShownEventData] -> ShowS
showList :: [WindowShownEventData] -> ShowS
Show,Typeable)
newtype WindowHiddenEventData =
WindowHiddenEventData {WindowHiddenEventData -> Window
windowHiddenEventWindow :: Window
}
deriving (WindowHiddenEventData -> WindowHiddenEventData -> Bool
(WindowHiddenEventData -> WindowHiddenEventData -> Bool)
-> (WindowHiddenEventData -> WindowHiddenEventData -> Bool)
-> Eq WindowHiddenEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WindowHiddenEventData -> WindowHiddenEventData -> Bool
== :: WindowHiddenEventData -> WindowHiddenEventData -> Bool
$c/= :: WindowHiddenEventData -> WindowHiddenEventData -> Bool
/= :: WindowHiddenEventData -> WindowHiddenEventData -> Bool
Eq,Eq WindowHiddenEventData
Eq WindowHiddenEventData =>
(WindowHiddenEventData -> WindowHiddenEventData -> Ordering)
-> (WindowHiddenEventData -> WindowHiddenEventData -> Bool)
-> (WindowHiddenEventData -> WindowHiddenEventData -> Bool)
-> (WindowHiddenEventData -> WindowHiddenEventData -> Bool)
-> (WindowHiddenEventData -> WindowHiddenEventData -> Bool)
-> (WindowHiddenEventData
-> WindowHiddenEventData -> WindowHiddenEventData)
-> (WindowHiddenEventData
-> WindowHiddenEventData -> WindowHiddenEventData)
-> Ord WindowHiddenEventData
WindowHiddenEventData -> WindowHiddenEventData -> Bool
WindowHiddenEventData -> WindowHiddenEventData -> Ordering
WindowHiddenEventData
-> WindowHiddenEventData -> WindowHiddenEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WindowHiddenEventData -> WindowHiddenEventData -> Ordering
compare :: WindowHiddenEventData -> WindowHiddenEventData -> Ordering
$c< :: WindowHiddenEventData -> WindowHiddenEventData -> Bool
< :: WindowHiddenEventData -> WindowHiddenEventData -> Bool
$c<= :: WindowHiddenEventData -> WindowHiddenEventData -> Bool
<= :: WindowHiddenEventData -> WindowHiddenEventData -> Bool
$c> :: WindowHiddenEventData -> WindowHiddenEventData -> Bool
> :: WindowHiddenEventData -> WindowHiddenEventData -> Bool
$c>= :: WindowHiddenEventData -> WindowHiddenEventData -> Bool
>= :: WindowHiddenEventData -> WindowHiddenEventData -> Bool
$cmax :: WindowHiddenEventData
-> WindowHiddenEventData -> WindowHiddenEventData
max :: WindowHiddenEventData
-> WindowHiddenEventData -> WindowHiddenEventData
$cmin :: WindowHiddenEventData
-> WindowHiddenEventData -> WindowHiddenEventData
min :: WindowHiddenEventData
-> WindowHiddenEventData -> WindowHiddenEventData
Ord,(forall x. WindowHiddenEventData -> Rep WindowHiddenEventData x)
-> (forall x. Rep WindowHiddenEventData x -> WindowHiddenEventData)
-> Generic WindowHiddenEventData
forall x. Rep WindowHiddenEventData x -> WindowHiddenEventData
forall x. WindowHiddenEventData -> Rep WindowHiddenEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WindowHiddenEventData -> Rep WindowHiddenEventData x
from :: forall x. WindowHiddenEventData -> Rep WindowHiddenEventData x
$cto :: forall x. Rep WindowHiddenEventData x -> WindowHiddenEventData
to :: forall x. Rep WindowHiddenEventData x -> WindowHiddenEventData
Generic,Int -> WindowHiddenEventData -> ShowS
[WindowHiddenEventData] -> ShowS
WindowHiddenEventData -> String
(Int -> WindowHiddenEventData -> ShowS)
-> (WindowHiddenEventData -> String)
-> ([WindowHiddenEventData] -> ShowS)
-> Show WindowHiddenEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindowHiddenEventData -> ShowS
showsPrec :: Int -> WindowHiddenEventData -> ShowS
$cshow :: WindowHiddenEventData -> String
show :: WindowHiddenEventData -> String
$cshowList :: [WindowHiddenEventData] -> ShowS
showList :: [WindowHiddenEventData] -> ShowS
Show,Typeable)
newtype WindowExposedEventData =
WindowExposedEventData {WindowExposedEventData -> Window
windowExposedEventWindow :: Window
}
deriving (WindowExposedEventData -> WindowExposedEventData -> Bool
(WindowExposedEventData -> WindowExposedEventData -> Bool)
-> (WindowExposedEventData -> WindowExposedEventData -> Bool)
-> Eq WindowExposedEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WindowExposedEventData -> WindowExposedEventData -> Bool
== :: WindowExposedEventData -> WindowExposedEventData -> Bool
$c/= :: WindowExposedEventData -> WindowExposedEventData -> Bool
/= :: WindowExposedEventData -> WindowExposedEventData -> Bool
Eq,Eq WindowExposedEventData
Eq WindowExposedEventData =>
(WindowExposedEventData -> WindowExposedEventData -> Ordering)
-> (WindowExposedEventData -> WindowExposedEventData -> Bool)
-> (WindowExposedEventData -> WindowExposedEventData -> Bool)
-> (WindowExposedEventData -> WindowExposedEventData -> Bool)
-> (WindowExposedEventData -> WindowExposedEventData -> Bool)
-> (WindowExposedEventData
-> WindowExposedEventData -> WindowExposedEventData)
-> (WindowExposedEventData
-> WindowExposedEventData -> WindowExposedEventData)
-> Ord WindowExposedEventData
WindowExposedEventData -> WindowExposedEventData -> Bool
WindowExposedEventData -> WindowExposedEventData -> Ordering
WindowExposedEventData
-> WindowExposedEventData -> WindowExposedEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WindowExposedEventData -> WindowExposedEventData -> Ordering
compare :: WindowExposedEventData -> WindowExposedEventData -> Ordering
$c< :: WindowExposedEventData -> WindowExposedEventData -> Bool
< :: WindowExposedEventData -> WindowExposedEventData -> Bool
$c<= :: WindowExposedEventData -> WindowExposedEventData -> Bool
<= :: WindowExposedEventData -> WindowExposedEventData -> Bool
$c> :: WindowExposedEventData -> WindowExposedEventData -> Bool
> :: WindowExposedEventData -> WindowExposedEventData -> Bool
$c>= :: WindowExposedEventData -> WindowExposedEventData -> Bool
>= :: WindowExposedEventData -> WindowExposedEventData -> Bool
$cmax :: WindowExposedEventData
-> WindowExposedEventData -> WindowExposedEventData
max :: WindowExposedEventData
-> WindowExposedEventData -> WindowExposedEventData
$cmin :: WindowExposedEventData
-> WindowExposedEventData -> WindowExposedEventData
min :: WindowExposedEventData
-> WindowExposedEventData -> WindowExposedEventData
Ord,(forall x. WindowExposedEventData -> Rep WindowExposedEventData x)
-> (forall x.
Rep WindowExposedEventData x -> WindowExposedEventData)
-> Generic WindowExposedEventData
forall x. Rep WindowExposedEventData x -> WindowExposedEventData
forall x. WindowExposedEventData -> Rep WindowExposedEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WindowExposedEventData -> Rep WindowExposedEventData x
from :: forall x. WindowExposedEventData -> Rep WindowExposedEventData x
$cto :: forall x. Rep WindowExposedEventData x -> WindowExposedEventData
to :: forall x. Rep WindowExposedEventData x -> WindowExposedEventData
Generic,Int -> WindowExposedEventData -> ShowS
[WindowExposedEventData] -> ShowS
WindowExposedEventData -> String
(Int -> WindowExposedEventData -> ShowS)
-> (WindowExposedEventData -> String)
-> ([WindowExposedEventData] -> ShowS)
-> Show WindowExposedEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindowExposedEventData -> ShowS
showsPrec :: Int -> WindowExposedEventData -> ShowS
$cshow :: WindowExposedEventData -> String
show :: WindowExposedEventData -> String
$cshowList :: [WindowExposedEventData] -> ShowS
showList :: [WindowExposedEventData] -> ShowS
Show,Typeable)
data WindowMovedEventData =
WindowMovedEventData {WindowMovedEventData -> Window
windowMovedEventWindow :: !Window
,WindowMovedEventData -> Point V2 Int32
windowMovedEventPosition :: !(Point V2 Int32)
}
deriving (WindowMovedEventData -> WindowMovedEventData -> Bool
(WindowMovedEventData -> WindowMovedEventData -> Bool)
-> (WindowMovedEventData -> WindowMovedEventData -> Bool)
-> Eq WindowMovedEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WindowMovedEventData -> WindowMovedEventData -> Bool
== :: WindowMovedEventData -> WindowMovedEventData -> Bool
$c/= :: WindowMovedEventData -> WindowMovedEventData -> Bool
/= :: WindowMovedEventData -> WindowMovedEventData -> Bool
Eq,Eq WindowMovedEventData
Eq WindowMovedEventData =>
(WindowMovedEventData -> WindowMovedEventData -> Ordering)
-> (WindowMovedEventData -> WindowMovedEventData -> Bool)
-> (WindowMovedEventData -> WindowMovedEventData -> Bool)
-> (WindowMovedEventData -> WindowMovedEventData -> Bool)
-> (WindowMovedEventData -> WindowMovedEventData -> Bool)
-> (WindowMovedEventData
-> WindowMovedEventData -> WindowMovedEventData)
-> (WindowMovedEventData
-> WindowMovedEventData -> WindowMovedEventData)
-> Ord WindowMovedEventData
WindowMovedEventData -> WindowMovedEventData -> Bool
WindowMovedEventData -> WindowMovedEventData -> Ordering
WindowMovedEventData
-> WindowMovedEventData -> WindowMovedEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WindowMovedEventData -> WindowMovedEventData -> Ordering
compare :: WindowMovedEventData -> WindowMovedEventData -> Ordering
$c< :: WindowMovedEventData -> WindowMovedEventData -> Bool
< :: WindowMovedEventData -> WindowMovedEventData -> Bool
$c<= :: WindowMovedEventData -> WindowMovedEventData -> Bool
<= :: WindowMovedEventData -> WindowMovedEventData -> Bool
$c> :: WindowMovedEventData -> WindowMovedEventData -> Bool
> :: WindowMovedEventData -> WindowMovedEventData -> Bool
$c>= :: WindowMovedEventData -> WindowMovedEventData -> Bool
>= :: WindowMovedEventData -> WindowMovedEventData -> Bool
$cmax :: WindowMovedEventData
-> WindowMovedEventData -> WindowMovedEventData
max :: WindowMovedEventData
-> WindowMovedEventData -> WindowMovedEventData
$cmin :: WindowMovedEventData
-> WindowMovedEventData -> WindowMovedEventData
min :: WindowMovedEventData
-> WindowMovedEventData -> WindowMovedEventData
Ord,(forall x. WindowMovedEventData -> Rep WindowMovedEventData x)
-> (forall x. Rep WindowMovedEventData x -> WindowMovedEventData)
-> Generic WindowMovedEventData
forall x. Rep WindowMovedEventData x -> WindowMovedEventData
forall x. WindowMovedEventData -> Rep WindowMovedEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WindowMovedEventData -> Rep WindowMovedEventData x
from :: forall x. WindowMovedEventData -> Rep WindowMovedEventData x
$cto :: forall x. Rep WindowMovedEventData x -> WindowMovedEventData
to :: forall x. Rep WindowMovedEventData x -> WindowMovedEventData
Generic,Int -> WindowMovedEventData -> ShowS
[WindowMovedEventData] -> ShowS
WindowMovedEventData -> String
(Int -> WindowMovedEventData -> ShowS)
-> (WindowMovedEventData -> String)
-> ([WindowMovedEventData] -> ShowS)
-> Show WindowMovedEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindowMovedEventData -> ShowS
showsPrec :: Int -> WindowMovedEventData -> ShowS
$cshow :: WindowMovedEventData -> String
show :: WindowMovedEventData -> String
$cshowList :: [WindowMovedEventData] -> ShowS
showList :: [WindowMovedEventData] -> ShowS
Show,Typeable)
data WindowResizedEventData =
WindowResizedEventData {WindowResizedEventData -> Window
windowResizedEventWindow :: !Window
,WindowResizedEventData -> V2 Int32
windowResizedEventSize :: !(V2 Int32)
}
deriving (WindowResizedEventData -> WindowResizedEventData -> Bool
(WindowResizedEventData -> WindowResizedEventData -> Bool)
-> (WindowResizedEventData -> WindowResizedEventData -> Bool)
-> Eq WindowResizedEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WindowResizedEventData -> WindowResizedEventData -> Bool
== :: WindowResizedEventData -> WindowResizedEventData -> Bool
$c/= :: WindowResizedEventData -> WindowResizedEventData -> Bool
/= :: WindowResizedEventData -> WindowResizedEventData -> Bool
Eq,Eq WindowResizedEventData
Eq WindowResizedEventData =>
(WindowResizedEventData -> WindowResizedEventData -> Ordering)
-> (WindowResizedEventData -> WindowResizedEventData -> Bool)
-> (WindowResizedEventData -> WindowResizedEventData -> Bool)
-> (WindowResizedEventData -> WindowResizedEventData -> Bool)
-> (WindowResizedEventData -> WindowResizedEventData -> Bool)
-> (WindowResizedEventData
-> WindowResizedEventData -> WindowResizedEventData)
-> (WindowResizedEventData
-> WindowResizedEventData -> WindowResizedEventData)
-> Ord WindowResizedEventData
WindowResizedEventData -> WindowResizedEventData -> Bool
WindowResizedEventData -> WindowResizedEventData -> Ordering
WindowResizedEventData
-> WindowResizedEventData -> WindowResizedEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WindowResizedEventData -> WindowResizedEventData -> Ordering
compare :: WindowResizedEventData -> WindowResizedEventData -> Ordering
$c< :: WindowResizedEventData -> WindowResizedEventData -> Bool
< :: WindowResizedEventData -> WindowResizedEventData -> Bool
$c<= :: WindowResizedEventData -> WindowResizedEventData -> Bool
<= :: WindowResizedEventData -> WindowResizedEventData -> Bool
$c> :: WindowResizedEventData -> WindowResizedEventData -> Bool
> :: WindowResizedEventData -> WindowResizedEventData -> Bool
$c>= :: WindowResizedEventData -> WindowResizedEventData -> Bool
>= :: WindowResizedEventData -> WindowResizedEventData -> Bool
$cmax :: WindowResizedEventData
-> WindowResizedEventData -> WindowResizedEventData
max :: WindowResizedEventData
-> WindowResizedEventData -> WindowResizedEventData
$cmin :: WindowResizedEventData
-> WindowResizedEventData -> WindowResizedEventData
min :: WindowResizedEventData
-> WindowResizedEventData -> WindowResizedEventData
Ord,(forall x. WindowResizedEventData -> Rep WindowResizedEventData x)
-> (forall x.
Rep WindowResizedEventData x -> WindowResizedEventData)
-> Generic WindowResizedEventData
forall x. Rep WindowResizedEventData x -> WindowResizedEventData
forall x. WindowResizedEventData -> Rep WindowResizedEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WindowResizedEventData -> Rep WindowResizedEventData x
from :: forall x. WindowResizedEventData -> Rep WindowResizedEventData x
$cto :: forall x. Rep WindowResizedEventData x -> WindowResizedEventData
to :: forall x. Rep WindowResizedEventData x -> WindowResizedEventData
Generic,Int -> WindowResizedEventData -> ShowS
[WindowResizedEventData] -> ShowS
WindowResizedEventData -> String
(Int -> WindowResizedEventData -> ShowS)
-> (WindowResizedEventData -> String)
-> ([WindowResizedEventData] -> ShowS)
-> Show WindowResizedEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindowResizedEventData -> ShowS
showsPrec :: Int -> WindowResizedEventData -> ShowS
$cshow :: WindowResizedEventData -> String
show :: WindowResizedEventData -> String
$cshowList :: [WindowResizedEventData] -> ShowS
showList :: [WindowResizedEventData] -> ShowS
Show,Typeable)
data WindowSizeChangedEventData =
WindowSizeChangedEventData {WindowSizeChangedEventData -> Window
windowSizeChangedEventWindow :: !Window
,WindowSizeChangedEventData -> V2 Int32
windowSizeChangedEventSize :: !(V2 Int32)
}
deriving (WindowSizeChangedEventData -> WindowSizeChangedEventData -> Bool
(WindowSizeChangedEventData -> WindowSizeChangedEventData -> Bool)
-> (WindowSizeChangedEventData
-> WindowSizeChangedEventData -> Bool)
-> Eq WindowSizeChangedEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WindowSizeChangedEventData -> WindowSizeChangedEventData -> Bool
== :: WindowSizeChangedEventData -> WindowSizeChangedEventData -> Bool
$c/= :: WindowSizeChangedEventData -> WindowSizeChangedEventData -> Bool
/= :: WindowSizeChangedEventData -> WindowSizeChangedEventData -> Bool
Eq,Eq WindowSizeChangedEventData
Eq WindowSizeChangedEventData =>
(WindowSizeChangedEventData
-> WindowSizeChangedEventData -> Ordering)
-> (WindowSizeChangedEventData
-> WindowSizeChangedEventData -> Bool)
-> (WindowSizeChangedEventData
-> WindowSizeChangedEventData -> Bool)
-> (WindowSizeChangedEventData
-> WindowSizeChangedEventData -> Bool)
-> (WindowSizeChangedEventData
-> WindowSizeChangedEventData -> Bool)
-> (WindowSizeChangedEventData
-> WindowSizeChangedEventData -> WindowSizeChangedEventData)
-> (WindowSizeChangedEventData
-> WindowSizeChangedEventData -> WindowSizeChangedEventData)
-> Ord WindowSizeChangedEventData
WindowSizeChangedEventData -> WindowSizeChangedEventData -> Bool
WindowSizeChangedEventData
-> WindowSizeChangedEventData -> Ordering
WindowSizeChangedEventData
-> WindowSizeChangedEventData -> WindowSizeChangedEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WindowSizeChangedEventData
-> WindowSizeChangedEventData -> Ordering
compare :: WindowSizeChangedEventData
-> WindowSizeChangedEventData -> Ordering
$c< :: WindowSizeChangedEventData -> WindowSizeChangedEventData -> Bool
< :: WindowSizeChangedEventData -> WindowSizeChangedEventData -> Bool
$c<= :: WindowSizeChangedEventData -> WindowSizeChangedEventData -> Bool
<= :: WindowSizeChangedEventData -> WindowSizeChangedEventData -> Bool
$c> :: WindowSizeChangedEventData -> WindowSizeChangedEventData -> Bool
> :: WindowSizeChangedEventData -> WindowSizeChangedEventData -> Bool
$c>= :: WindowSizeChangedEventData -> WindowSizeChangedEventData -> Bool
>= :: WindowSizeChangedEventData -> WindowSizeChangedEventData -> Bool
$cmax :: WindowSizeChangedEventData
-> WindowSizeChangedEventData -> WindowSizeChangedEventData
max :: WindowSizeChangedEventData
-> WindowSizeChangedEventData -> WindowSizeChangedEventData
$cmin :: WindowSizeChangedEventData
-> WindowSizeChangedEventData -> WindowSizeChangedEventData
min :: WindowSizeChangedEventData
-> WindowSizeChangedEventData -> WindowSizeChangedEventData
Ord,(forall x.
WindowSizeChangedEventData -> Rep WindowSizeChangedEventData x)
-> (forall x.
Rep WindowSizeChangedEventData x -> WindowSizeChangedEventData)
-> Generic WindowSizeChangedEventData
forall x.
Rep WindowSizeChangedEventData x -> WindowSizeChangedEventData
forall x.
WindowSizeChangedEventData -> Rep WindowSizeChangedEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
WindowSizeChangedEventData -> Rep WindowSizeChangedEventData x
from :: forall x.
WindowSizeChangedEventData -> Rep WindowSizeChangedEventData x
$cto :: forall x.
Rep WindowSizeChangedEventData x -> WindowSizeChangedEventData
to :: forall x.
Rep WindowSizeChangedEventData x -> WindowSizeChangedEventData
Generic,Int -> WindowSizeChangedEventData -> ShowS
[WindowSizeChangedEventData] -> ShowS
WindowSizeChangedEventData -> String
(Int -> WindowSizeChangedEventData -> ShowS)
-> (WindowSizeChangedEventData -> String)
-> ([WindowSizeChangedEventData] -> ShowS)
-> Show WindowSizeChangedEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindowSizeChangedEventData -> ShowS
showsPrec :: Int -> WindowSizeChangedEventData -> ShowS
$cshow :: WindowSizeChangedEventData -> String
show :: WindowSizeChangedEventData -> String
$cshowList :: [WindowSizeChangedEventData] -> ShowS
showList :: [WindowSizeChangedEventData] -> ShowS
Show,Typeable)
newtype WindowMinimizedEventData =
WindowMinimizedEventData {WindowMinimizedEventData -> Window
windowMinimizedEventWindow :: Window
}
deriving (WindowMinimizedEventData -> WindowMinimizedEventData -> Bool
(WindowMinimizedEventData -> WindowMinimizedEventData -> Bool)
-> (WindowMinimizedEventData -> WindowMinimizedEventData -> Bool)
-> Eq WindowMinimizedEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WindowMinimizedEventData -> WindowMinimizedEventData -> Bool
== :: WindowMinimizedEventData -> WindowMinimizedEventData -> Bool
$c/= :: WindowMinimizedEventData -> WindowMinimizedEventData -> Bool
/= :: WindowMinimizedEventData -> WindowMinimizedEventData -> Bool
Eq,Eq WindowMinimizedEventData
Eq WindowMinimizedEventData =>
(WindowMinimizedEventData -> WindowMinimizedEventData -> Ordering)
-> (WindowMinimizedEventData -> WindowMinimizedEventData -> Bool)
-> (WindowMinimizedEventData -> WindowMinimizedEventData -> Bool)
-> (WindowMinimizedEventData -> WindowMinimizedEventData -> Bool)
-> (WindowMinimizedEventData -> WindowMinimizedEventData -> Bool)
-> (WindowMinimizedEventData
-> WindowMinimizedEventData -> WindowMinimizedEventData)
-> (WindowMinimizedEventData
-> WindowMinimizedEventData -> WindowMinimizedEventData)
-> Ord WindowMinimizedEventData
WindowMinimizedEventData -> WindowMinimizedEventData -> Bool
WindowMinimizedEventData -> WindowMinimizedEventData -> Ordering
WindowMinimizedEventData
-> WindowMinimizedEventData -> WindowMinimizedEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WindowMinimizedEventData -> WindowMinimizedEventData -> Ordering
compare :: WindowMinimizedEventData -> WindowMinimizedEventData -> Ordering
$c< :: WindowMinimizedEventData -> WindowMinimizedEventData -> Bool
< :: WindowMinimizedEventData -> WindowMinimizedEventData -> Bool
$c<= :: WindowMinimizedEventData -> WindowMinimizedEventData -> Bool
<= :: WindowMinimizedEventData -> WindowMinimizedEventData -> Bool
$c> :: WindowMinimizedEventData -> WindowMinimizedEventData -> Bool
> :: WindowMinimizedEventData -> WindowMinimizedEventData -> Bool
$c>= :: WindowMinimizedEventData -> WindowMinimizedEventData -> Bool
>= :: WindowMinimizedEventData -> WindowMinimizedEventData -> Bool
$cmax :: WindowMinimizedEventData
-> WindowMinimizedEventData -> WindowMinimizedEventData
max :: WindowMinimizedEventData
-> WindowMinimizedEventData -> WindowMinimizedEventData
$cmin :: WindowMinimizedEventData
-> WindowMinimizedEventData -> WindowMinimizedEventData
min :: WindowMinimizedEventData
-> WindowMinimizedEventData -> WindowMinimizedEventData
Ord,(forall x.
WindowMinimizedEventData -> Rep WindowMinimizedEventData x)
-> (forall x.
Rep WindowMinimizedEventData x -> WindowMinimizedEventData)
-> Generic WindowMinimizedEventData
forall x.
Rep WindowMinimizedEventData x -> WindowMinimizedEventData
forall x.
WindowMinimizedEventData -> Rep WindowMinimizedEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
WindowMinimizedEventData -> Rep WindowMinimizedEventData x
from :: forall x.
WindowMinimizedEventData -> Rep WindowMinimizedEventData x
$cto :: forall x.
Rep WindowMinimizedEventData x -> WindowMinimizedEventData
to :: forall x.
Rep WindowMinimizedEventData x -> WindowMinimizedEventData
Generic,Int -> WindowMinimizedEventData -> ShowS
[WindowMinimizedEventData] -> ShowS
WindowMinimizedEventData -> String
(Int -> WindowMinimizedEventData -> ShowS)
-> (WindowMinimizedEventData -> String)
-> ([WindowMinimizedEventData] -> ShowS)
-> Show WindowMinimizedEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindowMinimizedEventData -> ShowS
showsPrec :: Int -> WindowMinimizedEventData -> ShowS
$cshow :: WindowMinimizedEventData -> String
show :: WindowMinimizedEventData -> String
$cshowList :: [WindowMinimizedEventData] -> ShowS
showList :: [WindowMinimizedEventData] -> ShowS
Show,Typeable)
newtype WindowMaximizedEventData =
WindowMaximizedEventData {WindowMaximizedEventData -> Window
windowMaximizedEventWindow :: Window
}
deriving (WindowMaximizedEventData -> WindowMaximizedEventData -> Bool
(WindowMaximizedEventData -> WindowMaximizedEventData -> Bool)
-> (WindowMaximizedEventData -> WindowMaximizedEventData -> Bool)
-> Eq WindowMaximizedEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WindowMaximizedEventData -> WindowMaximizedEventData -> Bool
== :: WindowMaximizedEventData -> WindowMaximizedEventData -> Bool
$c/= :: WindowMaximizedEventData -> WindowMaximizedEventData -> Bool
/= :: WindowMaximizedEventData -> WindowMaximizedEventData -> Bool
Eq,Eq WindowMaximizedEventData
Eq WindowMaximizedEventData =>
(WindowMaximizedEventData -> WindowMaximizedEventData -> Ordering)
-> (WindowMaximizedEventData -> WindowMaximizedEventData -> Bool)
-> (WindowMaximizedEventData -> WindowMaximizedEventData -> Bool)
-> (WindowMaximizedEventData -> WindowMaximizedEventData -> Bool)
-> (WindowMaximizedEventData -> WindowMaximizedEventData -> Bool)
-> (WindowMaximizedEventData
-> WindowMaximizedEventData -> WindowMaximizedEventData)
-> (WindowMaximizedEventData
-> WindowMaximizedEventData -> WindowMaximizedEventData)
-> Ord WindowMaximizedEventData
WindowMaximizedEventData -> WindowMaximizedEventData -> Bool
WindowMaximizedEventData -> WindowMaximizedEventData -> Ordering
WindowMaximizedEventData
-> WindowMaximizedEventData -> WindowMaximizedEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WindowMaximizedEventData -> WindowMaximizedEventData -> Ordering
compare :: WindowMaximizedEventData -> WindowMaximizedEventData -> Ordering
$c< :: WindowMaximizedEventData -> WindowMaximizedEventData -> Bool
< :: WindowMaximizedEventData -> WindowMaximizedEventData -> Bool
$c<= :: WindowMaximizedEventData -> WindowMaximizedEventData -> Bool
<= :: WindowMaximizedEventData -> WindowMaximizedEventData -> Bool
$c> :: WindowMaximizedEventData -> WindowMaximizedEventData -> Bool
> :: WindowMaximizedEventData -> WindowMaximizedEventData -> Bool
$c>= :: WindowMaximizedEventData -> WindowMaximizedEventData -> Bool
>= :: WindowMaximizedEventData -> WindowMaximizedEventData -> Bool
$cmax :: WindowMaximizedEventData
-> WindowMaximizedEventData -> WindowMaximizedEventData
max :: WindowMaximizedEventData
-> WindowMaximizedEventData -> WindowMaximizedEventData
$cmin :: WindowMaximizedEventData
-> WindowMaximizedEventData -> WindowMaximizedEventData
min :: WindowMaximizedEventData
-> WindowMaximizedEventData -> WindowMaximizedEventData
Ord,(forall x.
WindowMaximizedEventData -> Rep WindowMaximizedEventData x)
-> (forall x.
Rep WindowMaximizedEventData x -> WindowMaximizedEventData)
-> Generic WindowMaximizedEventData
forall x.
Rep WindowMaximizedEventData x -> WindowMaximizedEventData
forall x.
WindowMaximizedEventData -> Rep WindowMaximizedEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
WindowMaximizedEventData -> Rep WindowMaximizedEventData x
from :: forall x.
WindowMaximizedEventData -> Rep WindowMaximizedEventData x
$cto :: forall x.
Rep WindowMaximizedEventData x -> WindowMaximizedEventData
to :: forall x.
Rep WindowMaximizedEventData x -> WindowMaximizedEventData
Generic,Int -> WindowMaximizedEventData -> ShowS
[WindowMaximizedEventData] -> ShowS
WindowMaximizedEventData -> String
(Int -> WindowMaximizedEventData -> ShowS)
-> (WindowMaximizedEventData -> String)
-> ([WindowMaximizedEventData] -> ShowS)
-> Show WindowMaximizedEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindowMaximizedEventData -> ShowS
showsPrec :: Int -> WindowMaximizedEventData -> ShowS
$cshow :: WindowMaximizedEventData -> String
show :: WindowMaximizedEventData -> String
$cshowList :: [WindowMaximizedEventData] -> ShowS
showList :: [WindowMaximizedEventData] -> ShowS
Show,Typeable)
newtype WindowRestoredEventData =
WindowRestoredEventData {WindowRestoredEventData -> Window
windowRestoredEventWindow :: Window
}
deriving (WindowRestoredEventData -> WindowRestoredEventData -> Bool
(WindowRestoredEventData -> WindowRestoredEventData -> Bool)
-> (WindowRestoredEventData -> WindowRestoredEventData -> Bool)
-> Eq WindowRestoredEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WindowRestoredEventData -> WindowRestoredEventData -> Bool
== :: WindowRestoredEventData -> WindowRestoredEventData -> Bool
$c/= :: WindowRestoredEventData -> WindowRestoredEventData -> Bool
/= :: WindowRestoredEventData -> WindowRestoredEventData -> Bool
Eq,Eq WindowRestoredEventData
Eq WindowRestoredEventData =>
(WindowRestoredEventData -> WindowRestoredEventData -> Ordering)
-> (WindowRestoredEventData -> WindowRestoredEventData -> Bool)
-> (WindowRestoredEventData -> WindowRestoredEventData -> Bool)
-> (WindowRestoredEventData -> WindowRestoredEventData -> Bool)
-> (WindowRestoredEventData -> WindowRestoredEventData -> Bool)
-> (WindowRestoredEventData
-> WindowRestoredEventData -> WindowRestoredEventData)
-> (WindowRestoredEventData
-> WindowRestoredEventData -> WindowRestoredEventData)
-> Ord WindowRestoredEventData
WindowRestoredEventData -> WindowRestoredEventData -> Bool
WindowRestoredEventData -> WindowRestoredEventData -> Ordering
WindowRestoredEventData
-> WindowRestoredEventData -> WindowRestoredEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WindowRestoredEventData -> WindowRestoredEventData -> Ordering
compare :: WindowRestoredEventData -> WindowRestoredEventData -> Ordering
$c< :: WindowRestoredEventData -> WindowRestoredEventData -> Bool
< :: WindowRestoredEventData -> WindowRestoredEventData -> Bool
$c<= :: WindowRestoredEventData -> WindowRestoredEventData -> Bool
<= :: WindowRestoredEventData -> WindowRestoredEventData -> Bool
$c> :: WindowRestoredEventData -> WindowRestoredEventData -> Bool
> :: WindowRestoredEventData -> WindowRestoredEventData -> Bool
$c>= :: WindowRestoredEventData -> WindowRestoredEventData -> Bool
>= :: WindowRestoredEventData -> WindowRestoredEventData -> Bool
$cmax :: WindowRestoredEventData
-> WindowRestoredEventData -> WindowRestoredEventData
max :: WindowRestoredEventData
-> WindowRestoredEventData -> WindowRestoredEventData
$cmin :: WindowRestoredEventData
-> WindowRestoredEventData -> WindowRestoredEventData
min :: WindowRestoredEventData
-> WindowRestoredEventData -> WindowRestoredEventData
Ord,(forall x.
WindowRestoredEventData -> Rep WindowRestoredEventData x)
-> (forall x.
Rep WindowRestoredEventData x -> WindowRestoredEventData)
-> Generic WindowRestoredEventData
forall x. Rep WindowRestoredEventData x -> WindowRestoredEventData
forall x. WindowRestoredEventData -> Rep WindowRestoredEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WindowRestoredEventData -> Rep WindowRestoredEventData x
from :: forall x. WindowRestoredEventData -> Rep WindowRestoredEventData x
$cto :: forall x. Rep WindowRestoredEventData x -> WindowRestoredEventData
to :: forall x. Rep WindowRestoredEventData x -> WindowRestoredEventData
Generic,Int -> WindowRestoredEventData -> ShowS
[WindowRestoredEventData] -> ShowS
WindowRestoredEventData -> String
(Int -> WindowRestoredEventData -> ShowS)
-> (WindowRestoredEventData -> String)
-> ([WindowRestoredEventData] -> ShowS)
-> Show WindowRestoredEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindowRestoredEventData -> ShowS
showsPrec :: Int -> WindowRestoredEventData -> ShowS
$cshow :: WindowRestoredEventData -> String
show :: WindowRestoredEventData -> String
$cshowList :: [WindowRestoredEventData] -> ShowS
showList :: [WindowRestoredEventData] -> ShowS
Show,Typeable)
newtype WindowGainedMouseFocusEventData =
WindowGainedMouseFocusEventData {WindowGainedMouseFocusEventData -> Window
windowGainedMouseFocusEventWindow :: Window
}
deriving (WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Bool
(WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Bool)
-> (WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Bool)
-> Eq WindowGainedMouseFocusEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Bool
== :: WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Bool
$c/= :: WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Bool
/= :: WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Bool
Eq,Eq WindowGainedMouseFocusEventData
Eq WindowGainedMouseFocusEventData =>
(WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Ordering)
-> (WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Bool)
-> (WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Bool)
-> (WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Bool)
-> (WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Bool)
-> (WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData)
-> (WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData)
-> Ord WindowGainedMouseFocusEventData
WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Bool
WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Ordering
WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Ordering
compare :: WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Ordering
$c< :: WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Bool
< :: WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Bool
$c<= :: WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Bool
<= :: WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Bool
$c> :: WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Bool
> :: WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Bool
$c>= :: WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Bool
>= :: WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Bool
$cmax :: WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData
max :: WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData
$cmin :: WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData
min :: WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData
Ord,(forall x.
WindowGainedMouseFocusEventData
-> Rep WindowGainedMouseFocusEventData x)
-> (forall x.
Rep WindowGainedMouseFocusEventData x
-> WindowGainedMouseFocusEventData)
-> Generic WindowGainedMouseFocusEventData
forall x.
Rep WindowGainedMouseFocusEventData x
-> WindowGainedMouseFocusEventData
forall x.
WindowGainedMouseFocusEventData
-> Rep WindowGainedMouseFocusEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
WindowGainedMouseFocusEventData
-> Rep WindowGainedMouseFocusEventData x
from :: forall x.
WindowGainedMouseFocusEventData
-> Rep WindowGainedMouseFocusEventData x
$cto :: forall x.
Rep WindowGainedMouseFocusEventData x
-> WindowGainedMouseFocusEventData
to :: forall x.
Rep WindowGainedMouseFocusEventData x
-> WindowGainedMouseFocusEventData
Generic,Int -> WindowGainedMouseFocusEventData -> ShowS
[WindowGainedMouseFocusEventData] -> ShowS
WindowGainedMouseFocusEventData -> String
(Int -> WindowGainedMouseFocusEventData -> ShowS)
-> (WindowGainedMouseFocusEventData -> String)
-> ([WindowGainedMouseFocusEventData] -> ShowS)
-> Show WindowGainedMouseFocusEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindowGainedMouseFocusEventData -> ShowS
showsPrec :: Int -> WindowGainedMouseFocusEventData -> ShowS
$cshow :: WindowGainedMouseFocusEventData -> String
show :: WindowGainedMouseFocusEventData -> String
$cshowList :: [WindowGainedMouseFocusEventData] -> ShowS
showList :: [WindowGainedMouseFocusEventData] -> ShowS
Show,Typeable)
newtype WindowLostMouseFocusEventData =
WindowLostMouseFocusEventData {WindowLostMouseFocusEventData -> Window
windowLostMouseFocusEventWindow :: Window
}
deriving (WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Bool
(WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Bool)
-> (WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Bool)
-> Eq WindowLostMouseFocusEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Bool
== :: WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Bool
$c/= :: WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Bool
/= :: WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Bool
Eq,Eq WindowLostMouseFocusEventData
Eq WindowLostMouseFocusEventData =>
(WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Ordering)
-> (WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Bool)
-> (WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Bool)
-> (WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Bool)
-> (WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Bool)
-> (WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> WindowLostMouseFocusEventData)
-> (WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> WindowLostMouseFocusEventData)
-> Ord WindowLostMouseFocusEventData
WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Bool
WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Ordering
WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> WindowLostMouseFocusEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Ordering
compare :: WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Ordering
$c< :: WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Bool
< :: WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Bool
$c<= :: WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Bool
<= :: WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Bool
$c> :: WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Bool
> :: WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Bool
$c>= :: WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Bool
>= :: WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Bool
$cmax :: WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> WindowLostMouseFocusEventData
max :: WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> WindowLostMouseFocusEventData
$cmin :: WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> WindowLostMouseFocusEventData
min :: WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> WindowLostMouseFocusEventData
Ord,(forall x.
WindowLostMouseFocusEventData
-> Rep WindowLostMouseFocusEventData x)
-> (forall x.
Rep WindowLostMouseFocusEventData x
-> WindowLostMouseFocusEventData)
-> Generic WindowLostMouseFocusEventData
forall x.
Rep WindowLostMouseFocusEventData x
-> WindowLostMouseFocusEventData
forall x.
WindowLostMouseFocusEventData
-> Rep WindowLostMouseFocusEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
WindowLostMouseFocusEventData
-> Rep WindowLostMouseFocusEventData x
from :: forall x.
WindowLostMouseFocusEventData
-> Rep WindowLostMouseFocusEventData x
$cto :: forall x.
Rep WindowLostMouseFocusEventData x
-> WindowLostMouseFocusEventData
to :: forall x.
Rep WindowLostMouseFocusEventData x
-> WindowLostMouseFocusEventData
Generic,Int -> WindowLostMouseFocusEventData -> ShowS
[WindowLostMouseFocusEventData] -> ShowS
WindowLostMouseFocusEventData -> String
(Int -> WindowLostMouseFocusEventData -> ShowS)
-> (WindowLostMouseFocusEventData -> String)
-> ([WindowLostMouseFocusEventData] -> ShowS)
-> Show WindowLostMouseFocusEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindowLostMouseFocusEventData -> ShowS
showsPrec :: Int -> WindowLostMouseFocusEventData -> ShowS
$cshow :: WindowLostMouseFocusEventData -> String
show :: WindowLostMouseFocusEventData -> String
$cshowList :: [WindowLostMouseFocusEventData] -> ShowS
showList :: [WindowLostMouseFocusEventData] -> ShowS
Show,Typeable)
newtype WindowGainedKeyboardFocusEventData =
WindowGainedKeyboardFocusEventData {WindowGainedKeyboardFocusEventData -> Window
windowGainedKeyboardFocusEventWindow :: Window
}
deriving (WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Bool
(WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Bool)
-> (WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Bool)
-> Eq WindowGainedKeyboardFocusEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Bool
== :: WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Bool
$c/= :: WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Bool
/= :: WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Bool
Eq,Eq WindowGainedKeyboardFocusEventData
Eq WindowGainedKeyboardFocusEventData =>
(WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Ordering)
-> (WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Bool)
-> (WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Bool)
-> (WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Bool)
-> (WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Bool)
-> (WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData)
-> (WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData)
-> Ord WindowGainedKeyboardFocusEventData
WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Bool
WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Ordering
WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Ordering
compare :: WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Ordering
$c< :: WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Bool
< :: WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Bool
$c<= :: WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Bool
<= :: WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Bool
$c> :: WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Bool
> :: WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Bool
$c>= :: WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Bool
>= :: WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Bool
$cmax :: WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData
max :: WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData
$cmin :: WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData
min :: WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData
Ord,(forall x.
WindowGainedKeyboardFocusEventData
-> Rep WindowGainedKeyboardFocusEventData x)
-> (forall x.
Rep WindowGainedKeyboardFocusEventData x
-> WindowGainedKeyboardFocusEventData)
-> Generic WindowGainedKeyboardFocusEventData
forall x.
Rep WindowGainedKeyboardFocusEventData x
-> WindowGainedKeyboardFocusEventData
forall x.
WindowGainedKeyboardFocusEventData
-> Rep WindowGainedKeyboardFocusEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
WindowGainedKeyboardFocusEventData
-> Rep WindowGainedKeyboardFocusEventData x
from :: forall x.
WindowGainedKeyboardFocusEventData
-> Rep WindowGainedKeyboardFocusEventData x
$cto :: forall x.
Rep WindowGainedKeyboardFocusEventData x
-> WindowGainedKeyboardFocusEventData
to :: forall x.
Rep WindowGainedKeyboardFocusEventData x
-> WindowGainedKeyboardFocusEventData
Generic,Int -> WindowGainedKeyboardFocusEventData -> ShowS
[WindowGainedKeyboardFocusEventData] -> ShowS
WindowGainedKeyboardFocusEventData -> String
(Int -> WindowGainedKeyboardFocusEventData -> ShowS)
-> (WindowGainedKeyboardFocusEventData -> String)
-> ([WindowGainedKeyboardFocusEventData] -> ShowS)
-> Show WindowGainedKeyboardFocusEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindowGainedKeyboardFocusEventData -> ShowS
showsPrec :: Int -> WindowGainedKeyboardFocusEventData -> ShowS
$cshow :: WindowGainedKeyboardFocusEventData -> String
show :: WindowGainedKeyboardFocusEventData -> String
$cshowList :: [WindowGainedKeyboardFocusEventData] -> ShowS
showList :: [WindowGainedKeyboardFocusEventData] -> ShowS
Show,Typeable)
newtype WindowLostKeyboardFocusEventData =
WindowLostKeyboardFocusEventData {WindowLostKeyboardFocusEventData -> Window
windowLostKeyboardFocusEventWindow :: Window
}
deriving (WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Bool
(WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Bool)
-> (WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Bool)
-> Eq WindowLostKeyboardFocusEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Bool
== :: WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Bool
$c/= :: WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Bool
/= :: WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Bool
Eq,Eq WindowLostKeyboardFocusEventData
Eq WindowLostKeyboardFocusEventData =>
(WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Ordering)
-> (WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Bool)
-> (WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Bool)
-> (WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Bool)
-> (WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Bool)
-> (WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData)
-> (WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData)
-> Ord WindowLostKeyboardFocusEventData
WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Bool
WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Ordering
WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Ordering
compare :: WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Ordering
$c< :: WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Bool
< :: WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Bool
$c<= :: WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Bool
<= :: WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Bool
$c> :: WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Bool
> :: WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Bool
$c>= :: WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Bool
>= :: WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Bool
$cmax :: WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData
max :: WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData
$cmin :: WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData
min :: WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData
Ord,(forall x.
WindowLostKeyboardFocusEventData
-> Rep WindowLostKeyboardFocusEventData x)
-> (forall x.
Rep WindowLostKeyboardFocusEventData x
-> WindowLostKeyboardFocusEventData)
-> Generic WindowLostKeyboardFocusEventData
forall x.
Rep WindowLostKeyboardFocusEventData x
-> WindowLostKeyboardFocusEventData
forall x.
WindowLostKeyboardFocusEventData
-> Rep WindowLostKeyboardFocusEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
WindowLostKeyboardFocusEventData
-> Rep WindowLostKeyboardFocusEventData x
from :: forall x.
WindowLostKeyboardFocusEventData
-> Rep WindowLostKeyboardFocusEventData x
$cto :: forall x.
Rep WindowLostKeyboardFocusEventData x
-> WindowLostKeyboardFocusEventData
to :: forall x.
Rep WindowLostKeyboardFocusEventData x
-> WindowLostKeyboardFocusEventData
Generic,Int -> WindowLostKeyboardFocusEventData -> ShowS
[WindowLostKeyboardFocusEventData] -> ShowS
WindowLostKeyboardFocusEventData -> String
(Int -> WindowLostKeyboardFocusEventData -> ShowS)
-> (WindowLostKeyboardFocusEventData -> String)
-> ([WindowLostKeyboardFocusEventData] -> ShowS)
-> Show WindowLostKeyboardFocusEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindowLostKeyboardFocusEventData -> ShowS
showsPrec :: Int -> WindowLostKeyboardFocusEventData -> ShowS
$cshow :: WindowLostKeyboardFocusEventData -> String
show :: WindowLostKeyboardFocusEventData -> String
$cshowList :: [WindowLostKeyboardFocusEventData] -> ShowS
showList :: [WindowLostKeyboardFocusEventData] -> ShowS
Show,Typeable)
newtype WindowClosedEventData =
WindowClosedEventData {WindowClosedEventData -> Window
windowClosedEventWindow :: Window
}
deriving (WindowClosedEventData -> WindowClosedEventData -> Bool
(WindowClosedEventData -> WindowClosedEventData -> Bool)
-> (WindowClosedEventData -> WindowClosedEventData -> Bool)
-> Eq WindowClosedEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WindowClosedEventData -> WindowClosedEventData -> Bool
== :: WindowClosedEventData -> WindowClosedEventData -> Bool
$c/= :: WindowClosedEventData -> WindowClosedEventData -> Bool
/= :: WindowClosedEventData -> WindowClosedEventData -> Bool
Eq,Eq WindowClosedEventData
Eq WindowClosedEventData =>
(WindowClosedEventData -> WindowClosedEventData -> Ordering)
-> (WindowClosedEventData -> WindowClosedEventData -> Bool)
-> (WindowClosedEventData -> WindowClosedEventData -> Bool)
-> (WindowClosedEventData -> WindowClosedEventData -> Bool)
-> (WindowClosedEventData -> WindowClosedEventData -> Bool)
-> (WindowClosedEventData
-> WindowClosedEventData -> WindowClosedEventData)
-> (WindowClosedEventData
-> WindowClosedEventData -> WindowClosedEventData)
-> Ord WindowClosedEventData
WindowClosedEventData -> WindowClosedEventData -> Bool
WindowClosedEventData -> WindowClosedEventData -> Ordering
WindowClosedEventData
-> WindowClosedEventData -> WindowClosedEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WindowClosedEventData -> WindowClosedEventData -> Ordering
compare :: WindowClosedEventData -> WindowClosedEventData -> Ordering
$c< :: WindowClosedEventData -> WindowClosedEventData -> Bool
< :: WindowClosedEventData -> WindowClosedEventData -> Bool
$c<= :: WindowClosedEventData -> WindowClosedEventData -> Bool
<= :: WindowClosedEventData -> WindowClosedEventData -> Bool
$c> :: WindowClosedEventData -> WindowClosedEventData -> Bool
> :: WindowClosedEventData -> WindowClosedEventData -> Bool
$c>= :: WindowClosedEventData -> WindowClosedEventData -> Bool
>= :: WindowClosedEventData -> WindowClosedEventData -> Bool
$cmax :: WindowClosedEventData
-> WindowClosedEventData -> WindowClosedEventData
max :: WindowClosedEventData
-> WindowClosedEventData -> WindowClosedEventData
$cmin :: WindowClosedEventData
-> WindowClosedEventData -> WindowClosedEventData
min :: WindowClosedEventData
-> WindowClosedEventData -> WindowClosedEventData
Ord,(forall x. WindowClosedEventData -> Rep WindowClosedEventData x)
-> (forall x. Rep WindowClosedEventData x -> WindowClosedEventData)
-> Generic WindowClosedEventData
forall x. Rep WindowClosedEventData x -> WindowClosedEventData
forall x. WindowClosedEventData -> Rep WindowClosedEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WindowClosedEventData -> Rep WindowClosedEventData x
from :: forall x. WindowClosedEventData -> Rep WindowClosedEventData x
$cto :: forall x. Rep WindowClosedEventData x -> WindowClosedEventData
to :: forall x. Rep WindowClosedEventData x -> WindowClosedEventData
Generic,Int -> WindowClosedEventData -> ShowS
[WindowClosedEventData] -> ShowS
WindowClosedEventData -> String
(Int -> WindowClosedEventData -> ShowS)
-> (WindowClosedEventData -> String)
-> ([WindowClosedEventData] -> ShowS)
-> Show WindowClosedEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindowClosedEventData -> ShowS
showsPrec :: Int -> WindowClosedEventData -> ShowS
$cshow :: WindowClosedEventData -> String
show :: WindowClosedEventData -> String
$cshowList :: [WindowClosedEventData] -> ShowS
showList :: [WindowClosedEventData] -> ShowS
Show,Typeable)
data KeyboardEventData =
KeyboardEventData {KeyboardEventData -> Maybe Window
keyboardEventWindow :: !(Maybe Window)
,KeyboardEventData -> InputMotion
keyboardEventKeyMotion :: !InputMotion
,KeyboardEventData -> Bool
keyboardEventRepeat :: !Bool
,KeyboardEventData -> Keysym
keyboardEventKeysym :: !Keysym
}
deriving (KeyboardEventData -> KeyboardEventData -> Bool
(KeyboardEventData -> KeyboardEventData -> Bool)
-> (KeyboardEventData -> KeyboardEventData -> Bool)
-> Eq KeyboardEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyboardEventData -> KeyboardEventData -> Bool
== :: KeyboardEventData -> KeyboardEventData -> Bool
$c/= :: KeyboardEventData -> KeyboardEventData -> Bool
/= :: KeyboardEventData -> KeyboardEventData -> Bool
Eq,Eq KeyboardEventData
Eq KeyboardEventData =>
(KeyboardEventData -> KeyboardEventData -> Ordering)
-> (KeyboardEventData -> KeyboardEventData -> Bool)
-> (KeyboardEventData -> KeyboardEventData -> Bool)
-> (KeyboardEventData -> KeyboardEventData -> Bool)
-> (KeyboardEventData -> KeyboardEventData -> Bool)
-> (KeyboardEventData -> KeyboardEventData -> KeyboardEventData)
-> (KeyboardEventData -> KeyboardEventData -> KeyboardEventData)
-> Ord KeyboardEventData
KeyboardEventData -> KeyboardEventData -> Bool
KeyboardEventData -> KeyboardEventData -> Ordering
KeyboardEventData -> KeyboardEventData -> KeyboardEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: KeyboardEventData -> KeyboardEventData -> Ordering
compare :: KeyboardEventData -> KeyboardEventData -> Ordering
$c< :: KeyboardEventData -> KeyboardEventData -> Bool
< :: KeyboardEventData -> KeyboardEventData -> Bool
$c<= :: KeyboardEventData -> KeyboardEventData -> Bool
<= :: KeyboardEventData -> KeyboardEventData -> Bool
$c> :: KeyboardEventData -> KeyboardEventData -> Bool
> :: KeyboardEventData -> KeyboardEventData -> Bool
$c>= :: KeyboardEventData -> KeyboardEventData -> Bool
>= :: KeyboardEventData -> KeyboardEventData -> Bool
$cmax :: KeyboardEventData -> KeyboardEventData -> KeyboardEventData
max :: KeyboardEventData -> KeyboardEventData -> KeyboardEventData
$cmin :: KeyboardEventData -> KeyboardEventData -> KeyboardEventData
min :: KeyboardEventData -> KeyboardEventData -> KeyboardEventData
Ord,(forall x. KeyboardEventData -> Rep KeyboardEventData x)
-> (forall x. Rep KeyboardEventData x -> KeyboardEventData)
-> Generic KeyboardEventData
forall x. Rep KeyboardEventData x -> KeyboardEventData
forall x. KeyboardEventData -> Rep KeyboardEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. KeyboardEventData -> Rep KeyboardEventData x
from :: forall x. KeyboardEventData -> Rep KeyboardEventData x
$cto :: forall x. Rep KeyboardEventData x -> KeyboardEventData
to :: forall x. Rep KeyboardEventData x -> KeyboardEventData
Generic,Int -> KeyboardEventData -> ShowS
[KeyboardEventData] -> ShowS
KeyboardEventData -> String
(Int -> KeyboardEventData -> ShowS)
-> (KeyboardEventData -> String)
-> ([KeyboardEventData] -> ShowS)
-> Show KeyboardEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyboardEventData -> ShowS
showsPrec :: Int -> KeyboardEventData -> ShowS
$cshow :: KeyboardEventData -> String
show :: KeyboardEventData -> String
$cshowList :: [KeyboardEventData] -> ShowS
showList :: [KeyboardEventData] -> ShowS
Show,Typeable)
data TextEditingEventData =
TextEditingEventData {TextEditingEventData -> Maybe Window
textEditingEventWindow :: !(Maybe Window)
,TextEditingEventData -> Text
textEditingEventText :: !Text
,TextEditingEventData -> Int32
textEditingEventStart :: !Int32
,TextEditingEventData -> Int32
textEditingEventLength :: !Int32
}
deriving (TextEditingEventData -> TextEditingEventData -> Bool
(TextEditingEventData -> TextEditingEventData -> Bool)
-> (TextEditingEventData -> TextEditingEventData -> Bool)
-> Eq TextEditingEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextEditingEventData -> TextEditingEventData -> Bool
== :: TextEditingEventData -> TextEditingEventData -> Bool
$c/= :: TextEditingEventData -> TextEditingEventData -> Bool
/= :: TextEditingEventData -> TextEditingEventData -> Bool
Eq,Eq TextEditingEventData
Eq TextEditingEventData =>
(TextEditingEventData -> TextEditingEventData -> Ordering)
-> (TextEditingEventData -> TextEditingEventData -> Bool)
-> (TextEditingEventData -> TextEditingEventData -> Bool)
-> (TextEditingEventData -> TextEditingEventData -> Bool)
-> (TextEditingEventData -> TextEditingEventData -> Bool)
-> (TextEditingEventData
-> TextEditingEventData -> TextEditingEventData)
-> (TextEditingEventData
-> TextEditingEventData -> TextEditingEventData)
-> Ord TextEditingEventData
TextEditingEventData -> TextEditingEventData -> Bool
TextEditingEventData -> TextEditingEventData -> Ordering
TextEditingEventData
-> TextEditingEventData -> TextEditingEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TextEditingEventData -> TextEditingEventData -> Ordering
compare :: TextEditingEventData -> TextEditingEventData -> Ordering
$c< :: TextEditingEventData -> TextEditingEventData -> Bool
< :: TextEditingEventData -> TextEditingEventData -> Bool
$c<= :: TextEditingEventData -> TextEditingEventData -> Bool
<= :: TextEditingEventData -> TextEditingEventData -> Bool
$c> :: TextEditingEventData -> TextEditingEventData -> Bool
> :: TextEditingEventData -> TextEditingEventData -> Bool
$c>= :: TextEditingEventData -> TextEditingEventData -> Bool
>= :: TextEditingEventData -> TextEditingEventData -> Bool
$cmax :: TextEditingEventData
-> TextEditingEventData -> TextEditingEventData
max :: TextEditingEventData
-> TextEditingEventData -> TextEditingEventData
$cmin :: TextEditingEventData
-> TextEditingEventData -> TextEditingEventData
min :: TextEditingEventData
-> TextEditingEventData -> TextEditingEventData
Ord,(forall x. TextEditingEventData -> Rep TextEditingEventData x)
-> (forall x. Rep TextEditingEventData x -> TextEditingEventData)
-> Generic TextEditingEventData
forall x. Rep TextEditingEventData x -> TextEditingEventData
forall x. TextEditingEventData -> Rep TextEditingEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TextEditingEventData -> Rep TextEditingEventData x
from :: forall x. TextEditingEventData -> Rep TextEditingEventData x
$cto :: forall x. Rep TextEditingEventData x -> TextEditingEventData
to :: forall x. Rep TextEditingEventData x -> TextEditingEventData
Generic,Int -> TextEditingEventData -> ShowS
[TextEditingEventData] -> ShowS
TextEditingEventData -> String
(Int -> TextEditingEventData -> ShowS)
-> (TextEditingEventData -> String)
-> ([TextEditingEventData] -> ShowS)
-> Show TextEditingEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextEditingEventData -> ShowS
showsPrec :: Int -> TextEditingEventData -> ShowS
$cshow :: TextEditingEventData -> String
show :: TextEditingEventData -> String
$cshowList :: [TextEditingEventData] -> ShowS
showList :: [TextEditingEventData] -> ShowS
Show,Typeable)
data TextInputEventData =
TextInputEventData {TextInputEventData -> Maybe Window
textInputEventWindow :: !(Maybe Window)
,TextInputEventData -> Text
textInputEventText :: !Text
}
deriving (TextInputEventData -> TextInputEventData -> Bool
(TextInputEventData -> TextInputEventData -> Bool)
-> (TextInputEventData -> TextInputEventData -> Bool)
-> Eq TextInputEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextInputEventData -> TextInputEventData -> Bool
== :: TextInputEventData -> TextInputEventData -> Bool
$c/= :: TextInputEventData -> TextInputEventData -> Bool
/= :: TextInputEventData -> TextInputEventData -> Bool
Eq,Eq TextInputEventData
Eq TextInputEventData =>
(TextInputEventData -> TextInputEventData -> Ordering)
-> (TextInputEventData -> TextInputEventData -> Bool)
-> (TextInputEventData -> TextInputEventData -> Bool)
-> (TextInputEventData -> TextInputEventData -> Bool)
-> (TextInputEventData -> TextInputEventData -> Bool)
-> (TextInputEventData -> TextInputEventData -> TextInputEventData)
-> (TextInputEventData -> TextInputEventData -> TextInputEventData)
-> Ord TextInputEventData
TextInputEventData -> TextInputEventData -> Bool
TextInputEventData -> TextInputEventData -> Ordering
TextInputEventData -> TextInputEventData -> TextInputEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TextInputEventData -> TextInputEventData -> Ordering
compare :: TextInputEventData -> TextInputEventData -> Ordering
$c< :: TextInputEventData -> TextInputEventData -> Bool
< :: TextInputEventData -> TextInputEventData -> Bool
$c<= :: TextInputEventData -> TextInputEventData -> Bool
<= :: TextInputEventData -> TextInputEventData -> Bool
$c> :: TextInputEventData -> TextInputEventData -> Bool
> :: TextInputEventData -> TextInputEventData -> Bool
$c>= :: TextInputEventData -> TextInputEventData -> Bool
>= :: TextInputEventData -> TextInputEventData -> Bool
$cmax :: TextInputEventData -> TextInputEventData -> TextInputEventData
max :: TextInputEventData -> TextInputEventData -> TextInputEventData
$cmin :: TextInputEventData -> TextInputEventData -> TextInputEventData
min :: TextInputEventData -> TextInputEventData -> TextInputEventData
Ord,(forall x. TextInputEventData -> Rep TextInputEventData x)
-> (forall x. Rep TextInputEventData x -> TextInputEventData)
-> Generic TextInputEventData
forall x. Rep TextInputEventData x -> TextInputEventData
forall x. TextInputEventData -> Rep TextInputEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TextInputEventData -> Rep TextInputEventData x
from :: forall x. TextInputEventData -> Rep TextInputEventData x
$cto :: forall x. Rep TextInputEventData x -> TextInputEventData
to :: forall x. Rep TextInputEventData x -> TextInputEventData
Generic,Int -> TextInputEventData -> ShowS
[TextInputEventData] -> ShowS
TextInputEventData -> String
(Int -> TextInputEventData -> ShowS)
-> (TextInputEventData -> String)
-> ([TextInputEventData] -> ShowS)
-> Show TextInputEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextInputEventData -> ShowS
showsPrec :: Int -> TextInputEventData -> ShowS
$cshow :: TextInputEventData -> String
show :: TextInputEventData -> String
$cshowList :: [TextInputEventData] -> ShowS
showList :: [TextInputEventData] -> ShowS
Show,Typeable)
data MouseMotionEventData =
MouseMotionEventData {MouseMotionEventData -> Maybe Window
mouseMotionEventWindow :: !(Maybe Window)
,MouseMotionEventData -> MouseDevice
mouseMotionEventWhich :: !MouseDevice
,MouseMotionEventData -> [MouseButton]
mouseMotionEventState :: ![MouseButton]
,MouseMotionEventData -> Point V2 Int32
mouseMotionEventPos :: !(Point V2 Int32)
,MouseMotionEventData -> V2 Int32
mouseMotionEventRelMotion :: !(V2 Int32)
}
deriving (MouseMotionEventData -> MouseMotionEventData -> Bool
(MouseMotionEventData -> MouseMotionEventData -> Bool)
-> (MouseMotionEventData -> MouseMotionEventData -> Bool)
-> Eq MouseMotionEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MouseMotionEventData -> MouseMotionEventData -> Bool
== :: MouseMotionEventData -> MouseMotionEventData -> Bool
$c/= :: MouseMotionEventData -> MouseMotionEventData -> Bool
/= :: MouseMotionEventData -> MouseMotionEventData -> Bool
Eq,Eq MouseMotionEventData
Eq MouseMotionEventData =>
(MouseMotionEventData -> MouseMotionEventData -> Ordering)
-> (MouseMotionEventData -> MouseMotionEventData -> Bool)
-> (MouseMotionEventData -> MouseMotionEventData -> Bool)
-> (MouseMotionEventData -> MouseMotionEventData -> Bool)
-> (MouseMotionEventData -> MouseMotionEventData -> Bool)
-> (MouseMotionEventData
-> MouseMotionEventData -> MouseMotionEventData)
-> (MouseMotionEventData
-> MouseMotionEventData -> MouseMotionEventData)
-> Ord MouseMotionEventData
MouseMotionEventData -> MouseMotionEventData -> Bool
MouseMotionEventData -> MouseMotionEventData -> Ordering
MouseMotionEventData
-> MouseMotionEventData -> MouseMotionEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MouseMotionEventData -> MouseMotionEventData -> Ordering
compare :: MouseMotionEventData -> MouseMotionEventData -> Ordering
$c< :: MouseMotionEventData -> MouseMotionEventData -> Bool
< :: MouseMotionEventData -> MouseMotionEventData -> Bool
$c<= :: MouseMotionEventData -> MouseMotionEventData -> Bool
<= :: MouseMotionEventData -> MouseMotionEventData -> Bool
$c> :: MouseMotionEventData -> MouseMotionEventData -> Bool
> :: MouseMotionEventData -> MouseMotionEventData -> Bool
$c>= :: MouseMotionEventData -> MouseMotionEventData -> Bool
>= :: MouseMotionEventData -> MouseMotionEventData -> Bool
$cmax :: MouseMotionEventData
-> MouseMotionEventData -> MouseMotionEventData
max :: MouseMotionEventData
-> MouseMotionEventData -> MouseMotionEventData
$cmin :: MouseMotionEventData
-> MouseMotionEventData -> MouseMotionEventData
min :: MouseMotionEventData
-> MouseMotionEventData -> MouseMotionEventData
Ord,(forall x. MouseMotionEventData -> Rep MouseMotionEventData x)
-> (forall x. Rep MouseMotionEventData x -> MouseMotionEventData)
-> Generic MouseMotionEventData
forall x. Rep MouseMotionEventData x -> MouseMotionEventData
forall x. MouseMotionEventData -> Rep MouseMotionEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MouseMotionEventData -> Rep MouseMotionEventData x
from :: forall x. MouseMotionEventData -> Rep MouseMotionEventData x
$cto :: forall x. Rep MouseMotionEventData x -> MouseMotionEventData
to :: forall x. Rep MouseMotionEventData x -> MouseMotionEventData
Generic,Int -> MouseMotionEventData -> ShowS
[MouseMotionEventData] -> ShowS
MouseMotionEventData -> String
(Int -> MouseMotionEventData -> ShowS)
-> (MouseMotionEventData -> String)
-> ([MouseMotionEventData] -> ShowS)
-> Show MouseMotionEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MouseMotionEventData -> ShowS
showsPrec :: Int -> MouseMotionEventData -> ShowS
$cshow :: MouseMotionEventData -> String
show :: MouseMotionEventData -> String
$cshowList :: [MouseMotionEventData] -> ShowS
showList :: [MouseMotionEventData] -> ShowS
Show,Typeable)
data MouseButtonEventData =
MouseButtonEventData {MouseButtonEventData -> Maybe Window
mouseButtonEventWindow :: !(Maybe Window)
,MouseButtonEventData -> InputMotion
mouseButtonEventMotion :: !InputMotion
,MouseButtonEventData -> MouseDevice
mouseButtonEventWhich :: !MouseDevice
,MouseButtonEventData -> MouseButton
mouseButtonEventButton :: !MouseButton
,MouseButtonEventData -> Word8
mouseButtonEventClicks :: !Word8
,MouseButtonEventData -> Point V2 Int32
mouseButtonEventPos :: !(Point V2 Int32)
}
deriving (MouseButtonEventData -> MouseButtonEventData -> Bool
(MouseButtonEventData -> MouseButtonEventData -> Bool)
-> (MouseButtonEventData -> MouseButtonEventData -> Bool)
-> Eq MouseButtonEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MouseButtonEventData -> MouseButtonEventData -> Bool
== :: MouseButtonEventData -> MouseButtonEventData -> Bool
$c/= :: MouseButtonEventData -> MouseButtonEventData -> Bool
/= :: MouseButtonEventData -> MouseButtonEventData -> Bool
Eq,Eq MouseButtonEventData
Eq MouseButtonEventData =>
(MouseButtonEventData -> MouseButtonEventData -> Ordering)
-> (MouseButtonEventData -> MouseButtonEventData -> Bool)
-> (MouseButtonEventData -> MouseButtonEventData -> Bool)
-> (MouseButtonEventData -> MouseButtonEventData -> Bool)
-> (MouseButtonEventData -> MouseButtonEventData -> Bool)
-> (MouseButtonEventData
-> MouseButtonEventData -> MouseButtonEventData)
-> (MouseButtonEventData
-> MouseButtonEventData -> MouseButtonEventData)
-> Ord MouseButtonEventData
MouseButtonEventData -> MouseButtonEventData -> Bool
MouseButtonEventData -> MouseButtonEventData -> Ordering
MouseButtonEventData
-> MouseButtonEventData -> MouseButtonEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MouseButtonEventData -> MouseButtonEventData -> Ordering
compare :: MouseButtonEventData -> MouseButtonEventData -> Ordering
$c< :: MouseButtonEventData -> MouseButtonEventData -> Bool
< :: MouseButtonEventData -> MouseButtonEventData -> Bool
$c<= :: MouseButtonEventData -> MouseButtonEventData -> Bool
<= :: MouseButtonEventData -> MouseButtonEventData -> Bool
$c> :: MouseButtonEventData -> MouseButtonEventData -> Bool
> :: MouseButtonEventData -> MouseButtonEventData -> Bool
$c>= :: MouseButtonEventData -> MouseButtonEventData -> Bool
>= :: MouseButtonEventData -> MouseButtonEventData -> Bool
$cmax :: MouseButtonEventData
-> MouseButtonEventData -> MouseButtonEventData
max :: MouseButtonEventData
-> MouseButtonEventData -> MouseButtonEventData
$cmin :: MouseButtonEventData
-> MouseButtonEventData -> MouseButtonEventData
min :: MouseButtonEventData
-> MouseButtonEventData -> MouseButtonEventData
Ord,(forall x. MouseButtonEventData -> Rep MouseButtonEventData x)
-> (forall x. Rep MouseButtonEventData x -> MouseButtonEventData)
-> Generic MouseButtonEventData
forall x. Rep MouseButtonEventData x -> MouseButtonEventData
forall x. MouseButtonEventData -> Rep MouseButtonEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MouseButtonEventData -> Rep MouseButtonEventData x
from :: forall x. MouseButtonEventData -> Rep MouseButtonEventData x
$cto :: forall x. Rep MouseButtonEventData x -> MouseButtonEventData
to :: forall x. Rep MouseButtonEventData x -> MouseButtonEventData
Generic,Int -> MouseButtonEventData -> ShowS
[MouseButtonEventData] -> ShowS
MouseButtonEventData -> String
(Int -> MouseButtonEventData -> ShowS)
-> (MouseButtonEventData -> String)
-> ([MouseButtonEventData] -> ShowS)
-> Show MouseButtonEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MouseButtonEventData -> ShowS
showsPrec :: Int -> MouseButtonEventData -> ShowS
$cshow :: MouseButtonEventData -> String
show :: MouseButtonEventData -> String
$cshowList :: [MouseButtonEventData] -> ShowS
showList :: [MouseButtonEventData] -> ShowS
Show,Typeable)
data MouseWheelEventData =
MouseWheelEventData {MouseWheelEventData -> Maybe Window
mouseWheelEventWindow :: !(Maybe Window)
,MouseWheelEventData -> MouseDevice
mouseWheelEventWhich :: !MouseDevice
,MouseWheelEventData -> V2 Int32
mouseWheelEventPos :: !(V2 Int32)
,MouseWheelEventData -> MouseScrollDirection
mouseWheelEventDirection :: !MouseScrollDirection
}
deriving (MouseWheelEventData -> MouseWheelEventData -> Bool
(MouseWheelEventData -> MouseWheelEventData -> Bool)
-> (MouseWheelEventData -> MouseWheelEventData -> Bool)
-> Eq MouseWheelEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MouseWheelEventData -> MouseWheelEventData -> Bool
== :: MouseWheelEventData -> MouseWheelEventData -> Bool
$c/= :: MouseWheelEventData -> MouseWheelEventData -> Bool
/= :: MouseWheelEventData -> MouseWheelEventData -> Bool
Eq,Eq MouseWheelEventData
Eq MouseWheelEventData =>
(MouseWheelEventData -> MouseWheelEventData -> Ordering)
-> (MouseWheelEventData -> MouseWheelEventData -> Bool)
-> (MouseWheelEventData -> MouseWheelEventData -> Bool)
-> (MouseWheelEventData -> MouseWheelEventData -> Bool)
-> (MouseWheelEventData -> MouseWheelEventData -> Bool)
-> (MouseWheelEventData
-> MouseWheelEventData -> MouseWheelEventData)
-> (MouseWheelEventData
-> MouseWheelEventData -> MouseWheelEventData)
-> Ord MouseWheelEventData
MouseWheelEventData -> MouseWheelEventData -> Bool
MouseWheelEventData -> MouseWheelEventData -> Ordering
MouseWheelEventData -> MouseWheelEventData -> MouseWheelEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MouseWheelEventData -> MouseWheelEventData -> Ordering
compare :: MouseWheelEventData -> MouseWheelEventData -> Ordering
$c< :: MouseWheelEventData -> MouseWheelEventData -> Bool
< :: MouseWheelEventData -> MouseWheelEventData -> Bool
$c<= :: MouseWheelEventData -> MouseWheelEventData -> Bool
<= :: MouseWheelEventData -> MouseWheelEventData -> Bool
$c> :: MouseWheelEventData -> MouseWheelEventData -> Bool
> :: MouseWheelEventData -> MouseWheelEventData -> Bool
$c>= :: MouseWheelEventData -> MouseWheelEventData -> Bool
>= :: MouseWheelEventData -> MouseWheelEventData -> Bool
$cmax :: MouseWheelEventData -> MouseWheelEventData -> MouseWheelEventData
max :: MouseWheelEventData -> MouseWheelEventData -> MouseWheelEventData
$cmin :: MouseWheelEventData -> MouseWheelEventData -> MouseWheelEventData
min :: MouseWheelEventData -> MouseWheelEventData -> MouseWheelEventData
Ord,(forall x. MouseWheelEventData -> Rep MouseWheelEventData x)
-> (forall x. Rep MouseWheelEventData x -> MouseWheelEventData)
-> Generic MouseWheelEventData
forall x. Rep MouseWheelEventData x -> MouseWheelEventData
forall x. MouseWheelEventData -> Rep MouseWheelEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MouseWheelEventData -> Rep MouseWheelEventData x
from :: forall x. MouseWheelEventData -> Rep MouseWheelEventData x
$cto :: forall x. Rep MouseWheelEventData x -> MouseWheelEventData
to :: forall x. Rep MouseWheelEventData x -> MouseWheelEventData
Generic,Int -> MouseWheelEventData -> ShowS
[MouseWheelEventData] -> ShowS
MouseWheelEventData -> String
(Int -> MouseWheelEventData -> ShowS)
-> (MouseWheelEventData -> String)
-> ([MouseWheelEventData] -> ShowS)
-> Show MouseWheelEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MouseWheelEventData -> ShowS
showsPrec :: Int -> MouseWheelEventData -> ShowS
$cshow :: MouseWheelEventData -> String
show :: MouseWheelEventData -> String
$cshowList :: [MouseWheelEventData] -> ShowS
showList :: [MouseWheelEventData] -> ShowS
Show,Typeable)
data JoyAxisEventData =
JoyAxisEventData {JoyAxisEventData -> Int32
joyAxisEventWhich :: !Raw.JoystickID
,JoyAxisEventData -> Word8
joyAxisEventAxis :: !Word8
,JoyAxisEventData -> Int16
joyAxisEventValue :: !Int16
}
deriving (JoyAxisEventData -> JoyAxisEventData -> Bool
(JoyAxisEventData -> JoyAxisEventData -> Bool)
-> (JoyAxisEventData -> JoyAxisEventData -> Bool)
-> Eq JoyAxisEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JoyAxisEventData -> JoyAxisEventData -> Bool
== :: JoyAxisEventData -> JoyAxisEventData -> Bool
$c/= :: JoyAxisEventData -> JoyAxisEventData -> Bool
/= :: JoyAxisEventData -> JoyAxisEventData -> Bool
Eq,Eq JoyAxisEventData
Eq JoyAxisEventData =>
(JoyAxisEventData -> JoyAxisEventData -> Ordering)
-> (JoyAxisEventData -> JoyAxisEventData -> Bool)
-> (JoyAxisEventData -> JoyAxisEventData -> Bool)
-> (JoyAxisEventData -> JoyAxisEventData -> Bool)
-> (JoyAxisEventData -> JoyAxisEventData -> Bool)
-> (JoyAxisEventData -> JoyAxisEventData -> JoyAxisEventData)
-> (JoyAxisEventData -> JoyAxisEventData -> JoyAxisEventData)
-> Ord JoyAxisEventData
JoyAxisEventData -> JoyAxisEventData -> Bool
JoyAxisEventData -> JoyAxisEventData -> Ordering
JoyAxisEventData -> JoyAxisEventData -> JoyAxisEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: JoyAxisEventData -> JoyAxisEventData -> Ordering
compare :: JoyAxisEventData -> JoyAxisEventData -> Ordering
$c< :: JoyAxisEventData -> JoyAxisEventData -> Bool
< :: JoyAxisEventData -> JoyAxisEventData -> Bool
$c<= :: JoyAxisEventData -> JoyAxisEventData -> Bool
<= :: JoyAxisEventData -> JoyAxisEventData -> Bool
$c> :: JoyAxisEventData -> JoyAxisEventData -> Bool
> :: JoyAxisEventData -> JoyAxisEventData -> Bool
$c>= :: JoyAxisEventData -> JoyAxisEventData -> Bool
>= :: JoyAxisEventData -> JoyAxisEventData -> Bool
$cmax :: JoyAxisEventData -> JoyAxisEventData -> JoyAxisEventData
max :: JoyAxisEventData -> JoyAxisEventData -> JoyAxisEventData
$cmin :: JoyAxisEventData -> JoyAxisEventData -> JoyAxisEventData
min :: JoyAxisEventData -> JoyAxisEventData -> JoyAxisEventData
Ord,(forall x. JoyAxisEventData -> Rep JoyAxisEventData x)
-> (forall x. Rep JoyAxisEventData x -> JoyAxisEventData)
-> Generic JoyAxisEventData
forall x. Rep JoyAxisEventData x -> JoyAxisEventData
forall x. JoyAxisEventData -> Rep JoyAxisEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JoyAxisEventData -> Rep JoyAxisEventData x
from :: forall x. JoyAxisEventData -> Rep JoyAxisEventData x
$cto :: forall x. Rep JoyAxisEventData x -> JoyAxisEventData
to :: forall x. Rep JoyAxisEventData x -> JoyAxisEventData
Generic,Int -> JoyAxisEventData -> ShowS
[JoyAxisEventData] -> ShowS
JoyAxisEventData -> String
(Int -> JoyAxisEventData -> ShowS)
-> (JoyAxisEventData -> String)
-> ([JoyAxisEventData] -> ShowS)
-> Show JoyAxisEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JoyAxisEventData -> ShowS
showsPrec :: Int -> JoyAxisEventData -> ShowS
$cshow :: JoyAxisEventData -> String
show :: JoyAxisEventData -> String
$cshowList :: [JoyAxisEventData] -> ShowS
showList :: [JoyAxisEventData] -> ShowS
Show,Typeable)
data JoyBallEventData =
JoyBallEventData {JoyBallEventData -> Int32
joyBallEventWhich :: !Raw.JoystickID
,JoyBallEventData -> Word8
joyBallEventBall :: !Word8
,JoyBallEventData -> V2 Int16
joyBallEventRelMotion :: !(V2 Int16)
}
deriving (JoyBallEventData -> JoyBallEventData -> Bool
(JoyBallEventData -> JoyBallEventData -> Bool)
-> (JoyBallEventData -> JoyBallEventData -> Bool)
-> Eq JoyBallEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JoyBallEventData -> JoyBallEventData -> Bool
== :: JoyBallEventData -> JoyBallEventData -> Bool
$c/= :: JoyBallEventData -> JoyBallEventData -> Bool
/= :: JoyBallEventData -> JoyBallEventData -> Bool
Eq,Eq JoyBallEventData
Eq JoyBallEventData =>
(JoyBallEventData -> JoyBallEventData -> Ordering)
-> (JoyBallEventData -> JoyBallEventData -> Bool)
-> (JoyBallEventData -> JoyBallEventData -> Bool)
-> (JoyBallEventData -> JoyBallEventData -> Bool)
-> (JoyBallEventData -> JoyBallEventData -> Bool)
-> (JoyBallEventData -> JoyBallEventData -> JoyBallEventData)
-> (JoyBallEventData -> JoyBallEventData -> JoyBallEventData)
-> Ord JoyBallEventData
JoyBallEventData -> JoyBallEventData -> Bool
JoyBallEventData -> JoyBallEventData -> Ordering
JoyBallEventData -> JoyBallEventData -> JoyBallEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: JoyBallEventData -> JoyBallEventData -> Ordering
compare :: JoyBallEventData -> JoyBallEventData -> Ordering
$c< :: JoyBallEventData -> JoyBallEventData -> Bool
< :: JoyBallEventData -> JoyBallEventData -> Bool
$c<= :: JoyBallEventData -> JoyBallEventData -> Bool
<= :: JoyBallEventData -> JoyBallEventData -> Bool
$c> :: JoyBallEventData -> JoyBallEventData -> Bool
> :: JoyBallEventData -> JoyBallEventData -> Bool
$c>= :: JoyBallEventData -> JoyBallEventData -> Bool
>= :: JoyBallEventData -> JoyBallEventData -> Bool
$cmax :: JoyBallEventData -> JoyBallEventData -> JoyBallEventData
max :: JoyBallEventData -> JoyBallEventData -> JoyBallEventData
$cmin :: JoyBallEventData -> JoyBallEventData -> JoyBallEventData
min :: JoyBallEventData -> JoyBallEventData -> JoyBallEventData
Ord,(forall x. JoyBallEventData -> Rep JoyBallEventData x)
-> (forall x. Rep JoyBallEventData x -> JoyBallEventData)
-> Generic JoyBallEventData
forall x. Rep JoyBallEventData x -> JoyBallEventData
forall x. JoyBallEventData -> Rep JoyBallEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JoyBallEventData -> Rep JoyBallEventData x
from :: forall x. JoyBallEventData -> Rep JoyBallEventData x
$cto :: forall x. Rep JoyBallEventData x -> JoyBallEventData
to :: forall x. Rep JoyBallEventData x -> JoyBallEventData
Generic,Int -> JoyBallEventData -> ShowS
[JoyBallEventData] -> ShowS
JoyBallEventData -> String
(Int -> JoyBallEventData -> ShowS)
-> (JoyBallEventData -> String)
-> ([JoyBallEventData] -> ShowS)
-> Show JoyBallEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JoyBallEventData -> ShowS
showsPrec :: Int -> JoyBallEventData -> ShowS
$cshow :: JoyBallEventData -> String
show :: JoyBallEventData -> String
$cshowList :: [JoyBallEventData] -> ShowS
showList :: [JoyBallEventData] -> ShowS
Show,Typeable)
data JoyHatEventData =
JoyHatEventData {JoyHatEventData -> Int32
joyHatEventWhich :: !Raw.JoystickID
,JoyHatEventData -> Word8
joyHatEventHat :: !Word8
,JoyHatEventData -> JoyHatPosition
joyHatEventValue :: !JoyHatPosition
}
deriving (JoyHatEventData -> JoyHatEventData -> Bool
(JoyHatEventData -> JoyHatEventData -> Bool)
-> (JoyHatEventData -> JoyHatEventData -> Bool)
-> Eq JoyHatEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JoyHatEventData -> JoyHatEventData -> Bool
== :: JoyHatEventData -> JoyHatEventData -> Bool
$c/= :: JoyHatEventData -> JoyHatEventData -> Bool
/= :: JoyHatEventData -> JoyHatEventData -> Bool
Eq,Eq JoyHatEventData
Eq JoyHatEventData =>
(JoyHatEventData -> JoyHatEventData -> Ordering)
-> (JoyHatEventData -> JoyHatEventData -> Bool)
-> (JoyHatEventData -> JoyHatEventData -> Bool)
-> (JoyHatEventData -> JoyHatEventData -> Bool)
-> (JoyHatEventData -> JoyHatEventData -> Bool)
-> (JoyHatEventData -> JoyHatEventData -> JoyHatEventData)
-> (JoyHatEventData -> JoyHatEventData -> JoyHatEventData)
-> Ord JoyHatEventData
JoyHatEventData -> JoyHatEventData -> Bool
JoyHatEventData -> JoyHatEventData -> Ordering
JoyHatEventData -> JoyHatEventData -> JoyHatEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: JoyHatEventData -> JoyHatEventData -> Ordering
compare :: JoyHatEventData -> JoyHatEventData -> Ordering
$c< :: JoyHatEventData -> JoyHatEventData -> Bool
< :: JoyHatEventData -> JoyHatEventData -> Bool
$c<= :: JoyHatEventData -> JoyHatEventData -> Bool
<= :: JoyHatEventData -> JoyHatEventData -> Bool
$c> :: JoyHatEventData -> JoyHatEventData -> Bool
> :: JoyHatEventData -> JoyHatEventData -> Bool
$c>= :: JoyHatEventData -> JoyHatEventData -> Bool
>= :: JoyHatEventData -> JoyHatEventData -> Bool
$cmax :: JoyHatEventData -> JoyHatEventData -> JoyHatEventData
max :: JoyHatEventData -> JoyHatEventData -> JoyHatEventData
$cmin :: JoyHatEventData -> JoyHatEventData -> JoyHatEventData
min :: JoyHatEventData -> JoyHatEventData -> JoyHatEventData
Ord,(forall x. JoyHatEventData -> Rep JoyHatEventData x)
-> (forall x. Rep JoyHatEventData x -> JoyHatEventData)
-> Generic JoyHatEventData
forall x. Rep JoyHatEventData x -> JoyHatEventData
forall x. JoyHatEventData -> Rep JoyHatEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JoyHatEventData -> Rep JoyHatEventData x
from :: forall x. JoyHatEventData -> Rep JoyHatEventData x
$cto :: forall x. Rep JoyHatEventData x -> JoyHatEventData
to :: forall x. Rep JoyHatEventData x -> JoyHatEventData
Generic,Int -> JoyHatEventData -> ShowS
[JoyHatEventData] -> ShowS
JoyHatEventData -> String
(Int -> JoyHatEventData -> ShowS)
-> (JoyHatEventData -> String)
-> ([JoyHatEventData] -> ShowS)
-> Show JoyHatEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JoyHatEventData -> ShowS
showsPrec :: Int -> JoyHatEventData -> ShowS
$cshow :: JoyHatEventData -> String
show :: JoyHatEventData -> String
$cshowList :: [JoyHatEventData] -> ShowS
showList :: [JoyHatEventData] -> ShowS
Show,Typeable)
data JoyButtonEventData =
JoyButtonEventData {JoyButtonEventData -> Int32
joyButtonEventWhich :: !Raw.JoystickID
,JoyButtonEventData -> Word8
joyButtonEventButton :: !Word8
,JoyButtonEventData -> JoyButtonState
joyButtonEventState :: !JoyButtonState
}
deriving (JoyButtonEventData -> JoyButtonEventData -> Bool
(JoyButtonEventData -> JoyButtonEventData -> Bool)
-> (JoyButtonEventData -> JoyButtonEventData -> Bool)
-> Eq JoyButtonEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JoyButtonEventData -> JoyButtonEventData -> Bool
== :: JoyButtonEventData -> JoyButtonEventData -> Bool
$c/= :: JoyButtonEventData -> JoyButtonEventData -> Bool
/= :: JoyButtonEventData -> JoyButtonEventData -> Bool
Eq,Eq JoyButtonEventData
Eq JoyButtonEventData =>
(JoyButtonEventData -> JoyButtonEventData -> Ordering)
-> (JoyButtonEventData -> JoyButtonEventData -> Bool)
-> (JoyButtonEventData -> JoyButtonEventData -> Bool)
-> (JoyButtonEventData -> JoyButtonEventData -> Bool)
-> (JoyButtonEventData -> JoyButtonEventData -> Bool)
-> (JoyButtonEventData -> JoyButtonEventData -> JoyButtonEventData)
-> (JoyButtonEventData -> JoyButtonEventData -> JoyButtonEventData)
-> Ord JoyButtonEventData
JoyButtonEventData -> JoyButtonEventData -> Bool
JoyButtonEventData -> JoyButtonEventData -> Ordering
JoyButtonEventData -> JoyButtonEventData -> JoyButtonEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: JoyButtonEventData -> JoyButtonEventData -> Ordering
compare :: JoyButtonEventData -> JoyButtonEventData -> Ordering
$c< :: JoyButtonEventData -> JoyButtonEventData -> Bool
< :: JoyButtonEventData -> JoyButtonEventData -> Bool
$c<= :: JoyButtonEventData -> JoyButtonEventData -> Bool
<= :: JoyButtonEventData -> JoyButtonEventData -> Bool
$c> :: JoyButtonEventData -> JoyButtonEventData -> Bool
> :: JoyButtonEventData -> JoyButtonEventData -> Bool
$c>= :: JoyButtonEventData -> JoyButtonEventData -> Bool
>= :: JoyButtonEventData -> JoyButtonEventData -> Bool
$cmax :: JoyButtonEventData -> JoyButtonEventData -> JoyButtonEventData
max :: JoyButtonEventData -> JoyButtonEventData -> JoyButtonEventData
$cmin :: JoyButtonEventData -> JoyButtonEventData -> JoyButtonEventData
min :: JoyButtonEventData -> JoyButtonEventData -> JoyButtonEventData
Ord,(forall x. JoyButtonEventData -> Rep JoyButtonEventData x)
-> (forall x. Rep JoyButtonEventData x -> JoyButtonEventData)
-> Generic JoyButtonEventData
forall x. Rep JoyButtonEventData x -> JoyButtonEventData
forall x. JoyButtonEventData -> Rep JoyButtonEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JoyButtonEventData -> Rep JoyButtonEventData x
from :: forall x. JoyButtonEventData -> Rep JoyButtonEventData x
$cto :: forall x. Rep JoyButtonEventData x -> JoyButtonEventData
to :: forall x. Rep JoyButtonEventData x -> JoyButtonEventData
Generic,Int -> JoyButtonEventData -> ShowS
[JoyButtonEventData] -> ShowS
JoyButtonEventData -> String
(Int -> JoyButtonEventData -> ShowS)
-> (JoyButtonEventData -> String)
-> ([JoyButtonEventData] -> ShowS)
-> Show JoyButtonEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JoyButtonEventData -> ShowS
showsPrec :: Int -> JoyButtonEventData -> ShowS
$cshow :: JoyButtonEventData -> String
show :: JoyButtonEventData -> String
$cshowList :: [JoyButtonEventData] -> ShowS
showList :: [JoyButtonEventData] -> ShowS
Show,Typeable)
data JoyDeviceEventData =
JoyDeviceEventData {JoyDeviceEventData -> JoyDeviceConnection
joyDeviceEventConnection :: !JoyDeviceConnection
,JoyDeviceEventData -> Int32
joyDeviceEventWhich :: !Raw.JoystickID
}
deriving (JoyDeviceEventData -> JoyDeviceEventData -> Bool
(JoyDeviceEventData -> JoyDeviceEventData -> Bool)
-> (JoyDeviceEventData -> JoyDeviceEventData -> Bool)
-> Eq JoyDeviceEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JoyDeviceEventData -> JoyDeviceEventData -> Bool
== :: JoyDeviceEventData -> JoyDeviceEventData -> Bool
$c/= :: JoyDeviceEventData -> JoyDeviceEventData -> Bool
/= :: JoyDeviceEventData -> JoyDeviceEventData -> Bool
Eq,Eq JoyDeviceEventData
Eq JoyDeviceEventData =>
(JoyDeviceEventData -> JoyDeviceEventData -> Ordering)
-> (JoyDeviceEventData -> JoyDeviceEventData -> Bool)
-> (JoyDeviceEventData -> JoyDeviceEventData -> Bool)
-> (JoyDeviceEventData -> JoyDeviceEventData -> Bool)
-> (JoyDeviceEventData -> JoyDeviceEventData -> Bool)
-> (JoyDeviceEventData -> JoyDeviceEventData -> JoyDeviceEventData)
-> (JoyDeviceEventData -> JoyDeviceEventData -> JoyDeviceEventData)
-> Ord JoyDeviceEventData
JoyDeviceEventData -> JoyDeviceEventData -> Bool
JoyDeviceEventData -> JoyDeviceEventData -> Ordering
JoyDeviceEventData -> JoyDeviceEventData -> JoyDeviceEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: JoyDeviceEventData -> JoyDeviceEventData -> Ordering
compare :: JoyDeviceEventData -> JoyDeviceEventData -> Ordering
$c< :: JoyDeviceEventData -> JoyDeviceEventData -> Bool
< :: JoyDeviceEventData -> JoyDeviceEventData -> Bool
$c<= :: JoyDeviceEventData -> JoyDeviceEventData -> Bool
<= :: JoyDeviceEventData -> JoyDeviceEventData -> Bool
$c> :: JoyDeviceEventData -> JoyDeviceEventData -> Bool
> :: JoyDeviceEventData -> JoyDeviceEventData -> Bool
$c>= :: JoyDeviceEventData -> JoyDeviceEventData -> Bool
>= :: JoyDeviceEventData -> JoyDeviceEventData -> Bool
$cmax :: JoyDeviceEventData -> JoyDeviceEventData -> JoyDeviceEventData
max :: JoyDeviceEventData -> JoyDeviceEventData -> JoyDeviceEventData
$cmin :: JoyDeviceEventData -> JoyDeviceEventData -> JoyDeviceEventData
min :: JoyDeviceEventData -> JoyDeviceEventData -> JoyDeviceEventData
Ord,(forall x. JoyDeviceEventData -> Rep JoyDeviceEventData x)
-> (forall x. Rep JoyDeviceEventData x -> JoyDeviceEventData)
-> Generic JoyDeviceEventData
forall x. Rep JoyDeviceEventData x -> JoyDeviceEventData
forall x. JoyDeviceEventData -> Rep JoyDeviceEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JoyDeviceEventData -> Rep JoyDeviceEventData x
from :: forall x. JoyDeviceEventData -> Rep JoyDeviceEventData x
$cto :: forall x. Rep JoyDeviceEventData x -> JoyDeviceEventData
to :: forall x. Rep JoyDeviceEventData x -> JoyDeviceEventData
Generic,Int -> JoyDeviceEventData -> ShowS
[JoyDeviceEventData] -> ShowS
JoyDeviceEventData -> String
(Int -> JoyDeviceEventData -> ShowS)
-> (JoyDeviceEventData -> String)
-> ([JoyDeviceEventData] -> ShowS)
-> Show JoyDeviceEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JoyDeviceEventData -> ShowS
showsPrec :: Int -> JoyDeviceEventData -> ShowS
$cshow :: JoyDeviceEventData -> String
show :: JoyDeviceEventData -> String
$cshowList :: [JoyDeviceEventData] -> ShowS
showList :: [JoyDeviceEventData] -> ShowS
Show,Typeable)
data ControllerAxisEventData =
ControllerAxisEventData {ControllerAxisEventData -> Int32
controllerAxisEventWhich :: !Raw.JoystickID
,ControllerAxisEventData -> ControllerAxis
controllerAxisEventAxis :: !ControllerAxis
,ControllerAxisEventData -> Int16
controllerAxisEventValue :: !Int16
}
deriving (ControllerAxisEventData -> ControllerAxisEventData -> Bool
(ControllerAxisEventData -> ControllerAxisEventData -> Bool)
-> (ControllerAxisEventData -> ControllerAxisEventData -> Bool)
-> Eq ControllerAxisEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ControllerAxisEventData -> ControllerAxisEventData -> Bool
== :: ControllerAxisEventData -> ControllerAxisEventData -> Bool
$c/= :: ControllerAxisEventData -> ControllerAxisEventData -> Bool
/= :: ControllerAxisEventData -> ControllerAxisEventData -> Bool
Eq,Eq ControllerAxisEventData
Eq ControllerAxisEventData =>
(ControllerAxisEventData -> ControllerAxisEventData -> Ordering)
-> (ControllerAxisEventData -> ControllerAxisEventData -> Bool)
-> (ControllerAxisEventData -> ControllerAxisEventData -> Bool)
-> (ControllerAxisEventData -> ControllerAxisEventData -> Bool)
-> (ControllerAxisEventData -> ControllerAxisEventData -> Bool)
-> (ControllerAxisEventData
-> ControllerAxisEventData -> ControllerAxisEventData)
-> (ControllerAxisEventData
-> ControllerAxisEventData -> ControllerAxisEventData)
-> Ord ControllerAxisEventData
ControllerAxisEventData -> ControllerAxisEventData -> Bool
ControllerAxisEventData -> ControllerAxisEventData -> Ordering
ControllerAxisEventData
-> ControllerAxisEventData -> ControllerAxisEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ControllerAxisEventData -> ControllerAxisEventData -> Ordering
compare :: ControllerAxisEventData -> ControllerAxisEventData -> Ordering
$c< :: ControllerAxisEventData -> ControllerAxisEventData -> Bool
< :: ControllerAxisEventData -> ControllerAxisEventData -> Bool
$c<= :: ControllerAxisEventData -> ControllerAxisEventData -> Bool
<= :: ControllerAxisEventData -> ControllerAxisEventData -> Bool
$c> :: ControllerAxisEventData -> ControllerAxisEventData -> Bool
> :: ControllerAxisEventData -> ControllerAxisEventData -> Bool
$c>= :: ControllerAxisEventData -> ControllerAxisEventData -> Bool
>= :: ControllerAxisEventData -> ControllerAxisEventData -> Bool
$cmax :: ControllerAxisEventData
-> ControllerAxisEventData -> ControllerAxisEventData
max :: ControllerAxisEventData
-> ControllerAxisEventData -> ControllerAxisEventData
$cmin :: ControllerAxisEventData
-> ControllerAxisEventData -> ControllerAxisEventData
min :: ControllerAxisEventData
-> ControllerAxisEventData -> ControllerAxisEventData
Ord,(forall x.
ControllerAxisEventData -> Rep ControllerAxisEventData x)
-> (forall x.
Rep ControllerAxisEventData x -> ControllerAxisEventData)
-> Generic ControllerAxisEventData
forall x. Rep ControllerAxisEventData x -> ControllerAxisEventData
forall x. ControllerAxisEventData -> Rep ControllerAxisEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ControllerAxisEventData -> Rep ControllerAxisEventData x
from :: forall x. ControllerAxisEventData -> Rep ControllerAxisEventData x
$cto :: forall x. Rep ControllerAxisEventData x -> ControllerAxisEventData
to :: forall x. Rep ControllerAxisEventData x -> ControllerAxisEventData
Generic,Int -> ControllerAxisEventData -> ShowS
[ControllerAxisEventData] -> ShowS
ControllerAxisEventData -> String
(Int -> ControllerAxisEventData -> ShowS)
-> (ControllerAxisEventData -> String)
-> ([ControllerAxisEventData] -> ShowS)
-> Show ControllerAxisEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ControllerAxisEventData -> ShowS
showsPrec :: Int -> ControllerAxisEventData -> ShowS
$cshow :: ControllerAxisEventData -> String
show :: ControllerAxisEventData -> String
$cshowList :: [ControllerAxisEventData] -> ShowS
showList :: [ControllerAxisEventData] -> ShowS
Show,Typeable)
data ControllerButtonEventData =
ControllerButtonEventData {ControllerButtonEventData -> Int32
controllerButtonEventWhich :: !Raw.JoystickID
,ControllerButtonEventData -> ControllerButton
controllerButtonEventButton :: !ControllerButton
,ControllerButtonEventData -> ControllerButtonState
controllerButtonEventState :: !ControllerButtonState
}
deriving (ControllerButtonEventData -> ControllerButtonEventData -> Bool
(ControllerButtonEventData -> ControllerButtonEventData -> Bool)
-> (ControllerButtonEventData -> ControllerButtonEventData -> Bool)
-> Eq ControllerButtonEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ControllerButtonEventData -> ControllerButtonEventData -> Bool
== :: ControllerButtonEventData -> ControllerButtonEventData -> Bool
$c/= :: ControllerButtonEventData -> ControllerButtonEventData -> Bool
/= :: ControllerButtonEventData -> ControllerButtonEventData -> Bool
Eq,Eq ControllerButtonEventData
Eq ControllerButtonEventData =>
(ControllerButtonEventData
-> ControllerButtonEventData -> Ordering)
-> (ControllerButtonEventData -> ControllerButtonEventData -> Bool)
-> (ControllerButtonEventData -> ControllerButtonEventData -> Bool)
-> (ControllerButtonEventData -> ControllerButtonEventData -> Bool)
-> (ControllerButtonEventData -> ControllerButtonEventData -> Bool)
-> (ControllerButtonEventData
-> ControllerButtonEventData -> ControllerButtonEventData)
-> (ControllerButtonEventData
-> ControllerButtonEventData -> ControllerButtonEventData)
-> Ord ControllerButtonEventData
ControllerButtonEventData -> ControllerButtonEventData -> Bool
ControllerButtonEventData -> ControllerButtonEventData -> Ordering
ControllerButtonEventData
-> ControllerButtonEventData -> ControllerButtonEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ControllerButtonEventData -> ControllerButtonEventData -> Ordering
compare :: ControllerButtonEventData -> ControllerButtonEventData -> Ordering
$c< :: ControllerButtonEventData -> ControllerButtonEventData -> Bool
< :: ControllerButtonEventData -> ControllerButtonEventData -> Bool
$c<= :: ControllerButtonEventData -> ControllerButtonEventData -> Bool
<= :: ControllerButtonEventData -> ControllerButtonEventData -> Bool
$c> :: ControllerButtonEventData -> ControllerButtonEventData -> Bool
> :: ControllerButtonEventData -> ControllerButtonEventData -> Bool
$c>= :: ControllerButtonEventData -> ControllerButtonEventData -> Bool
>= :: ControllerButtonEventData -> ControllerButtonEventData -> Bool
$cmax :: ControllerButtonEventData
-> ControllerButtonEventData -> ControllerButtonEventData
max :: ControllerButtonEventData
-> ControllerButtonEventData -> ControllerButtonEventData
$cmin :: ControllerButtonEventData
-> ControllerButtonEventData -> ControllerButtonEventData
min :: ControllerButtonEventData
-> ControllerButtonEventData -> ControllerButtonEventData
Ord,(forall x.
ControllerButtonEventData -> Rep ControllerButtonEventData x)
-> (forall x.
Rep ControllerButtonEventData x -> ControllerButtonEventData)
-> Generic ControllerButtonEventData
forall x.
Rep ControllerButtonEventData x -> ControllerButtonEventData
forall x.
ControllerButtonEventData -> Rep ControllerButtonEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ControllerButtonEventData -> Rep ControllerButtonEventData x
from :: forall x.
ControllerButtonEventData -> Rep ControllerButtonEventData x
$cto :: forall x.
Rep ControllerButtonEventData x -> ControllerButtonEventData
to :: forall x.
Rep ControllerButtonEventData x -> ControllerButtonEventData
Generic,Int -> ControllerButtonEventData -> ShowS
[ControllerButtonEventData] -> ShowS
ControllerButtonEventData -> String
(Int -> ControllerButtonEventData -> ShowS)
-> (ControllerButtonEventData -> String)
-> ([ControllerButtonEventData] -> ShowS)
-> Show ControllerButtonEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ControllerButtonEventData -> ShowS
showsPrec :: Int -> ControllerButtonEventData -> ShowS
$cshow :: ControllerButtonEventData -> String
show :: ControllerButtonEventData -> String
$cshowList :: [ControllerButtonEventData] -> ShowS
showList :: [ControllerButtonEventData] -> ShowS
Show,Typeable)
data ControllerDeviceEventData =
ControllerDeviceEventData {ControllerDeviceEventData -> ControllerDeviceConnection
controllerDeviceEventConnection :: !ControllerDeviceConnection
,ControllerDeviceEventData -> Int32
controllerDeviceEventWhich :: !Raw.JoystickID
}
deriving (ControllerDeviceEventData -> ControllerDeviceEventData -> Bool
(ControllerDeviceEventData -> ControllerDeviceEventData -> Bool)
-> (ControllerDeviceEventData -> ControllerDeviceEventData -> Bool)
-> Eq ControllerDeviceEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ControllerDeviceEventData -> ControllerDeviceEventData -> Bool
== :: ControllerDeviceEventData -> ControllerDeviceEventData -> Bool
$c/= :: ControllerDeviceEventData -> ControllerDeviceEventData -> Bool
/= :: ControllerDeviceEventData -> ControllerDeviceEventData -> Bool
Eq,Eq ControllerDeviceEventData
Eq ControllerDeviceEventData =>
(ControllerDeviceEventData
-> ControllerDeviceEventData -> Ordering)
-> (ControllerDeviceEventData -> ControllerDeviceEventData -> Bool)
-> (ControllerDeviceEventData -> ControllerDeviceEventData -> Bool)
-> (ControllerDeviceEventData -> ControllerDeviceEventData -> Bool)
-> (ControllerDeviceEventData -> ControllerDeviceEventData -> Bool)
-> (ControllerDeviceEventData
-> ControllerDeviceEventData -> ControllerDeviceEventData)
-> (ControllerDeviceEventData
-> ControllerDeviceEventData -> ControllerDeviceEventData)
-> Ord ControllerDeviceEventData
ControllerDeviceEventData -> ControllerDeviceEventData -> Bool
ControllerDeviceEventData -> ControllerDeviceEventData -> Ordering
ControllerDeviceEventData
-> ControllerDeviceEventData -> ControllerDeviceEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ControllerDeviceEventData -> ControllerDeviceEventData -> Ordering
compare :: ControllerDeviceEventData -> ControllerDeviceEventData -> Ordering
$c< :: ControllerDeviceEventData -> ControllerDeviceEventData -> Bool
< :: ControllerDeviceEventData -> ControllerDeviceEventData -> Bool
$c<= :: ControllerDeviceEventData -> ControllerDeviceEventData -> Bool
<= :: ControllerDeviceEventData -> ControllerDeviceEventData -> Bool
$c> :: ControllerDeviceEventData -> ControllerDeviceEventData -> Bool
> :: ControllerDeviceEventData -> ControllerDeviceEventData -> Bool
$c>= :: ControllerDeviceEventData -> ControllerDeviceEventData -> Bool
>= :: ControllerDeviceEventData -> ControllerDeviceEventData -> Bool
$cmax :: ControllerDeviceEventData
-> ControllerDeviceEventData -> ControllerDeviceEventData
max :: ControllerDeviceEventData
-> ControllerDeviceEventData -> ControllerDeviceEventData
$cmin :: ControllerDeviceEventData
-> ControllerDeviceEventData -> ControllerDeviceEventData
min :: ControllerDeviceEventData
-> ControllerDeviceEventData -> ControllerDeviceEventData
Ord,(forall x.
ControllerDeviceEventData -> Rep ControllerDeviceEventData x)
-> (forall x.
Rep ControllerDeviceEventData x -> ControllerDeviceEventData)
-> Generic ControllerDeviceEventData
forall x.
Rep ControllerDeviceEventData x -> ControllerDeviceEventData
forall x.
ControllerDeviceEventData -> Rep ControllerDeviceEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ControllerDeviceEventData -> Rep ControllerDeviceEventData x
from :: forall x.
ControllerDeviceEventData -> Rep ControllerDeviceEventData x
$cto :: forall x.
Rep ControllerDeviceEventData x -> ControllerDeviceEventData
to :: forall x.
Rep ControllerDeviceEventData x -> ControllerDeviceEventData
Generic,Int -> ControllerDeviceEventData -> ShowS
[ControllerDeviceEventData] -> ShowS
ControllerDeviceEventData -> String
(Int -> ControllerDeviceEventData -> ShowS)
-> (ControllerDeviceEventData -> String)
-> ([ControllerDeviceEventData] -> ShowS)
-> Show ControllerDeviceEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ControllerDeviceEventData -> ShowS
showsPrec :: Int -> ControllerDeviceEventData -> ShowS
$cshow :: ControllerDeviceEventData -> String
show :: ControllerDeviceEventData -> String
$cshowList :: [ControllerDeviceEventData] -> ShowS
showList :: [ControllerDeviceEventData] -> ShowS
Show,Typeable)
data AudioDeviceEventData =
AudioDeviceEventData {AudioDeviceEventData -> Bool
audioDeviceEventIsAddition :: !Bool
,AudioDeviceEventData -> Word32
audioDeviceEventWhich :: !Word32
,AudioDeviceEventData -> Bool
audioDeviceEventIsCapture :: !Bool
}
deriving (AudioDeviceEventData -> AudioDeviceEventData -> Bool
(AudioDeviceEventData -> AudioDeviceEventData -> Bool)
-> (AudioDeviceEventData -> AudioDeviceEventData -> Bool)
-> Eq AudioDeviceEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AudioDeviceEventData -> AudioDeviceEventData -> Bool
== :: AudioDeviceEventData -> AudioDeviceEventData -> Bool
$c/= :: AudioDeviceEventData -> AudioDeviceEventData -> Bool
/= :: AudioDeviceEventData -> AudioDeviceEventData -> Bool
Eq,Eq AudioDeviceEventData
Eq AudioDeviceEventData =>
(AudioDeviceEventData -> AudioDeviceEventData -> Ordering)
-> (AudioDeviceEventData -> AudioDeviceEventData -> Bool)
-> (AudioDeviceEventData -> AudioDeviceEventData -> Bool)
-> (AudioDeviceEventData -> AudioDeviceEventData -> Bool)
-> (AudioDeviceEventData -> AudioDeviceEventData -> Bool)
-> (AudioDeviceEventData
-> AudioDeviceEventData -> AudioDeviceEventData)
-> (AudioDeviceEventData
-> AudioDeviceEventData -> AudioDeviceEventData)
-> Ord AudioDeviceEventData
AudioDeviceEventData -> AudioDeviceEventData -> Bool
AudioDeviceEventData -> AudioDeviceEventData -> Ordering
AudioDeviceEventData
-> AudioDeviceEventData -> AudioDeviceEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AudioDeviceEventData -> AudioDeviceEventData -> Ordering
compare :: AudioDeviceEventData -> AudioDeviceEventData -> Ordering
$c< :: AudioDeviceEventData -> AudioDeviceEventData -> Bool
< :: AudioDeviceEventData -> AudioDeviceEventData -> Bool
$c<= :: AudioDeviceEventData -> AudioDeviceEventData -> Bool
<= :: AudioDeviceEventData -> AudioDeviceEventData -> Bool
$c> :: AudioDeviceEventData -> AudioDeviceEventData -> Bool
> :: AudioDeviceEventData -> AudioDeviceEventData -> Bool
$c>= :: AudioDeviceEventData -> AudioDeviceEventData -> Bool
>= :: AudioDeviceEventData -> AudioDeviceEventData -> Bool
$cmax :: AudioDeviceEventData
-> AudioDeviceEventData -> AudioDeviceEventData
max :: AudioDeviceEventData
-> AudioDeviceEventData -> AudioDeviceEventData
$cmin :: AudioDeviceEventData
-> AudioDeviceEventData -> AudioDeviceEventData
min :: AudioDeviceEventData
-> AudioDeviceEventData -> AudioDeviceEventData
Ord,(forall x. AudioDeviceEventData -> Rep AudioDeviceEventData x)
-> (forall x. Rep AudioDeviceEventData x -> AudioDeviceEventData)
-> Generic AudioDeviceEventData
forall x. Rep AudioDeviceEventData x -> AudioDeviceEventData
forall x. AudioDeviceEventData -> Rep AudioDeviceEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AudioDeviceEventData -> Rep AudioDeviceEventData x
from :: forall x. AudioDeviceEventData -> Rep AudioDeviceEventData x
$cto :: forall x. Rep AudioDeviceEventData x -> AudioDeviceEventData
to :: forall x. Rep AudioDeviceEventData x -> AudioDeviceEventData
Generic,Int -> AudioDeviceEventData -> ShowS
[AudioDeviceEventData] -> ShowS
AudioDeviceEventData -> String
(Int -> AudioDeviceEventData -> ShowS)
-> (AudioDeviceEventData -> String)
-> ([AudioDeviceEventData] -> ShowS)
-> Show AudioDeviceEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AudioDeviceEventData -> ShowS
showsPrec :: Int -> AudioDeviceEventData -> ShowS
$cshow :: AudioDeviceEventData -> String
show :: AudioDeviceEventData -> String
$cshowList :: [AudioDeviceEventData] -> ShowS
showList :: [AudioDeviceEventData] -> ShowS
Show,Typeable)
data UserEventData =
UserEventData {UserEventData -> Word32
userEventType :: !Word32
,UserEventData -> Maybe Window
userEventWindow :: !(Maybe Window)
,UserEventData -> Int32
userEventCode :: !Int32
,UserEventData -> Ptr ()
userEventData1 :: !(Ptr ())
,UserEventData -> Ptr ()
userEventData2 :: !(Ptr ())
}
deriving (UserEventData -> UserEventData -> Bool
(UserEventData -> UserEventData -> Bool)
-> (UserEventData -> UserEventData -> Bool) -> Eq UserEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserEventData -> UserEventData -> Bool
== :: UserEventData -> UserEventData -> Bool
$c/= :: UserEventData -> UserEventData -> Bool
/= :: UserEventData -> UserEventData -> Bool
Eq,Eq UserEventData
Eq UserEventData =>
(UserEventData -> UserEventData -> Ordering)
-> (UserEventData -> UserEventData -> Bool)
-> (UserEventData -> UserEventData -> Bool)
-> (UserEventData -> UserEventData -> Bool)
-> (UserEventData -> UserEventData -> Bool)
-> (UserEventData -> UserEventData -> UserEventData)
-> (UserEventData -> UserEventData -> UserEventData)
-> Ord UserEventData
UserEventData -> UserEventData -> Bool
UserEventData -> UserEventData -> Ordering
UserEventData -> UserEventData -> UserEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UserEventData -> UserEventData -> Ordering
compare :: UserEventData -> UserEventData -> Ordering
$c< :: UserEventData -> UserEventData -> Bool
< :: UserEventData -> UserEventData -> Bool
$c<= :: UserEventData -> UserEventData -> Bool
<= :: UserEventData -> UserEventData -> Bool
$c> :: UserEventData -> UserEventData -> Bool
> :: UserEventData -> UserEventData -> Bool
$c>= :: UserEventData -> UserEventData -> Bool
>= :: UserEventData -> UserEventData -> Bool
$cmax :: UserEventData -> UserEventData -> UserEventData
max :: UserEventData -> UserEventData -> UserEventData
$cmin :: UserEventData -> UserEventData -> UserEventData
min :: UserEventData -> UserEventData -> UserEventData
Ord,(forall x. UserEventData -> Rep UserEventData x)
-> (forall x. Rep UserEventData x -> UserEventData)
-> Generic UserEventData
forall x. Rep UserEventData x -> UserEventData
forall x. UserEventData -> Rep UserEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserEventData -> Rep UserEventData x
from :: forall x. UserEventData -> Rep UserEventData x
$cto :: forall x. Rep UserEventData x -> UserEventData
to :: forall x. Rep UserEventData x -> UserEventData
Generic,Int -> UserEventData -> ShowS
[UserEventData] -> ShowS
UserEventData -> String
(Int -> UserEventData -> ShowS)
-> (UserEventData -> String)
-> ([UserEventData] -> ShowS)
-> Show UserEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserEventData -> ShowS
showsPrec :: Int -> UserEventData -> ShowS
$cshow :: UserEventData -> String
show :: UserEventData -> String
$cshowList :: [UserEventData] -> ShowS
showList :: [UserEventData] -> ShowS
Show,Typeable)
newtype SysWMEventData =
SysWMEventData {SysWMEventData -> Ptr ()
sysWMEventMsg :: Raw.SysWMmsg}
deriving (SysWMEventData -> SysWMEventData -> Bool
(SysWMEventData -> SysWMEventData -> Bool)
-> (SysWMEventData -> SysWMEventData -> Bool) -> Eq SysWMEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SysWMEventData -> SysWMEventData -> Bool
== :: SysWMEventData -> SysWMEventData -> Bool
$c/= :: SysWMEventData -> SysWMEventData -> Bool
/= :: SysWMEventData -> SysWMEventData -> Bool
Eq,Eq SysWMEventData
Eq SysWMEventData =>
(SysWMEventData -> SysWMEventData -> Ordering)
-> (SysWMEventData -> SysWMEventData -> Bool)
-> (SysWMEventData -> SysWMEventData -> Bool)
-> (SysWMEventData -> SysWMEventData -> Bool)
-> (SysWMEventData -> SysWMEventData -> Bool)
-> (SysWMEventData -> SysWMEventData -> SysWMEventData)
-> (SysWMEventData -> SysWMEventData -> SysWMEventData)
-> Ord SysWMEventData
SysWMEventData -> SysWMEventData -> Bool
SysWMEventData -> SysWMEventData -> Ordering
SysWMEventData -> SysWMEventData -> SysWMEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SysWMEventData -> SysWMEventData -> Ordering
compare :: SysWMEventData -> SysWMEventData -> Ordering
$c< :: SysWMEventData -> SysWMEventData -> Bool
< :: SysWMEventData -> SysWMEventData -> Bool
$c<= :: SysWMEventData -> SysWMEventData -> Bool
<= :: SysWMEventData -> SysWMEventData -> Bool
$c> :: SysWMEventData -> SysWMEventData -> Bool
> :: SysWMEventData -> SysWMEventData -> Bool
$c>= :: SysWMEventData -> SysWMEventData -> Bool
>= :: SysWMEventData -> SysWMEventData -> Bool
$cmax :: SysWMEventData -> SysWMEventData -> SysWMEventData
max :: SysWMEventData -> SysWMEventData -> SysWMEventData
$cmin :: SysWMEventData -> SysWMEventData -> SysWMEventData
min :: SysWMEventData -> SysWMEventData -> SysWMEventData
Ord,(forall x. SysWMEventData -> Rep SysWMEventData x)
-> (forall x. Rep SysWMEventData x -> SysWMEventData)
-> Generic SysWMEventData
forall x. Rep SysWMEventData x -> SysWMEventData
forall x. SysWMEventData -> Rep SysWMEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SysWMEventData -> Rep SysWMEventData x
from :: forall x. SysWMEventData -> Rep SysWMEventData x
$cto :: forall x. Rep SysWMEventData x -> SysWMEventData
to :: forall x. Rep SysWMEventData x -> SysWMEventData
Generic,Int -> SysWMEventData -> ShowS
[SysWMEventData] -> ShowS
SysWMEventData -> String
(Int -> SysWMEventData -> ShowS)
-> (SysWMEventData -> String)
-> ([SysWMEventData] -> ShowS)
-> Show SysWMEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SysWMEventData -> ShowS
showsPrec :: Int -> SysWMEventData -> ShowS
$cshow :: SysWMEventData -> String
show :: SysWMEventData -> String
$cshowList :: [SysWMEventData] -> ShowS
showList :: [SysWMEventData] -> ShowS
Show,Typeable)
data TouchFingerEventData =
TouchFingerEventData {TouchFingerEventData -> TouchID
touchFingerEventTouchID :: !Raw.TouchID
,TouchFingerEventData -> TouchID
touchFingerEventFingerID :: !Raw.FingerID
,TouchFingerEventData -> InputMotion
touchFingerEventMotion :: !InputMotion
,TouchFingerEventData -> Point V2 CFloat
touchFingerEventPos :: !(Point V2 CFloat)
,TouchFingerEventData -> CFloat
touchFingerEventPressure :: !CFloat
}
deriving (TouchFingerEventData -> TouchFingerEventData -> Bool
(TouchFingerEventData -> TouchFingerEventData -> Bool)
-> (TouchFingerEventData -> TouchFingerEventData -> Bool)
-> Eq TouchFingerEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TouchFingerEventData -> TouchFingerEventData -> Bool
== :: TouchFingerEventData -> TouchFingerEventData -> Bool
$c/= :: TouchFingerEventData -> TouchFingerEventData -> Bool
/= :: TouchFingerEventData -> TouchFingerEventData -> Bool
Eq,Eq TouchFingerEventData
Eq TouchFingerEventData =>
(TouchFingerEventData -> TouchFingerEventData -> Ordering)
-> (TouchFingerEventData -> TouchFingerEventData -> Bool)
-> (TouchFingerEventData -> TouchFingerEventData -> Bool)
-> (TouchFingerEventData -> TouchFingerEventData -> Bool)
-> (TouchFingerEventData -> TouchFingerEventData -> Bool)
-> (TouchFingerEventData
-> TouchFingerEventData -> TouchFingerEventData)
-> (TouchFingerEventData
-> TouchFingerEventData -> TouchFingerEventData)
-> Ord TouchFingerEventData
TouchFingerEventData -> TouchFingerEventData -> Bool
TouchFingerEventData -> TouchFingerEventData -> Ordering
TouchFingerEventData
-> TouchFingerEventData -> TouchFingerEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TouchFingerEventData -> TouchFingerEventData -> Ordering
compare :: TouchFingerEventData -> TouchFingerEventData -> Ordering
$c< :: TouchFingerEventData -> TouchFingerEventData -> Bool
< :: TouchFingerEventData -> TouchFingerEventData -> Bool
$c<= :: TouchFingerEventData -> TouchFingerEventData -> Bool
<= :: TouchFingerEventData -> TouchFingerEventData -> Bool
$c> :: TouchFingerEventData -> TouchFingerEventData -> Bool
> :: TouchFingerEventData -> TouchFingerEventData -> Bool
$c>= :: TouchFingerEventData -> TouchFingerEventData -> Bool
>= :: TouchFingerEventData -> TouchFingerEventData -> Bool
$cmax :: TouchFingerEventData
-> TouchFingerEventData -> TouchFingerEventData
max :: TouchFingerEventData
-> TouchFingerEventData -> TouchFingerEventData
$cmin :: TouchFingerEventData
-> TouchFingerEventData -> TouchFingerEventData
min :: TouchFingerEventData
-> TouchFingerEventData -> TouchFingerEventData
Ord,(forall x. TouchFingerEventData -> Rep TouchFingerEventData x)
-> (forall x. Rep TouchFingerEventData x -> TouchFingerEventData)
-> Generic TouchFingerEventData
forall x. Rep TouchFingerEventData x -> TouchFingerEventData
forall x. TouchFingerEventData -> Rep TouchFingerEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TouchFingerEventData -> Rep TouchFingerEventData x
from :: forall x. TouchFingerEventData -> Rep TouchFingerEventData x
$cto :: forall x. Rep TouchFingerEventData x -> TouchFingerEventData
to :: forall x. Rep TouchFingerEventData x -> TouchFingerEventData
Generic,Int -> TouchFingerEventData -> ShowS
[TouchFingerEventData] -> ShowS
TouchFingerEventData -> String
(Int -> TouchFingerEventData -> ShowS)
-> (TouchFingerEventData -> String)
-> ([TouchFingerEventData] -> ShowS)
-> Show TouchFingerEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TouchFingerEventData -> ShowS
showsPrec :: Int -> TouchFingerEventData -> ShowS
$cshow :: TouchFingerEventData -> String
show :: TouchFingerEventData -> String
$cshowList :: [TouchFingerEventData] -> ShowS
showList :: [TouchFingerEventData] -> ShowS
Show,Typeable)
data TouchFingerMotionEventData =
TouchFingerMotionEventData {TouchFingerMotionEventData -> TouchID
touchFingerMotionEventTouchID :: !Raw.TouchID
,TouchFingerMotionEventData -> TouchID
touchFingerMotionEventFingerID :: !Raw.FingerID
,TouchFingerMotionEventData -> Point V2 CFloat
touchFingerMotionEventPos :: !(Point V2 CFloat)
,TouchFingerMotionEventData -> V2 CFloat
touchFingerMotionEventRelMotion :: !(V2 CFloat)
,TouchFingerMotionEventData -> CFloat
touchFingerMotionEventPressure :: !CFloat
}
deriving (TouchFingerMotionEventData -> TouchFingerMotionEventData -> Bool
(TouchFingerMotionEventData -> TouchFingerMotionEventData -> Bool)
-> (TouchFingerMotionEventData
-> TouchFingerMotionEventData -> Bool)
-> Eq TouchFingerMotionEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TouchFingerMotionEventData -> TouchFingerMotionEventData -> Bool
== :: TouchFingerMotionEventData -> TouchFingerMotionEventData -> Bool
$c/= :: TouchFingerMotionEventData -> TouchFingerMotionEventData -> Bool
/= :: TouchFingerMotionEventData -> TouchFingerMotionEventData -> Bool
Eq,Eq TouchFingerMotionEventData
Eq TouchFingerMotionEventData =>
(TouchFingerMotionEventData
-> TouchFingerMotionEventData -> Ordering)
-> (TouchFingerMotionEventData
-> TouchFingerMotionEventData -> Bool)
-> (TouchFingerMotionEventData
-> TouchFingerMotionEventData -> Bool)
-> (TouchFingerMotionEventData
-> TouchFingerMotionEventData -> Bool)
-> (TouchFingerMotionEventData
-> TouchFingerMotionEventData -> Bool)
-> (TouchFingerMotionEventData
-> TouchFingerMotionEventData -> TouchFingerMotionEventData)
-> (TouchFingerMotionEventData
-> TouchFingerMotionEventData -> TouchFingerMotionEventData)
-> Ord TouchFingerMotionEventData
TouchFingerMotionEventData -> TouchFingerMotionEventData -> Bool
TouchFingerMotionEventData
-> TouchFingerMotionEventData -> Ordering
TouchFingerMotionEventData
-> TouchFingerMotionEventData -> TouchFingerMotionEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TouchFingerMotionEventData
-> TouchFingerMotionEventData -> Ordering
compare :: TouchFingerMotionEventData
-> TouchFingerMotionEventData -> Ordering
$c< :: TouchFingerMotionEventData -> TouchFingerMotionEventData -> Bool
< :: TouchFingerMotionEventData -> TouchFingerMotionEventData -> Bool
$c<= :: TouchFingerMotionEventData -> TouchFingerMotionEventData -> Bool
<= :: TouchFingerMotionEventData -> TouchFingerMotionEventData -> Bool
$c> :: TouchFingerMotionEventData -> TouchFingerMotionEventData -> Bool
> :: TouchFingerMotionEventData -> TouchFingerMotionEventData -> Bool
$c>= :: TouchFingerMotionEventData -> TouchFingerMotionEventData -> Bool
>= :: TouchFingerMotionEventData -> TouchFingerMotionEventData -> Bool
$cmax :: TouchFingerMotionEventData
-> TouchFingerMotionEventData -> TouchFingerMotionEventData
max :: TouchFingerMotionEventData
-> TouchFingerMotionEventData -> TouchFingerMotionEventData
$cmin :: TouchFingerMotionEventData
-> TouchFingerMotionEventData -> TouchFingerMotionEventData
min :: TouchFingerMotionEventData
-> TouchFingerMotionEventData -> TouchFingerMotionEventData
Ord,(forall x.
TouchFingerMotionEventData -> Rep TouchFingerMotionEventData x)
-> (forall x.
Rep TouchFingerMotionEventData x -> TouchFingerMotionEventData)
-> Generic TouchFingerMotionEventData
forall x.
Rep TouchFingerMotionEventData x -> TouchFingerMotionEventData
forall x.
TouchFingerMotionEventData -> Rep TouchFingerMotionEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
TouchFingerMotionEventData -> Rep TouchFingerMotionEventData x
from :: forall x.
TouchFingerMotionEventData -> Rep TouchFingerMotionEventData x
$cto :: forall x.
Rep TouchFingerMotionEventData x -> TouchFingerMotionEventData
to :: forall x.
Rep TouchFingerMotionEventData x -> TouchFingerMotionEventData
Generic,Int -> TouchFingerMotionEventData -> ShowS
[TouchFingerMotionEventData] -> ShowS
TouchFingerMotionEventData -> String
(Int -> TouchFingerMotionEventData -> ShowS)
-> (TouchFingerMotionEventData -> String)
-> ([TouchFingerMotionEventData] -> ShowS)
-> Show TouchFingerMotionEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TouchFingerMotionEventData -> ShowS
showsPrec :: Int -> TouchFingerMotionEventData -> ShowS
$cshow :: TouchFingerMotionEventData -> String
show :: TouchFingerMotionEventData -> String
$cshowList :: [TouchFingerMotionEventData] -> ShowS
showList :: [TouchFingerMotionEventData] -> ShowS
Show,Typeable)
data MultiGestureEventData =
MultiGestureEventData {MultiGestureEventData -> TouchID
multiGestureEventTouchID :: !Raw.TouchID
,MultiGestureEventData -> CFloat
multiGestureEventDTheta :: !CFloat
,MultiGestureEventData -> CFloat
multiGestureEventDDist :: !CFloat
,MultiGestureEventData -> Point V2 CFloat
multiGestureEventPos :: !(Point V2 CFloat)
,MultiGestureEventData -> Word16
multiGestureEventNumFingers :: !Word16
}
deriving (MultiGestureEventData -> MultiGestureEventData -> Bool
(MultiGestureEventData -> MultiGestureEventData -> Bool)
-> (MultiGestureEventData -> MultiGestureEventData -> Bool)
-> Eq MultiGestureEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MultiGestureEventData -> MultiGestureEventData -> Bool
== :: MultiGestureEventData -> MultiGestureEventData -> Bool
$c/= :: MultiGestureEventData -> MultiGestureEventData -> Bool
/= :: MultiGestureEventData -> MultiGestureEventData -> Bool
Eq,Eq MultiGestureEventData
Eq MultiGestureEventData =>
(MultiGestureEventData -> MultiGestureEventData -> Ordering)
-> (MultiGestureEventData -> MultiGestureEventData -> Bool)
-> (MultiGestureEventData -> MultiGestureEventData -> Bool)
-> (MultiGestureEventData -> MultiGestureEventData -> Bool)
-> (MultiGestureEventData -> MultiGestureEventData -> Bool)
-> (MultiGestureEventData
-> MultiGestureEventData -> MultiGestureEventData)
-> (MultiGestureEventData
-> MultiGestureEventData -> MultiGestureEventData)
-> Ord MultiGestureEventData
MultiGestureEventData -> MultiGestureEventData -> Bool
MultiGestureEventData -> MultiGestureEventData -> Ordering
MultiGestureEventData
-> MultiGestureEventData -> MultiGestureEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MultiGestureEventData -> MultiGestureEventData -> Ordering
compare :: MultiGestureEventData -> MultiGestureEventData -> Ordering
$c< :: MultiGestureEventData -> MultiGestureEventData -> Bool
< :: MultiGestureEventData -> MultiGestureEventData -> Bool
$c<= :: MultiGestureEventData -> MultiGestureEventData -> Bool
<= :: MultiGestureEventData -> MultiGestureEventData -> Bool
$c> :: MultiGestureEventData -> MultiGestureEventData -> Bool
> :: MultiGestureEventData -> MultiGestureEventData -> Bool
$c>= :: MultiGestureEventData -> MultiGestureEventData -> Bool
>= :: MultiGestureEventData -> MultiGestureEventData -> Bool
$cmax :: MultiGestureEventData
-> MultiGestureEventData -> MultiGestureEventData
max :: MultiGestureEventData
-> MultiGestureEventData -> MultiGestureEventData
$cmin :: MultiGestureEventData
-> MultiGestureEventData -> MultiGestureEventData
min :: MultiGestureEventData
-> MultiGestureEventData -> MultiGestureEventData
Ord,(forall x. MultiGestureEventData -> Rep MultiGestureEventData x)
-> (forall x. Rep MultiGestureEventData x -> MultiGestureEventData)
-> Generic MultiGestureEventData
forall x. Rep MultiGestureEventData x -> MultiGestureEventData
forall x. MultiGestureEventData -> Rep MultiGestureEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MultiGestureEventData -> Rep MultiGestureEventData x
from :: forall x. MultiGestureEventData -> Rep MultiGestureEventData x
$cto :: forall x. Rep MultiGestureEventData x -> MultiGestureEventData
to :: forall x. Rep MultiGestureEventData x -> MultiGestureEventData
Generic,Int -> MultiGestureEventData -> ShowS
[MultiGestureEventData] -> ShowS
MultiGestureEventData -> String
(Int -> MultiGestureEventData -> ShowS)
-> (MultiGestureEventData -> String)
-> ([MultiGestureEventData] -> ShowS)
-> Show MultiGestureEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MultiGestureEventData -> ShowS
showsPrec :: Int -> MultiGestureEventData -> ShowS
$cshow :: MultiGestureEventData -> String
show :: MultiGestureEventData -> String
$cshowList :: [MultiGestureEventData] -> ShowS
showList :: [MultiGestureEventData] -> ShowS
Show,Typeable)
data DollarGestureEventData =
DollarGestureEventData {DollarGestureEventData -> TouchID
dollarGestureEventTouchID :: !Raw.TouchID
,DollarGestureEventData -> TouchID
dollarGestureEventGestureID :: !Raw.GestureID
,DollarGestureEventData -> Word32
dollarGestureEventNumFingers :: !Word32
,DollarGestureEventData -> CFloat
dollarGestureEventError :: !CFloat
,DollarGestureEventData -> Point V2 CFloat
dollarGestureEventPos :: !(Point V2 CFloat)
}
deriving (DollarGestureEventData -> DollarGestureEventData -> Bool
(DollarGestureEventData -> DollarGestureEventData -> Bool)
-> (DollarGestureEventData -> DollarGestureEventData -> Bool)
-> Eq DollarGestureEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DollarGestureEventData -> DollarGestureEventData -> Bool
== :: DollarGestureEventData -> DollarGestureEventData -> Bool
$c/= :: DollarGestureEventData -> DollarGestureEventData -> Bool
/= :: DollarGestureEventData -> DollarGestureEventData -> Bool
Eq,Eq DollarGestureEventData
Eq DollarGestureEventData =>
(DollarGestureEventData -> DollarGestureEventData -> Ordering)
-> (DollarGestureEventData -> DollarGestureEventData -> Bool)
-> (DollarGestureEventData -> DollarGestureEventData -> Bool)
-> (DollarGestureEventData -> DollarGestureEventData -> Bool)
-> (DollarGestureEventData -> DollarGestureEventData -> Bool)
-> (DollarGestureEventData
-> DollarGestureEventData -> DollarGestureEventData)
-> (DollarGestureEventData
-> DollarGestureEventData -> DollarGestureEventData)
-> Ord DollarGestureEventData
DollarGestureEventData -> DollarGestureEventData -> Bool
DollarGestureEventData -> DollarGestureEventData -> Ordering
DollarGestureEventData
-> DollarGestureEventData -> DollarGestureEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DollarGestureEventData -> DollarGestureEventData -> Ordering
compare :: DollarGestureEventData -> DollarGestureEventData -> Ordering
$c< :: DollarGestureEventData -> DollarGestureEventData -> Bool
< :: DollarGestureEventData -> DollarGestureEventData -> Bool
$c<= :: DollarGestureEventData -> DollarGestureEventData -> Bool
<= :: DollarGestureEventData -> DollarGestureEventData -> Bool
$c> :: DollarGestureEventData -> DollarGestureEventData -> Bool
> :: DollarGestureEventData -> DollarGestureEventData -> Bool
$c>= :: DollarGestureEventData -> DollarGestureEventData -> Bool
>= :: DollarGestureEventData -> DollarGestureEventData -> Bool
$cmax :: DollarGestureEventData
-> DollarGestureEventData -> DollarGestureEventData
max :: DollarGestureEventData
-> DollarGestureEventData -> DollarGestureEventData
$cmin :: DollarGestureEventData
-> DollarGestureEventData -> DollarGestureEventData
min :: DollarGestureEventData
-> DollarGestureEventData -> DollarGestureEventData
Ord,(forall x. DollarGestureEventData -> Rep DollarGestureEventData x)
-> (forall x.
Rep DollarGestureEventData x -> DollarGestureEventData)
-> Generic DollarGestureEventData
forall x. Rep DollarGestureEventData x -> DollarGestureEventData
forall x. DollarGestureEventData -> Rep DollarGestureEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DollarGestureEventData -> Rep DollarGestureEventData x
from :: forall x. DollarGestureEventData -> Rep DollarGestureEventData x
$cto :: forall x. Rep DollarGestureEventData x -> DollarGestureEventData
to :: forall x. Rep DollarGestureEventData x -> DollarGestureEventData
Generic,Int -> DollarGestureEventData -> ShowS
[DollarGestureEventData] -> ShowS
DollarGestureEventData -> String
(Int -> DollarGestureEventData -> ShowS)
-> (DollarGestureEventData -> String)
-> ([DollarGestureEventData] -> ShowS)
-> Show DollarGestureEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DollarGestureEventData -> ShowS
showsPrec :: Int -> DollarGestureEventData -> ShowS
$cshow :: DollarGestureEventData -> String
show :: DollarGestureEventData -> String
$cshowList :: [DollarGestureEventData] -> ShowS
showList :: [DollarGestureEventData] -> ShowS
Show,Typeable)
newtype DropEventData =
DropEventData {DropEventData -> CString
dropEventFile :: CString
}
deriving (DropEventData -> DropEventData -> Bool
(DropEventData -> DropEventData -> Bool)
-> (DropEventData -> DropEventData -> Bool) -> Eq DropEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DropEventData -> DropEventData -> Bool
== :: DropEventData -> DropEventData -> Bool
$c/= :: DropEventData -> DropEventData -> Bool
/= :: DropEventData -> DropEventData -> Bool
Eq,Eq DropEventData
Eq DropEventData =>
(DropEventData -> DropEventData -> Ordering)
-> (DropEventData -> DropEventData -> Bool)
-> (DropEventData -> DropEventData -> Bool)
-> (DropEventData -> DropEventData -> Bool)
-> (DropEventData -> DropEventData -> Bool)
-> (DropEventData -> DropEventData -> DropEventData)
-> (DropEventData -> DropEventData -> DropEventData)
-> Ord DropEventData
DropEventData -> DropEventData -> Bool
DropEventData -> DropEventData -> Ordering
DropEventData -> DropEventData -> DropEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DropEventData -> DropEventData -> Ordering
compare :: DropEventData -> DropEventData -> Ordering
$c< :: DropEventData -> DropEventData -> Bool
< :: DropEventData -> DropEventData -> Bool
$c<= :: DropEventData -> DropEventData -> Bool
<= :: DropEventData -> DropEventData -> Bool
$c> :: DropEventData -> DropEventData -> Bool
> :: DropEventData -> DropEventData -> Bool
$c>= :: DropEventData -> DropEventData -> Bool
>= :: DropEventData -> DropEventData -> Bool
$cmax :: DropEventData -> DropEventData -> DropEventData
max :: DropEventData -> DropEventData -> DropEventData
$cmin :: DropEventData -> DropEventData -> DropEventData
min :: DropEventData -> DropEventData -> DropEventData
Ord,(forall x. DropEventData -> Rep DropEventData x)
-> (forall x. Rep DropEventData x -> DropEventData)
-> Generic DropEventData
forall x. Rep DropEventData x -> DropEventData
forall x. DropEventData -> Rep DropEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DropEventData -> Rep DropEventData x
from :: forall x. DropEventData -> Rep DropEventData x
$cto :: forall x. Rep DropEventData x -> DropEventData
to :: forall x. Rep DropEventData x -> DropEventData
Generic,Int -> DropEventData -> ShowS
[DropEventData] -> ShowS
DropEventData -> String
(Int -> DropEventData -> ShowS)
-> (DropEventData -> String)
-> ([DropEventData] -> ShowS)
-> Show DropEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DropEventData -> ShowS
showsPrec :: Int -> DropEventData -> ShowS
$cshow :: DropEventData -> String
show :: DropEventData -> String
$cshowList :: [DropEventData] -> ShowS
showList :: [DropEventData] -> ShowS
Show,Typeable)
newtype UnknownEventData =
UnknownEventData {UnknownEventData -> Word32
unknownEventType :: Word32
}
deriving (UnknownEventData -> UnknownEventData -> Bool
(UnknownEventData -> UnknownEventData -> Bool)
-> (UnknownEventData -> UnknownEventData -> Bool)
-> Eq UnknownEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnknownEventData -> UnknownEventData -> Bool
== :: UnknownEventData -> UnknownEventData -> Bool
$c/= :: UnknownEventData -> UnknownEventData -> Bool
/= :: UnknownEventData -> UnknownEventData -> Bool
Eq,Eq UnknownEventData
Eq UnknownEventData =>
(UnknownEventData -> UnknownEventData -> Ordering)
-> (UnknownEventData -> UnknownEventData -> Bool)
-> (UnknownEventData -> UnknownEventData -> Bool)
-> (UnknownEventData -> UnknownEventData -> Bool)
-> (UnknownEventData -> UnknownEventData -> Bool)
-> (UnknownEventData -> UnknownEventData -> UnknownEventData)
-> (UnknownEventData -> UnknownEventData -> UnknownEventData)
-> Ord UnknownEventData
UnknownEventData -> UnknownEventData -> Bool
UnknownEventData -> UnknownEventData -> Ordering
UnknownEventData -> UnknownEventData -> UnknownEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UnknownEventData -> UnknownEventData -> Ordering
compare :: UnknownEventData -> UnknownEventData -> Ordering
$c< :: UnknownEventData -> UnknownEventData -> Bool
< :: UnknownEventData -> UnknownEventData -> Bool
$c<= :: UnknownEventData -> UnknownEventData -> Bool
<= :: UnknownEventData -> UnknownEventData -> Bool
$c> :: UnknownEventData -> UnknownEventData -> Bool
> :: UnknownEventData -> UnknownEventData -> Bool
$c>= :: UnknownEventData -> UnknownEventData -> Bool
>= :: UnknownEventData -> UnknownEventData -> Bool
$cmax :: UnknownEventData -> UnknownEventData -> UnknownEventData
max :: UnknownEventData -> UnknownEventData -> UnknownEventData
$cmin :: UnknownEventData -> UnknownEventData -> UnknownEventData
min :: UnknownEventData -> UnknownEventData -> UnknownEventData
Ord,(forall x. UnknownEventData -> Rep UnknownEventData x)
-> (forall x. Rep UnknownEventData x -> UnknownEventData)
-> Generic UnknownEventData
forall x. Rep UnknownEventData x -> UnknownEventData
forall x. UnknownEventData -> Rep UnknownEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UnknownEventData -> Rep UnknownEventData x
from :: forall x. UnknownEventData -> Rep UnknownEventData x
$cto :: forall x. Rep UnknownEventData x -> UnknownEventData
to :: forall x. Rep UnknownEventData x -> UnknownEventData
Generic,Int -> UnknownEventData -> ShowS
[UnknownEventData] -> ShowS
UnknownEventData -> String
(Int -> UnknownEventData -> ShowS)
-> (UnknownEventData -> String)
-> ([UnknownEventData] -> ShowS)
-> Show UnknownEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnknownEventData -> ShowS
showsPrec :: Int -> UnknownEventData -> ShowS
$cshow :: UnknownEventData -> String
show :: UnknownEventData -> String
$cshowList :: [UnknownEventData] -> ShowS
showList :: [UnknownEventData] -> ShowS
Show,Typeable)
data InputMotion = Released | Pressed
deriving (InputMotion
InputMotion -> InputMotion -> Bounded InputMotion
forall a. a -> a -> Bounded a
$cminBound :: InputMotion
minBound :: InputMotion
$cmaxBound :: InputMotion
maxBound :: InputMotion
Bounded, Int -> InputMotion
InputMotion -> Int
InputMotion -> [InputMotion]
InputMotion -> InputMotion
InputMotion -> InputMotion -> [InputMotion]
InputMotion -> InputMotion -> InputMotion -> [InputMotion]
(InputMotion -> InputMotion)
-> (InputMotion -> InputMotion)
-> (Int -> InputMotion)
-> (InputMotion -> Int)
-> (InputMotion -> [InputMotion])
-> (InputMotion -> InputMotion -> [InputMotion])
-> (InputMotion -> InputMotion -> [InputMotion])
-> (InputMotion -> InputMotion -> InputMotion -> [InputMotion])
-> Enum InputMotion
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: InputMotion -> InputMotion
succ :: InputMotion -> InputMotion
$cpred :: InputMotion -> InputMotion
pred :: InputMotion -> InputMotion
$ctoEnum :: Int -> InputMotion
toEnum :: Int -> InputMotion
$cfromEnum :: InputMotion -> Int
fromEnum :: InputMotion -> Int
$cenumFrom :: InputMotion -> [InputMotion]
enumFrom :: InputMotion -> [InputMotion]
$cenumFromThen :: InputMotion -> InputMotion -> [InputMotion]
enumFromThen :: InputMotion -> InputMotion -> [InputMotion]
$cenumFromTo :: InputMotion -> InputMotion -> [InputMotion]
enumFromTo :: InputMotion -> InputMotion -> [InputMotion]
$cenumFromThenTo :: InputMotion -> InputMotion -> InputMotion -> [InputMotion]
enumFromThenTo :: InputMotion -> InputMotion -> InputMotion -> [InputMotion]
Enum, InputMotion -> InputMotion -> Bool
(InputMotion -> InputMotion -> Bool)
-> (InputMotion -> InputMotion -> Bool) -> Eq InputMotion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputMotion -> InputMotion -> Bool
== :: InputMotion -> InputMotion -> Bool
$c/= :: InputMotion -> InputMotion -> Bool
/= :: InputMotion -> InputMotion -> Bool
Eq, Eq InputMotion
Eq InputMotion =>
(InputMotion -> InputMotion -> Ordering)
-> (InputMotion -> InputMotion -> Bool)
-> (InputMotion -> InputMotion -> Bool)
-> (InputMotion -> InputMotion -> Bool)
-> (InputMotion -> InputMotion -> Bool)
-> (InputMotion -> InputMotion -> InputMotion)
-> (InputMotion -> InputMotion -> InputMotion)
-> Ord InputMotion
InputMotion -> InputMotion -> Bool
InputMotion -> InputMotion -> Ordering
InputMotion -> InputMotion -> InputMotion
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: InputMotion -> InputMotion -> Ordering
compare :: InputMotion -> InputMotion -> Ordering
$c< :: InputMotion -> InputMotion -> Bool
< :: InputMotion -> InputMotion -> Bool
$c<= :: InputMotion -> InputMotion -> Bool
<= :: InputMotion -> InputMotion -> Bool
$c> :: InputMotion -> InputMotion -> Bool
> :: InputMotion -> InputMotion -> Bool
$c>= :: InputMotion -> InputMotion -> Bool
>= :: InputMotion -> InputMotion -> Bool
$cmax :: InputMotion -> InputMotion -> InputMotion
max :: InputMotion -> InputMotion -> InputMotion
$cmin :: InputMotion -> InputMotion -> InputMotion
min :: InputMotion -> InputMotion -> InputMotion
Ord, ReadPrec [InputMotion]
ReadPrec InputMotion
Int -> ReadS InputMotion
ReadS [InputMotion]
(Int -> ReadS InputMotion)
-> ReadS [InputMotion]
-> ReadPrec InputMotion
-> ReadPrec [InputMotion]
-> Read InputMotion
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS InputMotion
readsPrec :: Int -> ReadS InputMotion
$creadList :: ReadS [InputMotion]
readList :: ReadS [InputMotion]
$creadPrec :: ReadPrec InputMotion
readPrec :: ReadPrec InputMotion
$creadListPrec :: ReadPrec [InputMotion]
readListPrec :: ReadPrec [InputMotion]
Read, Typeable InputMotion
Typeable InputMotion =>
(forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InputMotion -> c InputMotion)
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InputMotion)
-> (InputMotion -> Constr)
-> (InputMotion -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InputMotion))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InputMotion))
-> ((forall b. Data b => b -> b) -> InputMotion -> InputMotion)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InputMotion -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InputMotion -> r)
-> (forall u. (forall d. Data d => d -> u) -> InputMotion -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> InputMotion -> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> InputMotion -> m InputMotion)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InputMotion -> m InputMotion)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InputMotion -> m InputMotion)
-> Data InputMotion
InputMotion -> Constr
InputMotion -> DataType
(forall b. Data b => b -> b) -> InputMotion -> InputMotion
forall a.
Typeable a =>
(forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> InputMotion -> u
forall u. (forall d. Data d => d -> u) -> InputMotion -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InputMotion -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InputMotion -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> InputMotion -> m InputMotion
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InputMotion -> m InputMotion
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InputMotion
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InputMotion -> c InputMotion
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InputMotion)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InputMotion)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InputMotion -> c InputMotion
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InputMotion -> c InputMotion
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InputMotion
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InputMotion
$ctoConstr :: InputMotion -> Constr
toConstr :: InputMotion -> Constr
$cdataTypeOf :: InputMotion -> DataType
dataTypeOf :: InputMotion -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InputMotion)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InputMotion)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InputMotion)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InputMotion)
$cgmapT :: (forall b. Data b => b -> b) -> InputMotion -> InputMotion
gmapT :: (forall b. Data b => b -> b) -> InputMotion -> InputMotion
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InputMotion -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InputMotion -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InputMotion -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InputMotion -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> InputMotion -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> InputMotion -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> InputMotion -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> InputMotion -> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> InputMotion -> m InputMotion
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> InputMotion -> m InputMotion
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InputMotion -> m InputMotion
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InputMotion -> m InputMotion
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InputMotion -> m InputMotion
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InputMotion -> m InputMotion
Data, (forall x. InputMotion -> Rep InputMotion x)
-> (forall x. Rep InputMotion x -> InputMotion)
-> Generic InputMotion
forall x. Rep InputMotion x -> InputMotion
forall x. InputMotion -> Rep InputMotion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InputMotion -> Rep InputMotion x
from :: forall x. InputMotion -> Rep InputMotion x
$cto :: forall x. Rep InputMotion x -> InputMotion
to :: forall x. Rep InputMotion x -> InputMotion
Generic, Int -> InputMotion -> ShowS
[InputMotion] -> ShowS
InputMotion -> String
(Int -> InputMotion -> ShowS)
-> (InputMotion -> String)
-> ([InputMotion] -> ShowS)
-> Show InputMotion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InputMotion -> ShowS
showsPrec :: Int -> InputMotion -> ShowS
$cshow :: InputMotion -> String
show :: InputMotion -> String
$cshowList :: [InputMotion] -> ShowS
showList :: [InputMotion] -> ShowS
Show, Typeable)
ccharStringToText :: [CChar] -> Text
ccharStringToText :: [CChar] -> Text
ccharStringToText = ByteString -> Text
Text.decodeUtf8 (ByteString -> Text) -> ([CChar] -> ByteString) -> [CChar] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BSC8.pack (String -> ByteString)
-> ([CChar] -> String) -> [CChar] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CChar -> Char) -> [CChar] -> String
forall a b. (a -> b) -> [a] -> [b]
map CChar -> Char
castCCharToChar
fromRawKeysym :: Raw.Keysym -> Keysym
fromRawKeysym :: Keysym -> Keysym
fromRawKeysym (Raw.Keysym Word32
scancode Int32
keycode Word16
modifier) =
Scancode -> Keycode -> KeyModifier -> Keysym
Keysym Scancode
scancode' Keycode
keycode' KeyModifier
modifier'
where scancode' :: Scancode
scancode' = Word32 -> Scancode
forall a b. FromNumber a b => b -> a
fromNumber Word32
scancode
keycode' :: Keycode
keycode' = Int32 -> Keycode
forall a b. FromNumber a b => b -> a
fromNumber Int32
keycode
modifier' :: KeyModifier
modifier' = Word32 -> KeyModifier
forall a b. FromNumber a b => b -> a
fromNumber (Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
modifier)
convertRaw :: Raw.Event -> IO Event
convertRaw :: Event -> IO Event
convertRaw (Raw.WindowEvent Word32
t Word32
ts Word32
a Word8
b Int32
c Int32
d) =
do Window
w <- (Ptr () -> Window) -> IO (Ptr ()) -> IO Window
forall a b. (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr () -> Window
Window (Word32 -> IO (Ptr ())
forall (m :: Type -> Type). MonadIO m => Word32 -> m (Ptr ())
Raw.getWindowFromID Word32
a)
Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts
(case Word8
b of
Word8
Raw.SDL_WINDOWEVENT_SHOWN ->
WindowShownEventData -> EventPayload
WindowShownEvent (Window -> WindowShownEventData
WindowShownEventData Window
w)
Word8
Raw.SDL_WINDOWEVENT_HIDDEN ->
WindowHiddenEventData -> EventPayload
WindowHiddenEvent (Window -> WindowHiddenEventData
WindowHiddenEventData Window
w)
Word8
Raw.SDL_WINDOWEVENT_EXPOSED ->
WindowExposedEventData -> EventPayload
WindowExposedEvent (Window -> WindowExposedEventData
WindowExposedEventData Window
w)
Word8
Raw.SDL_WINDOWEVENT_MOVED ->
WindowMovedEventData -> EventPayload
WindowMovedEvent
(Window -> Point V2 Int32 -> WindowMovedEventData
WindowMovedEventData Window
w
(V2 Int32 -> Point V2 Int32
forall (f :: Type -> Type) a. f a -> Point f a
P (Int32 -> Int32 -> V2 Int32
forall a. a -> a -> V2 a
V2 Int32
c Int32
d)))
Word8
Raw.SDL_WINDOWEVENT_RESIZED ->
WindowResizedEventData -> EventPayload
WindowResizedEvent
(Window -> V2 Int32 -> WindowResizedEventData
WindowResizedEventData Window
w
(Int32 -> Int32 -> V2 Int32
forall a. a -> a -> V2 a
V2 Int32
c Int32
d))
Word8
Raw.SDL_WINDOWEVENT_SIZE_CHANGED ->
WindowSizeChangedEventData -> EventPayload
WindowSizeChangedEvent (Window -> V2 Int32 -> WindowSizeChangedEventData
WindowSizeChangedEventData Window
w (Int32 -> Int32 -> V2 Int32
forall a. a -> a -> V2 a
V2 Int32
c Int32
d))
Word8
Raw.SDL_WINDOWEVENT_MINIMIZED ->
WindowMinimizedEventData -> EventPayload
WindowMinimizedEvent (Window -> WindowMinimizedEventData
WindowMinimizedEventData Window
w)
Word8
Raw.SDL_WINDOWEVENT_MAXIMIZED ->
WindowMaximizedEventData -> EventPayload
WindowMaximizedEvent (Window -> WindowMaximizedEventData
WindowMaximizedEventData Window
w)
Word8
Raw.SDL_WINDOWEVENT_RESTORED ->
WindowRestoredEventData -> EventPayload
WindowRestoredEvent (Window -> WindowRestoredEventData
WindowRestoredEventData Window
w)
Word8
Raw.SDL_WINDOWEVENT_ENTER ->
WindowGainedMouseFocusEventData -> EventPayload
WindowGainedMouseFocusEvent (Window -> WindowGainedMouseFocusEventData
WindowGainedMouseFocusEventData Window
w)
Word8
Raw.SDL_WINDOWEVENT_LEAVE ->
WindowLostMouseFocusEventData -> EventPayload
WindowLostMouseFocusEvent (Window -> WindowLostMouseFocusEventData
WindowLostMouseFocusEventData Window
w)
Word8
Raw.SDL_WINDOWEVENT_FOCUS_GAINED ->
WindowGainedKeyboardFocusEventData -> EventPayload
WindowGainedKeyboardFocusEvent (Window -> WindowGainedKeyboardFocusEventData
WindowGainedKeyboardFocusEventData Window
w)
Word8
Raw.SDL_WINDOWEVENT_FOCUS_LOST ->
WindowLostKeyboardFocusEventData -> EventPayload
WindowLostKeyboardFocusEvent (Window -> WindowLostKeyboardFocusEventData
WindowLostKeyboardFocusEventData Window
w)
Word8
Raw.SDL_WINDOWEVENT_CLOSE ->
WindowClosedEventData -> EventPayload
WindowClosedEvent (Window -> WindowClosedEventData
WindowClosedEventData Window
w)
Word8
_ ->
UnknownEventData -> EventPayload
UnknownEvent (Word32 -> UnknownEventData
UnknownEventData Word32
t)))
convertRaw (Raw.KeyboardEvent Word32
Raw.SDL_KEYDOWN Word32
ts Word32
a Word8
_ Word8
c Keysym
d) =
do Maybe Window
w <- Word32 -> IO (Maybe Window)
forall (m :: Type -> Type). MonadIO m => Word32 -> m (Maybe Window)
getWindowFromID Word32
a
Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts
(KeyboardEventData -> EventPayload
KeyboardEvent
(Maybe Window -> InputMotion -> Bool -> Keysym -> KeyboardEventData
KeyboardEventData Maybe Window
w
InputMotion
Pressed
(Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0)
(Keysym -> Keysym
fromRawKeysym Keysym
d))))
convertRaw (Raw.KeyboardEvent Word32
Raw.SDL_KEYUP Word32
ts Word32
a Word8
_ Word8
c Keysym
d) =
do Maybe Window
w <- Word32 -> IO (Maybe Window)
forall (m :: Type -> Type). MonadIO m => Word32 -> m (Maybe Window)
getWindowFromID Word32
a
Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts
(KeyboardEventData -> EventPayload
KeyboardEvent
(Maybe Window -> InputMotion -> Bool -> Keysym -> KeyboardEventData
KeyboardEventData Maybe Window
w
InputMotion
Released
(Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0)
(Keysym -> Keysym
fromRawKeysym Keysym
d))))
convertRaw Raw.KeyboardEvent{} = String -> IO Event
forall a. HasCallStack => String -> a
error String
"convertRaw: Unknown keyboard motion"
convertRaw (Raw.TextEditingEvent Word32
_ Word32
ts Word32
a [CChar]
b Int32
c Int32
d) =
do Maybe Window
w <- Word32 -> IO (Maybe Window)
forall (m :: Type -> Type). MonadIO m => Word32 -> m (Maybe Window)
getWindowFromID Word32
a
Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts
(TextEditingEventData -> EventPayload
TextEditingEvent
(Maybe Window -> Text -> Int32 -> Int32 -> TextEditingEventData
TextEditingEventData Maybe Window
w
([CChar] -> Text
ccharStringToText [CChar]
b)
Int32
c
Int32
d)))
convertRaw (Raw.TextInputEvent Word32
_ Word32
ts Word32
a [CChar]
b) =
do Maybe Window
w <- Word32 -> IO (Maybe Window)
forall (m :: Type -> Type). MonadIO m => Word32 -> m (Maybe Window)
getWindowFromID Word32
a
Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts
(TextInputEventData -> EventPayload
TextInputEvent
(Maybe Window -> Text -> TextInputEventData
TextInputEventData Maybe Window
w
([CChar] -> Text
ccharStringToText [CChar]
b))))
convertRaw (Raw.KeymapChangedEvent Word32
_ Word32
ts) =
Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts EventPayload
KeymapChangedEvent)
convertRaw (Raw.MouseMotionEvent Word32
_ Word32
ts Word32
a Word32
b Word32
c Int32
d Int32
e Int32
f Int32
g) =
do Maybe Window
w <- Word32 -> IO (Maybe Window)
forall (m :: Type -> Type). MonadIO m => Word32 -> m (Maybe Window)
getWindowFromID Word32
a
let buttons :: [MouseButton]
buttons =
[Maybe MouseButton] -> [MouseButton]
forall a. [Maybe a] -> [a]
catMaybes [(Word32
forall {a}. (Eq a, Num a) => a
Raw.SDL_BUTTON_LMASK Word32 -> Word32 -> MouseButton -> Maybe MouseButton
forall {a} {a}. (Bits a, Num a) => a -> a -> a -> Maybe a
`test` Word32
c) MouseButton
ButtonLeft
,(Word32
forall {a}. (Eq a, Num a) => a
Raw.SDL_BUTTON_RMASK Word32 -> Word32 -> MouseButton -> Maybe MouseButton
forall {a} {a}. (Bits a, Num a) => a -> a -> a -> Maybe a
`test` Word32
c) MouseButton
ButtonRight
,(Word32
forall {a}. (Eq a, Num a) => a
Raw.SDL_BUTTON_MMASK Word32 -> Word32 -> MouseButton -> Maybe MouseButton
forall {a} {a}. (Bits a, Num a) => a -> a -> a -> Maybe a
`test` Word32
c) MouseButton
ButtonMiddle
,(Word32
forall {a}. (Eq a, Num a) => a
Raw.SDL_BUTTON_X1MASK Word32 -> Word32 -> MouseButton -> Maybe MouseButton
forall {a} {a}. (Bits a, Num a) => a -> a -> a -> Maybe a
`test` Word32
c) MouseButton
ButtonX1
,(Word32
forall {a}. (Eq a, Num a) => a
Raw.SDL_BUTTON_X2MASK Word32 -> Word32 -> MouseButton -> Maybe MouseButton
forall {a} {a}. (Bits a, Num a) => a -> a -> a -> Maybe a
`test` Word32
c) MouseButton
ButtonX2]
Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts
(MouseMotionEventData -> EventPayload
MouseMotionEvent
(Maybe Window
-> MouseDevice
-> [MouseButton]
-> Point V2 Int32
-> V2 Int32
-> MouseMotionEventData
MouseMotionEventData Maybe Window
w
(Word32 -> MouseDevice
forall a b. FromNumber a b => b -> a
fromNumber Word32
b)
[MouseButton]
buttons
(V2 Int32 -> Point V2 Int32
forall (f :: Type -> Type) a. f a -> Point f a
P (Int32 -> Int32 -> V2 Int32
forall a. a -> a -> V2 a
V2 Int32
d Int32
e))
(Int32 -> Int32 -> V2 Int32
forall a. a -> a -> V2 a
V2 Int32
f Int32
g))))
where a
mask test :: a -> a -> a -> Maybe a
`test` a
x =
if a
mask a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0
then a -> Maybe a
forall a. a -> Maybe a
Just
else Maybe a -> a -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing
convertRaw (Raw.MouseButtonEvent Word32
t Word32
ts Word32
a Word32
b Word8
c Word8
_ Word8
e Int32
f Int32
g) =
do Maybe Window
w <- Word32 -> IO (Maybe Window)
forall (m :: Type -> Type). MonadIO m => Word32 -> m (Maybe Window)
getWindowFromID Word32
a
let motion :: InputMotion
motion
| Word32
t Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
forall {a}. (Eq a, Num a) => a
Raw.SDL_MOUSEBUTTONUP = InputMotion
Released
| Word32
t Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
forall {a}. (Eq a, Num a) => a
Raw.SDL_MOUSEBUTTONDOWN = InputMotion
Pressed
| Bool
otherwise = String -> InputMotion
forall a. HasCallStack => String -> a
error String
"convertRaw: Unexpected mouse button motion"
Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts
(MouseButtonEventData -> EventPayload
MouseButtonEvent
(Maybe Window
-> InputMotion
-> MouseDevice
-> MouseButton
-> Word8
-> Point V2 Int32
-> MouseButtonEventData
MouseButtonEventData Maybe Window
w
InputMotion
motion
(Word32 -> MouseDevice
forall a b. FromNumber a b => b -> a
fromNumber Word32
b)
(Word8 -> MouseButton
forall a b. FromNumber a b => b -> a
fromNumber Word8
c)
Word8
e
(V2 Int32 -> Point V2 Int32
forall (f :: Type -> Type) a. f a -> Point f a
P (Int32 -> Int32 -> V2 Int32
forall a. a -> a -> V2 a
V2 Int32
f Int32
g)))))
convertRaw (Raw.MouseWheelEvent Word32
_ Word32
ts Word32
a Word32
b Int32
c Int32
d Word32
e) =
do Maybe Window
w <- Word32 -> IO (Maybe Window)
forall (m :: Type -> Type). MonadIO m => Word32 -> m (Maybe Window)
getWindowFromID Word32
a
Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts
(MouseWheelEventData -> EventPayload
MouseWheelEvent
(Maybe Window
-> MouseDevice
-> V2 Int32
-> MouseScrollDirection
-> MouseWheelEventData
MouseWheelEventData Maybe Window
w
(Word32 -> MouseDevice
forall a b. FromNumber a b => b -> a
fromNumber Word32
b)
(Int32 -> Int32 -> V2 Int32
forall a. a -> a -> V2 a
V2 Int32
c Int32
d)
(Word32 -> MouseScrollDirection
forall a b. FromNumber a b => b -> a
fromNumber Word32
e))))
convertRaw (Raw.JoyAxisEvent Word32
_ Word32
ts Int32
a Word8
b Int16
c) =
Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts (JoyAxisEventData -> EventPayload
JoyAxisEvent (Int32 -> Word8 -> Int16 -> JoyAxisEventData
JoyAxisEventData Int32
a Word8
b Int16
c)))
convertRaw (Raw.JoyBallEvent Word32
_ Word32
ts Int32
a Word8
b Int16
c Int16
d) =
Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts
(JoyBallEventData -> EventPayload
JoyBallEvent
(Int32 -> Word8 -> V2 Int16 -> JoyBallEventData
JoyBallEventData Int32
a
Word8
b
(Int16 -> Int16 -> V2 Int16
forall a. a -> a -> V2 a
V2 Int16
c Int16
d))))
convertRaw (Raw.JoyHatEvent Word32
_ Word32
ts Int32
a Word8
b Word8
c) =
Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts
(JoyHatEventData -> EventPayload
JoyHatEvent
(Int32 -> Word8 -> JoyHatPosition -> JoyHatEventData
JoyHatEventData Int32
a
Word8
b
(Word8 -> JoyHatPosition
forall a b. FromNumber a b => b -> a
fromNumber Word8
c))))
convertRaw (Raw.JoyButtonEvent Word32
_ Word32
ts Int32
a Word8
b Word8
c) =
Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts (JoyButtonEventData -> EventPayload
JoyButtonEvent (Int32 -> Word8 -> JoyButtonState -> JoyButtonEventData
JoyButtonEventData Int32
a Word8
b (Word8 -> JoyButtonState
forall a b. FromNumber a b => b -> a
fromNumber Word8
c))))
convertRaw (Raw.JoyDeviceEvent Word32
t Word32
ts Int32
a) =
Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts (JoyDeviceEventData -> EventPayload
JoyDeviceEvent (JoyDeviceConnection -> Int32 -> JoyDeviceEventData
JoyDeviceEventData (Word32 -> JoyDeviceConnection
forall a b. FromNumber a b => b -> a
fromNumber Word32
t) Int32
a)))
convertRaw (Raw.ControllerAxisEvent Word32
_ Word32
ts Int32
a Word8
b Int16
c) =
Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts
(ControllerAxisEventData -> EventPayload
ControllerAxisEvent
(Int32 -> ControllerAxis -> Int16 -> ControllerAxisEventData
ControllerAxisEventData Int32
a
(Int32 -> ControllerAxis
forall a b. FromNumber a b => b -> a
fromNumber (Int32 -> ControllerAxis) -> Int32 -> ControllerAxis
forall a b. (a -> b) -> a -> b
$ Word8 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b)
Int16
c)))
convertRaw (Raw.ControllerButtonEvent Word32
t Word32
ts Int32
a Word8
b Word8
_) =
Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts
(ControllerButtonEventData -> EventPayload
ControllerButtonEvent
(Int32
-> ControllerButton
-> ControllerButtonState
-> ControllerButtonEventData
ControllerButtonEventData Int32
a
(Int32 -> ControllerButton
forall a b. FromNumber a b => b -> a
fromNumber (Int32 -> ControllerButton) -> Int32 -> ControllerButton
forall a b. (a -> b) -> a -> b
$ Word8 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b)
(Word32 -> ControllerButtonState
forall a b. FromNumber a b => b -> a
fromNumber Word32
t))))
convertRaw (Raw.ControllerDeviceEvent Word32
t Word32
ts Int32
a) =
Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts (ControllerDeviceEventData -> EventPayload
ControllerDeviceEvent (ControllerDeviceConnection -> Int32 -> ControllerDeviceEventData
ControllerDeviceEventData (Word32 -> ControllerDeviceConnection
forall a b. FromNumber a b => b -> a
fromNumber Word32
t) Int32
a)))
convertRaw (Raw.AudioDeviceEvent Word32
Raw.SDL_AUDIODEVICEADDED Word32
ts Word32
a Word8
b) =
Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts (AudioDeviceEventData -> EventPayload
AudioDeviceEvent (Bool -> Word32 -> Bool -> AudioDeviceEventData
AudioDeviceEventData Bool
True Word32
a (Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0))))
convertRaw (Raw.AudioDeviceEvent Word32
Raw.SDL_AUDIODEVICEREMOVED Word32
ts Word32
a Word8
b) =
Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts (AudioDeviceEventData -> EventPayload
AudioDeviceEvent (Bool -> Word32 -> Bool -> AudioDeviceEventData
AudioDeviceEventData Bool
False Word32
a (Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0))))
convertRaw Raw.AudioDeviceEvent{} =
String -> IO Event
forall a. HasCallStack => String -> a
error String
"convertRaw: Unknown audio device motion"
convertRaw (Raw.QuitEvent Word32
_ Word32
ts) =
Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts EventPayload
QuitEvent)
convertRaw (Raw.UserEvent Word32
t Word32
ts Word32
a Int32
b Ptr ()
c Ptr ()
d) =
do Maybe Window
w <- Word32 -> IO (Maybe Window)
forall (m :: Type -> Type). MonadIO m => Word32 -> m (Maybe Window)
getWindowFromID Word32
a
Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts (UserEventData -> EventPayload
UserEvent (Word32
-> Maybe Window -> Int32 -> Ptr () -> Ptr () -> UserEventData
UserEventData Word32
t Maybe Window
w Int32
b Ptr ()
c Ptr ()
d)))
convertRaw (Raw.SysWMEvent Word32
_ Word32
ts Ptr ()
a) =
Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts (SysWMEventData -> EventPayload
SysWMEvent (Ptr () -> SysWMEventData
SysWMEventData Ptr ()
a)))
convertRaw (Raw.TouchFingerEvent Word32
t Word32
ts TouchID
a TouchID
b CFloat
c CFloat
d CFloat
e CFloat
f CFloat
g) =
do let touchFingerEvent :: InputMotion -> EventPayload
touchFingerEvent InputMotion
motion = TouchFingerEventData -> EventPayload
TouchFingerEvent
(TouchID
-> TouchID
-> InputMotion
-> Point V2 CFloat
-> CFloat
-> TouchFingerEventData
TouchFingerEventData TouchID
a
TouchID
b
InputMotion
motion
(V2 CFloat -> Point V2 CFloat
forall (f :: Type -> Type) a. f a -> Point f a
P (CFloat -> CFloat -> V2 CFloat
forall a. a -> a -> V2 a
V2 CFloat
c CFloat
d))
CFloat
g)
let touchFingerMotionEvent :: EventPayload
touchFingerMotionEvent = TouchFingerMotionEventData -> EventPayload
TouchFingerMotionEvent
(TouchID
-> TouchID
-> Point V2 CFloat
-> V2 CFloat
-> CFloat
-> TouchFingerMotionEventData
TouchFingerMotionEventData TouchID
a
TouchID
b
(V2 CFloat -> Point V2 CFloat
forall (f :: Type -> Type) a. f a -> Point f a
P (CFloat -> CFloat -> V2 CFloat
forall a. a -> a -> V2 a
V2 CFloat
c CFloat
d))
(CFloat -> CFloat -> V2 CFloat
forall a. a -> a -> V2 a
V2 CFloat
e CFloat
f)
CFloat
g)
case Word32
t of
Word32
Raw.SDL_FINGERDOWN -> Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts (InputMotion -> EventPayload
touchFingerEvent InputMotion
Pressed))
Word32
Raw.SDL_FINGERUP -> Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts (InputMotion -> EventPayload
touchFingerEvent InputMotion
Released))
Word32
Raw.SDL_FINGERMOTION -> Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts EventPayload
touchFingerMotionEvent)
Word32
_ -> String -> IO Event
forall a. HasCallStack => String -> a
error String
"convertRaw: Unexpected touch finger event"
convertRaw (Raw.MultiGestureEvent Word32
_ Word32
ts TouchID
a CFloat
b CFloat
c CFloat
d CFloat
e Word16
f) =
Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts
(MultiGestureEventData -> EventPayload
MultiGestureEvent
(TouchID
-> CFloat
-> CFloat
-> Point V2 CFloat
-> Word16
-> MultiGestureEventData
MultiGestureEventData TouchID
a
CFloat
b
CFloat
c
(V2 CFloat -> Point V2 CFloat
forall (f :: Type -> Type) a. f a -> Point f a
P (CFloat -> CFloat -> V2 CFloat
forall a. a -> a -> V2 a
V2 CFloat
d CFloat
e))
Word16
f)))
convertRaw (Raw.DollarGestureEvent Word32
_ Word32
ts TouchID
a TouchID
b Word32
c CFloat
d CFloat
e CFloat
f) =
Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts
(DollarGestureEventData -> EventPayload
DollarGestureEvent
(TouchID
-> TouchID
-> Word32
-> CFloat
-> Point V2 CFloat
-> DollarGestureEventData
DollarGestureEventData TouchID
a
TouchID
b
Word32
c
CFloat
d
(V2 CFloat -> Point V2 CFloat
forall (f :: Type -> Type) a. f a -> Point f a
P (CFloat -> CFloat -> V2 CFloat
forall a. a -> a -> V2 a
V2 CFloat
e CFloat
f)))))
convertRaw (Raw.DropEvent Word32
_ Word32
ts CString
a) =
Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts (DropEventData -> EventPayload
DropEvent (CString -> DropEventData
DropEventData CString
a)))
convertRaw (Raw.ClipboardUpdateEvent Word32
_ Word32
ts) =
Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts EventPayload
ClipboardUpdateEvent)
convertRaw (Raw.UnknownEvent Word32
t Word32
ts) =
Event -> IO Event
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Word32 -> EventPayload -> Event
Event Word32
ts (UnknownEventData -> EventPayload
UnknownEvent (Word32 -> UnknownEventData
UnknownEventData Word32
t)))
pollEvent :: MonadIO m => m (Maybe Event)
pollEvent :: forall (m :: Type -> Type). MonadIO m => m (Maybe Event)
pollEvent =
IO (Maybe Event) -> m (Maybe Event)
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Event) -> m (Maybe Event))
-> IO (Maybe Event) -> m (Maybe Event)
forall a b. (a -> b) -> a -> b
$ do
CInt
n <- Ptr Event -> IO CInt
forall (m :: Type -> Type). MonadIO m => Ptr Event -> m CInt
Raw.pollEvent Ptr Event
forall a. Ptr a
nullPtr
if CInt
n CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
then Maybe Event -> IO (Maybe Event)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe Event
forall a. Maybe a
Nothing
else (Ptr Event -> IO (Maybe Event)) -> IO (Maybe Event)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Event -> IO (Maybe Event)) -> IO (Maybe Event))
-> (Ptr Event -> IO (Maybe Event)) -> IO (Maybe Event)
forall a b. (a -> b) -> a -> b
$ \Ptr Event
e -> do
CInt
n' <- Ptr Event -> IO CInt
forall (m :: Type -> Type). MonadIO m => Ptr Event -> m CInt
Raw.pollEvent Ptr Event
e
if CInt
n' CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
then Maybe Event -> IO (Maybe Event)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe Event
forall a. Maybe a
Nothing
else (Event -> Maybe Event) -> IO Event -> IO (Maybe Event)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Event -> Maybe Event
forall a. a -> Maybe a
Just (Ptr Event -> IO Event
forall a. Storable a => Ptr a -> IO a
peek Ptr Event
e IO Event -> (Event -> IO Event) -> IO Event
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Event -> IO Event
convertRaw)
pollEvents :: MonadIO m => m [Event]
pollEvents :: forall (m :: Type -> Type). MonadIO m => m [Event]
pollEvents = IO [Event] -> m [Event]
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Event] -> m [Event]) -> IO [Event] -> m [Event]
forall a b. (a -> b) -> a -> b
$ do
IO ()
forall (m :: Type -> Type). MonadIO m => m ()
Raw.pumpEvents
IO [Event]
peepAllEvents IO [Event] -> ([Event] -> IO [Event]) -> IO [Event]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Event -> IO Event) -> [Event] -> IO [Event]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM Event -> IO Event
convertRaw where
peepAllEvents :: IO [Event]
peepAllEvents = do
CInt
numPeeped <- Ptr Event -> CInt -> Word32 -> Word32 -> Word32 -> IO CInt
forall (m :: Type -> Type).
MonadIO m =>
Ptr Event -> CInt -> Word32 -> Word32 -> Word32 -> m CInt
Raw.peepEvents
Ptr Event
Raw.eventBuffer
CInt
Raw.eventBufferSize
Word32
Raw.SDL_GETEVENT
Word32
forall {a}. (Eq a, Num a) => a
Raw.SDL_FIRSTEVENT
Word32
forall {a}. (Eq a, Num a) => a
Raw.SDL_LASTEVENT
[Event]
peeped <- Int -> Ptr Event -> IO [Event]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
numPeeped) Ptr Event
Raw.eventBuffer
if CInt
numPeeped CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
Raw.eventBufferSize
then ([Event]
peeped [Event] -> [Event] -> [Event]
forall a. [a] -> [a] -> [a]
++) ([Event] -> [Event]) -> IO [Event] -> IO [Event]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Event]
peepAllEvents
else [Event] -> IO [Event]
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return [Event]
peeped
mapEvents :: MonadIO m => (Event -> m ()) -> m ()
mapEvents :: forall (m :: Type -> Type). MonadIO m => (Event -> m ()) -> m ()
mapEvents Event -> m ()
h = do
Maybe Event
event' <- m (Maybe Event)
forall (m :: Type -> Type). MonadIO m => m (Maybe Event)
pollEvent
case Maybe Event
event' of
Just Event
event -> Event -> m ()
h Event
event m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> (Event -> m ()) -> m ()
forall (m :: Type -> Type). MonadIO m => (Event -> m ()) -> m ()
mapEvents Event -> m ()
h
Maybe Event
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
waitEvent :: MonadIO m => m Event
waitEvent :: forall (m :: Type -> Type). MonadIO m => m Event
waitEvent = IO Event -> m Event
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event) -> IO Event -> m Event
forall a b. (a -> b) -> a -> b
$ (Ptr Event -> IO Event) -> IO Event
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Event -> IO Event) -> IO Event)
-> (Ptr Event -> IO Event) -> IO Event
forall a b. (a -> b) -> a -> b
$ \Ptr Event
e -> do
Text -> Text -> IO CInt -> IO ()
forall (m :: Type -> Type) a.
(MonadIO m, Num a, Ord a) =>
Text -> Text -> m a -> m ()
throwIfNeg_ Text
"SDL.Events.waitEvent" Text
"SDL_WaitEvent" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
Ptr Event -> IO CInt
forall (m :: Type -> Type). MonadIO m => Ptr Event -> m CInt
Raw.waitEvent Ptr Event
e
Ptr Event -> IO Event
forall a. Storable a => Ptr a -> IO a
peek Ptr Event
e IO Event -> (Event -> IO Event) -> IO Event
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Event -> IO Event
convertRaw
waitEventTimeout :: MonadIO m
=> CInt
-> m (Maybe Event)
waitEventTimeout :: forall (m :: Type -> Type). MonadIO m => CInt -> m (Maybe Event)
waitEventTimeout CInt
timeout = IO (Maybe Event) -> m (Maybe Event)
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Event) -> m (Maybe Event))
-> IO (Maybe Event) -> m (Maybe Event)
forall a b. (a -> b) -> a -> b
$ (Ptr Event -> IO (Maybe Event)) -> IO (Maybe Event)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Event -> IO (Maybe Event)) -> IO (Maybe Event))
-> (Ptr Event -> IO (Maybe Event)) -> IO (Maybe Event)
forall a b. (a -> b) -> a -> b
$ \Ptr Event
e -> do
CInt
n <- Ptr Event -> CInt -> IO CInt
forall (m :: Type -> Type).
MonadIO m =>
Ptr Event -> CInt -> m CInt
Raw.waitEventTimeout Ptr Event
e CInt
timeout
if CInt
n CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
then Maybe Event -> IO (Maybe Event)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe Event
forall a. Maybe a
Nothing
else (Event -> Maybe Event) -> IO Event -> IO (Maybe Event)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Event -> Maybe Event
forall a. a -> Maybe a
Just (Ptr Event -> IO Event
forall a. Storable a => Ptr a -> IO a
peek Ptr Event
e IO Event -> (Event -> IO Event) -> IO Event
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Event -> IO Event
convertRaw)
data RegisteredEventType a =
RegisteredEventType {forall a. RegisteredEventType a -> a -> IO EventPushResult
pushRegisteredEvent :: a -> IO EventPushResult
,forall a. RegisteredEventType a -> Event -> IO (Maybe a)
getRegisteredEvent :: Event -> IO (Maybe a)
}
data RegisteredEventData =
RegisteredEventData {RegisteredEventData -> Maybe Window
registeredEventWindow :: !(Maybe Window)
,RegisteredEventData -> Int32
registeredEventCode :: !Int32
,RegisteredEventData -> Ptr ()
registeredEventData1 :: !(Ptr ())
,RegisteredEventData -> Ptr ()
registeredEventData2 :: !(Ptr ())
}
deriving (RegisteredEventData -> RegisteredEventData -> Bool
(RegisteredEventData -> RegisteredEventData -> Bool)
-> (RegisteredEventData -> RegisteredEventData -> Bool)
-> Eq RegisteredEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegisteredEventData -> RegisteredEventData -> Bool
== :: RegisteredEventData -> RegisteredEventData -> Bool
$c/= :: RegisteredEventData -> RegisteredEventData -> Bool
/= :: RegisteredEventData -> RegisteredEventData -> Bool
Eq,Eq RegisteredEventData
Eq RegisteredEventData =>
(RegisteredEventData -> RegisteredEventData -> Ordering)
-> (RegisteredEventData -> RegisteredEventData -> Bool)
-> (RegisteredEventData -> RegisteredEventData -> Bool)
-> (RegisteredEventData -> RegisteredEventData -> Bool)
-> (RegisteredEventData -> RegisteredEventData -> Bool)
-> (RegisteredEventData
-> RegisteredEventData -> RegisteredEventData)
-> (RegisteredEventData
-> RegisteredEventData -> RegisteredEventData)
-> Ord RegisteredEventData
RegisteredEventData -> RegisteredEventData -> Bool
RegisteredEventData -> RegisteredEventData -> Ordering
RegisteredEventData -> RegisteredEventData -> RegisteredEventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RegisteredEventData -> RegisteredEventData -> Ordering
compare :: RegisteredEventData -> RegisteredEventData -> Ordering
$c< :: RegisteredEventData -> RegisteredEventData -> Bool
< :: RegisteredEventData -> RegisteredEventData -> Bool
$c<= :: RegisteredEventData -> RegisteredEventData -> Bool
<= :: RegisteredEventData -> RegisteredEventData -> Bool
$c> :: RegisteredEventData -> RegisteredEventData -> Bool
> :: RegisteredEventData -> RegisteredEventData -> Bool
$c>= :: RegisteredEventData -> RegisteredEventData -> Bool
>= :: RegisteredEventData -> RegisteredEventData -> Bool
$cmax :: RegisteredEventData -> RegisteredEventData -> RegisteredEventData
max :: RegisteredEventData -> RegisteredEventData -> RegisteredEventData
$cmin :: RegisteredEventData -> RegisteredEventData -> RegisteredEventData
min :: RegisteredEventData -> RegisteredEventData -> RegisteredEventData
Ord,(forall x. RegisteredEventData -> Rep RegisteredEventData x)
-> (forall x. Rep RegisteredEventData x -> RegisteredEventData)
-> Generic RegisteredEventData
forall x. Rep RegisteredEventData x -> RegisteredEventData
forall x. RegisteredEventData -> Rep RegisteredEventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RegisteredEventData -> Rep RegisteredEventData x
from :: forall x. RegisteredEventData -> Rep RegisteredEventData x
$cto :: forall x. Rep RegisteredEventData x -> RegisteredEventData
to :: forall x. Rep RegisteredEventData x -> RegisteredEventData
Generic,Int -> RegisteredEventData -> ShowS
[RegisteredEventData] -> ShowS
RegisteredEventData -> String
(Int -> RegisteredEventData -> ShowS)
-> (RegisteredEventData -> String)
-> ([RegisteredEventData] -> ShowS)
-> Show RegisteredEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegisteredEventData -> ShowS
showsPrec :: Int -> RegisteredEventData -> ShowS
$cshow :: RegisteredEventData -> String
show :: RegisteredEventData -> String
$cshowList :: [RegisteredEventData] -> ShowS
showList :: [RegisteredEventData] -> ShowS
Show,Typeable)
emptyRegisteredEvent :: RegisteredEventData
emptyRegisteredEvent :: RegisteredEventData
emptyRegisteredEvent = Maybe Window -> Int32 -> Ptr () -> Ptr () -> RegisteredEventData
RegisteredEventData Maybe Window
forall a. Maybe a
Nothing Int32
0 Ptr ()
forall a. Ptr a
nullPtr Ptr ()
forall a. Ptr a
nullPtr
data EventPushResult = EventPushSuccess | EventPushFiltered | EventPushFailure Text
deriving (Typeable EventPushResult
Typeable EventPushResult =>
(forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EventPushResult -> c EventPushResult)
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EventPushResult)
-> (EventPushResult -> Constr)
-> (EventPushResult -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EventPushResult))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EventPushResult))
-> ((forall b. Data b => b -> b)
-> EventPushResult -> EventPushResult)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EventPushResult -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EventPushResult -> r)
-> (forall u.
(forall d. Data d => d -> u) -> EventPushResult -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> EventPushResult -> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> EventPushResult -> m EventPushResult)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EventPushResult -> m EventPushResult)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EventPushResult -> m EventPushResult)
-> Data EventPushResult
EventPushResult -> Constr
EventPushResult -> DataType
(forall b. Data b => b -> b) -> EventPushResult -> EventPushResult
forall a.
Typeable a =>
(forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> EventPushResult -> u
forall u. (forall d. Data d => d -> u) -> EventPushResult -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EventPushResult -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EventPushResult -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> EventPushResult -> m EventPushResult
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EventPushResult -> m EventPushResult
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EventPushResult
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EventPushResult -> c EventPushResult
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EventPushResult)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EventPushResult)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EventPushResult -> c EventPushResult
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EventPushResult -> c EventPushResult
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EventPushResult
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EventPushResult
$ctoConstr :: EventPushResult -> Constr
toConstr :: EventPushResult -> Constr
$cdataTypeOf :: EventPushResult -> DataType
dataTypeOf :: EventPushResult -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EventPushResult)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EventPushResult)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EventPushResult)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EventPushResult)
$cgmapT :: (forall b. Data b => b -> b) -> EventPushResult -> EventPushResult
gmapT :: (forall b. Data b => b -> b) -> EventPushResult -> EventPushResult
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EventPushResult -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EventPushResult -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EventPushResult -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EventPushResult -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EventPushResult -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> EventPushResult -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> EventPushResult -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> EventPushResult -> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> EventPushResult -> m EventPushResult
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> EventPushResult -> m EventPushResult
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EventPushResult -> m EventPushResult
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EventPushResult -> m EventPushResult
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EventPushResult -> m EventPushResult
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EventPushResult -> m EventPushResult
Data, EventPushResult -> EventPushResult -> Bool
(EventPushResult -> EventPushResult -> Bool)
-> (EventPushResult -> EventPushResult -> Bool)
-> Eq EventPushResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EventPushResult -> EventPushResult -> Bool
== :: EventPushResult -> EventPushResult -> Bool
$c/= :: EventPushResult -> EventPushResult -> Bool
/= :: EventPushResult -> EventPushResult -> Bool
Eq, (forall x. EventPushResult -> Rep EventPushResult x)
-> (forall x. Rep EventPushResult x -> EventPushResult)
-> Generic EventPushResult
forall x. Rep EventPushResult x -> EventPushResult
forall x. EventPushResult -> Rep EventPushResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EventPushResult -> Rep EventPushResult x
from :: forall x. EventPushResult -> Rep EventPushResult x
$cto :: forall x. Rep EventPushResult x -> EventPushResult
to :: forall x. Rep EventPushResult x -> EventPushResult
Generic, Eq EventPushResult
Eq EventPushResult =>
(EventPushResult -> EventPushResult -> Ordering)
-> (EventPushResult -> EventPushResult -> Bool)
-> (EventPushResult -> EventPushResult -> Bool)
-> (EventPushResult -> EventPushResult -> Bool)
-> (EventPushResult -> EventPushResult -> Bool)
-> (EventPushResult -> EventPushResult -> EventPushResult)
-> (EventPushResult -> EventPushResult -> EventPushResult)
-> Ord EventPushResult
EventPushResult -> EventPushResult -> Bool
EventPushResult -> EventPushResult -> Ordering
EventPushResult -> EventPushResult -> EventPushResult
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EventPushResult -> EventPushResult -> Ordering
compare :: EventPushResult -> EventPushResult -> Ordering
$c< :: EventPushResult -> EventPushResult -> Bool
< :: EventPushResult -> EventPushResult -> Bool
$c<= :: EventPushResult -> EventPushResult -> Bool
<= :: EventPushResult -> EventPushResult -> Bool
$c> :: EventPushResult -> EventPushResult -> Bool
> :: EventPushResult -> EventPushResult -> Bool
$c>= :: EventPushResult -> EventPushResult -> Bool
>= :: EventPushResult -> EventPushResult -> Bool
$cmax :: EventPushResult -> EventPushResult -> EventPushResult
max :: EventPushResult -> EventPushResult -> EventPushResult
$cmin :: EventPushResult -> EventPushResult -> EventPushResult
min :: EventPushResult -> EventPushResult -> EventPushResult
Ord, ReadPrec [EventPushResult]
ReadPrec EventPushResult
Int -> ReadS EventPushResult
ReadS [EventPushResult]
(Int -> ReadS EventPushResult)
-> ReadS [EventPushResult]
-> ReadPrec EventPushResult
-> ReadPrec [EventPushResult]
-> Read EventPushResult
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS EventPushResult
readsPrec :: Int -> ReadS EventPushResult
$creadList :: ReadS [EventPushResult]
readList :: ReadS [EventPushResult]
$creadPrec :: ReadPrec EventPushResult
readPrec :: ReadPrec EventPushResult
$creadListPrec :: ReadPrec [EventPushResult]
readListPrec :: ReadPrec [EventPushResult]
Read, Int -> EventPushResult -> ShowS
[EventPushResult] -> ShowS
EventPushResult -> String
(Int -> EventPushResult -> ShowS)
-> (EventPushResult -> String)
-> ([EventPushResult] -> ShowS)
-> Show EventPushResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EventPushResult -> ShowS
showsPrec :: Int -> EventPushResult -> ShowS
$cshow :: EventPushResult -> String
show :: EventPushResult -> String
$cshowList :: [EventPushResult] -> ShowS
showList :: [EventPushResult] -> ShowS
Show, Typeable)
registerEvent :: MonadIO m
=> (RegisteredEventData -> Timestamp -> IO (Maybe a))
-> (a -> IO RegisteredEventData)
-> m (Maybe (RegisteredEventType a))
registerEvent :: forall (m :: Type -> Type) a.
MonadIO m =>
(RegisteredEventData -> Word32 -> IO (Maybe a))
-> (a -> IO RegisteredEventData)
-> m (Maybe (RegisteredEventType a))
registerEvent RegisteredEventData -> Word32 -> IO (Maybe a)
registeredEventDataToEvent a -> IO RegisteredEventData
eventToRegisteredEventData = do
Word32
typ <- CInt -> m Word32
forall (m :: Type -> Type). MonadIO m => CInt -> m Word32
Raw.registerEvents CInt
1
if Word32
typ Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
forall a. Bounded a => a
maxBound
then Maybe (RegisteredEventType a) -> m (Maybe (RegisteredEventType a))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe (RegisteredEventType a)
forall a. Maybe a
Nothing
else
let pushEv :: a -> IO EventPushResult
pushEv a
ev = do
RegisteredEventData Maybe Window
mWin Int32
code Ptr ()
d1 Ptr ()
d2 <- a -> IO RegisteredEventData
eventToRegisteredEventData a
ev
Word32
windowID <- case Maybe Window
mWin of
Just (Window Ptr ()
w) -> Ptr () -> IO Word32
forall (m :: Type -> Type). MonadIO m => Ptr () -> m Word32
Raw.getWindowID Ptr ()
w
Maybe Window
Nothing -> Word32 -> IO Word32
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Word32
0
let rawEvent :: Event
rawEvent = Word32 -> Word32 -> Word32 -> Int32 -> Ptr () -> Ptr () -> Event
Raw.UserEvent Word32
typ Word32
0 Word32
windowID Int32
code Ptr ()
d1 Ptr ()
d2
IO EventPushResult -> IO EventPushResult
forall a. IO a -> IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO EventPushResult -> IO EventPushResult)
-> ((Ptr Event -> IO EventPushResult) -> IO EventPushResult)
-> (Ptr Event -> IO EventPushResult)
-> IO EventPushResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr Event -> IO EventPushResult) -> IO EventPushResult
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Event -> IO EventPushResult) -> IO EventPushResult)
-> (Ptr Event -> IO EventPushResult) -> IO EventPushResult
forall a b. (a -> b) -> a -> b
$ \Ptr Event
eventPtr -> do
Ptr Event -> Event -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Event
eventPtr Event
rawEvent
CInt
pushResult <- Ptr Event -> IO CInt
forall (m :: Type -> Type). MonadIO m => Ptr Event -> m CInt
Raw.pushEvent Ptr Event
eventPtr
case CInt
pushResult of
CInt
1 -> EventPushResult -> IO EventPushResult
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (EventPushResult -> IO EventPushResult)
-> EventPushResult -> IO EventPushResult
forall a b. (a -> b) -> a -> b
$ EventPushResult
EventPushSuccess
CInt
0 -> EventPushResult -> IO EventPushResult
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (EventPushResult -> IO EventPushResult)
-> EventPushResult -> IO EventPushResult
forall a b. (a -> b) -> a -> b
$ EventPushResult
EventPushFiltered
CInt
_ -> Text -> EventPushResult
EventPushFailure (Text -> EventPushResult) -> IO Text -> IO EventPushResult
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
forall (m :: Type -> Type). MonadIO m => m Text
getError
getEv :: Event -> IO (Maybe a)
getEv (Event Word32
ts (UserEvent (UserEventData Word32
_typ Maybe Window
mWin Int32
code Ptr ()
d1 Ptr ()
d2))) =
RegisteredEventData -> Word32 -> IO (Maybe a)
registeredEventDataToEvent (Maybe Window -> Int32 -> Ptr () -> Ptr () -> RegisteredEventData
RegisteredEventData Maybe Window
mWin Int32
code Ptr ()
d1 Ptr ()
d2) Word32
ts
getEv Event
_ = Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
in Maybe (RegisteredEventType a) -> m (Maybe (RegisteredEventType a))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (RegisteredEventType a)
-> m (Maybe (RegisteredEventType a)))
-> (RegisteredEventType a -> Maybe (RegisteredEventType a))
-> RegisteredEventType a
-> m (Maybe (RegisteredEventType a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegisteredEventType a -> Maybe (RegisteredEventType a)
forall a. a -> Maybe a
Just (RegisteredEventType a -> m (Maybe (RegisteredEventType a)))
-> RegisteredEventType a -> m (Maybe (RegisteredEventType a))
forall a b. (a -> b) -> a -> b
$ (a -> IO EventPushResult)
-> (Event -> IO (Maybe a)) -> RegisteredEventType a
forall a.
(a -> IO EventPushResult)
-> (Event -> IO (Maybe a)) -> RegisteredEventType a
RegisteredEventType a -> IO EventPushResult
pushEv Event -> IO (Maybe a)
getEv
pumpEvents :: MonadIO m => m ()
pumpEvents :: forall (m :: Type -> Type). MonadIO m => m ()
pumpEvents = m ()
forall (m :: Type -> Type). MonadIO m => m ()
Raw.pumpEvents
type EventWatchCallback = Event -> IO ()
newtype EventWatch = EventWatch {EventWatch -> IO ()
runEventWatchRemoval :: IO ()}
addEventWatch :: MonadIO m => EventWatchCallback -> m EventWatch
addEventWatch :: forall (m :: Type -> Type).
MonadIO m =>
EventWatchCallback -> m EventWatch
addEventWatch EventWatchCallback
callback = IO EventWatch -> m EventWatch
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO EventWatch -> m EventWatch) -> IO EventWatch -> m EventWatch
forall a b. (a -> b) -> a -> b
$ do
EventFilter
rawFilter <- (Ptr () -> Ptr Event -> IO CInt) -> IO EventFilter
Raw.mkEventFilter Ptr () -> Ptr Event -> IO CInt
wrappedCb
EventFilter -> Ptr () -> IO ()
forall (m :: Type -> Type).
MonadIO m =>
EventFilter -> Ptr () -> m ()
Raw.addEventWatch EventFilter
rawFilter Ptr ()
forall a. Ptr a
nullPtr
EventWatch -> IO EventWatch
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (IO () -> EventWatch
EventWatch (IO () -> EventWatch) -> IO () -> EventWatch
forall a b. (a -> b) -> a -> b
$ EventFilter -> IO ()
auxRemove EventFilter
rawFilter)
where
wrappedCb :: Ptr () -> Ptr Raw.Event -> IO CInt
wrappedCb :: Ptr () -> Ptr Event -> IO CInt
wrappedCb Ptr ()
_ Ptr Event
evPtr = CInt
0 CInt -> IO () -> IO CInt
forall a b. a -> IO b -> IO a
forall (f :: Type -> Type) a b. Functor f => a -> f b -> f a
<$ (EventWatchCallback
callback EventWatchCallback -> IO Event -> IO ()
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< Event -> IO Event
convertRaw (Event -> IO Event) -> IO Event -> IO Event
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Event -> IO Event
forall a. Storable a => Ptr a -> IO a
peek Ptr Event
evPtr)
auxRemove :: Raw.EventFilter -> IO ()
auxRemove :: EventFilter -> IO ()
auxRemove EventFilter
rawFilter = do
EventFilter -> Ptr () -> IO ()
forall (m :: Type -> Type).
MonadIO m =>
EventFilter -> Ptr () -> m ()
Raw.delEventWatch EventFilter
rawFilter Ptr ()
forall a. Ptr a
nullPtr
EventFilter -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr EventFilter
rawFilter
delEventWatch :: MonadIO m => EventWatch -> m ()
delEventWatch :: forall (m :: Type -> Type). MonadIO m => EventWatch -> m ()
delEventWatch = IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (EventWatch -> IO ()) -> EventWatch -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventWatch -> IO ()
runEventWatchRemoval
getWindowFromID :: MonadIO m => Word32 -> m (Maybe Window)
getWindowFromID :: forall (m :: Type -> Type). MonadIO m => Word32 -> m (Maybe Window)
getWindowFromID Word32
windowId = do
Ptr ()
rawWindow <- Word32 -> m (Ptr ())
forall (m :: Type -> Type). MonadIO m => Word32 -> m (Ptr ())
Raw.getWindowFromID Word32
windowId
Maybe Window -> m (Maybe Window)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe Window -> m (Maybe Window))
-> Maybe Window -> m (Maybe Window)
forall a b. (a -> b) -> a -> b
$ if Ptr ()
rawWindow Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
forall a. Ptr a
nullPtr then Maybe Window
forall a. Maybe a
Nothing else Window -> Maybe Window
forall a. a -> Maybe a
Just (Window -> Maybe Window) -> Window -> Maybe Window
forall a b. (a -> b) -> a -> b
$ Ptr () -> Window
Window Ptr ()
rawWindow