{-# OPTIONS -fspec-constr-count=5 #-}
{-# LANGUAGE Rank2Types #-}
module Graphics.Gloss.Internals.Interface.Backend.Types
        ( module Graphics.Gloss.Internals.Interface.Backend.Types
        , module Graphics.Gloss.Data.Display)
where
import Data.IORef
import Graphics.Gloss.Data.Display


-- | The functions every backend window managed backend needs to support.
--
--   The Backend module interfaces with the window manager, and handles opening
--   and closing the window, and managing key events etc.
--
--   It doesn't know anything about drawing lines or setting colors.
--   When we get a display callback, Gloss will perform OpenGL actions, and
--   the backend needs to have OpenGL in a state where it's able to accept them.
--
class Backend a where
        -- | Initialize the state used by the backend. If you don't use any state,
        -- make a Unit-like type; see the GLUT backend for an example.
        initBackendState           :: a

        -- | Perform any initialization that needs to happen before opening a window
        --   The Boolean flag indicates if any debug information should be printed to
        --   the terminal
        initializeBackend          :: IORef a -> Bool -> IO ()

        -- | Perform any deinitialization and close the backend.
        exitBackend                :: IORef a -> IO ()

        -- | Open a window with the given display mode.
        openWindow                 :: IORef a -> Display -> IO ()

        -- | Dump information about the backend to the terminal.
        dumpBackendState           :: IORef a -> IO ()

        -- | Install the display callbacks.
        installDisplayCallback     :: IORef a -> [Callback] -> IO ()

        -- | Install the window close callback.
        installWindowCloseCallback :: IORef a -> IO ()

        -- | Install the reshape callbacks.
        installReshapeCallback     :: IORef a -> [Callback] -> IO ()

        -- | Install the keymouse press callbacks.
        installKeyMouseCallback    :: IORef a -> [Callback] -> IO ()

        -- | Install the mouse motion callbacks.
        installMotionCallback      :: IORef a -> [Callback] -> IO ()

        -- | Install the idle callbacks.
        installIdleCallback        :: IORef a -> [Callback] -> IO ()

        -- | The mainloop of the backend.
        runMainLoop                :: IORef a -> IO ()

        -- | A function that signals that screen has to be updated.
        postRedisplay              :: IORef a -> IO ()

        -- | Function that returns (width,height) of the window in pixels.
        getWindowDimensions        :: IORef a -> IO (Int,Int)

        -- | Function that returns (width,height) of a fullscreen window in pixels.
        getScreenSize              :: IORef a -> IO (Int,Int)

        -- | Function that reports the time elapsed since the application started.
        --   (in seconds)
        elapsedTime                :: IORef a -> IO Double

        -- | Function that puts the current thread to sleep for 'n' seconds.
        sleep                      :: IORef a -> Double -> IO ()


-- The callbacks should work for all backends. We pass a reference to the
-- backend state so that the callbacks have access to the class dictionary and
-- can thus call the appropriate backend functions.

-- | Display callback has no arguments.
type DisplayCallback
        = forall a . Backend a => IORef a -> IO ()

-- | Arguments: KeyType, Key Up \/ Down, Ctrl \/ Alt \/ Shift pressed, latest mouse location.
type KeyboardMouseCallback
        = forall a . Backend a => IORef a -> Key -> KeyState -> Modifiers -> (Int,Int) -> IO ()

-- | Arguments: (PosX,PosY) in pixels.
type MotionCallback
        = forall a . Backend a => IORef a -> (Int,Int) -> IO ()

-- | No arguments.
type IdleCallback
        = forall a . Backend a => IORef a -> IO ()

-- | Arguments: (Width,Height) in pixels.
type ReshapeCallback
        = forall a . Backend a => IORef a -> (Int,Int) -> IO ()


-------------------------------------------------------------------------------
data Callback
        = Display  DisplayCallback
        | KeyMouse KeyboardMouseCallback
        | Idle     IdleCallback
        | Motion   MotionCallback
        | Reshape  ReshapeCallback


-- | Check if this is an `Idle` callback.
isIdleCallback :: Callback -> Bool
isIdleCallback :: Callback -> Bool
isIdleCallback Callback
cc
 = case Callback
cc of
        Idle IdleCallback
_  -> Bool
True
        Callback
_       -> Bool
False


-------------------------------------------------------------------------------
-- This is Glosses view of mouse and keyboard events.
-- The actual events provided by the backends are converted to this form
-- by the backend module.

data Key
        = Char        Char
        | SpecialKey  SpecialKey
        | MouseButton MouseButton
        deriving (Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
(Int -> Key -> ShowS)
-> (Key -> String) -> ([Key] -> ShowS) -> Show Key
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Key] -> ShowS
$cshowList :: [Key] -> ShowS
show :: Key -> String
$cshow :: Key -> String
showsPrec :: Int -> Key -> ShowS
$cshowsPrec :: Int -> Key -> ShowS
Show, Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: Key -> Key -> Bool
Eq, Eq Key
Eq Key
-> (Key -> Key -> Ordering)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Key)
-> (Key -> Key -> Key)
-> Ord Key
Key -> Key -> Bool
Key -> Key -> Ordering
Key -> Key -> Key
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 :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmax :: Key -> Key -> Key
>= :: Key -> Key -> Bool
$c>= :: Key -> Key -> Bool
> :: Key -> Key -> Bool
$c> :: Key -> Key -> Bool
<= :: Key -> Key -> Bool
$c<= :: Key -> Key -> Bool
< :: Key -> Key -> Bool
$c< :: Key -> Key -> Bool
compare :: Key -> Key -> Ordering
$ccompare :: Key -> Key -> Ordering
$cp1Ord :: Eq Key
Ord)

data MouseButton
        = LeftButton
        | MiddleButton
        | RightButton
        | WheelUp
        | WheelDown
        | AdditionalButton Int
        deriving (Int -> MouseButton -> ShowS
[MouseButton] -> ShowS
MouseButton -> String
(Int -> MouseButton -> ShowS)
-> (MouseButton -> String)
-> ([MouseButton] -> ShowS)
-> Show MouseButton
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MouseButton] -> ShowS
$cshowList :: [MouseButton] -> ShowS
show :: MouseButton -> String
$cshow :: MouseButton -> String
showsPrec :: Int -> MouseButton -> ShowS
$cshowsPrec :: Int -> MouseButton -> ShowS
Show, MouseButton -> MouseButton -> Bool
(MouseButton -> MouseButton -> Bool)
-> (MouseButton -> MouseButton -> Bool) -> Eq MouseButton
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MouseButton -> MouseButton -> Bool
$c/= :: MouseButton -> MouseButton -> Bool
== :: MouseButton -> MouseButton -> Bool
$c== :: MouseButton -> MouseButton -> Bool
Eq, Eq MouseButton
Eq MouseButton
-> (MouseButton -> MouseButton -> Ordering)
-> (MouseButton -> MouseButton -> Bool)
-> (MouseButton -> MouseButton -> Bool)
-> (MouseButton -> MouseButton -> Bool)
-> (MouseButton -> MouseButton -> Bool)
-> (MouseButton -> MouseButton -> MouseButton)
-> (MouseButton -> MouseButton -> MouseButton)
-> Ord MouseButton
MouseButton -> MouseButton -> Bool
MouseButton -> MouseButton -> Ordering
MouseButton -> MouseButton -> MouseButton
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 :: MouseButton -> MouseButton -> MouseButton
$cmin :: MouseButton -> MouseButton -> MouseButton
max :: MouseButton -> MouseButton -> MouseButton
$cmax :: MouseButton -> MouseButton -> MouseButton
>= :: MouseButton -> MouseButton -> Bool
$c>= :: MouseButton -> MouseButton -> Bool
> :: MouseButton -> MouseButton -> Bool
$c> :: MouseButton -> MouseButton -> Bool
<= :: MouseButton -> MouseButton -> Bool
$c<= :: MouseButton -> MouseButton -> Bool
< :: MouseButton -> MouseButton -> Bool
$c< :: MouseButton -> MouseButton -> Bool
compare :: MouseButton -> MouseButton -> Ordering
$ccompare :: MouseButton -> MouseButton -> Ordering
$cp1Ord :: Eq MouseButton
Ord)

data KeyState
        = Down
        | Up
        deriving (Int -> KeyState -> ShowS
[KeyState] -> ShowS
KeyState -> String
(Int -> KeyState -> ShowS)
-> (KeyState -> String) -> ([KeyState] -> ShowS) -> Show KeyState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyState] -> ShowS
$cshowList :: [KeyState] -> ShowS
show :: KeyState -> String
$cshow :: KeyState -> String
showsPrec :: Int -> KeyState -> ShowS
$cshowsPrec :: Int -> KeyState -> ShowS
Show, KeyState -> KeyState -> Bool
(KeyState -> KeyState -> Bool)
-> (KeyState -> KeyState -> Bool) -> Eq KeyState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyState -> KeyState -> Bool
$c/= :: KeyState -> KeyState -> Bool
== :: KeyState -> KeyState -> Bool
$c== :: KeyState -> KeyState -> Bool
Eq, Eq KeyState
Eq KeyState
-> (KeyState -> KeyState -> Ordering)
-> (KeyState -> KeyState -> Bool)
-> (KeyState -> KeyState -> Bool)
-> (KeyState -> KeyState -> Bool)
-> (KeyState -> KeyState -> Bool)
-> (KeyState -> KeyState -> KeyState)
-> (KeyState -> KeyState -> KeyState)
-> Ord KeyState
KeyState -> KeyState -> Bool
KeyState -> KeyState -> Ordering
KeyState -> KeyState -> KeyState
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 :: KeyState -> KeyState -> KeyState
$cmin :: KeyState -> KeyState -> KeyState
max :: KeyState -> KeyState -> KeyState
$cmax :: KeyState -> KeyState -> KeyState
>= :: KeyState -> KeyState -> Bool
$c>= :: KeyState -> KeyState -> Bool
> :: KeyState -> KeyState -> Bool
$c> :: KeyState -> KeyState -> Bool
<= :: KeyState -> KeyState -> Bool
$c<= :: KeyState -> KeyState -> Bool
< :: KeyState -> KeyState -> Bool
$c< :: KeyState -> KeyState -> Bool
compare :: KeyState -> KeyState -> Ordering
$ccompare :: KeyState -> KeyState -> Ordering
$cp1Ord :: Eq KeyState
Ord)

data SpecialKey
        = KeyUnknown
        | KeySpace
        | KeyEsc
        | KeyF1
        | KeyF2
        | KeyF3
        | KeyF4
        | KeyF5
        | KeyF6
        | KeyF7
        | KeyF8
        | KeyF9
        | KeyF10
        | KeyF11
        | KeyF12
        | KeyF13
        | KeyF14
        | KeyF15
        | KeyF16
        | KeyF17
        | KeyF18
        | KeyF19
        | KeyF20
        | KeyF21
        | KeyF22
        | KeyF23
        | KeyF24
        | KeyF25
        | KeyUp
        | KeyDown
        | KeyLeft
        | KeyRight
        | KeyTab
        | KeyEnter
        | KeyBackspace
        | KeyInsert
        | KeyNumLock
        | KeyBegin
        | KeyDelete
        | KeyPageUp
        | KeyPageDown
        | KeyHome
        | KeyEnd
        | KeyShiftL
        | KeyShiftR
        | KeyCtrlL
        | KeyCtrlR
        | KeyAltL
        | KeyAltR
        | KeyPad0
        | KeyPad1
        | KeyPad2
        | KeyPad3
        | KeyPad4
        | KeyPad5
        | KeyPad6
        | KeyPad7
        | KeyPad8
        | KeyPad9
        | KeyPadDivide
        | KeyPadMultiply
        | KeyPadSubtract
        | KeyPadAdd
        | KeyPadDecimal
        | KeyPadEqual
        | KeyPadEnter
        deriving (Int -> SpecialKey -> ShowS
[SpecialKey] -> ShowS
SpecialKey -> String
(Int -> SpecialKey -> ShowS)
-> (SpecialKey -> String)
-> ([SpecialKey] -> ShowS)
-> Show SpecialKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpecialKey] -> ShowS
$cshowList :: [SpecialKey] -> ShowS
show :: SpecialKey -> String
$cshow :: SpecialKey -> String
showsPrec :: Int -> SpecialKey -> ShowS
$cshowsPrec :: Int -> SpecialKey -> ShowS
Show, SpecialKey -> SpecialKey -> Bool
(SpecialKey -> SpecialKey -> Bool)
-> (SpecialKey -> SpecialKey -> Bool) -> Eq SpecialKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpecialKey -> SpecialKey -> Bool
$c/= :: SpecialKey -> SpecialKey -> Bool
== :: SpecialKey -> SpecialKey -> Bool
$c== :: SpecialKey -> SpecialKey -> Bool
Eq, Eq SpecialKey
Eq SpecialKey
-> (SpecialKey -> SpecialKey -> Ordering)
-> (SpecialKey -> SpecialKey -> Bool)
-> (SpecialKey -> SpecialKey -> Bool)
-> (SpecialKey -> SpecialKey -> Bool)
-> (SpecialKey -> SpecialKey -> Bool)
-> (SpecialKey -> SpecialKey -> SpecialKey)
-> (SpecialKey -> SpecialKey -> SpecialKey)
-> Ord SpecialKey
SpecialKey -> SpecialKey -> Bool
SpecialKey -> SpecialKey -> Ordering
SpecialKey -> SpecialKey -> SpecialKey
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 :: SpecialKey -> SpecialKey -> SpecialKey
$cmin :: SpecialKey -> SpecialKey -> SpecialKey
max :: SpecialKey -> SpecialKey -> SpecialKey
$cmax :: SpecialKey -> SpecialKey -> SpecialKey
>= :: SpecialKey -> SpecialKey -> Bool
$c>= :: SpecialKey -> SpecialKey -> Bool
> :: SpecialKey -> SpecialKey -> Bool
$c> :: SpecialKey -> SpecialKey -> Bool
<= :: SpecialKey -> SpecialKey -> Bool
$c<= :: SpecialKey -> SpecialKey -> Bool
< :: SpecialKey -> SpecialKey -> Bool
$c< :: SpecialKey -> SpecialKey -> Bool
compare :: SpecialKey -> SpecialKey -> Ordering
$ccompare :: SpecialKey -> SpecialKey -> Ordering
$cp1Ord :: Eq SpecialKey
Ord)


data Modifiers
        = Modifiers
        { Modifiers -> KeyState
shift :: KeyState
        , Modifiers -> KeyState
ctrl  :: KeyState
        , Modifiers -> KeyState
alt   :: KeyState }
        deriving (Int -> Modifiers -> ShowS
[Modifiers] -> ShowS
Modifiers -> String
(Int -> Modifiers -> ShowS)
-> (Modifiers -> String)
-> ([Modifiers] -> ShowS)
-> Show Modifiers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Modifiers] -> ShowS
$cshowList :: [Modifiers] -> ShowS
show :: Modifiers -> String
$cshow :: Modifiers -> String
showsPrec :: Int -> Modifiers -> ShowS
$cshowsPrec :: Int -> Modifiers -> ShowS
Show, Modifiers -> Modifiers -> Bool
(Modifiers -> Modifiers -> Bool)
-> (Modifiers -> Modifiers -> Bool) -> Eq Modifiers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Modifiers -> Modifiers -> Bool
$c/= :: Modifiers -> Modifiers -> Bool
== :: Modifiers -> Modifiers -> Bool
$c== :: Modifiers -> Modifiers -> Bool
Eq, Eq Modifiers
Eq Modifiers
-> (Modifiers -> Modifiers -> Ordering)
-> (Modifiers -> Modifiers -> Bool)
-> (Modifiers -> Modifiers -> Bool)
-> (Modifiers -> Modifiers -> Bool)
-> (Modifiers -> Modifiers -> Bool)
-> (Modifiers -> Modifiers -> Modifiers)
-> (Modifiers -> Modifiers -> Modifiers)
-> Ord Modifiers
Modifiers -> Modifiers -> Bool
Modifiers -> Modifiers -> Ordering
Modifiers -> Modifiers -> Modifiers
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 :: Modifiers -> Modifiers -> Modifiers
$cmin :: Modifiers -> Modifiers -> Modifiers
max :: Modifiers -> Modifiers -> Modifiers
$cmax :: Modifiers -> Modifiers -> Modifiers
>= :: Modifiers -> Modifiers -> Bool
$c>= :: Modifiers -> Modifiers -> Bool
> :: Modifiers -> Modifiers -> Bool
$c> :: Modifiers -> Modifiers -> Bool
<= :: Modifiers -> Modifiers -> Bool
$c<= :: Modifiers -> Modifiers -> Bool
< :: Modifiers -> Modifiers -> Bool
$c< :: Modifiers -> Modifiers -> Bool
compare :: Modifiers -> Modifiers -> Ordering
$ccompare :: Modifiers -> Modifiers -> Ordering
$cp1Ord :: Eq Modifiers
Ord)