{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}

-- | "SDL.Event" exports an interface for working with the SDL event model. Event handling allows your application to receive input from the user. Internally, SDL stores all the events waiting to be handled in an event queue. Using functions like 'pollEvent' and 'waitEvent' you can observe and handle waiting input events.
--
-- The event queue itself is composed of a series of 'Event' values, one for each waiting event. 'Event' values are read from the queue with the 'pollEvent' function and it is then up to the application to process the information stored with them.
module SDL.Event
  ( -- * Polling events
    pollEvent
  , pollEvents
  , mapEvents
  , pumpEvents
  , waitEvent
  , waitEventTimeout
    -- * Registering user events
  , RegisteredEventType(..)
  , RegisteredEventData(..)
  , EventPushResult(..)
  , emptyRegisteredEvent
  , registerEvent
    -- * Watching events
  , EventWatchCallback
  , EventWatch
  , addEventWatch
  , delEventWatch
    -- * Event data
  , Event(..)
  , Timestamp
  , EventPayload(..)
    -- ** Window events
  , WindowShownEventData(..)
  , WindowHiddenEventData(..)
  , WindowExposedEventData(..)
  , WindowMovedEventData(..)
  , WindowResizedEventData(..)
  , WindowSizeChangedEventData(..)
  , WindowMinimizedEventData(..)
  , WindowMaximizedEventData(..)
  , WindowRestoredEventData(..)
  , WindowGainedMouseFocusEventData(..)
  , WindowLostMouseFocusEventData(..)
  , WindowGainedKeyboardFocusEventData(..)
  , WindowLostKeyboardFocusEventData(..)
  , WindowClosedEventData(..)
  , SysWMEventData(..)
    -- ** Keyboard events
  , KeyboardEventData(..)
  , TextEditingEventData(..)
  , TextInputEventData(..)
    -- ** Mouse events
  , MouseMotionEventData(..)
  , MouseButtonEventData(..)
  , MouseWheelEventData(..)
    -- ** Joystick events
  , JoyAxisEventData(..)
  , JoyBallEventData(..)
  , JoyHatEventData(..)
  , JoyButtonEventData(..)
  , JoyDeviceEventData(..)
    -- ** Controller events
  , ControllerAxisEventData(..)
  , ControllerButtonEventData(..)
  , ControllerDeviceEventData(..)
    -- ** Audio events
  , AudioDeviceEventData(..)
    -- ** User events
  , UserEventData(..)
    -- ** Touch events
  , TouchFingerEventData(..)
  , TouchFingerMotionEventData(..)
    -- ** Gesture events
  , MultiGestureEventData(..)
  , DollarGestureEventData(..)
    -- ** Drag and drop events
  , DropEventData(..)
    -- ** Unknown events
  , UnknownEventData(..)
    -- * Auxiliary event data
  , 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

-- | A single SDL event. This event occured at 'eventTimestamp' and carries data under 'eventPayload'.
data Event = Event
  { Event -> Timestamp
eventTimestamp :: Timestamp
    -- ^ The time the event occured.
  , Event -> EventPayload
eventPayload :: EventPayload
    -- ^ Data pertaining to this event.
  } deriving (Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: 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
min :: Event -> Event -> Event
$cmin :: Event -> Event -> Event
max :: Event -> Event -> Event
$cmax :: Event -> Event -> Event
>= :: Event -> Event -> Bool
$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
compare :: Event -> Event -> Ordering
$ccompare :: Event -> Event -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep Event x -> Event
$cfrom :: forall x. Event -> Rep Event x
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
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show, Typeable)

type Timestamp = Word32

-- | An enumeration of all possible SDL event types. This data type pairs up event types with
-- their payload, where possible.
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
/= :: EventPayload -> EventPayload -> Bool
$c/= :: EventPayload -> EventPayload -> Bool
== :: EventPayload -> EventPayload -> Bool
$c== :: 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
min :: EventPayload -> EventPayload -> EventPayload
$cmin :: EventPayload -> EventPayload -> EventPayload
max :: EventPayload -> EventPayload -> EventPayload
$cmax :: EventPayload -> EventPayload -> EventPayload
>= :: EventPayload -> EventPayload -> Bool
$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
compare :: EventPayload -> EventPayload -> Ordering
$ccompare :: EventPayload -> EventPayload -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep EventPayload x -> EventPayload
$cfrom :: forall x. EventPayload -> Rep EventPayload x
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
showList :: [EventPayload] -> ShowS
$cshowList :: [EventPayload] -> ShowS
show :: EventPayload -> String
$cshow :: EventPayload -> String
showsPrec :: Int -> EventPayload -> ShowS
$cshowsPrec :: Int -> EventPayload -> ShowS
Show, Typeable)

-- | A window has been shown.
newtype WindowShownEventData =
  WindowShownEventData {WindowShownEventData -> Window
windowShownEventWindow :: Window
                        -- ^ The associated 'Window'.
                       }
  deriving (WindowShownEventData -> WindowShownEventData -> Bool
(WindowShownEventData -> WindowShownEventData -> Bool)
-> (WindowShownEventData -> WindowShownEventData -> Bool)
-> Eq WindowShownEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowShownEventData -> WindowShownEventData -> Bool
$c/= :: WindowShownEventData -> WindowShownEventData -> Bool
== :: WindowShownEventData -> WindowShownEventData -> Bool
$c== :: 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
min :: WindowShownEventData
-> WindowShownEventData -> WindowShownEventData
$cmin :: WindowShownEventData
-> WindowShownEventData -> WindowShownEventData
max :: WindowShownEventData
-> WindowShownEventData -> WindowShownEventData
$cmax :: WindowShownEventData
-> WindowShownEventData -> WindowShownEventData
>= :: WindowShownEventData -> WindowShownEventData -> Bool
$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
compare :: WindowShownEventData -> WindowShownEventData -> Ordering
$ccompare :: WindowShownEventData -> WindowShownEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep WindowShownEventData x -> WindowShownEventData
$cfrom :: forall x. WindowShownEventData -> Rep WindowShownEventData x
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
showList :: [WindowShownEventData] -> ShowS
$cshowList :: [WindowShownEventData] -> ShowS
show :: WindowShownEventData -> String
$cshow :: WindowShownEventData -> String
showsPrec :: Int -> WindowShownEventData -> ShowS
$cshowsPrec :: Int -> WindowShownEventData -> ShowS
Show,Typeable)

-- | A window has been hidden.
newtype WindowHiddenEventData =
  WindowHiddenEventData {WindowHiddenEventData -> Window
windowHiddenEventWindow :: Window
                         -- ^ The associated 'Window'.
                        }
  deriving (WindowHiddenEventData -> WindowHiddenEventData -> Bool
(WindowHiddenEventData -> WindowHiddenEventData -> Bool)
-> (WindowHiddenEventData -> WindowHiddenEventData -> Bool)
-> Eq WindowHiddenEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowHiddenEventData -> WindowHiddenEventData -> Bool
$c/= :: WindowHiddenEventData -> WindowHiddenEventData -> Bool
== :: WindowHiddenEventData -> WindowHiddenEventData -> Bool
$c== :: 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
min :: WindowHiddenEventData
-> WindowHiddenEventData -> WindowHiddenEventData
$cmin :: WindowHiddenEventData
-> WindowHiddenEventData -> WindowHiddenEventData
max :: WindowHiddenEventData
-> WindowHiddenEventData -> WindowHiddenEventData
$cmax :: WindowHiddenEventData
-> WindowHiddenEventData -> WindowHiddenEventData
>= :: WindowHiddenEventData -> WindowHiddenEventData -> Bool
$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
compare :: WindowHiddenEventData -> WindowHiddenEventData -> Ordering
$ccompare :: WindowHiddenEventData -> WindowHiddenEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep WindowHiddenEventData x -> WindowHiddenEventData
$cfrom :: forall x. WindowHiddenEventData -> Rep WindowHiddenEventData x
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
showList :: [WindowHiddenEventData] -> ShowS
$cshowList :: [WindowHiddenEventData] -> ShowS
show :: WindowHiddenEventData -> String
$cshow :: WindowHiddenEventData -> String
showsPrec :: Int -> WindowHiddenEventData -> ShowS
$cshowsPrec :: Int -> WindowHiddenEventData -> ShowS
Show,Typeable)

-- | A part of a window has been exposed - where exposure means to become visible (for example, an overlapping window no longer overlaps with the window).
newtype WindowExposedEventData =
  WindowExposedEventData {WindowExposedEventData -> Window
windowExposedEventWindow :: Window
                          -- ^ The associated 'Window'.
                         }
  deriving (WindowExposedEventData -> WindowExposedEventData -> Bool
(WindowExposedEventData -> WindowExposedEventData -> Bool)
-> (WindowExposedEventData -> WindowExposedEventData -> Bool)
-> Eq WindowExposedEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowExposedEventData -> WindowExposedEventData -> Bool
$c/= :: WindowExposedEventData -> WindowExposedEventData -> Bool
== :: WindowExposedEventData -> WindowExposedEventData -> Bool
$c== :: 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
min :: WindowExposedEventData
-> WindowExposedEventData -> WindowExposedEventData
$cmin :: WindowExposedEventData
-> WindowExposedEventData -> WindowExposedEventData
max :: WindowExposedEventData
-> WindowExposedEventData -> WindowExposedEventData
$cmax :: WindowExposedEventData
-> WindowExposedEventData -> WindowExposedEventData
>= :: WindowExposedEventData -> WindowExposedEventData -> Bool
$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
compare :: WindowExposedEventData -> WindowExposedEventData -> Ordering
$ccompare :: WindowExposedEventData -> WindowExposedEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep WindowExposedEventData x -> WindowExposedEventData
$cfrom :: forall x. WindowExposedEventData -> Rep WindowExposedEventData x
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
showList :: [WindowExposedEventData] -> ShowS
$cshowList :: [WindowExposedEventData] -> ShowS
show :: WindowExposedEventData -> String
$cshow :: WindowExposedEventData -> String
showsPrec :: Int -> WindowExposedEventData -> ShowS
$cshowsPrec :: Int -> WindowExposedEventData -> ShowS
Show,Typeable)

-- | A 'Window' has been moved.
data WindowMovedEventData =
  WindowMovedEventData {WindowMovedEventData -> Window
windowMovedEventWindow :: !Window
                        -- ^ The associated 'Window'.
                       ,WindowMovedEventData -> Point V2 Int32
windowMovedEventPosition :: !(Point V2 Int32)
                        -- ^ The new position of the 'Window'.
                       }
  deriving (WindowMovedEventData -> WindowMovedEventData -> Bool
(WindowMovedEventData -> WindowMovedEventData -> Bool)
-> (WindowMovedEventData -> WindowMovedEventData -> Bool)
-> Eq WindowMovedEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowMovedEventData -> WindowMovedEventData -> Bool
$c/= :: WindowMovedEventData -> WindowMovedEventData -> Bool
== :: WindowMovedEventData -> WindowMovedEventData -> Bool
$c== :: 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
min :: WindowMovedEventData
-> WindowMovedEventData -> WindowMovedEventData
$cmin :: WindowMovedEventData
-> WindowMovedEventData -> WindowMovedEventData
max :: WindowMovedEventData
-> WindowMovedEventData -> WindowMovedEventData
$cmax :: WindowMovedEventData
-> WindowMovedEventData -> WindowMovedEventData
>= :: WindowMovedEventData -> WindowMovedEventData -> Bool
$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
compare :: WindowMovedEventData -> WindowMovedEventData -> Ordering
$ccompare :: WindowMovedEventData -> WindowMovedEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep WindowMovedEventData x -> WindowMovedEventData
$cfrom :: forall x. WindowMovedEventData -> Rep WindowMovedEventData x
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
showList :: [WindowMovedEventData] -> ShowS
$cshowList :: [WindowMovedEventData] -> ShowS
show :: WindowMovedEventData -> String
$cshow :: WindowMovedEventData -> String
showsPrec :: Int -> WindowMovedEventData -> ShowS
$cshowsPrec :: Int -> WindowMovedEventData -> ShowS
Show,Typeable)

-- | Window has been resized. This is event is always preceded by 'WindowSizeChangedEvent'.
data WindowResizedEventData =
  WindowResizedEventData {WindowResizedEventData -> Window
windowResizedEventWindow :: !Window
                          -- ^ The associated 'Window'.
                         ,WindowResizedEventData -> V2 Int32
windowResizedEventSize :: !(V2 Int32)
                          -- ^ The new size of the 'Window'.
                         }
  deriving (WindowResizedEventData -> WindowResizedEventData -> Bool
(WindowResizedEventData -> WindowResizedEventData -> Bool)
-> (WindowResizedEventData -> WindowResizedEventData -> Bool)
-> Eq WindowResizedEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowResizedEventData -> WindowResizedEventData -> Bool
$c/= :: WindowResizedEventData -> WindowResizedEventData -> Bool
== :: WindowResizedEventData -> WindowResizedEventData -> Bool
$c== :: 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
min :: WindowResizedEventData
-> WindowResizedEventData -> WindowResizedEventData
$cmin :: WindowResizedEventData
-> WindowResizedEventData -> WindowResizedEventData
max :: WindowResizedEventData
-> WindowResizedEventData -> WindowResizedEventData
$cmax :: WindowResizedEventData
-> WindowResizedEventData -> WindowResizedEventData
>= :: WindowResizedEventData -> WindowResizedEventData -> Bool
$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
compare :: WindowResizedEventData -> WindowResizedEventData -> Ordering
$ccompare :: WindowResizedEventData -> WindowResizedEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep WindowResizedEventData x -> WindowResizedEventData
$cfrom :: forall x. WindowResizedEventData -> Rep WindowResizedEventData x
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
showList :: [WindowResizedEventData] -> ShowS
$cshowList :: [WindowResizedEventData] -> ShowS
show :: WindowResizedEventData -> String
$cshow :: WindowResizedEventData -> String
showsPrec :: Int -> WindowResizedEventData -> ShowS
$cshowsPrec :: Int -> WindowResizedEventData -> ShowS
Show,Typeable)

-- | The window size has changed, either as a result of an API call or through the system or user changing the window size; this event is followed by 'WindowResizedEvent' if the size was changed by an external event, i.e. the user or the window manager.
data WindowSizeChangedEventData =
  WindowSizeChangedEventData {WindowSizeChangedEventData -> Window
windowSizeChangedEventWindow :: !Window
                              -- ^ The associated 'Window'.
                             ,WindowSizeChangedEventData -> V2 Int32
windowSizeChangedEventSize :: !(V2 Int32)
                              -- ^ The new size of the 'Window'.
                             }
  deriving (WindowSizeChangedEventData -> WindowSizeChangedEventData -> Bool
(WindowSizeChangedEventData -> WindowSizeChangedEventData -> Bool)
-> (WindowSizeChangedEventData
    -> WindowSizeChangedEventData -> Bool)
-> Eq WindowSizeChangedEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowSizeChangedEventData -> WindowSizeChangedEventData -> Bool
$c/= :: WindowSizeChangedEventData -> WindowSizeChangedEventData -> Bool
== :: WindowSizeChangedEventData -> WindowSizeChangedEventData -> Bool
$c== :: 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
min :: WindowSizeChangedEventData
-> WindowSizeChangedEventData -> WindowSizeChangedEventData
$cmin :: WindowSizeChangedEventData
-> WindowSizeChangedEventData -> WindowSizeChangedEventData
max :: WindowSizeChangedEventData
-> WindowSizeChangedEventData -> WindowSizeChangedEventData
$cmax :: WindowSizeChangedEventData
-> WindowSizeChangedEventData -> WindowSizeChangedEventData
>= :: WindowSizeChangedEventData -> WindowSizeChangedEventData -> Bool
$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
compare :: WindowSizeChangedEventData
-> WindowSizeChangedEventData -> Ordering
$ccompare :: WindowSizeChangedEventData
-> WindowSizeChangedEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x.
Rep WindowSizeChangedEventData x -> WindowSizeChangedEventData
$cfrom :: forall x.
WindowSizeChangedEventData -> Rep WindowSizeChangedEventData x
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
showList :: [WindowSizeChangedEventData] -> ShowS
$cshowList :: [WindowSizeChangedEventData] -> ShowS
show :: WindowSizeChangedEventData -> String
$cshow :: WindowSizeChangedEventData -> String
showsPrec :: Int -> WindowSizeChangedEventData -> ShowS
$cshowsPrec :: Int -> WindowSizeChangedEventData -> ShowS
Show,Typeable)

-- | The window has been minimized.
newtype WindowMinimizedEventData =
  WindowMinimizedEventData {WindowMinimizedEventData -> Window
windowMinimizedEventWindow :: Window
                            -- ^ The associated 'Window'.
                           }
  deriving (WindowMinimizedEventData -> WindowMinimizedEventData -> Bool
(WindowMinimizedEventData -> WindowMinimizedEventData -> Bool)
-> (WindowMinimizedEventData -> WindowMinimizedEventData -> Bool)
-> Eq WindowMinimizedEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowMinimizedEventData -> WindowMinimizedEventData -> Bool
$c/= :: WindowMinimizedEventData -> WindowMinimizedEventData -> Bool
== :: WindowMinimizedEventData -> WindowMinimizedEventData -> Bool
$c== :: 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
min :: WindowMinimizedEventData
-> WindowMinimizedEventData -> WindowMinimizedEventData
$cmin :: WindowMinimizedEventData
-> WindowMinimizedEventData -> WindowMinimizedEventData
max :: WindowMinimizedEventData
-> WindowMinimizedEventData -> WindowMinimizedEventData
$cmax :: WindowMinimizedEventData
-> WindowMinimizedEventData -> WindowMinimizedEventData
>= :: WindowMinimizedEventData -> WindowMinimizedEventData -> Bool
$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
compare :: WindowMinimizedEventData -> WindowMinimizedEventData -> Ordering
$ccompare :: WindowMinimizedEventData -> WindowMinimizedEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x.
Rep WindowMinimizedEventData x -> WindowMinimizedEventData
$cfrom :: forall x.
WindowMinimizedEventData -> Rep WindowMinimizedEventData x
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
showList :: [WindowMinimizedEventData] -> ShowS
$cshowList :: [WindowMinimizedEventData] -> ShowS
show :: WindowMinimizedEventData -> String
$cshow :: WindowMinimizedEventData -> String
showsPrec :: Int -> WindowMinimizedEventData -> ShowS
$cshowsPrec :: Int -> WindowMinimizedEventData -> ShowS
Show,Typeable)

-- | The window has been maximized.
newtype WindowMaximizedEventData =
  WindowMaximizedEventData {WindowMaximizedEventData -> Window
windowMaximizedEventWindow :: Window
                            -- ^ The associated 'Window'.
                           }
  deriving (WindowMaximizedEventData -> WindowMaximizedEventData -> Bool
(WindowMaximizedEventData -> WindowMaximizedEventData -> Bool)
-> (WindowMaximizedEventData -> WindowMaximizedEventData -> Bool)
-> Eq WindowMaximizedEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowMaximizedEventData -> WindowMaximizedEventData -> Bool
$c/= :: WindowMaximizedEventData -> WindowMaximizedEventData -> Bool
== :: WindowMaximizedEventData -> WindowMaximizedEventData -> Bool
$c== :: 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
min :: WindowMaximizedEventData
-> WindowMaximizedEventData -> WindowMaximizedEventData
$cmin :: WindowMaximizedEventData
-> WindowMaximizedEventData -> WindowMaximizedEventData
max :: WindowMaximizedEventData
-> WindowMaximizedEventData -> WindowMaximizedEventData
$cmax :: WindowMaximizedEventData
-> WindowMaximizedEventData -> WindowMaximizedEventData
>= :: WindowMaximizedEventData -> WindowMaximizedEventData -> Bool
$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
compare :: WindowMaximizedEventData -> WindowMaximizedEventData -> Ordering
$ccompare :: WindowMaximizedEventData -> WindowMaximizedEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x.
Rep WindowMaximizedEventData x -> WindowMaximizedEventData
$cfrom :: forall x.
WindowMaximizedEventData -> Rep WindowMaximizedEventData x
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
showList :: [WindowMaximizedEventData] -> ShowS
$cshowList :: [WindowMaximizedEventData] -> ShowS
show :: WindowMaximizedEventData -> String
$cshow :: WindowMaximizedEventData -> String
showsPrec :: Int -> WindowMaximizedEventData -> ShowS
$cshowsPrec :: Int -> WindowMaximizedEventData -> ShowS
Show,Typeable)

-- | The window has been restored to normal size and position.
newtype WindowRestoredEventData =
  WindowRestoredEventData {WindowRestoredEventData -> Window
windowRestoredEventWindow :: Window
                           -- ^ The associated 'Window'.
                          }
  deriving (WindowRestoredEventData -> WindowRestoredEventData -> Bool
(WindowRestoredEventData -> WindowRestoredEventData -> Bool)
-> (WindowRestoredEventData -> WindowRestoredEventData -> Bool)
-> Eq WindowRestoredEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowRestoredEventData -> WindowRestoredEventData -> Bool
$c/= :: WindowRestoredEventData -> WindowRestoredEventData -> Bool
== :: WindowRestoredEventData -> WindowRestoredEventData -> Bool
$c== :: 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
min :: WindowRestoredEventData
-> WindowRestoredEventData -> WindowRestoredEventData
$cmin :: WindowRestoredEventData
-> WindowRestoredEventData -> WindowRestoredEventData
max :: WindowRestoredEventData
-> WindowRestoredEventData -> WindowRestoredEventData
$cmax :: WindowRestoredEventData
-> WindowRestoredEventData -> WindowRestoredEventData
>= :: WindowRestoredEventData -> WindowRestoredEventData -> Bool
$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
compare :: WindowRestoredEventData -> WindowRestoredEventData -> Ordering
$ccompare :: WindowRestoredEventData -> WindowRestoredEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep WindowRestoredEventData x -> WindowRestoredEventData
$cfrom :: forall x. WindowRestoredEventData -> Rep WindowRestoredEventData x
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
showList :: [WindowRestoredEventData] -> ShowS
$cshowList :: [WindowRestoredEventData] -> ShowS
show :: WindowRestoredEventData -> String
$cshow :: WindowRestoredEventData -> String
showsPrec :: Int -> WindowRestoredEventData -> ShowS
$cshowsPrec :: Int -> WindowRestoredEventData -> ShowS
Show,Typeable)

-- | The window has gained mouse focus.
newtype WindowGainedMouseFocusEventData =
  WindowGainedMouseFocusEventData {WindowGainedMouseFocusEventData -> Window
windowGainedMouseFocusEventWindow :: Window
                                   -- ^ The associated 'Window'.
                                  }
  deriving (WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Bool
(WindowGainedMouseFocusEventData
 -> WindowGainedMouseFocusEventData -> Bool)
-> (WindowGainedMouseFocusEventData
    -> WindowGainedMouseFocusEventData -> Bool)
-> Eq WindowGainedMouseFocusEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Bool
$c/= :: WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Bool
== :: WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Bool
$c== :: 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
min :: WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData
$cmin :: WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData
max :: WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData
$cmax :: WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData
>= :: WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Bool
$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
compare :: WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Ordering
$ccompare :: WindowGainedMouseFocusEventData
-> WindowGainedMouseFocusEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x.
Rep WindowGainedMouseFocusEventData x
-> WindowGainedMouseFocusEventData
$cfrom :: forall x.
WindowGainedMouseFocusEventData
-> Rep WindowGainedMouseFocusEventData x
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
showList :: [WindowGainedMouseFocusEventData] -> ShowS
$cshowList :: [WindowGainedMouseFocusEventData] -> ShowS
show :: WindowGainedMouseFocusEventData -> String
$cshow :: WindowGainedMouseFocusEventData -> String
showsPrec :: Int -> WindowGainedMouseFocusEventData -> ShowS
$cshowsPrec :: Int -> WindowGainedMouseFocusEventData -> ShowS
Show,Typeable)

-- | The window has lost mouse focus.
newtype WindowLostMouseFocusEventData =
  WindowLostMouseFocusEventData {WindowLostMouseFocusEventData -> Window
windowLostMouseFocusEventWindow :: Window
                                 -- ^ The associated 'Window'.
                                }
  deriving (WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Bool
(WindowLostMouseFocusEventData
 -> WindowLostMouseFocusEventData -> Bool)
-> (WindowLostMouseFocusEventData
    -> WindowLostMouseFocusEventData -> Bool)
-> Eq WindowLostMouseFocusEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Bool
$c/= :: WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Bool
== :: WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Bool
$c== :: 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
min :: WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> WindowLostMouseFocusEventData
$cmin :: WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> WindowLostMouseFocusEventData
max :: WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> WindowLostMouseFocusEventData
$cmax :: WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> WindowLostMouseFocusEventData
>= :: WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Bool
$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
compare :: WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Ordering
$ccompare :: WindowLostMouseFocusEventData
-> WindowLostMouseFocusEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x.
Rep WindowLostMouseFocusEventData x
-> WindowLostMouseFocusEventData
$cfrom :: forall x.
WindowLostMouseFocusEventData
-> Rep WindowLostMouseFocusEventData x
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
showList :: [WindowLostMouseFocusEventData] -> ShowS
$cshowList :: [WindowLostMouseFocusEventData] -> ShowS
show :: WindowLostMouseFocusEventData -> String
$cshow :: WindowLostMouseFocusEventData -> String
showsPrec :: Int -> WindowLostMouseFocusEventData -> ShowS
$cshowsPrec :: Int -> WindowLostMouseFocusEventData -> ShowS
Show,Typeable)

-- | The window has gained keyboard focus.
newtype WindowGainedKeyboardFocusEventData =
  WindowGainedKeyboardFocusEventData {WindowGainedKeyboardFocusEventData -> Window
windowGainedKeyboardFocusEventWindow :: Window
                                      -- ^ The associated 'Window'.
                                     }
  deriving (WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Bool
(WindowGainedKeyboardFocusEventData
 -> WindowGainedKeyboardFocusEventData -> Bool)
-> (WindowGainedKeyboardFocusEventData
    -> WindowGainedKeyboardFocusEventData -> Bool)
-> Eq WindowGainedKeyboardFocusEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Bool
$c/= :: WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Bool
== :: WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Bool
$c== :: 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
min :: WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData
$cmin :: WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData
max :: WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData
$cmax :: WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData
>= :: WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Bool
$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
compare :: WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Ordering
$ccompare :: WindowGainedKeyboardFocusEventData
-> WindowGainedKeyboardFocusEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x.
Rep WindowGainedKeyboardFocusEventData x
-> WindowGainedKeyboardFocusEventData
$cfrom :: forall x.
WindowGainedKeyboardFocusEventData
-> Rep WindowGainedKeyboardFocusEventData x
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
showList :: [WindowGainedKeyboardFocusEventData] -> ShowS
$cshowList :: [WindowGainedKeyboardFocusEventData] -> ShowS
show :: WindowGainedKeyboardFocusEventData -> String
$cshow :: WindowGainedKeyboardFocusEventData -> String
showsPrec :: Int -> WindowGainedKeyboardFocusEventData -> ShowS
$cshowsPrec :: Int -> WindowGainedKeyboardFocusEventData -> ShowS
Show,Typeable)

-- | The window has lost keyboard focus.
newtype WindowLostKeyboardFocusEventData =
  WindowLostKeyboardFocusEventData {WindowLostKeyboardFocusEventData -> Window
windowLostKeyboardFocusEventWindow :: Window
                                    -- ^ The associated 'Window'.
                                   }
  deriving (WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Bool
(WindowLostKeyboardFocusEventData
 -> WindowLostKeyboardFocusEventData -> Bool)
-> (WindowLostKeyboardFocusEventData
    -> WindowLostKeyboardFocusEventData -> Bool)
-> Eq WindowLostKeyboardFocusEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Bool
$c/= :: WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Bool
== :: WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Bool
$c== :: 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
min :: WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData
$cmin :: WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData
max :: WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData
$cmax :: WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData
>= :: WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Bool
$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
compare :: WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Ordering
$ccompare :: WindowLostKeyboardFocusEventData
-> WindowLostKeyboardFocusEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x.
Rep WindowLostKeyboardFocusEventData x
-> WindowLostKeyboardFocusEventData
$cfrom :: forall x.
WindowLostKeyboardFocusEventData
-> Rep WindowLostKeyboardFocusEventData x
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
showList :: [WindowLostKeyboardFocusEventData] -> ShowS
$cshowList :: [WindowLostKeyboardFocusEventData] -> ShowS
show :: WindowLostKeyboardFocusEventData -> String
$cshow :: WindowLostKeyboardFocusEventData -> String
showsPrec :: Int -> WindowLostKeyboardFocusEventData -> ShowS
$cshowsPrec :: Int -> WindowLostKeyboardFocusEventData -> ShowS
Show,Typeable)

-- | The window manager requests that the window be closed.
newtype WindowClosedEventData =
  WindowClosedEventData {WindowClosedEventData -> Window
windowClosedEventWindow :: Window
                         -- ^ The associated 'Window'.
                        }
  deriving (WindowClosedEventData -> WindowClosedEventData -> Bool
(WindowClosedEventData -> WindowClosedEventData -> Bool)
-> (WindowClosedEventData -> WindowClosedEventData -> Bool)
-> Eq WindowClosedEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowClosedEventData -> WindowClosedEventData -> Bool
$c/= :: WindowClosedEventData -> WindowClosedEventData -> Bool
== :: WindowClosedEventData -> WindowClosedEventData -> Bool
$c== :: 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
min :: WindowClosedEventData
-> WindowClosedEventData -> WindowClosedEventData
$cmin :: WindowClosedEventData
-> WindowClosedEventData -> WindowClosedEventData
max :: WindowClosedEventData
-> WindowClosedEventData -> WindowClosedEventData
$cmax :: WindowClosedEventData
-> WindowClosedEventData -> WindowClosedEventData
>= :: WindowClosedEventData -> WindowClosedEventData -> Bool
$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
compare :: WindowClosedEventData -> WindowClosedEventData -> Ordering
$ccompare :: WindowClosedEventData -> WindowClosedEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep WindowClosedEventData x -> WindowClosedEventData
$cfrom :: forall x. WindowClosedEventData -> Rep WindowClosedEventData x
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
showList :: [WindowClosedEventData] -> ShowS
$cshowList :: [WindowClosedEventData] -> ShowS
show :: WindowClosedEventData -> String
$cshow :: WindowClosedEventData -> String
showsPrec :: Int -> WindowClosedEventData -> ShowS
$cshowsPrec :: Int -> WindowClosedEventData -> ShowS
Show,Typeable)

-- | A keyboard key has been pressed or released.
data KeyboardEventData =
  KeyboardEventData {KeyboardEventData -> Maybe Window
keyboardEventWindow :: !(Maybe Window)
                     -- ^ The 'Window' with keyboard focus, if any.
                    ,KeyboardEventData -> InputMotion
keyboardEventKeyMotion :: !InputMotion
                     -- ^ Whether the key was pressed or released.
                    ,KeyboardEventData -> Bool
keyboardEventRepeat :: !Bool
                     -- ^ 'True' if this is a repeating key press from the user holding the key down.
                    ,KeyboardEventData -> Keysym
keyboardEventKeysym :: !Keysym
                     -- ^ A description of the key that this event pertains to.
                    }
  deriving (KeyboardEventData -> KeyboardEventData -> Bool
(KeyboardEventData -> KeyboardEventData -> Bool)
-> (KeyboardEventData -> KeyboardEventData -> Bool)
-> Eq KeyboardEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyboardEventData -> KeyboardEventData -> Bool
$c/= :: KeyboardEventData -> KeyboardEventData -> Bool
== :: KeyboardEventData -> KeyboardEventData -> Bool
$c== :: 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
min :: KeyboardEventData -> KeyboardEventData -> KeyboardEventData
$cmin :: KeyboardEventData -> KeyboardEventData -> KeyboardEventData
max :: KeyboardEventData -> KeyboardEventData -> KeyboardEventData
$cmax :: KeyboardEventData -> KeyboardEventData -> KeyboardEventData
>= :: KeyboardEventData -> KeyboardEventData -> Bool
$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
compare :: KeyboardEventData -> KeyboardEventData -> Ordering
$ccompare :: KeyboardEventData -> KeyboardEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep KeyboardEventData x -> KeyboardEventData
$cfrom :: forall x. KeyboardEventData -> Rep KeyboardEventData x
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
showList :: [KeyboardEventData] -> ShowS
$cshowList :: [KeyboardEventData] -> ShowS
show :: KeyboardEventData -> String
$cshow :: KeyboardEventData -> String
showsPrec :: Int -> KeyboardEventData -> ShowS
$cshowsPrec :: Int -> KeyboardEventData -> ShowS
Show,Typeable)

-- | Keyboard text editing event information.
data TextEditingEventData =
  TextEditingEventData {TextEditingEventData -> Maybe Window
textEditingEventWindow :: !(Maybe Window)
                        -- ^ The 'Window' with keyboard focus, if any.
                       ,TextEditingEventData -> Text
textEditingEventText :: !Text
                        -- ^ The editing text.
                       ,TextEditingEventData -> Int32
textEditingEventStart :: !Int32
                        -- ^ The location to begin editing from.
                       ,TextEditingEventData -> Int32
textEditingEventLength :: !Int32
                        -- ^ The number of characters to edit from the start point.
                       }
  deriving (TextEditingEventData -> TextEditingEventData -> Bool
(TextEditingEventData -> TextEditingEventData -> Bool)
-> (TextEditingEventData -> TextEditingEventData -> Bool)
-> Eq TextEditingEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextEditingEventData -> TextEditingEventData -> Bool
$c/= :: TextEditingEventData -> TextEditingEventData -> Bool
== :: TextEditingEventData -> TextEditingEventData -> Bool
$c== :: 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
min :: TextEditingEventData
-> TextEditingEventData -> TextEditingEventData
$cmin :: TextEditingEventData
-> TextEditingEventData -> TextEditingEventData
max :: TextEditingEventData
-> TextEditingEventData -> TextEditingEventData
$cmax :: TextEditingEventData
-> TextEditingEventData -> TextEditingEventData
>= :: TextEditingEventData -> TextEditingEventData -> Bool
$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
compare :: TextEditingEventData -> TextEditingEventData -> Ordering
$ccompare :: TextEditingEventData -> TextEditingEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep TextEditingEventData x -> TextEditingEventData
$cfrom :: forall x. TextEditingEventData -> Rep TextEditingEventData x
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
showList :: [TextEditingEventData] -> ShowS
$cshowList :: [TextEditingEventData] -> ShowS
show :: TextEditingEventData -> String
$cshow :: TextEditingEventData -> String
showsPrec :: Int -> TextEditingEventData -> ShowS
$cshowsPrec :: Int -> TextEditingEventData -> ShowS
Show,Typeable)

-- | Keyboard text input event information.
data TextInputEventData =
  TextInputEventData {TextInputEventData -> Maybe Window
textInputEventWindow :: !(Maybe Window)
                      -- ^ The 'Window' with keyboard focus, if any.
                     ,TextInputEventData -> Text
textInputEventText :: !Text
                      -- ^ The input text.
                     }
  deriving (TextInputEventData -> TextInputEventData -> Bool
(TextInputEventData -> TextInputEventData -> Bool)
-> (TextInputEventData -> TextInputEventData -> Bool)
-> Eq TextInputEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextInputEventData -> TextInputEventData -> Bool
$c/= :: TextInputEventData -> TextInputEventData -> Bool
== :: TextInputEventData -> TextInputEventData -> Bool
$c== :: 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
min :: TextInputEventData -> TextInputEventData -> TextInputEventData
$cmin :: TextInputEventData -> TextInputEventData -> TextInputEventData
max :: TextInputEventData -> TextInputEventData -> TextInputEventData
$cmax :: TextInputEventData -> TextInputEventData -> TextInputEventData
>= :: TextInputEventData -> TextInputEventData -> Bool
$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
compare :: TextInputEventData -> TextInputEventData -> Ordering
$ccompare :: TextInputEventData -> TextInputEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep TextInputEventData x -> TextInputEventData
$cfrom :: forall x. TextInputEventData -> Rep TextInputEventData x
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
showList :: [TextInputEventData] -> ShowS
$cshowList :: [TextInputEventData] -> ShowS
show :: TextInputEventData -> String
$cshow :: TextInputEventData -> String
showsPrec :: Int -> TextInputEventData -> ShowS
$cshowsPrec :: Int -> TextInputEventData -> ShowS
Show,Typeable)

-- | A mouse or pointer device was moved.
data MouseMotionEventData =
  MouseMotionEventData {MouseMotionEventData -> Maybe Window
mouseMotionEventWindow :: !(Maybe Window)
                        -- ^ The 'Window' with mouse focus, if any.
                       ,MouseMotionEventData -> MouseDevice
mouseMotionEventWhich :: !MouseDevice
                        -- ^ The 'MouseDevice' that was moved.
                       ,MouseMotionEventData -> [MouseButton]
mouseMotionEventState :: ![MouseButton]
                        -- ^ A collection of 'MouseButton's that are currently held down.
                       ,MouseMotionEventData -> Point V2 Int32
mouseMotionEventPos :: !(Point V2 Int32)
                        -- ^ The new position of the mouse.
                       ,MouseMotionEventData -> V2 Int32
mouseMotionEventRelMotion :: !(V2 Int32)
                        -- ^ The relative mouse motion of the mouse.
                       }
  deriving (MouseMotionEventData -> MouseMotionEventData -> Bool
(MouseMotionEventData -> MouseMotionEventData -> Bool)
-> (MouseMotionEventData -> MouseMotionEventData -> Bool)
-> Eq MouseMotionEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MouseMotionEventData -> MouseMotionEventData -> Bool
$c/= :: MouseMotionEventData -> MouseMotionEventData -> Bool
== :: MouseMotionEventData -> MouseMotionEventData -> Bool
$c== :: 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
min :: MouseMotionEventData
-> MouseMotionEventData -> MouseMotionEventData
$cmin :: MouseMotionEventData
-> MouseMotionEventData -> MouseMotionEventData
max :: MouseMotionEventData
-> MouseMotionEventData -> MouseMotionEventData
$cmax :: MouseMotionEventData
-> MouseMotionEventData -> MouseMotionEventData
>= :: MouseMotionEventData -> MouseMotionEventData -> Bool
$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
compare :: MouseMotionEventData -> MouseMotionEventData -> Ordering
$ccompare :: MouseMotionEventData -> MouseMotionEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep MouseMotionEventData x -> MouseMotionEventData
$cfrom :: forall x. MouseMotionEventData -> Rep MouseMotionEventData x
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
showList :: [MouseMotionEventData] -> ShowS
$cshowList :: [MouseMotionEventData] -> ShowS
show :: MouseMotionEventData -> String
$cshow :: MouseMotionEventData -> String
showsPrec :: Int -> MouseMotionEventData -> ShowS
$cshowsPrec :: Int -> MouseMotionEventData -> ShowS
Show,Typeable)

-- | A mouse or pointer device button was pressed or released.
data MouseButtonEventData =
  MouseButtonEventData {MouseButtonEventData -> Maybe Window
mouseButtonEventWindow :: !(Maybe Window)
                        -- ^ The 'Window' with mouse focus, if any.
                       ,MouseButtonEventData -> InputMotion
mouseButtonEventMotion :: !InputMotion
                        -- ^ Whether the button was pressed or released.
                       ,MouseButtonEventData -> MouseDevice
mouseButtonEventWhich :: !MouseDevice
                        -- ^ The 'MouseDevice' whose button was pressed or released.
                       ,MouseButtonEventData -> MouseButton
mouseButtonEventButton :: !MouseButton
                        -- ^ The button that was pressed or released.
                       ,MouseButtonEventData -> Word8
mouseButtonEventClicks :: !Word8
                        -- ^ The amount of clicks. 1 for a single-click, 2 for a double-click, etc.
                       ,MouseButtonEventData -> Point V2 Int32
mouseButtonEventPos :: !(Point V2 Int32)
                        -- ^ The coordinates of the mouse click.
                       }
  deriving (MouseButtonEventData -> MouseButtonEventData -> Bool
(MouseButtonEventData -> MouseButtonEventData -> Bool)
-> (MouseButtonEventData -> MouseButtonEventData -> Bool)
-> Eq MouseButtonEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MouseButtonEventData -> MouseButtonEventData -> Bool
$c/= :: MouseButtonEventData -> MouseButtonEventData -> Bool
== :: MouseButtonEventData -> MouseButtonEventData -> Bool
$c== :: 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
min :: MouseButtonEventData
-> MouseButtonEventData -> MouseButtonEventData
$cmin :: MouseButtonEventData
-> MouseButtonEventData -> MouseButtonEventData
max :: MouseButtonEventData
-> MouseButtonEventData -> MouseButtonEventData
$cmax :: MouseButtonEventData
-> MouseButtonEventData -> MouseButtonEventData
>= :: MouseButtonEventData -> MouseButtonEventData -> Bool
$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
compare :: MouseButtonEventData -> MouseButtonEventData -> Ordering
$ccompare :: MouseButtonEventData -> MouseButtonEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep MouseButtonEventData x -> MouseButtonEventData
$cfrom :: forall x. MouseButtonEventData -> Rep MouseButtonEventData x
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
showList :: [MouseButtonEventData] -> ShowS
$cshowList :: [MouseButtonEventData] -> ShowS
show :: MouseButtonEventData -> String
$cshow :: MouseButtonEventData -> String
showsPrec :: Int -> MouseButtonEventData -> ShowS
$cshowsPrec :: Int -> MouseButtonEventData -> ShowS
Show,Typeable)

-- | Mouse wheel event information.
data MouseWheelEventData =
  MouseWheelEventData {MouseWheelEventData -> Maybe Window
mouseWheelEventWindow :: !(Maybe Window)
                        -- ^ The 'Window' with mouse focus, if any.
                      ,MouseWheelEventData -> MouseDevice
mouseWheelEventWhich :: !MouseDevice
                       -- ^ The 'MouseDevice' whose wheel was scrolled.
                      ,MouseWheelEventData -> V2 Int32
mouseWheelEventPos :: !(V2 Int32)
                       -- ^ The amount scrolled.
                      ,MouseWheelEventData -> MouseScrollDirection
mouseWheelEventDirection :: !MouseScrollDirection
                       -- ^ The scroll direction mode.
                      }
  deriving (MouseWheelEventData -> MouseWheelEventData -> Bool
(MouseWheelEventData -> MouseWheelEventData -> Bool)
-> (MouseWheelEventData -> MouseWheelEventData -> Bool)
-> Eq MouseWheelEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MouseWheelEventData -> MouseWheelEventData -> Bool
$c/= :: MouseWheelEventData -> MouseWheelEventData -> Bool
== :: MouseWheelEventData -> MouseWheelEventData -> Bool
$c== :: 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
min :: MouseWheelEventData -> MouseWheelEventData -> MouseWheelEventData
$cmin :: MouseWheelEventData -> MouseWheelEventData -> MouseWheelEventData
max :: MouseWheelEventData -> MouseWheelEventData -> MouseWheelEventData
$cmax :: MouseWheelEventData -> MouseWheelEventData -> MouseWheelEventData
>= :: MouseWheelEventData -> MouseWheelEventData -> Bool
$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
compare :: MouseWheelEventData -> MouseWheelEventData -> Ordering
$ccompare :: MouseWheelEventData -> MouseWheelEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep MouseWheelEventData x -> MouseWheelEventData
$cfrom :: forall x. MouseWheelEventData -> Rep MouseWheelEventData x
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
showList :: [MouseWheelEventData] -> ShowS
$cshowList :: [MouseWheelEventData] -> ShowS
show :: MouseWheelEventData -> String
$cshow :: MouseWheelEventData -> String
showsPrec :: Int -> MouseWheelEventData -> ShowS
$cshowsPrec :: Int -> MouseWheelEventData -> ShowS
Show,Typeable)

-- | Joystick axis motion event information
data JoyAxisEventData =
  JoyAxisEventData {JoyAxisEventData -> Int32
joyAxisEventWhich :: !Raw.JoystickID
                    -- ^ The instance id of the joystick that reported the event.
                   ,JoyAxisEventData -> Word8
joyAxisEventAxis :: !Word8
                    -- ^ The index of the axis that changed.
                   ,JoyAxisEventData -> Int16
joyAxisEventValue :: !Int16
                    -- ^ The current position of the axis, ranging between -32768 and 32767.
                   }
  deriving (JoyAxisEventData -> JoyAxisEventData -> Bool
(JoyAxisEventData -> JoyAxisEventData -> Bool)
-> (JoyAxisEventData -> JoyAxisEventData -> Bool)
-> Eq JoyAxisEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JoyAxisEventData -> JoyAxisEventData -> Bool
$c/= :: JoyAxisEventData -> JoyAxisEventData -> Bool
== :: JoyAxisEventData -> JoyAxisEventData -> Bool
$c== :: 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
min :: JoyAxisEventData -> JoyAxisEventData -> JoyAxisEventData
$cmin :: JoyAxisEventData -> JoyAxisEventData -> JoyAxisEventData
max :: JoyAxisEventData -> JoyAxisEventData -> JoyAxisEventData
$cmax :: JoyAxisEventData -> JoyAxisEventData -> JoyAxisEventData
>= :: JoyAxisEventData -> JoyAxisEventData -> Bool
$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
compare :: JoyAxisEventData -> JoyAxisEventData -> Ordering
$ccompare :: JoyAxisEventData -> JoyAxisEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep JoyAxisEventData x -> JoyAxisEventData
$cfrom :: forall x. JoyAxisEventData -> Rep JoyAxisEventData x
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
showList :: [JoyAxisEventData] -> ShowS
$cshowList :: [JoyAxisEventData] -> ShowS
show :: JoyAxisEventData -> String
$cshow :: JoyAxisEventData -> String
showsPrec :: Int -> JoyAxisEventData -> ShowS
$cshowsPrec :: Int -> JoyAxisEventData -> ShowS
Show,Typeable)

-- | Joystick trackball motion event information.
data JoyBallEventData =
  JoyBallEventData {JoyBallEventData -> Int32
joyBallEventWhich :: !Raw.JoystickID
                    -- ^ The instance id of the joystick that reported the event.
                   ,JoyBallEventData -> Word8
joyBallEventBall :: !Word8
                    -- ^ The index of the trackball that changed.
                   ,JoyBallEventData -> V2 Int16
joyBallEventRelMotion :: !(V2 Int16)
                    -- ^ The relative motion of the trackball.
                   }
  deriving (JoyBallEventData -> JoyBallEventData -> Bool
(JoyBallEventData -> JoyBallEventData -> Bool)
-> (JoyBallEventData -> JoyBallEventData -> Bool)
-> Eq JoyBallEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JoyBallEventData -> JoyBallEventData -> Bool
$c/= :: JoyBallEventData -> JoyBallEventData -> Bool
== :: JoyBallEventData -> JoyBallEventData -> Bool
$c== :: 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
min :: JoyBallEventData -> JoyBallEventData -> JoyBallEventData
$cmin :: JoyBallEventData -> JoyBallEventData -> JoyBallEventData
max :: JoyBallEventData -> JoyBallEventData -> JoyBallEventData
$cmax :: JoyBallEventData -> JoyBallEventData -> JoyBallEventData
>= :: JoyBallEventData -> JoyBallEventData -> Bool
$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
compare :: JoyBallEventData -> JoyBallEventData -> Ordering
$ccompare :: JoyBallEventData -> JoyBallEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep JoyBallEventData x -> JoyBallEventData
$cfrom :: forall x. JoyBallEventData -> Rep JoyBallEventData x
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
showList :: [JoyBallEventData] -> ShowS
$cshowList :: [JoyBallEventData] -> ShowS
show :: JoyBallEventData -> String
$cshow :: JoyBallEventData -> String
showsPrec :: Int -> JoyBallEventData -> ShowS
$cshowsPrec :: Int -> JoyBallEventData -> ShowS
Show,Typeable)

-- | Joystick hat position change event information
data JoyHatEventData =
  JoyHatEventData {JoyHatEventData -> Int32
joyHatEventWhich :: !Raw.JoystickID
                    -- ^ The instance id of the joystick that reported the event.
                  ,JoyHatEventData -> Word8
joyHatEventHat :: !Word8
                   -- ^ The index of the hat that changed.
                  ,JoyHatEventData -> JoyHatPosition
joyHatEventValue :: !JoyHatPosition
                   -- ^ The new position of the hat.
                  }
  deriving (JoyHatEventData -> JoyHatEventData -> Bool
(JoyHatEventData -> JoyHatEventData -> Bool)
-> (JoyHatEventData -> JoyHatEventData -> Bool)
-> Eq JoyHatEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JoyHatEventData -> JoyHatEventData -> Bool
$c/= :: JoyHatEventData -> JoyHatEventData -> Bool
== :: JoyHatEventData -> JoyHatEventData -> Bool
$c== :: 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
min :: JoyHatEventData -> JoyHatEventData -> JoyHatEventData
$cmin :: JoyHatEventData -> JoyHatEventData -> JoyHatEventData
max :: JoyHatEventData -> JoyHatEventData -> JoyHatEventData
$cmax :: JoyHatEventData -> JoyHatEventData -> JoyHatEventData
>= :: JoyHatEventData -> JoyHatEventData -> Bool
$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
compare :: JoyHatEventData -> JoyHatEventData -> Ordering
$ccompare :: JoyHatEventData -> JoyHatEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep JoyHatEventData x -> JoyHatEventData
$cfrom :: forall x. JoyHatEventData -> Rep JoyHatEventData x
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
showList :: [JoyHatEventData] -> ShowS
$cshowList :: [JoyHatEventData] -> ShowS
show :: JoyHatEventData -> String
$cshow :: JoyHatEventData -> String
showsPrec :: Int -> JoyHatEventData -> ShowS
$cshowsPrec :: Int -> JoyHatEventData -> ShowS
Show,Typeable)

-- | Joystick button event information.
data JoyButtonEventData =
  JoyButtonEventData {JoyButtonEventData -> Int32
joyButtonEventWhich :: !Raw.JoystickID
                      -- ^ The instance id of the joystick that reported the event.
                     ,JoyButtonEventData -> Word8
joyButtonEventButton :: !Word8
                      -- ^ The index of the button that changed.
                     ,JoyButtonEventData -> JoyButtonState
joyButtonEventState :: !JoyButtonState
                      -- ^ The state of the button.
                     }
  deriving (JoyButtonEventData -> JoyButtonEventData -> Bool
(JoyButtonEventData -> JoyButtonEventData -> Bool)
-> (JoyButtonEventData -> JoyButtonEventData -> Bool)
-> Eq JoyButtonEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JoyButtonEventData -> JoyButtonEventData -> Bool
$c/= :: JoyButtonEventData -> JoyButtonEventData -> Bool
== :: JoyButtonEventData -> JoyButtonEventData -> Bool
$c== :: 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
min :: JoyButtonEventData -> JoyButtonEventData -> JoyButtonEventData
$cmin :: JoyButtonEventData -> JoyButtonEventData -> JoyButtonEventData
max :: JoyButtonEventData -> JoyButtonEventData -> JoyButtonEventData
$cmax :: JoyButtonEventData -> JoyButtonEventData -> JoyButtonEventData
>= :: JoyButtonEventData -> JoyButtonEventData -> Bool
$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
compare :: JoyButtonEventData -> JoyButtonEventData -> Ordering
$ccompare :: JoyButtonEventData -> JoyButtonEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep JoyButtonEventData x -> JoyButtonEventData
$cfrom :: forall x. JoyButtonEventData -> Rep JoyButtonEventData x
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
showList :: [JoyButtonEventData] -> ShowS
$cshowList :: [JoyButtonEventData] -> ShowS
show :: JoyButtonEventData -> String
$cshow :: JoyButtonEventData -> String
showsPrec :: Int -> JoyButtonEventData -> ShowS
$cshowsPrec :: Int -> JoyButtonEventData -> ShowS
Show,Typeable)

-- | Joystick device event information.
data JoyDeviceEventData =
  JoyDeviceEventData {JoyDeviceEventData -> JoyDeviceConnection
joyDeviceEventConnection :: !JoyDeviceConnection
                      -- ^ Was the device added or removed?
                     ,JoyDeviceEventData -> Int32
joyDeviceEventWhich :: !Int32
                      -- ^ The instance id of the joystick that reported the event.
                     }
  deriving (JoyDeviceEventData -> JoyDeviceEventData -> Bool
(JoyDeviceEventData -> JoyDeviceEventData -> Bool)
-> (JoyDeviceEventData -> JoyDeviceEventData -> Bool)
-> Eq JoyDeviceEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JoyDeviceEventData -> JoyDeviceEventData -> Bool
$c/= :: JoyDeviceEventData -> JoyDeviceEventData -> Bool
== :: JoyDeviceEventData -> JoyDeviceEventData -> Bool
$c== :: 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
min :: JoyDeviceEventData -> JoyDeviceEventData -> JoyDeviceEventData
$cmin :: JoyDeviceEventData -> JoyDeviceEventData -> JoyDeviceEventData
max :: JoyDeviceEventData -> JoyDeviceEventData -> JoyDeviceEventData
$cmax :: JoyDeviceEventData -> JoyDeviceEventData -> JoyDeviceEventData
>= :: JoyDeviceEventData -> JoyDeviceEventData -> Bool
$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
compare :: JoyDeviceEventData -> JoyDeviceEventData -> Ordering
$ccompare :: JoyDeviceEventData -> JoyDeviceEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep JoyDeviceEventData x -> JoyDeviceEventData
$cfrom :: forall x. JoyDeviceEventData -> Rep JoyDeviceEventData x
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
showList :: [JoyDeviceEventData] -> ShowS
$cshowList :: [JoyDeviceEventData] -> ShowS
show :: JoyDeviceEventData -> String
$cshow :: JoyDeviceEventData -> String
showsPrec :: Int -> JoyDeviceEventData -> ShowS
$cshowsPrec :: Int -> JoyDeviceEventData -> ShowS
Show,Typeable)

-- | Game controller axis motion event information.
data ControllerAxisEventData =
  ControllerAxisEventData {ControllerAxisEventData -> Int32
controllerAxisEventWhich :: !Raw.JoystickID
                           -- ^ The joystick instance ID that reported the event.
                          ,ControllerAxisEventData -> Word8
controllerAxisEventAxis :: !Word8
                           -- ^ The index of the axis.
                          ,ControllerAxisEventData -> Int16
controllerAxisEventValue :: !Int16
                           -- ^ The axis value ranging between -32768 and 32767.
                          }
  deriving (ControllerAxisEventData -> ControllerAxisEventData -> Bool
(ControllerAxisEventData -> ControllerAxisEventData -> Bool)
-> (ControllerAxisEventData -> ControllerAxisEventData -> Bool)
-> Eq ControllerAxisEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ControllerAxisEventData -> ControllerAxisEventData -> Bool
$c/= :: ControllerAxisEventData -> ControllerAxisEventData -> Bool
== :: ControllerAxisEventData -> ControllerAxisEventData -> Bool
$c== :: 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
min :: ControllerAxisEventData
-> ControllerAxisEventData -> ControllerAxisEventData
$cmin :: ControllerAxisEventData
-> ControllerAxisEventData -> ControllerAxisEventData
max :: ControllerAxisEventData
-> ControllerAxisEventData -> ControllerAxisEventData
$cmax :: ControllerAxisEventData
-> ControllerAxisEventData -> ControllerAxisEventData
>= :: ControllerAxisEventData -> ControllerAxisEventData -> Bool
$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
compare :: ControllerAxisEventData -> ControllerAxisEventData -> Ordering
$ccompare :: ControllerAxisEventData -> ControllerAxisEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep ControllerAxisEventData x -> ControllerAxisEventData
$cfrom :: forall x. ControllerAxisEventData -> Rep ControllerAxisEventData x
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
showList :: [ControllerAxisEventData] -> ShowS
$cshowList :: [ControllerAxisEventData] -> ShowS
show :: ControllerAxisEventData -> String
$cshow :: ControllerAxisEventData -> String
showsPrec :: Int -> ControllerAxisEventData -> ShowS
$cshowsPrec :: Int -> ControllerAxisEventData -> ShowS
Show,Typeable)

-- | Game controller button event information
data ControllerButtonEventData =
  ControllerButtonEventData {ControllerButtonEventData -> Int32
controllerButtonEventWhich :: !Raw.JoystickID
                           -- ^ The joystick instance ID that reported the event.
                            ,ControllerButtonEventData -> ControllerButton
controllerButtonEventButton :: !ControllerButton
                             -- ^ The controller button.
                            ,ControllerButtonEventData -> ControllerButtonState
controllerButtonEventState :: !ControllerButtonState
                             -- ^ The state of the button.
                            }
  deriving (ControllerButtonEventData -> ControllerButtonEventData -> Bool
(ControllerButtonEventData -> ControllerButtonEventData -> Bool)
-> (ControllerButtonEventData -> ControllerButtonEventData -> Bool)
-> Eq ControllerButtonEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ControllerButtonEventData -> ControllerButtonEventData -> Bool
$c/= :: ControllerButtonEventData -> ControllerButtonEventData -> Bool
== :: ControllerButtonEventData -> ControllerButtonEventData -> Bool
$c== :: 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
min :: ControllerButtonEventData
-> ControllerButtonEventData -> ControllerButtonEventData
$cmin :: ControllerButtonEventData
-> ControllerButtonEventData -> ControllerButtonEventData
max :: ControllerButtonEventData
-> ControllerButtonEventData -> ControllerButtonEventData
$cmax :: ControllerButtonEventData
-> ControllerButtonEventData -> ControllerButtonEventData
>= :: ControllerButtonEventData -> ControllerButtonEventData -> Bool
$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
compare :: ControllerButtonEventData -> ControllerButtonEventData -> Ordering
$ccompare :: ControllerButtonEventData -> ControllerButtonEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x.
Rep ControllerButtonEventData x -> ControllerButtonEventData
$cfrom :: forall x.
ControllerButtonEventData -> Rep ControllerButtonEventData x
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
showList :: [ControllerButtonEventData] -> ShowS
$cshowList :: [ControllerButtonEventData] -> ShowS
show :: ControllerButtonEventData -> String
$cshow :: ControllerButtonEventData -> String
showsPrec :: Int -> ControllerButtonEventData -> ShowS
$cshowsPrec :: Int -> ControllerButtonEventData -> ShowS
Show,Typeable)

-- | Controller device event information
data ControllerDeviceEventData =
  ControllerDeviceEventData {ControllerDeviceEventData -> ControllerDeviceConnection
controllerDeviceEventConnection :: !ControllerDeviceConnection
                             -- ^ Was the device added, removed, or remapped?
                            ,ControllerDeviceEventData -> Int32
controllerDeviceEventWhich :: !Int32
                             -- ^ The joystick instance ID that reported the event.
                            }
  deriving (ControllerDeviceEventData -> ControllerDeviceEventData -> Bool
(ControllerDeviceEventData -> ControllerDeviceEventData -> Bool)
-> (ControllerDeviceEventData -> ControllerDeviceEventData -> Bool)
-> Eq ControllerDeviceEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ControllerDeviceEventData -> ControllerDeviceEventData -> Bool
$c/= :: ControllerDeviceEventData -> ControllerDeviceEventData -> Bool
== :: ControllerDeviceEventData -> ControllerDeviceEventData -> Bool
$c== :: 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
min :: ControllerDeviceEventData
-> ControllerDeviceEventData -> ControllerDeviceEventData
$cmin :: ControllerDeviceEventData
-> ControllerDeviceEventData -> ControllerDeviceEventData
max :: ControllerDeviceEventData
-> ControllerDeviceEventData -> ControllerDeviceEventData
$cmax :: ControllerDeviceEventData
-> ControllerDeviceEventData -> ControllerDeviceEventData
>= :: ControllerDeviceEventData -> ControllerDeviceEventData -> Bool
$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
compare :: ControllerDeviceEventData -> ControllerDeviceEventData -> Ordering
$ccompare :: ControllerDeviceEventData -> ControllerDeviceEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x.
Rep ControllerDeviceEventData x -> ControllerDeviceEventData
$cfrom :: forall x.
ControllerDeviceEventData -> Rep ControllerDeviceEventData x
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
showList :: [ControllerDeviceEventData] -> ShowS
$cshowList :: [ControllerDeviceEventData] -> ShowS
show :: ControllerDeviceEventData -> String
$cshow :: ControllerDeviceEventData -> String
showsPrec :: Int -> ControllerDeviceEventData -> ShowS
$cshowsPrec :: Int -> ControllerDeviceEventData -> ShowS
Show,Typeable)

data AudioDeviceEventData =
  AudioDeviceEventData {AudioDeviceEventData -> Bool
audioDeviceEventIsAddition :: !Bool
                        -- ^ If the audio device is an addition, or a removal.
                       ,AudioDeviceEventData -> Timestamp
audioDeviceEventWhich :: !Word32
                        -- ^ The audio device ID that reported the event.
                       ,AudioDeviceEventData -> Bool
audioDeviceEventIsCapture :: !Bool
                        -- ^ If the audio device is a capture device.
                       }
  deriving (AudioDeviceEventData -> AudioDeviceEventData -> Bool
(AudioDeviceEventData -> AudioDeviceEventData -> Bool)
-> (AudioDeviceEventData -> AudioDeviceEventData -> Bool)
-> Eq AudioDeviceEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AudioDeviceEventData -> AudioDeviceEventData -> Bool
$c/= :: AudioDeviceEventData -> AudioDeviceEventData -> Bool
== :: AudioDeviceEventData -> AudioDeviceEventData -> Bool
$c== :: 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
min :: AudioDeviceEventData
-> AudioDeviceEventData -> AudioDeviceEventData
$cmin :: AudioDeviceEventData
-> AudioDeviceEventData -> AudioDeviceEventData
max :: AudioDeviceEventData
-> AudioDeviceEventData -> AudioDeviceEventData
$cmax :: AudioDeviceEventData
-> AudioDeviceEventData -> AudioDeviceEventData
>= :: AudioDeviceEventData -> AudioDeviceEventData -> Bool
$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
compare :: AudioDeviceEventData -> AudioDeviceEventData -> Ordering
$ccompare :: AudioDeviceEventData -> AudioDeviceEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep AudioDeviceEventData x -> AudioDeviceEventData
$cfrom :: forall x. AudioDeviceEventData -> Rep AudioDeviceEventData x
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
showList :: [AudioDeviceEventData] -> ShowS
$cshowList :: [AudioDeviceEventData] -> ShowS
show :: AudioDeviceEventData -> String
$cshow :: AudioDeviceEventData -> String
showsPrec :: Int -> AudioDeviceEventData -> ShowS
$cshowsPrec :: Int -> AudioDeviceEventData -> ShowS
Show,Typeable)

-- | Event data for application-defined events.
data UserEventData =
  UserEventData {UserEventData -> Timestamp
userEventType :: !Word32
                 -- ^ User defined event type.
                ,UserEventData -> Maybe Window
userEventWindow :: !(Maybe Window)
                 -- ^ The associated 'Window'.
                ,UserEventData -> Int32
userEventCode :: !Int32
                 -- ^ User defined event code.
                ,UserEventData -> Ptr ()
userEventData1 :: !(Ptr ())
                 -- ^ User defined data pointer.
                ,UserEventData -> Ptr ()
userEventData2 :: !(Ptr ())
                 -- ^ User defined data pointer.
                }
  deriving (UserEventData -> UserEventData -> Bool
(UserEventData -> UserEventData -> Bool)
-> (UserEventData -> UserEventData -> Bool) -> Eq UserEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserEventData -> UserEventData -> Bool
$c/= :: UserEventData -> UserEventData -> Bool
== :: UserEventData -> UserEventData -> Bool
$c== :: 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
min :: UserEventData -> UserEventData -> UserEventData
$cmin :: UserEventData -> UserEventData -> UserEventData
max :: UserEventData -> UserEventData -> UserEventData
$cmax :: UserEventData -> UserEventData -> UserEventData
>= :: UserEventData -> UserEventData -> Bool
$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
compare :: UserEventData -> UserEventData -> Ordering
$ccompare :: UserEventData -> UserEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep UserEventData x -> UserEventData
$cfrom :: forall x. UserEventData -> Rep UserEventData x
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
showList :: [UserEventData] -> ShowS
$cshowList :: [UserEventData] -> ShowS
show :: UserEventData -> String
$cshow :: UserEventData -> String
showsPrec :: Int -> UserEventData -> ShowS
$cshowsPrec :: Int -> UserEventData -> ShowS
Show,Typeable)

-- | A video driver dependent system event
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
/= :: SysWMEventData -> SysWMEventData -> Bool
$c/= :: SysWMEventData -> SysWMEventData -> Bool
== :: SysWMEventData -> SysWMEventData -> Bool
$c== :: 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
min :: SysWMEventData -> SysWMEventData -> SysWMEventData
$cmin :: SysWMEventData -> SysWMEventData -> SysWMEventData
max :: SysWMEventData -> SysWMEventData -> SysWMEventData
$cmax :: SysWMEventData -> SysWMEventData -> SysWMEventData
>= :: SysWMEventData -> SysWMEventData -> Bool
$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
compare :: SysWMEventData -> SysWMEventData -> Ordering
$ccompare :: SysWMEventData -> SysWMEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep SysWMEventData x -> SysWMEventData
$cfrom :: forall x. SysWMEventData -> Rep SysWMEventData x
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
showList :: [SysWMEventData] -> ShowS
$cshowList :: [SysWMEventData] -> ShowS
show :: SysWMEventData -> String
$cshow :: SysWMEventData -> String
showsPrec :: Int -> SysWMEventData -> ShowS
$cshowsPrec :: Int -> SysWMEventData -> ShowS
Show,Typeable)

-- | Finger touch event information.
data TouchFingerEventData =
  TouchFingerEventData {TouchFingerEventData -> TouchID
touchFingerEventTouchID :: !Raw.TouchID
                        -- ^ The touch device index.
                       ,TouchFingerEventData -> TouchID
touchFingerEventFingerID :: !Raw.FingerID
                        -- ^ The finger index.
                       ,TouchFingerEventData -> InputMotion
touchFingerEventMotion :: !InputMotion
                        -- ^ Whether the finger was pressed or released.
                       ,TouchFingerEventData -> Point V2 CFloat
touchFingerEventPos :: !(Point V2 CFloat)
                        -- ^ The location of the touch event, normalized between 0 and 1.
                       ,TouchFingerEventData -> CFloat
touchFingerEventPressure :: !CFloat
                        -- ^ The quantity of the pressure applied, normalized between 0 and 1.
                       }
  deriving (TouchFingerEventData -> TouchFingerEventData -> Bool
(TouchFingerEventData -> TouchFingerEventData -> Bool)
-> (TouchFingerEventData -> TouchFingerEventData -> Bool)
-> Eq TouchFingerEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TouchFingerEventData -> TouchFingerEventData -> Bool
$c/= :: TouchFingerEventData -> TouchFingerEventData -> Bool
== :: TouchFingerEventData -> TouchFingerEventData -> Bool
$c== :: 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
min :: TouchFingerEventData
-> TouchFingerEventData -> TouchFingerEventData
$cmin :: TouchFingerEventData
-> TouchFingerEventData -> TouchFingerEventData
max :: TouchFingerEventData
-> TouchFingerEventData -> TouchFingerEventData
$cmax :: TouchFingerEventData
-> TouchFingerEventData -> TouchFingerEventData
>= :: TouchFingerEventData -> TouchFingerEventData -> Bool
$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
compare :: TouchFingerEventData -> TouchFingerEventData -> Ordering
$ccompare :: TouchFingerEventData -> TouchFingerEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep TouchFingerEventData x -> TouchFingerEventData
$cfrom :: forall x. TouchFingerEventData -> Rep TouchFingerEventData x
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
showList :: [TouchFingerEventData] -> ShowS
$cshowList :: [TouchFingerEventData] -> ShowS
show :: TouchFingerEventData -> String
$cshow :: TouchFingerEventData -> String
showsPrec :: Int -> TouchFingerEventData -> ShowS
$cshowsPrec :: Int -> TouchFingerEventData -> ShowS
Show,Typeable)

-- | Finger motion event information.
data TouchFingerMotionEventData =
  TouchFingerMotionEventData {TouchFingerMotionEventData -> TouchID
touchFingerMotionEventTouchID :: !Raw.TouchID
                              -- ^ The touch device index.
                             ,TouchFingerMotionEventData -> TouchID
touchFingerMotionEventFingerID :: !Raw.FingerID
                              -- ^ The finger index.
                             ,TouchFingerMotionEventData -> Point V2 CFloat
touchFingerMotionEventPos :: !(Point V2 CFloat)
                              -- ^ The location of the touch event, normalized between 0 and 1.
                             ,TouchFingerMotionEventData -> V2 CFloat
touchFingerMotionEventRelMotion :: !(V2 CFloat)
                              -- ^ The distance moved, normalized between -1 and 1.
                             ,TouchFingerMotionEventData -> CFloat
touchFingerMotionEventPressure :: !CFloat
                              -- ^ The quantity of the pressure applied, normalized between 0 and 1.
                             }
  deriving (TouchFingerMotionEventData -> TouchFingerMotionEventData -> Bool
(TouchFingerMotionEventData -> TouchFingerMotionEventData -> Bool)
-> (TouchFingerMotionEventData
    -> TouchFingerMotionEventData -> Bool)
-> Eq TouchFingerMotionEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TouchFingerMotionEventData -> TouchFingerMotionEventData -> Bool
$c/= :: TouchFingerMotionEventData -> TouchFingerMotionEventData -> Bool
== :: TouchFingerMotionEventData -> TouchFingerMotionEventData -> Bool
$c== :: 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
min :: TouchFingerMotionEventData
-> TouchFingerMotionEventData -> TouchFingerMotionEventData
$cmin :: TouchFingerMotionEventData
-> TouchFingerMotionEventData -> TouchFingerMotionEventData
max :: TouchFingerMotionEventData
-> TouchFingerMotionEventData -> TouchFingerMotionEventData
$cmax :: TouchFingerMotionEventData
-> TouchFingerMotionEventData -> TouchFingerMotionEventData
>= :: TouchFingerMotionEventData -> TouchFingerMotionEventData -> Bool
$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
compare :: TouchFingerMotionEventData
-> TouchFingerMotionEventData -> Ordering
$ccompare :: TouchFingerMotionEventData
-> TouchFingerMotionEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x.
Rep TouchFingerMotionEventData x -> TouchFingerMotionEventData
$cfrom :: forall x.
TouchFingerMotionEventData -> Rep TouchFingerMotionEventData x
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
showList :: [TouchFingerMotionEventData] -> ShowS
$cshowList :: [TouchFingerMotionEventData] -> ShowS
show :: TouchFingerMotionEventData -> String
$cshow :: TouchFingerMotionEventData -> String
showsPrec :: Int -> TouchFingerMotionEventData -> ShowS
$cshowsPrec :: Int -> TouchFingerMotionEventData -> ShowS
Show,Typeable)

-- | Multiple finger gesture event information
data MultiGestureEventData =
  MultiGestureEventData {MultiGestureEventData -> TouchID
multiGestureEventTouchID :: !Raw.TouchID
                         -- ^ The touch device index.
                        ,MultiGestureEventData -> CFloat
multiGestureEventDTheta :: !CFloat
                         -- ^ The amount that the fingers rotated during this motion.
                        ,MultiGestureEventData -> CFloat
multiGestureEventDDist :: !CFloat
                         -- ^ The amount that the fingers pinched during this motion.
                        ,MultiGestureEventData -> Point V2 CFloat
multiGestureEventPos :: !(Point V2 CFloat)
                         -- ^ The normalized center of the gesture.
                        ,MultiGestureEventData -> Word16
multiGestureEventNumFingers :: !Word16
                         -- ^ The number of fingers used in this gesture.
                        }
  deriving (MultiGestureEventData -> MultiGestureEventData -> Bool
(MultiGestureEventData -> MultiGestureEventData -> Bool)
-> (MultiGestureEventData -> MultiGestureEventData -> Bool)
-> Eq MultiGestureEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MultiGestureEventData -> MultiGestureEventData -> Bool
$c/= :: MultiGestureEventData -> MultiGestureEventData -> Bool
== :: MultiGestureEventData -> MultiGestureEventData -> Bool
$c== :: 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
min :: MultiGestureEventData
-> MultiGestureEventData -> MultiGestureEventData
$cmin :: MultiGestureEventData
-> MultiGestureEventData -> MultiGestureEventData
max :: MultiGestureEventData
-> MultiGestureEventData -> MultiGestureEventData
$cmax :: MultiGestureEventData
-> MultiGestureEventData -> MultiGestureEventData
>= :: MultiGestureEventData -> MultiGestureEventData -> Bool
$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
compare :: MultiGestureEventData -> MultiGestureEventData -> Ordering
$ccompare :: MultiGestureEventData -> MultiGestureEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep MultiGestureEventData x -> MultiGestureEventData
$cfrom :: forall x. MultiGestureEventData -> Rep MultiGestureEventData x
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
showList :: [MultiGestureEventData] -> ShowS
$cshowList :: [MultiGestureEventData] -> ShowS
show :: MultiGestureEventData -> String
$cshow :: MultiGestureEventData -> String
showsPrec :: Int -> MultiGestureEventData -> ShowS
$cshowsPrec :: Int -> MultiGestureEventData -> ShowS
Show,Typeable)

-- | Complex gesture event information.
data DollarGestureEventData =
  DollarGestureEventData {DollarGestureEventData -> TouchID
dollarGestureEventTouchID :: !Raw.TouchID
                          -- ^ The touch device index.
                         ,DollarGestureEventData -> TouchID
dollarGestureEventGestureID :: !Raw.GestureID
                          -- ^ The unique id of the closest gesture to the performed stroke.
                         ,DollarGestureEventData -> Timestamp
dollarGestureEventNumFingers :: !Word32
                          -- ^ The number of fingers used to draw the stroke.
                         ,DollarGestureEventData -> CFloat
dollarGestureEventError :: !CFloat
                          -- ^ The difference between the gesture template and the actual performed gesture (lower errors correspond to closer matches).
                         ,DollarGestureEventData -> Point V2 CFloat
dollarGestureEventPos :: !(Point V2 CFloat)
                          -- ^ The normalized center of the gesture.
                         }
  deriving (DollarGestureEventData -> DollarGestureEventData -> Bool
(DollarGestureEventData -> DollarGestureEventData -> Bool)
-> (DollarGestureEventData -> DollarGestureEventData -> Bool)
-> Eq DollarGestureEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DollarGestureEventData -> DollarGestureEventData -> Bool
$c/= :: DollarGestureEventData -> DollarGestureEventData -> Bool
== :: DollarGestureEventData -> DollarGestureEventData -> Bool
$c== :: 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
min :: DollarGestureEventData
-> DollarGestureEventData -> DollarGestureEventData
$cmin :: DollarGestureEventData
-> DollarGestureEventData -> DollarGestureEventData
max :: DollarGestureEventData
-> DollarGestureEventData -> DollarGestureEventData
$cmax :: DollarGestureEventData
-> DollarGestureEventData -> DollarGestureEventData
>= :: DollarGestureEventData -> DollarGestureEventData -> Bool
$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
compare :: DollarGestureEventData -> DollarGestureEventData -> Ordering
$ccompare :: DollarGestureEventData -> DollarGestureEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep DollarGestureEventData x -> DollarGestureEventData
$cfrom :: forall x. DollarGestureEventData -> Rep DollarGestureEventData x
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
showList :: [DollarGestureEventData] -> ShowS
$cshowList :: [DollarGestureEventData] -> ShowS
show :: DollarGestureEventData -> String
$cshow :: DollarGestureEventData -> String
showsPrec :: Int -> DollarGestureEventData -> ShowS
$cshowsPrec :: Int -> DollarGestureEventData -> ShowS
Show,Typeable)

-- | An event used to request a file open by the system
newtype DropEventData =
  DropEventData {DropEventData -> CString
dropEventFile :: CString
                 -- ^ The file name.
                }
  deriving (DropEventData -> DropEventData -> Bool
(DropEventData -> DropEventData -> Bool)
-> (DropEventData -> DropEventData -> Bool) -> Eq DropEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DropEventData -> DropEventData -> Bool
$c/= :: DropEventData -> DropEventData -> Bool
== :: DropEventData -> DropEventData -> Bool
$c== :: 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
min :: DropEventData -> DropEventData -> DropEventData
$cmin :: DropEventData -> DropEventData -> DropEventData
max :: DropEventData -> DropEventData -> DropEventData
$cmax :: DropEventData -> DropEventData -> DropEventData
>= :: DropEventData -> DropEventData -> Bool
$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
compare :: DropEventData -> DropEventData -> Ordering
$ccompare :: DropEventData -> DropEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep DropEventData x -> DropEventData
$cfrom :: forall x. DropEventData -> Rep DropEventData x
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
showList :: [DropEventData] -> ShowS
$cshowList :: [DropEventData] -> ShowS
show :: DropEventData -> String
$cshow :: DropEventData -> String
showsPrec :: Int -> DropEventData -> ShowS
$cshowsPrec :: Int -> DropEventData -> ShowS
Show,Typeable)

-- | SDL reported an unknown event type.
newtype UnknownEventData =
  UnknownEventData {UnknownEventData -> Timestamp
unknownEventType :: Word32
                    -- ^ The unknown event code.
                   }
  deriving (UnknownEventData -> UnknownEventData -> Bool
(UnknownEventData -> UnknownEventData -> Bool)
-> (UnknownEventData -> UnknownEventData -> Bool)
-> Eq UnknownEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnknownEventData -> UnknownEventData -> Bool
$c/= :: UnknownEventData -> UnknownEventData -> Bool
== :: UnknownEventData -> UnknownEventData -> Bool
$c== :: 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
min :: UnknownEventData -> UnknownEventData -> UnknownEventData
$cmin :: UnknownEventData -> UnknownEventData -> UnknownEventData
max :: UnknownEventData -> UnknownEventData -> UnknownEventData
$cmax :: UnknownEventData -> UnknownEventData -> UnknownEventData
>= :: UnknownEventData -> UnknownEventData -> Bool
$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
compare :: UnknownEventData -> UnknownEventData -> Ordering
$ccompare :: UnknownEventData -> UnknownEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep UnknownEventData x -> UnknownEventData
$cfrom :: forall x. UnknownEventData -> Rep UnknownEventData x
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
showList :: [UnknownEventData] -> ShowS
$cshowList :: [UnknownEventData] -> ShowS
show :: UnknownEventData -> String
$cshow :: UnknownEventData -> String
showsPrec :: Int -> UnknownEventData -> ShowS
$cshowsPrec :: Int -> UnknownEventData -> ShowS
Show,Typeable)

data InputMotion = Released | Pressed
  deriving (InputMotion
InputMotion -> InputMotion -> Bounded InputMotion
forall a. a -> a -> Bounded a
maxBound :: InputMotion
$cmaxBound :: InputMotion
minBound :: InputMotion
$cminBound :: 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
enumFromThenTo :: InputMotion -> InputMotion -> InputMotion -> [InputMotion]
$cenumFromThenTo :: InputMotion -> InputMotion -> InputMotion -> [InputMotion]
enumFromTo :: InputMotion -> InputMotion -> [InputMotion]
$cenumFromTo :: InputMotion -> InputMotion -> [InputMotion]
enumFromThen :: InputMotion -> InputMotion -> [InputMotion]
$cenumFromThen :: InputMotion -> InputMotion -> [InputMotion]
enumFrom :: InputMotion -> [InputMotion]
$cenumFrom :: InputMotion -> [InputMotion]
fromEnum :: InputMotion -> Int
$cfromEnum :: InputMotion -> Int
toEnum :: Int -> InputMotion
$ctoEnum :: Int -> InputMotion
pred :: InputMotion -> InputMotion
$cpred :: InputMotion -> InputMotion
succ :: InputMotion -> InputMotion
$csucc :: InputMotion -> InputMotion
Enum, InputMotion -> InputMotion -> Bool
(InputMotion -> InputMotion -> Bool)
-> (InputMotion -> InputMotion -> Bool) -> Eq InputMotion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputMotion -> InputMotion -> Bool
$c/= :: InputMotion -> InputMotion -> Bool
== :: InputMotion -> InputMotion -> Bool
$c== :: 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
min :: InputMotion -> InputMotion -> InputMotion
$cmin :: InputMotion -> InputMotion -> InputMotion
max :: InputMotion -> InputMotion -> InputMotion
$cmax :: InputMotion -> InputMotion -> InputMotion
>= :: InputMotion -> InputMotion -> Bool
$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
compare :: InputMotion -> InputMotion -> Ordering
$ccompare :: InputMotion -> InputMotion -> Ordering
$cp1Ord :: Eq 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
readListPrec :: ReadPrec [InputMotion]
$creadListPrec :: ReadPrec [InputMotion]
readPrec :: ReadPrec InputMotion
$creadPrec :: ReadPrec InputMotion
readList :: ReadS [InputMotion]
$creadList :: ReadS [InputMotion]
readsPrec :: Int -> ReadS InputMotion
$creadsPrec :: Int -> ReadS InputMotion
Read, Typeable InputMotion
DataType
Constr
Typeable InputMotion =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> InputMotion -> c InputMotion)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c InputMotion)
-> (InputMotion -> Constr)
-> (InputMotion -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c InputMotion))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    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 :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> InputMotion -> m InputMotion)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> InputMotion -> m InputMotion)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> InputMotion -> m InputMotion)
-> Data InputMotion
InputMotion -> DataType
InputMotion -> Constr
(forall b. Data b => b -> b) -> InputMotion -> InputMotion
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InputMotion -> c InputMotion
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InputMotion
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    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 :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    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 :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InputMotion -> m InputMotion
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InputMotion -> m InputMotion
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InputMotion
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InputMotion -> c InputMotion
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InputMotion)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InputMotion)
$cPressed :: Constr
$cReleased :: Constr
$tInputMotion :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> InputMotion -> m InputMotion
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InputMotion -> m InputMotion
gmapMp :: (forall d. Data d => d -> m d) -> InputMotion -> m InputMotion
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InputMotion -> m InputMotion
gmapM :: (forall d. Data d => d -> m d) -> InputMotion -> m InputMotion
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InputMotion -> m InputMotion
gmapQi :: Int -> (forall d. Data d => d -> u) -> InputMotion -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> InputMotion -> u
gmapQ :: (forall d. Data d => d -> u) -> InputMotion -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> InputMotion -> [u]
gmapQr :: (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
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InputMotion -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InputMotion -> r
gmapT :: (forall b. Data b => b -> b) -> InputMotion -> InputMotion
$cgmapT :: (forall b. Data b => b -> b) -> InputMotion -> InputMotion
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InputMotion)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InputMotion)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c InputMotion)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InputMotion)
dataTypeOf :: InputMotion -> DataType
$cdataTypeOf :: InputMotion -> DataType
toConstr :: InputMotion -> Constr
$ctoConstr :: InputMotion -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InputMotion
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InputMotion
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InputMotion -> c InputMotion
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InputMotion -> c InputMotion
$cp1Data :: Typeable 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
$cto :: forall x. Rep InputMotion x -> InputMotion
$cfrom :: forall x. InputMotion -> Rep InputMotion x
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
showList :: [InputMotion] -> ShowS
$cshowList :: [InputMotion] -> ShowS
show :: InputMotion -> String
$cshow :: InputMotion -> String
showsPrec :: Int -> InputMotion -> ShowS
$cshowsPrec :: Int -> 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 scancode :: Timestamp
scancode keycode :: Int32
keycode modifier :: Word16
modifier) =
  Scancode -> Keycode -> KeyModifier -> Keysym
Keysym Scancode
scancode' Keycode
keycode' KeyModifier
modifier'
  where scancode' :: Scancode
scancode' = Timestamp -> Scancode
forall a b. FromNumber a b => b -> a
fromNumber Timestamp
scancode
        keycode' :: Keycode
keycode'  = Int32 -> Keycode
forall a b. FromNumber a b => b -> a
fromNumber Int32
keycode
        modifier' :: KeyModifier
modifier' = Timestamp -> KeyModifier
forall a b. FromNumber a b => b -> a
fromNumber (Word16 -> Timestamp
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
modifier)

convertRaw :: Raw.Event -> IO Event
convertRaw :: Event -> IO Event
convertRaw (Raw.WindowEvent t :: Timestamp
t ts :: Timestamp
ts a :: Timestamp
a b :: Word8
b c :: Int32
c d :: Int32
d) =
  do Window
w <- (Ptr () -> Window) -> IO (Ptr ()) -> IO Window
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr () -> Window
Window (Timestamp -> IO (Ptr ())
forall (m :: * -> *). MonadIO m => Timestamp -> m (Ptr ())
Raw.getWindowFromID Timestamp
a)
     Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
ts
                   (case Word8
b of
                      Raw.SDL_WINDOWEVENT_SHOWN ->
                        WindowShownEventData -> EventPayload
WindowShownEvent (Window -> WindowShownEventData
WindowShownEventData Window
w)
                      Raw.SDL_WINDOWEVENT_HIDDEN ->
                        WindowHiddenEventData -> EventPayload
WindowHiddenEvent (Window -> WindowHiddenEventData
WindowHiddenEventData Window
w)
                      Raw.SDL_WINDOWEVENT_EXPOSED ->
                        WindowExposedEventData -> EventPayload
WindowExposedEvent (Window -> WindowExposedEventData
WindowExposedEventData Window
w)
                      Raw.SDL_WINDOWEVENT_MOVED ->
                        WindowMovedEventData -> EventPayload
WindowMovedEvent
                          (Window -> Point V2 Int32 -> WindowMovedEventData
WindowMovedEventData Window
w
                                                (V2 Int32 -> Point V2 Int32
forall (f :: * -> *) a. f a -> Point f a
P (Int32 -> Int32 -> V2 Int32
forall a. a -> a -> V2 a
V2 Int32
c Int32
d)))
                      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))
                      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))
                      Raw.SDL_WINDOWEVENT_MINIMIZED ->
                        WindowMinimizedEventData -> EventPayload
WindowMinimizedEvent (Window -> WindowMinimizedEventData
WindowMinimizedEventData Window
w)
                      Raw.SDL_WINDOWEVENT_MAXIMIZED ->
                        WindowMaximizedEventData -> EventPayload
WindowMaximizedEvent (Window -> WindowMaximizedEventData
WindowMaximizedEventData Window
w)
                      Raw.SDL_WINDOWEVENT_RESTORED ->
                        WindowRestoredEventData -> EventPayload
WindowRestoredEvent (Window -> WindowRestoredEventData
WindowRestoredEventData Window
w)
                      Raw.SDL_WINDOWEVENT_ENTER ->
                        WindowGainedMouseFocusEventData -> EventPayload
WindowGainedMouseFocusEvent (Window -> WindowGainedMouseFocusEventData
WindowGainedMouseFocusEventData Window
w)
                      Raw.SDL_WINDOWEVENT_LEAVE ->
                        WindowLostMouseFocusEventData -> EventPayload
WindowLostMouseFocusEvent (Window -> WindowLostMouseFocusEventData
WindowLostMouseFocusEventData Window
w)
                      Raw.SDL_WINDOWEVENT_FOCUS_GAINED ->
                        WindowGainedKeyboardFocusEventData -> EventPayload
WindowGainedKeyboardFocusEvent (Window -> WindowGainedKeyboardFocusEventData
WindowGainedKeyboardFocusEventData Window
w)
                      Raw.SDL_WINDOWEVENT_FOCUS_LOST ->
                        WindowLostKeyboardFocusEventData -> EventPayload
WindowLostKeyboardFocusEvent (Window -> WindowLostKeyboardFocusEventData
WindowLostKeyboardFocusEventData Window
w)
                      Raw.SDL_WINDOWEVENT_CLOSE ->
                        WindowClosedEventData -> EventPayload
WindowClosedEvent (Window -> WindowClosedEventData
WindowClosedEventData Window
w)
                      _ ->
                        UnknownEventData -> EventPayload
UnknownEvent (Timestamp -> UnknownEventData
UnknownEventData Timestamp
t)))
convertRaw (Raw.KeyboardEvent Raw.SDL_KEYDOWN ts :: Timestamp
ts a :: Timestamp
a _ c :: Word8
c d :: Keysym
d) =
  do Maybe Window
w <- Timestamp -> IO (Maybe Window)
forall (m :: * -> *). MonadIO m => Timestamp -> m (Maybe Window)
getWindowFromID Timestamp
a
     Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
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
/= 0)
                                         (Keysym -> Keysym
fromRawKeysym Keysym
d))))
convertRaw (Raw.KeyboardEvent Raw.SDL_KEYUP ts :: Timestamp
ts a :: Timestamp
a _ c :: Word8
c d :: Keysym
d) =
  do Maybe Window
w <- Timestamp -> IO (Maybe Window)
forall (m :: * -> *). MonadIO m => Timestamp -> m (Maybe Window)
getWindowFromID Timestamp
a
     Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
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
/= 0)
                                         (Keysym -> Keysym
fromRawKeysym Keysym
d))))
convertRaw Raw.KeyboardEvent{} = String -> IO Event
forall a. HasCallStack => String -> a
error "convertRaw: Unknown keyboard motion"
convertRaw (Raw.TextEditingEvent _ ts :: Timestamp
ts a :: Timestamp
a b :: [CChar]
b c :: Int32
c d :: Int32
d) =
  do Maybe Window
w <- Timestamp -> IO (Maybe Window)
forall (m :: * -> *). MonadIO m => Timestamp -> m (Maybe Window)
getWindowFromID Timestamp
a
     Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
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 _ ts :: Timestamp
ts a :: Timestamp
a b :: [CChar]
b) =
  do Maybe Window
w <- Timestamp -> IO (Maybe Window)
forall (m :: * -> *). MonadIO m => Timestamp -> m (Maybe Window)
getWindowFromID Timestamp
a
     Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
ts
                   (TextInputEventData -> EventPayload
TextInputEvent
                      (Maybe Window -> Text -> TextInputEventData
TextInputEventData Maybe Window
w
                                          ([CChar] -> Text
ccharStringToText [CChar]
b))))
convertRaw (Raw.KeymapChangedEvent _ ts :: Timestamp
ts) =
  Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
ts EventPayload
KeymapChangedEvent)
convertRaw (Raw.MouseMotionEvent _ ts :: Timestamp
ts a :: Timestamp
a b :: Timestamp
b c :: Timestamp
c d :: Int32
d e :: Int32
e f :: Int32
f g :: Int32
g) =
  do Maybe Window
w <- Timestamp -> IO (Maybe Window)
forall (m :: * -> *). MonadIO m => Timestamp -> m (Maybe Window)
getWindowFromID Timestamp
a
     let buttons :: [MouseButton]
buttons =
           [Maybe MouseButton] -> [MouseButton]
forall a. [Maybe a] -> [a]
catMaybes [(Timestamp
forall a. (Eq a, Num a) => a
Raw.SDL_BUTTON_LMASK Timestamp -> Timestamp -> MouseButton -> Maybe MouseButton
forall a a. (Bits a, Num a) => a -> a -> a -> Maybe a
`test` Timestamp
c) MouseButton
ButtonLeft
                     ,(Timestamp
forall a. (Eq a, Num a) => a
Raw.SDL_BUTTON_RMASK Timestamp -> Timestamp -> MouseButton -> Maybe MouseButton
forall a a. (Bits a, Num a) => a -> a -> a -> Maybe a
`test` Timestamp
c) MouseButton
ButtonRight
                     ,(Timestamp
forall a. (Eq a, Num a) => a
Raw.SDL_BUTTON_MMASK Timestamp -> Timestamp -> MouseButton -> Maybe MouseButton
forall a a. (Bits a, Num a) => a -> a -> a -> Maybe a
`test` Timestamp
c) MouseButton
ButtonMiddle
                     ,(Timestamp
forall a. (Eq a, Num a) => a
Raw.SDL_BUTTON_X1MASK Timestamp -> Timestamp -> MouseButton -> Maybe MouseButton
forall a a. (Bits a, Num a) => a -> a -> a -> Maybe a
`test` Timestamp
c) MouseButton
ButtonX1
                     ,(Timestamp
forall a. (Eq a, Num a) => a
Raw.SDL_BUTTON_X2MASK Timestamp -> Timestamp -> MouseButton -> Maybe MouseButton
forall a a. (Bits a, Num a) => a -> a -> a -> Maybe a
`test` Timestamp
c) MouseButton
ButtonX2]
     Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
ts
                   (MouseMotionEventData -> EventPayload
MouseMotionEvent
                      (Maybe Window
-> MouseDevice
-> [MouseButton]
-> Point V2 Int32
-> V2 Int32
-> MouseMotionEventData
MouseMotionEventData Maybe Window
w
                                            (Timestamp -> MouseDevice
forall a b. FromNumber a b => b -> a
fromNumber Timestamp
b)
                                            [MouseButton]
buttons
                                            (V2 Int32 -> Point V2 Int32
forall (f :: * -> *) 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 mask :: a
mask test :: a -> a -> a -> Maybe a
`test` x :: 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
/= 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 t :: Timestamp
t ts :: Timestamp
ts a :: Timestamp
a b :: Timestamp
b c :: Word8
c _ e :: Word8
e f :: Int32
f g :: Int32
g) =
  do Maybe Window
w <- Timestamp -> IO (Maybe Window)
forall (m :: * -> *). MonadIO m => Timestamp -> m (Maybe Window)
getWindowFromID Timestamp
a
     let motion :: InputMotion
motion
           | Timestamp
t Timestamp -> Timestamp -> Bool
forall a. Eq a => a -> a -> Bool
== Timestamp
forall a. (Eq a, Num a) => a
Raw.SDL_MOUSEBUTTONUP = InputMotion
Released
           | Timestamp
t Timestamp -> Timestamp -> Bool
forall a. Eq a => a -> a -> Bool
== Timestamp
forall a. (Eq a, Num a) => a
Raw.SDL_MOUSEBUTTONDOWN = InputMotion
Pressed
           | Bool
otherwise = String -> InputMotion
forall a. HasCallStack => String -> a
error "convertRaw: Unexpected mouse button motion"
     Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
ts
                   (MouseButtonEventData -> EventPayload
MouseButtonEvent
                      (Maybe Window
-> InputMotion
-> MouseDevice
-> MouseButton
-> Word8
-> Point V2 Int32
-> MouseButtonEventData
MouseButtonEventData Maybe Window
w
                                            InputMotion
motion
                                            (Timestamp -> MouseDevice
forall a b. FromNumber a b => b -> a
fromNumber Timestamp
b)
                                            (Word8 -> MouseButton
forall a b. FromNumber a b => b -> a
fromNumber Word8
c)
                                            Word8
e
                                            (V2 Int32 -> Point V2 Int32
forall (f :: * -> *) 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 _ ts :: Timestamp
ts a :: Timestamp
a b :: Timestamp
b c :: Int32
c d :: Int32
d e :: Timestamp
e) =
  do Maybe Window
w <- Timestamp -> IO (Maybe Window)
forall (m :: * -> *). MonadIO m => Timestamp -> m (Maybe Window)
getWindowFromID Timestamp
a
     Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
ts
                   (MouseWheelEventData -> EventPayload
MouseWheelEvent
                      (Maybe Window
-> MouseDevice
-> V2 Int32
-> MouseScrollDirection
-> MouseWheelEventData
MouseWheelEventData Maybe Window
w
                                           (Timestamp -> MouseDevice
forall a b. FromNumber a b => b -> a
fromNumber Timestamp
b)
                                           (Int32 -> Int32 -> V2 Int32
forall a. a -> a -> V2 a
V2 Int32
c Int32
d)
                                           (Timestamp -> MouseScrollDirection
forall a b. FromNumber a b => b -> a
fromNumber Timestamp
e))))
convertRaw (Raw.JoyAxisEvent _ ts :: Timestamp
ts a :: Int32
a b :: Word8
b c :: Int16
c) =
  Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
ts (JoyAxisEventData -> EventPayload
JoyAxisEvent (Int32 -> Word8 -> Int16 -> JoyAxisEventData
JoyAxisEventData Int32
a Word8
b Int16
c)))
convertRaw (Raw.JoyBallEvent _ ts :: Timestamp
ts a :: Int32
a b :: Word8
b c :: Int16
c d :: Int16
d) =
  Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
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 _ ts :: Timestamp
ts a :: Int32
a b :: Word8
b c :: Word8
c) =
  Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
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 _ ts :: Timestamp
ts a :: Int32
a b :: Word8
b c :: Word8
c) =
  Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
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 t :: Timestamp
t ts :: Timestamp
ts a :: Int32
a) =
  Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
ts (JoyDeviceEventData -> EventPayload
JoyDeviceEvent (JoyDeviceConnection -> Int32 -> JoyDeviceEventData
JoyDeviceEventData (Timestamp -> JoyDeviceConnection
forall a b. FromNumber a b => b -> a
fromNumber Timestamp
t) Int32
a)))
convertRaw (Raw.ControllerAxisEvent _ ts :: Timestamp
ts a :: Int32
a b :: Word8
b c :: Int16
c) =
  Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
ts (ControllerAxisEventData -> EventPayload
ControllerAxisEvent (Int32 -> Word8 -> Int16 -> ControllerAxisEventData
ControllerAxisEventData Int32
a Word8
b Int16
c)))
convertRaw (Raw.ControllerButtonEvent t :: Timestamp
t ts :: Timestamp
ts a :: Int32
a b :: Word8
b _) =
  Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
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)
                                        (Timestamp -> ControllerButtonState
forall a b. FromNumber a b => b -> a
fromNumber Timestamp
t))))
convertRaw (Raw.ControllerDeviceEvent t :: Timestamp
t ts :: Timestamp
ts a :: Int32
a) =
  Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
ts (ControllerDeviceEventData -> EventPayload
ControllerDeviceEvent (ControllerDeviceConnection -> Int32 -> ControllerDeviceEventData
ControllerDeviceEventData (Timestamp -> ControllerDeviceConnection
forall a b. FromNumber a b => b -> a
fromNumber Timestamp
t) Int32
a)))
convertRaw (Raw.AudioDeviceEvent Raw.SDL_AUDIODEVICEADDED ts :: Timestamp
ts a :: Timestamp
a b :: Word8
b) =
  Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
ts (AudioDeviceEventData -> EventPayload
AudioDeviceEvent (Bool -> Timestamp -> Bool -> AudioDeviceEventData
AudioDeviceEventData Bool
True Timestamp
a (Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= 0))))
convertRaw (Raw.AudioDeviceEvent Raw.SDL_AUDIODEVICEREMOVED ts :: Timestamp
ts a :: Timestamp
a b :: Word8
b) =
  Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
ts (AudioDeviceEventData -> EventPayload
AudioDeviceEvent (Bool -> Timestamp -> Bool -> AudioDeviceEventData
AudioDeviceEventData Bool
False Timestamp
a (Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= 0))))
convertRaw Raw.AudioDeviceEvent{} =
  String -> IO Event
forall a. HasCallStack => String -> a
error "convertRaw: Unknown audio device motion"
convertRaw (Raw.QuitEvent _ ts :: Timestamp
ts) =
  Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
ts EventPayload
QuitEvent)
convertRaw (Raw.UserEvent t :: Timestamp
t ts :: Timestamp
ts a :: Timestamp
a b :: Int32
b c :: Ptr ()
c d :: Ptr ()
d) =
  do Maybe Window
w <- Timestamp -> IO (Maybe Window)
forall (m :: * -> *). MonadIO m => Timestamp -> m (Maybe Window)
getWindowFromID Timestamp
a
     Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
ts (UserEventData -> EventPayload
UserEvent (Timestamp
-> Maybe Window -> Int32 -> Ptr () -> Ptr () -> UserEventData
UserEventData Timestamp
t Maybe Window
w Int32
b Ptr ()
c Ptr ()
d)))
convertRaw (Raw.SysWMEvent _ ts :: Timestamp
ts a :: Ptr ()
a) =
  Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
ts (SysWMEventData -> EventPayload
SysWMEvent (Ptr () -> SysWMEventData
SysWMEventData Ptr ()
a)))
convertRaw (Raw.TouchFingerEvent t :: Timestamp
t ts :: Timestamp
ts a :: TouchID
a b :: TouchID
b c :: CFloat
c d :: CFloat
d e :: CFloat
e f :: CFloat
f g :: CFloat
g) =
  do let touchFingerEvent :: InputMotion -> EventPayload
touchFingerEvent motion :: 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 :: * -> *) 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 :: * -> *) 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 Timestamp
t of
       Raw.SDL_FINGERDOWN   -> Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
ts (InputMotion -> EventPayload
touchFingerEvent InputMotion
Pressed))
       Raw.SDL_FINGERUP     -> Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
ts (InputMotion -> EventPayload
touchFingerEvent InputMotion
Released))
       Raw.SDL_FINGERMOTION -> Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
ts EventPayload
touchFingerMotionEvent)
       _                    -> String -> IO Event
forall a. HasCallStack => String -> a
error "convertRaw: Unexpected touch finger event"
convertRaw (Raw.MultiGestureEvent _ ts :: Timestamp
ts a :: TouchID
a b :: CFloat
b c :: CFloat
c d :: CFloat
d e :: CFloat
e f :: Word16
f) =
  Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
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 :: * -> *) 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 _ ts :: Timestamp
ts a :: TouchID
a b :: TouchID
b c :: Timestamp
c d :: CFloat
d e :: CFloat
e f :: CFloat
f) =
  Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
ts
                (DollarGestureEventData -> EventPayload
DollarGestureEvent
                   (TouchID
-> TouchID
-> Timestamp
-> CFloat
-> Point V2 CFloat
-> DollarGestureEventData
DollarGestureEventData TouchID
a
                                           TouchID
b
                                           Timestamp
c
                                           CFloat
d
                                           (V2 CFloat -> Point V2 CFloat
forall (f :: * -> *) 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 _ ts :: Timestamp
ts a :: CString
a) =
  Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
ts (DropEventData -> EventPayload
DropEvent (CString -> DropEventData
DropEventData CString
a)))
convertRaw (Raw.ClipboardUpdateEvent _ ts :: Timestamp
ts) =
  Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
ts EventPayload
ClipboardUpdateEvent)
convertRaw (Raw.UnknownEvent t :: Timestamp
t ts :: Timestamp
ts) =
  Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventPayload -> Event
Event Timestamp
ts (UnknownEventData -> EventPayload
UnknownEvent (Timestamp -> UnknownEventData
UnknownEventData Timestamp
t)))

-- | Poll for currently pending events. You can only call this function in the
-- OS thread that set the video mode.
pollEvent :: MonadIO m => m (Maybe Event)
pollEvent :: m (Maybe Event)
pollEvent =
  IO (Maybe Event) -> m (Maybe Event)
forall (m :: * -> *) 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 :: * -> *). MonadIO m => Ptr Event -> m CInt
Raw.pollEvent Ptr Event
forall a. Ptr a
nullPtr
    -- We use NULL first to check if there's an event.
    if CInt
n CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 0
      then Maybe Event -> IO (Maybe Event)
forall (m :: * -> *) 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
$ \e :: Ptr Event
e -> do
             CInt
n <- Ptr Event -> IO CInt
forall (m :: * -> *). MonadIO m => Ptr Event -> m CInt
Raw.pollEvent Ptr Event
e
             -- Checking 0 again doesn't hurt and it's good to be safe.
             if CInt
n CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 0
               then Maybe Event -> IO (Maybe Event)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Event
forall a. Maybe a
Nothing
               else (Event -> Maybe Event) -> IO Event -> IO (Maybe Event)
forall (f :: * -> *) 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Event -> IO Event
convertRaw)

-- | Clear the event queue by polling for all pending events.
--
-- Like 'pollEvent' this function should only be called in the OS thread which
-- set the video mode.
pollEvents :: MonadIO m => m [Event]
pollEvents :: m [Event]
pollEvents =
  do Maybe Event
e <- m (Maybe Event)
forall (m :: * -> *). MonadIO m => m (Maybe Event)
pollEvent
     case Maybe Event
e of
       Nothing -> [Event] -> m [Event]
forall (m :: * -> *) a. Monad m => a -> m a
return []
       Just e' :: Event
e' -> (Event
e' Event -> [Event] -> [Event]
forall a. a -> [a] -> [a]
:) ([Event] -> [Event]) -> m [Event] -> m [Event]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Event]
forall (m :: * -> *). MonadIO m => m [Event]
pollEvents

-- | Run a monadic computation, accumulating over all known 'Event's.
--
-- This can be useful when used with a state monad, allowing you to fold all events together.
mapEvents :: MonadIO m => (Event -> m ()) -> m ()
mapEvents :: (Event -> m ()) -> m ()
mapEvents h :: Event -> m ()
h = do
  Maybe Event
event' <- m (Maybe Event)
forall (m :: * -> *). MonadIO m => m (Maybe Event)
pollEvent
  case Maybe Event
event' of
    Just event :: Event
event -> Event -> m ()
h Event
event m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Event -> m ()) -> m ()
forall (m :: * -> *). MonadIO m => (Event -> m ()) -> m ()
mapEvents Event -> m ()
h
    Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Wait indefinitely for the next available event.
waitEvent :: MonadIO m => m Event
waitEvent :: m Event
waitEvent = IO Event -> m Event
forall (m :: * -> *) 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
$ \e :: Ptr Event
e -> do
  Text -> Text -> IO CInt -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Num a, Ord a) =>
Text -> Text -> m a -> m ()
throwIfNeg_ "SDL.Events.waitEvent" "SDL_WaitEvent" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
    Ptr Event -> IO CInt
forall (m :: * -> *). 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Event -> IO Event
convertRaw

-- | Wait until the specified timeout for the next available amount.
waitEventTimeout :: MonadIO m
                 => CInt -- ^ The maximum amount of time to wait, in milliseconds.
                 -> m (Maybe Event)
waitEventTimeout :: CInt -> m (Maybe Event)
waitEventTimeout timeout :: CInt
timeout = IO (Maybe Event) -> m (Maybe Event)
forall (m :: * -> *) 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
$ \e :: Ptr Event
e -> do
  CInt
n <- Ptr Event -> CInt -> IO CInt
forall (m :: * -> *). 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
== 0
     then Maybe Event -> IO (Maybe Event)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Event
forall a. Maybe a
Nothing
     else (Event -> Maybe Event) -> IO Event -> IO (Maybe Event)
forall (f :: * -> *) 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Event -> IO Event
convertRaw)

-- | A user defined event structure that has been registered with SDL.
--
-- Use 'registerEvent', below, to obtain an instance.
data RegisteredEventType a =
  RegisteredEventType {RegisteredEventType a -> a -> IO EventPushResult
pushRegisteredEvent :: a -> IO EventPushResult
                      ,RegisteredEventType a -> Event -> IO (Maybe a)
getRegisteredEvent :: Event -> IO (Maybe a)
                      }

-- | A record used to convert between SDL Events and user-defined data structures.
--
-- Used for 'registerEvent', below.
data RegisteredEventData =
  RegisteredEventData {RegisteredEventData -> Maybe Window
registeredEventWindow :: !(Maybe Window)
                       -- ^ The associated 'Window'.
                      ,RegisteredEventData -> Int32
registeredEventCode :: !Int32
                       -- ^ User defined event code.
                      ,RegisteredEventData -> Ptr ()
registeredEventData1 :: !(Ptr ())
                       -- ^ User defined data pointer.
                      ,RegisteredEventData -> Ptr ()
registeredEventData2 :: !(Ptr ())
                       -- ^ User defined data pointer.
                      }
  deriving (RegisteredEventData -> RegisteredEventData -> Bool
(RegisteredEventData -> RegisteredEventData -> Bool)
-> (RegisteredEventData -> RegisteredEventData -> Bool)
-> Eq RegisteredEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisteredEventData -> RegisteredEventData -> Bool
$c/= :: RegisteredEventData -> RegisteredEventData -> Bool
== :: RegisteredEventData -> RegisteredEventData -> Bool
$c== :: 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
min :: RegisteredEventData -> RegisteredEventData -> RegisteredEventData
$cmin :: RegisteredEventData -> RegisteredEventData -> RegisteredEventData
max :: RegisteredEventData -> RegisteredEventData -> RegisteredEventData
$cmax :: RegisteredEventData -> RegisteredEventData -> RegisteredEventData
>= :: RegisteredEventData -> RegisteredEventData -> Bool
$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
compare :: RegisteredEventData -> RegisteredEventData -> Ordering
$ccompare :: RegisteredEventData -> RegisteredEventData -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep RegisteredEventData x -> RegisteredEventData
$cfrom :: forall x. RegisteredEventData -> Rep RegisteredEventData x
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
showList :: [RegisteredEventData] -> ShowS
$cshowList :: [RegisteredEventData] -> ShowS
show :: RegisteredEventData -> String
$cshow :: RegisteredEventData -> String
showsPrec :: Int -> RegisteredEventData -> ShowS
$cshowsPrec :: Int -> RegisteredEventData -> ShowS
Show,Typeable)

-- | A registered event with no associated data.
--
-- This is a resonable baseline to modify for converting to
-- 'RegisteredEventData'.
emptyRegisteredEvent :: RegisteredEventData
emptyRegisteredEvent :: RegisteredEventData
emptyRegisteredEvent = Maybe Window -> Int32 -> Ptr () -> Ptr () -> RegisteredEventData
RegisteredEventData Maybe Window
forall a. Maybe a
Nothing 0 Ptr ()
forall a. Ptr a
nullPtr Ptr ()
forall a. Ptr a
nullPtr

-- | Possible results of an attempted push of an event to the queue.
data EventPushResult = EventPushSuccess | EventPushFiltered | EventPushFailure Text
  deriving (Typeable EventPushResult
DataType
Constr
Typeable EventPushResult =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> EventPushResult -> c EventPushResult)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c EventPushResult)
-> (EventPushResult -> Constr)
-> (EventPushResult -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c EventPushResult))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    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 :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> EventPushResult -> m EventPushResult)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> EventPushResult -> m EventPushResult)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> EventPushResult -> m EventPushResult)
-> Data EventPushResult
EventPushResult -> DataType
EventPushResult -> Constr
(forall b. Data b => b -> b) -> EventPushResult -> EventPushResult
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EventPushResult -> c EventPushResult
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EventPushResult
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    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 :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    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 :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> EventPushResult -> m EventPushResult
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EventPushResult -> m EventPushResult
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EventPushResult
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EventPushResult -> c EventPushResult
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EventPushResult)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EventPushResult)
$cEventPushFailure :: Constr
$cEventPushFiltered :: Constr
$cEventPushSuccess :: Constr
$tEventPushResult :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> EventPushResult -> m EventPushResult
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EventPushResult -> m EventPushResult
gmapMp :: (forall d. Data d => d -> m d)
-> EventPushResult -> m EventPushResult
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EventPushResult -> m EventPushResult
gmapM :: (forall d. Data d => d -> m d)
-> EventPushResult -> m EventPushResult
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> EventPushResult -> m EventPushResult
gmapQi :: Int -> (forall d. Data d => d -> u) -> EventPushResult -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> EventPushResult -> u
gmapQ :: (forall d. Data d => d -> u) -> EventPushResult -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EventPushResult -> [u]
gmapQr :: (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
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EventPushResult -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EventPushResult -> r
gmapT :: (forall b. Data b => b -> b) -> EventPushResult -> EventPushResult
$cgmapT :: (forall b. Data b => b -> b) -> EventPushResult -> EventPushResult
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EventPushResult)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EventPushResult)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c EventPushResult)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EventPushResult)
dataTypeOf :: EventPushResult -> DataType
$cdataTypeOf :: EventPushResult -> DataType
toConstr :: EventPushResult -> Constr
$ctoConstr :: EventPushResult -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EventPushResult
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EventPushResult
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EventPushResult -> c EventPushResult
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EventPushResult -> c EventPushResult
$cp1Data :: Typeable EventPushResult
Data, EventPushResult -> EventPushResult -> Bool
(EventPushResult -> EventPushResult -> Bool)
-> (EventPushResult -> EventPushResult -> Bool)
-> Eq EventPushResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventPushResult -> EventPushResult -> Bool
$c/= :: EventPushResult -> EventPushResult -> Bool
== :: EventPushResult -> EventPushResult -> Bool
$c== :: 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
$cto :: forall x. Rep EventPushResult x -> EventPushResult
$cfrom :: forall x. EventPushResult -> Rep EventPushResult x
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
min :: EventPushResult -> EventPushResult -> EventPushResult
$cmin :: EventPushResult -> EventPushResult -> EventPushResult
max :: EventPushResult -> EventPushResult -> EventPushResult
$cmax :: EventPushResult -> EventPushResult -> EventPushResult
>= :: EventPushResult -> EventPushResult -> Bool
$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
compare :: EventPushResult -> EventPushResult -> Ordering
$ccompare :: EventPushResult -> EventPushResult -> Ordering
$cp1Ord :: Eq 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
readListPrec :: ReadPrec [EventPushResult]
$creadListPrec :: ReadPrec [EventPushResult]
readPrec :: ReadPrec EventPushResult
$creadPrec :: ReadPrec EventPushResult
readList :: ReadS [EventPushResult]
$creadList :: ReadS [EventPushResult]
readsPrec :: Int -> ReadS EventPushResult
$creadsPrec :: Int -> ReadS 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
showList :: [EventPushResult] -> ShowS
$cshowList :: [EventPushResult] -> ShowS
show :: EventPushResult -> String
$cshow :: EventPushResult -> String
showsPrec :: Int -> EventPushResult -> ShowS
$cshowsPrec :: Int -> EventPushResult -> ShowS
Show, Typeable)

-- | Register a new event type with SDL.
--
-- Provide functions that convert between 'UserEventData' and your structure.
-- You can then use 'pushRegisteredEvent' to add a custom event of the
-- registered type to the queue, and 'getRegisteredEvent' to test for such
-- events in the main loop.
registerEvent :: MonadIO m
              => (RegisteredEventData -> Timestamp -> IO (Maybe a))
              -> (a -> IO RegisteredEventData)
              -> m (Maybe (RegisteredEventType a))
registerEvent :: (RegisteredEventData -> Timestamp -> IO (Maybe a))
-> (a -> IO RegisteredEventData)
-> m (Maybe (RegisteredEventType a))
registerEvent registeredEventDataToEvent :: RegisteredEventData -> Timestamp -> IO (Maybe a)
registeredEventDataToEvent eventToRegisteredEventData :: a -> IO RegisteredEventData
eventToRegisteredEventData = do
  Timestamp
typ <- CInt -> m Timestamp
forall (m :: * -> *). MonadIO m => CInt -> m Timestamp
Raw.registerEvents 1
  if Timestamp
typ Timestamp -> Timestamp -> Bool
forall a. Eq a => a -> a -> Bool
== Timestamp
forall a. Bounded a => a
maxBound
  then Maybe (RegisteredEventType a) -> m (Maybe (RegisteredEventType a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (RegisteredEventType a)
forall a. Maybe a
Nothing
  else
    let pushEv :: a -> IO EventPushResult
pushEv ev :: a
ev = do
          RegisteredEventData mWin :: Maybe Window
mWin code :: Int32
code d1 :: Ptr ()
d1 d2 :: Ptr ()
d2 <- a -> IO RegisteredEventData
eventToRegisteredEventData a
ev
          Timestamp
windowID <- case Maybe Window
mWin of
            Just (Window w :: Ptr ()
w) -> Ptr () -> IO Timestamp
forall (m :: * -> *). MonadIO m => Ptr () -> m Timestamp
Raw.getWindowID Ptr ()
w
            Nothing         -> Timestamp -> IO Timestamp
forall (m :: * -> *) a. Monad m => a -> m a
return 0
          -- timestamp will be filled in by SDL
          let rawEvent :: Event
rawEvent = Timestamp
-> Timestamp -> Timestamp -> Int32 -> Ptr () -> Ptr () -> Event
Raw.UserEvent Timestamp
typ 0 Timestamp
windowID Int32
code Ptr ()
d1 Ptr ()
d2
          IO EventPushResult -> IO EventPushResult
forall (m :: * -> *) 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
$ \eventPtr :: 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 :: * -> *). MonadIO m => Ptr Event -> m CInt
Raw.pushEvent Ptr Event
eventPtr
            case CInt
pushResult of
              1 -> EventPushResult -> IO EventPushResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EventPushResult -> IO EventPushResult)
-> EventPushResult -> IO EventPushResult
forall a b. (a -> b) -> a -> b
$ EventPushResult
EventPushSuccess
              0 -> EventPushResult -> IO EventPushResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EventPushResult -> IO EventPushResult)
-> EventPushResult -> IO EventPushResult
forall a b. (a -> b) -> a -> b
$ EventPushResult
EventPushFiltered
              _ -> Text -> EventPushResult
EventPushFailure (Text -> EventPushResult) -> IO Text -> IO EventPushResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
forall (m :: * -> *). MonadIO m => m Text
getError

        getEv :: Event -> IO (Maybe a)
getEv (Event ts :: Timestamp
ts (UserEvent (UserEventData typ :: Timestamp
typ mWin :: Maybe Window
mWin code :: Int32
code d1 :: Ptr ()
d1 d2 :: Ptr ()
d2))) =
          RegisteredEventData -> Timestamp -> IO (Maybe a)
registeredEventDataToEvent (Maybe Window -> Int32 -> Ptr () -> Ptr () -> RegisteredEventData
RegisteredEventData Maybe Window
mWin Int32
code Ptr ()
d1 Ptr ()
d2) Timestamp
ts
        getEv _ = Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

    in Maybe (RegisteredEventType a) -> m (Maybe (RegisteredEventType a))
forall (m :: * -> *) 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

-- | Pump the event loop, gathering events from the input devices.
--
-- This function updates the event queue and internal input device state.
--
-- This should only be run in the OS thread that initialized the video subsystem, and for extra safety, you should consider only doing those things on the main thread in any case.
--
-- 'pumpEvents' gathers all the pending input information from devices and places it in the event queue. Without calls to 'pumpEvents' no events would ever be placed on the queue. Often the need for calls to 'pumpEvents' is hidden from the user since 'pollEvent' and 'waitEvent' implicitly call 'pumpEvents'. However, if you are not polling or waiting for events (e.g. you are filtering them), then you must call 'pumpEvents' to force an event queue update.
--
-- See @<https://wiki.libsdl.org/SDL_PumpEvents SDL_PumpEvents>@ for C documentation.
pumpEvents :: MonadIO m => m ()
pumpEvents :: m ()
pumpEvents = m ()
forall (m :: * -> *). MonadIO m => m ()
Raw.pumpEvents

-- | An 'EventWatchCallback' can process and respond to an event
-- when it is added to the event queue.
type EventWatchCallback = Event -> IO ()
newtype EventWatch = EventWatch {EventWatch -> IO ()
runEventWatchRemoval :: IO ()}

-- | Trigger an 'EventWatchCallback' when an event is added to the SDL
-- event queue.
--
-- See @<https://wiki.libsdl.org/SDL_AddEventWatch>@ for C documentation.
addEventWatch :: MonadIO m => EventWatchCallback -> m EventWatch
addEventWatch :: EventWatchCallback -> m EventWatch
addEventWatch callback :: EventWatchCallback
callback = IO EventWatch -> m EventWatch
forall (m :: * -> *) 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 :: * -> *). MonadIO m => EventFilter -> Ptr () -> m ()
Raw.addEventWatch EventFilter
rawFilter Ptr ()
forall a. Ptr a
nullPtr
  EventWatch -> IO EventWatch
forall (m :: * -> *) 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 _ evPtr :: Ptr Event
evPtr = 0 CInt -> IO () -> IO CInt
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (EventWatchCallback
callback EventWatchCallback -> IO Event -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Event -> IO Event
convertRaw (Event -> IO Event) -> IO Event -> IO Event
forall (m :: * -> *) 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 rawFilter :: EventFilter
rawFilter = do
      EventFilter -> Ptr () -> IO ()
forall (m :: * -> *). 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

-- | Remove an 'EventWatch'.
--
-- See @<https://wiki.libsdl.org/SDL_DelEventWatch>@ for C documentation.
delEventWatch :: MonadIO m => EventWatch -> m ()
delEventWatch :: EventWatch -> m ()
delEventWatch = IO () -> m ()
forall (m :: * -> *) 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

-- | Checks raw Windows for null references.
getWindowFromID :: MonadIO m => Word32 -> m (Maybe Window)
getWindowFromID :: Timestamp -> m (Maybe Window)
getWindowFromID id :: Timestamp
id = do
  Ptr ()
rawWindow <- Timestamp -> m (Ptr ())
forall (m :: * -> *). MonadIO m => Timestamp -> m (Ptr ())
Raw.getWindowFromID Timestamp
id
  Maybe Window -> m (Maybe Window)
forall (m :: * -> *) 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