{-# OPTIONS -fspec-constr-count=5 #-}
{-# LANGUAGE Rank2Types #-}

module Brillo.Internals.Interface.Backend.Types (
  module Brillo.Internals.Interface.Backend.Types,
  module Brillo.Data.Display,
)
where

import Brillo.Data.Display
import Data.IORef


{-| 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, Brillo 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.
  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 Brillo's 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
$cshowsPrec :: Int -> Key -> ShowS
showsPrec :: Int -> Key -> ShowS
$cshow :: Key -> String
show :: Key -> String
$cshowList :: [Key] -> ShowS
showList :: [Key] -> ShowS
Show, Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
/= :: 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
$ccompare :: Key -> Key -> Ordering
compare :: Key -> Key -> Ordering
$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
>= :: Key -> Key -> Bool
$cmax :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
min :: Key -> Key -> 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
$cshowsPrec :: Int -> MouseButton -> ShowS
showsPrec :: Int -> MouseButton -> ShowS
$cshow :: MouseButton -> String
show :: MouseButton -> String
$cshowList :: [MouseButton] -> ShowS
showList :: [MouseButton] -> ShowS
Show, MouseButton -> MouseButton -> Bool
(MouseButton -> MouseButton -> Bool)
-> (MouseButton -> MouseButton -> Bool) -> Eq MouseButton
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MouseButton -> MouseButton -> Bool
== :: MouseButton -> MouseButton -> Bool
$c/= :: MouseButton -> MouseButton -> Bool
/= :: 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
$ccompare :: MouseButton -> MouseButton -> Ordering
compare :: MouseButton -> MouseButton -> Ordering
$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
>= :: MouseButton -> MouseButton -> Bool
$cmax :: MouseButton -> MouseButton -> MouseButton
max :: MouseButton -> MouseButton -> MouseButton
$cmin :: MouseButton -> MouseButton -> MouseButton
min :: MouseButton -> MouseButton -> 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
$cshowsPrec :: Int -> KeyState -> ShowS
showsPrec :: Int -> KeyState -> ShowS
$cshow :: KeyState -> String
show :: KeyState -> String
$cshowList :: [KeyState] -> ShowS
showList :: [KeyState] -> ShowS
Show, KeyState -> KeyState -> Bool
(KeyState -> KeyState -> Bool)
-> (KeyState -> KeyState -> Bool) -> Eq KeyState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyState -> KeyState -> Bool
== :: KeyState -> KeyState -> Bool
$c/= :: KeyState -> KeyState -> Bool
/= :: 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
$ccompare :: KeyState -> KeyState -> Ordering
compare :: KeyState -> KeyState -> Ordering
$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
>= :: KeyState -> KeyState -> Bool
$cmax :: KeyState -> KeyState -> KeyState
max :: KeyState -> KeyState -> KeyState
$cmin :: KeyState -> KeyState -> KeyState
min :: KeyState -> KeyState -> 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
$cshowsPrec :: Int -> SpecialKey -> ShowS
showsPrec :: Int -> SpecialKey -> ShowS
$cshow :: SpecialKey -> String
show :: SpecialKey -> String
$cshowList :: [SpecialKey] -> ShowS
showList :: [SpecialKey] -> ShowS
Show, SpecialKey -> SpecialKey -> Bool
(SpecialKey -> SpecialKey -> Bool)
-> (SpecialKey -> SpecialKey -> Bool) -> Eq SpecialKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpecialKey -> SpecialKey -> Bool
== :: SpecialKey -> SpecialKey -> Bool
$c/= :: SpecialKey -> SpecialKey -> Bool
/= :: 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
$ccompare :: SpecialKey -> SpecialKey -> Ordering
compare :: SpecialKey -> SpecialKey -> Ordering
$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
>= :: SpecialKey -> SpecialKey -> Bool
$cmax :: SpecialKey -> SpecialKey -> SpecialKey
max :: SpecialKey -> SpecialKey -> SpecialKey
$cmin :: SpecialKey -> SpecialKey -> SpecialKey
min :: SpecialKey -> SpecialKey -> 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
$cshowsPrec :: Int -> Modifiers -> ShowS
showsPrec :: Int -> Modifiers -> ShowS
$cshow :: Modifiers -> String
show :: Modifiers -> String
$cshowList :: [Modifiers] -> ShowS
showList :: [Modifiers] -> ShowS
Show, Modifiers -> Modifiers -> Bool
(Modifiers -> Modifiers -> Bool)
-> (Modifiers -> Modifiers -> Bool) -> Eq Modifiers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Modifiers -> Modifiers -> Bool
== :: Modifiers -> Modifiers -> Bool
$c/= :: Modifiers -> Modifiers -> Bool
/= :: 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
$ccompare :: Modifiers -> Modifiers -> Ordering
compare :: Modifiers -> Modifiers -> Ordering
$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
>= :: Modifiers -> Modifiers -> Bool
$cmax :: Modifiers -> Modifiers -> Modifiers
max :: Modifiers -> Modifiers -> Modifiers
$cmin :: Modifiers -> Modifiers -> Modifiers
min :: Modifiers -> Modifiers -> Modifiers
Ord)