{-# 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 occurred at 'eventTimestamp' and carries data under 'eventPayload'.
data Event = Event
  { Event -> Word32
eventTimestamp :: Timestamp
    -- ^ The time the event occurred.
  , Event -> EventPayload
eventPayload :: EventPayload
    -- ^ Data pertaining to this event.
  } deriving (Event -> Event -> Bool
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
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
Ord, 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
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
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
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
Ord, 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
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
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
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
Ord,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
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
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
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
Ord,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
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
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
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
Ord,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
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
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
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
Ord,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
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
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
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
Ord,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
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
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
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
Ord,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
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
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
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
Ord,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
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
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
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
Ord,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
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
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
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
Ord,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
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
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
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
Ord,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
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
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
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
Ord,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
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
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
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
Ord,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
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
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
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
Ord,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
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
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
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
Ord,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
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
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
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
Ord,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
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
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
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
Ord,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
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
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
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
Ord,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
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
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
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
Ord,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
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
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
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
Ord,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
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
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
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
Ord,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
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
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
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
Ord,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
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
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
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
Ord,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
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
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
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
Ord,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
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
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
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
Ord,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
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 :: !Raw.JoystickID
                      -- ^ The instance id of the joystick that reported the event.
                     }
  deriving (JoyDeviceEventData -> JoyDeviceEventData -> Bool
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
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
Ord,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
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 -> ControllerAxis
controllerAxisEventAxis :: !ControllerAxis
                           -- ^ The index of the axis.
                          ,ControllerAxisEventData -> Int16
controllerAxisEventValue :: !Int16
                           -- ^ The axis value ranging between -32768 and 32767.
                          }
  deriving (ControllerAxisEventData -> ControllerAxisEventData -> Bool
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
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
Ord,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
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
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
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
Ord,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
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 :: !Raw.JoystickID
                             -- ^ The joystick instance ID that reported the event.
                            }
  deriving (ControllerDeviceEventData -> ControllerDeviceEventData -> Bool
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
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
Ord,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
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 -> Word32
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
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
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
Ord,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
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 -> Word32
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
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
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
Ord,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
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
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
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
Ord,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
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
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
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
Ord,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
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
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
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
Ord,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
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
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
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
Ord,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
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 -> Word32
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
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
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
Ord,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
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
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
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
Ord,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
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 -> Word32
unknownEventType :: Word32
                    -- ^ The unknown event code.
                   }
  deriving (UnknownEventData -> UnknownEventData -> Bool
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
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
Ord,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
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
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]
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
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
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
Ord, ReadPrec [InputMotion]
ReadPrec InputMotion
Int -> ReadS InputMotion
ReadS [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
InputMotion -> DataType
InputMotion -> Constr
(forall b. Data b => b -> b) -> InputMotion -> InputMotion
forall a.
Typeable a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> InputMotion -> u
forall u. (forall d. Data d => d -> u) -> InputMotion -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InputMotion -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InputMotion -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> InputMotion -> m InputMotion
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InputMotion -> m InputMotion
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InputMotion
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InputMotion -> c InputMotion
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InputMotion)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InputMotion)
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InputMotion -> m InputMotion
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InputMotion -> m InputMotion
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InputMotion -> m InputMotion
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InputMotion -> m InputMotion
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> InputMotion -> m InputMotion
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> InputMotion -> m InputMotion
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> InputMotion -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> InputMotion -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> InputMotion -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> InputMotion -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InputMotion -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InputMotion -> r
gmapQl :: forall r r'.
(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 (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InputMotion)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InputMotion)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InputMotion)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
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 (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InputMotion
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InputMotion
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InputMotion -> c InputMotion
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InputMotion -> c InputMotion
Data, 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
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BSC8.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map CChar -> Char
castCCharToChar

fromRawKeysym :: Raw.Keysym -> Keysym
fromRawKeysym :: Keysym -> Keysym
fromRawKeysym (Raw.Keysym Word32
scancode Int32
keycode Word16
modifier) =
  Scancode -> Keycode -> KeyModifier -> Keysym
Keysym Scancode
scancode' Keycode
keycode' KeyModifier
modifier'
  where scancode' :: Scancode
scancode' = forall a b. FromNumber a b => b -> a
fromNumber Word32
scancode
        keycode' :: Keycode
keycode'  = forall a b. FromNumber a b => b -> a
fromNumber Int32
keycode
        modifier' :: KeyModifier
modifier' = forall a b. FromNumber a b => b -> a
fromNumber (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
modifier)

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

-- | 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 :: forall (m :: Type -> Type). MonadIO m => m (Maybe Event)
pollEvent =
  forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    CInt
n <- forall (m :: Type -> Type). MonadIO m => Ptr Event -> m CInt
Raw.pollEvent forall a. Ptr a
nullPtr
    -- We use NULL first to check if there's an event.
    if CInt
n forall a. Eq a => a -> a -> Bool
== CInt
0
      then forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      else forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Event
e -> do
             CInt
n' <- forall (m :: Type -> Type). 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' forall a. Eq a => a -> a -> Bool
== CInt
0
               then forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
               else forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just (forall a. Storable a => Ptr a -> IO a
peek Ptr Event
e forall (m :: Type -> Type) 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 :: forall (m :: Type -> Type). MonadIO m => m [Event]
pollEvents = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  forall (m :: Type -> Type). MonadIO m => m ()
Raw.pumpEvents
  IO [Event]
peepAllEvents forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Event -> IO Event
convertRaw where
    peepAllEvents :: IO [Event]
peepAllEvents = do
      CInt
numPeeped <- forall (m :: Type -> Type).
MonadIO m =>
Ptr Event -> CInt -> Word32 -> Word32 -> Word32 -> m CInt
Raw.peepEvents
        Ptr Event
Raw.eventBuffer
        CInt
Raw.eventBufferSize
        Word32
Raw.SDL_GETEVENT
        forall {a}. (Eq a, Num a) => a
Raw.SDL_FIRSTEVENT
        forall {a}. (Eq a, Num a) => a
Raw.SDL_LASTEVENT
      [Event]
peeped <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
numPeeped) Ptr Event
Raw.eventBuffer
      if CInt
numPeeped forall a. Eq a => a -> a -> Bool
== CInt
Raw.eventBufferSize -- are there more events to peep?
        then ([Event]
peeped forall a. [a] -> [a] -> [a]
++) forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Event]
peepAllEvents
        else forall (m :: Type -> Type) a. Monad m => a -> m a
return [Event]
peeped

-- | 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 :: forall (m :: Type -> Type). MonadIO m => (Event -> m ()) -> m ()
mapEvents Event -> m ()
h = do
  Maybe Event
event' <- forall (m :: Type -> Type). MonadIO m => m (Maybe Event)
pollEvent
  case Maybe Event
event' of
    Just Event
event -> Event -> m ()
h Event
event forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> forall (m :: Type -> Type). MonadIO m => (Event -> m ()) -> m ()
mapEvents Event -> m ()
h
    Maybe Event
Nothing -> forall (m :: Type -> Type) a. Monad m => a -> m a
return ()

-- | Wait indefinitely for the next available event.
waitEvent :: MonadIO m => m Event
waitEvent :: forall (m :: Type -> Type). MonadIO m => m Event
waitEvent = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Event
e -> do
  forall (m :: Type -> Type) a.
(MonadIO m, Num a, Ord a) =>
Text -> Text -> m a -> m ()
throwIfNeg_ Text
"SDL.Events.waitEvent" Text
"SDL_WaitEvent" forall a b. (a -> b) -> a -> b
$
    forall (m :: Type -> Type). MonadIO m => Ptr Event -> m CInt
Raw.waitEvent Ptr Event
e
  forall a. Storable a => Ptr a -> IO a
peek Ptr Event
e forall (m :: Type -> Type) 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 :: forall (m :: Type -> Type). MonadIO m => CInt -> m (Maybe Event)
waitEventTimeout CInt
timeout = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Event
e -> do
  CInt
n <- forall (m :: Type -> Type).
MonadIO m =>
Ptr Event -> CInt -> m CInt
Raw.waitEventTimeout Ptr Event
e CInt
timeout
  if CInt
n forall a. Eq a => a -> a -> Bool
== CInt
0
     then forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
     else forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just (forall a. Storable a => Ptr a -> IO a
peek Ptr Event
e forall (m :: Type -> Type) 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 {forall a. RegisteredEventType a -> a -> IO EventPushResult
pushRegisteredEvent :: a -> IO EventPushResult
                      ,forall a. 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
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
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
Ord,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
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 forall a. Maybe a
Nothing Int32
0 forall a. Ptr a
nullPtr 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
EventPushResult -> DataType
EventPushResult -> Constr
(forall b. Data b => b -> b) -> EventPushResult -> EventPushResult
forall a.
Typeable a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> EventPushResult -> u
forall u. (forall d. Data d => d -> u) -> EventPushResult -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EventPushResult -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EventPushResult -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> EventPushResult -> m EventPushResult
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EventPushResult -> m EventPushResult
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EventPushResult
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EventPushResult -> c EventPushResult
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EventPushResult)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EventPushResult)
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EventPushResult -> m EventPushResult
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EventPushResult -> m EventPushResult
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EventPushResult -> m EventPushResult
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EventPushResult -> m EventPushResult
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> EventPushResult -> m EventPushResult
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> EventPushResult -> m EventPushResult
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> EventPushResult -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> EventPushResult -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> EventPushResult -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EventPushResult -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EventPushResult -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EventPushResult -> r
gmapQl :: forall r r'.
(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 (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EventPushResult)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EventPushResult)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EventPushResult)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
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 (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EventPushResult
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EventPushResult
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EventPushResult -> c EventPushResult
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EventPushResult -> c EventPushResult
Data, EventPushResult -> EventPushResult -> Bool
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. 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
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
Ord, ReadPrec [EventPushResult]
ReadPrec EventPushResult
Int -> ReadS EventPushResult
ReadS [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
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 :: forall (m :: Type -> Type) a.
MonadIO m =>
(RegisteredEventData -> Word32 -> IO (Maybe a))
-> (a -> IO RegisteredEventData)
-> m (Maybe (RegisteredEventType a))
registerEvent RegisteredEventData -> Word32 -> IO (Maybe a)
registeredEventDataToEvent a -> IO RegisteredEventData
eventToRegisteredEventData = do
  Word32
typ <- forall (m :: Type -> Type). MonadIO m => CInt -> m Word32
Raw.registerEvents CInt
1
  if Word32
typ forall a. Eq a => a -> a -> Bool
== forall a. Bounded a => a
maxBound
  then forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
  else
    let pushEv :: a -> IO EventPushResult
pushEv a
ev = do
          RegisteredEventData Maybe Window
mWin Int32
code Ptr ()
d1 Ptr ()
d2 <- a -> IO RegisteredEventData
eventToRegisteredEventData a
ev
          Word32
windowID <- case Maybe Window
mWin of
            Just (Window Ptr ()
w) -> forall (m :: Type -> Type). MonadIO m => Ptr () -> m Word32
Raw.getWindowID Ptr ()
w
            Maybe Window
Nothing         -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Word32
0
          -- timestamp will be filled in by SDL
          let rawEvent :: Event
rawEvent = Word32 -> Word32 -> Word32 -> Int32 -> Ptr () -> Ptr () -> Event
Raw.UserEvent Word32
typ Word32
0 Word32
windowID Int32
code Ptr ()
d1 Ptr ()
d2
          forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Event
eventPtr -> do
            forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Event
eventPtr Event
rawEvent
            CInt
pushResult <- forall (m :: Type -> Type). MonadIO m => Ptr Event -> m CInt
Raw.pushEvent Ptr Event
eventPtr
            case CInt
pushResult of
              CInt
1 -> forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ EventPushResult
EventPushSuccess
              CInt
0 -> forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ EventPushResult
EventPushFiltered
              CInt
_ -> Text -> EventPushResult
EventPushFailure forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: Type -> Type). MonadIO m => m Text
getError

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

    in forall (m :: Type -> Type) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 :: forall (m :: Type -> Type). MonadIO m => m ()
pumpEvents = forall (m :: Type -> Type). 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 :: forall (m :: Type -> Type).
MonadIO m =>
EventWatchCallback -> m EventWatch
addEventWatch EventWatchCallback
callback = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO 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
  forall (m :: Type -> Type).
MonadIO m =>
EventFilter -> Ptr () -> m ()
Raw.addEventWatch EventFilter
rawFilter forall a. Ptr a
nullPtr
  forall (m :: Type -> Type) a. Monad m => a -> m a
return (IO () -> EventWatch
EventWatch forall a b. (a -> b) -> a -> b
$ EventFilter -> IO ()
auxRemove EventFilter
rawFilter)
  where
    wrappedCb :: Ptr () -> Ptr Raw.Event -> IO CInt
    wrappedCb :: Ptr () -> Ptr Event -> IO CInt
wrappedCb Ptr ()
_ Ptr Event
evPtr = CInt
0 forall (f :: Type -> Type) a b. Functor f => a -> f b -> f a
<$ (EventWatchCallback
callback forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< Event -> IO Event
convertRaw forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr a -> IO a
peek Ptr Event
evPtr)

    auxRemove :: Raw.EventFilter -> IO ()
    auxRemove :: EventFilter -> IO ()
auxRemove EventFilter
rawFilter = do
      forall (m :: Type -> Type).
MonadIO m =>
EventFilter -> Ptr () -> m ()
Raw.delEventWatch EventFilter
rawFilter forall a. Ptr a
nullPtr
      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 :: forall (m :: Type -> Type). MonadIO m => EventWatch -> m ()
delEventWatch = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO 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 :: forall (m :: Type -> Type). MonadIO m => Word32 -> m (Maybe Window)
getWindowFromID Word32
windowId = do
  Ptr ()
rawWindow <- forall (m :: Type -> Type). MonadIO m => Word32 -> m (Ptr ())
Raw.getWindowFromID Word32
windowId
  forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Ptr ()
rawWindow forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Ptr () -> Window
Window Ptr ()
rawWindow